Delphi如何制造透明背景窗体

Posted 2023-05-07

在Delphi中制作的程序都十分的“丑陋”，利用第三方插件可以让界面美观一点，但是如何制造透明窗体？一般背景是淡灰色的，在Form的Color属性上可以选择背景颜色，可是都不是透明色的。Form1.AlphaBlend:=true;
Form1.AlphaBlendValue:=0;可以透明，但是把所有的全部设置为透明了…… 求教

用TransformColor属性就可以调透明色
然后把Transform属性设为true
这样你指定的颜色就能成透明的 参考技术A 　　unit uTranslucentForm;
　　
　　interface
　　uses
　　Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
　　Dialogs, ActiveX, Gdiplus,GdipUtil,StdCtrls, XPMan, ExtCtrls;
　　type
　　TTranslucentForm = class(TComponent)
　　private
　　FAlpha : Byte;
　　FOverlayerForm : TForm;
　　FBackground : TFileName;
　　FOwner : TForm;
　　FFirstTime : Boolean;
　　FMouseEvent : TMouseEvent;
　　FOldOnActive : TNotifyEvent;
　　FOldOverlayWndProc : TWndMethod;
　　FMove : Boolean;
　　procedure SetAlpha(const value : Byte) ;
　　procedure SetBackground(const value : TFileName);
　　procedure RenderForm(TransparentValue: Byte);
　　procedure OverlayWndMethod(var Msg : TMessage);
　　procedure InitOverForm;
　　procedure OnOwnerMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
　　procedure OnOwnerActive(Sender : TObject);
　　procedure SetMove(const value : Boolean);
　　public
　　constructor Create(AOwner: TComponent); override;
　　destructor Destroy; override;
　　published
　　property AlphaValue : Byte read FAlpha write SetAlpha;
　　property Background : TFileName read FBackground write SetBackground;
　　property Move : Boolean read FMove write SetMove;
　　end;
　　procedure Register;
　　implementation
　　
　　procedure Register;
　　begin
　　RegisterComponents('MyControl', [TTranslucentForm]);
　　end;
　　 TTranslucentForm
　　
　　constructor TTranslucentForm.Create(AOwner: TComponent);
　　begin
　　inherited Create(AOwner);
　　FOwner := TForm(AOwner);
　　FAlpha := 255 ;
　　FMove := True;
　　if (csDesigning in ComponentState) then Exit;
　　InitOverForm;
　　SetWindowLong(FOverlayerForm.Handle,GWL_EXSTYLE,GetWindowLong(FOverlayerForm.Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
　　RenderForm(FAlpha);
　　end;
　　
　　destructor TTranslucentForm.Destroy;
　　begin
　　if not (csDesigning in ComponentState) then
　　begin
　　if Assigned(FOverlayerForm) then
　　begin
　　FOverlayerForm.WindowProc := FOldOverlayWndProc;
　　FreeAndNil(FOverlayerForm);
　　end;
　　end;
　　inherited Destroy;
　　end;
　　
　　procedure TTranslucentForm.InitOverForm;
　　begin
　　FOverlayerForm := TForm.Create(nil);
　　with FOverlayerForm do
　　begin
　　Left := FOwner.Left ;
　　Top := FOwner.Top;
　　Width := FOwner.Width ;
　　Height := FOwner.Height ;
　　BorderStyle := bsNone;
　　color := FOwner.Color;
　　Show;
　　FOldOverlayWndProc := FOverlayerForm.WindowProc;
　　FOverlayerForm.WindowProc := OverlayWndMethod;
　　end;
　　with FOwner do
　　begin
　　Left := FOwner.Left ;
　　Top := FOwner.Top ;
　　Color := clOlive;
　　TransparentColorValue := clOlive;
　　TransparentColor := True;
　　BorderStyle := bsNone;
　　FMouseEvent := OnMouseDown;
　　FOldOnActive := OnActivate;
　　OnActivate := OnOwnerActive;
　　OnMouseDown := OnOwnerMouseDown;
　　Show;
　　end;
　　FFirstTime := True;
　　RenderForm(FAlpha);
　　end;
　　
　　procedure TTranslucentForm.OnOwnerActive(Sender: TObject);
　　begin
　　with FOverlayerForm do
　　begin
　　Left := FOwner.Left ;
　　Top := FOwner.Top ;
　　Width := FOwner.Width ;
　　Height := FOwner.Height ;
　　end;
　　RenderForm(FAlpha);
　　if Assigned(FOldOnActive) then FOldOnActive(FOwner);
　　end;
　　
　　procedure TTranslucentForm.OnOwnerMouseDown(Sender: TObject;
　　Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
　　begin
　　if Assigned(FOverlayerForm) and FMove then
　　begin
　　ReleaseCapture;
　　SendMessage(FOverlayerForm.Handle,WM_SYSCOMMAND, SC_MOVE or HTCAPTION, 0);
　　FOwner.Show;
　　if Assigned(FMouseEvent) then FMouseEvent(Sender,Button,Shift, X, Y);
　　end;
　　end;
　　
　　procedure TTranslucentForm.OverlayWndMethod(var Msg: TMessage);
　　begin
　　if (Msg.Msg = WM_MOVE) and FMove then
　　begin
　　if Assigned(FOverlayerForm) then
　　begin
　　FOwner.Left := FOverlayerForm.Left ;
　　FOwner.Top := FOverlayerForm.Top ;
　　end;
　　end;
　　if Msg.Msg = CM_ACTIVATE then
　　begin
　　if FFirstTime then FOwner.Show;
　　FFirstTime := False;
　　end;
　　FOldOverlayWndProc(Msg);
　　end;
　　
　　procedure TTranslucentForm.RenderForm(TransparentValue: Byte);
　　var
　　zsize: TSize;
　　zpoint: TPoint;
　　zbf: TBlendFunction;
　　TopLeft: TPoint;
　　WR: TRect;
　　GPGraph: TGPGraphics;
　　m_hdcMemory: HDC;
　　hdcScreen: HDC;
　　hBMP: HBITMAP;
　　FGpBitmap , FBmp: TGpBitmap;
　　gd : TGpGraphics;
　　gBrush : TGpSolidBrush;
　　begin
　　if (csDesigning in ComponentState) then Exit;
　　if not FileExists(FBackground) then //如果背景图不存在
　　begin
　　FGpBitmap := TGpBitmap.Create(FOwner.Width,FOwner.Height);
　　gd := TGpGraphics.Create(FGpBitmap);
　　//颜色画刷
　　gBrush := TGpSolidBrush.Create(ARGBFromTColor(FOverlayerForm.Color));
　　//填充
　　gd.FillRectangle(gBrush,GpRect(0,0,FGpBitmap.Width,FGpBitmap.Height));
　　FreeAndNil(gd);
　　FreeAndNil(gBrush);
　　end
　　else
　　begin
　　try
　　//读取背景图
　　FBmp := TGpBitmap.Create(FBackground);
　　FGpBitmap := TGpBitmap.Create(FOwner.Width,FOwner.Height);
　　gd := TGpGraphics.Create(FGpBitmap);
　　gd.DrawImage(FBmp,GpRect(0,0,FGpBitmap.Width,FGpBitmap.Height),0,0,FBmp.Width,FBmp.Height,utPixel);
　　FreeAndNil(gd);
　　FreeAndNil(FBmp);
　　except
　　Exit;
　　end;
　　end;
　　hdcScreen := GetDC(0);
　　m_hdcMemory := CreateCompatibleDC(hdcScreen);
　　hBMP := CreateCompatibleBitmap(hdcScreen, FGpBitmap.Width, FGpBitmap.Height);
　　SelectObject(m_hdcMemory, hBMP);
　　GPGraph := TGPGraphics.Create(m_hdcMemory);
　　try
　　GPGraph.DrawImage(FGpBitmap, 0, 0, FGpBitmap.Width, FGpBitmap.Height);
　　zsize.cx := FGpBitmap.Width;
　　zsize.cy := FGpBitmap.Height;
　　zpoint := Point(0, 0);
　　with zbf do
　　begin
　　BlendOp := AC_SRC_OVER;
　　BlendFlags := 0;
　　SourceConstantAlpha := TransparentValue;
　　AlphaFormat := AC_SRC_ALPHA;
　　end;
　　
　　GetWindowRect(FOverlayerForm.Handle, WR);
　　TopLeft := WR.TopLeft;
　　UpdateLayeredWindow(FOverlayerForm.Handle, 0, @TopLeft, @zsize, GPGraph.GetHDC, @zpoint,0, @zbf, 2);
　　finally
　　GPGraph.ReleaseHDC(m_hdcMemory);
　　ReleaseDC(0, hdcScreen);
　　DeleteObject(hBMP);
　　DeleteDC(m_hdcMemory);
　　GPGraph.Free;
　　end;
　　FreeAndNil(FGpBitmap);
　　end;
　　
　　procedure TTranslucentForm.SetAlpha(const value : Byte);
　　begin
　　FAlpha := Value;
　　RenderForm(FAlpha);
　　end;
　　
　　procedure TTranslucentForm.SetBackground(const value: TFileName);
　　begin
　　FBackground := value;
　　RenderForm(FAlpha);
　　end;
　　
　　procedure TTranslucentForm.SetMove(const value: Boolean);
　　begin
　　FMove := value;
　　end;
　　
　　end. 参考技术B 同意2楼的说法。 参考技术C 利用API可以实现，我以前见过这种程序，不过很久以前了忘了怎么弄了！

delphi 如何做成带有阴影的窗体，像QQ那样

我按照这里试了一下
http://blog.csdn.net/k1988/article/details/4336759
发现有个提到的问题没解决
“在白背景下慢慢溶入背景看起来很好，可是在深色背景下看起来四周的阴影看起来就没有渐变效果了，只是一圈灰边。”
求高手解答，谢谢。

参考技术A Edit1的onkeydown里写ifKey=VK_RETURNthenbeginform1.close;form2.Show;end;