delphi 异形窗体
2024-05-31 19:41:36
DELPHI 透明窗体
心血来潮想用delphi做透明窗体，要知道我虽然搞了N年编程，但什么也没编写成。惭愧的很，以前VCVB之类的光搞懂它们的控件就让我很费劲，没办法不懂英文。还是学DELPHI吧，听说是聪明程序员学习的语言。在网络上搜索下透明窗体，哈文章不少，视频也有，但都太繁琐，关键看不懂，总算有个简单的，实验成功了哈哈。博下来以后用：unit StyleForm;interfaceusesWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, StdCtrls;
constWS_EX_LAYERED = $80000;AC_SRC_OVER = $0;AC_SRC_ALPHA = $1;AC_SRC_NO_PREMULT_ALPHA = $1;AC_SRC_NO_ALPHA = $2;AC_DST_NO_PREMULT_ALPHA = $10;AC_DST_NO_ALPHA = $20;LWA_COLORKEY = $1;LWA_ALPHA = $2;ULW_COLORKEY = $1;ULW_ALPHA = $2;ULW_OPAQUE = $4;typeTForm1 = class(TForm)Button1: TButton;procedure FormCreate(Sender: TObject);private{ Private declarations }public{ Public declarations }end;function SetLayeredWindowAttributes(hwnd:HWND; crKey:Longint; bAlpha:byte; dwFlags:longint ):longint; stdcall; external user32;varForm1: TForm1;implementation{$R *.dfm}procedure TForm1.FormCreate(Sender: TObject);
var I:longint;beginForm1.Brush.Color:=rgb(0,0,0);I:=getWindowLong(Handle, GWL_EXSTYLE);I:= I Or WS_EX_LAYERED;SetWindowLong (handle, GWL_EXSTYLE, I);SetLayeredWindowAttributes (handle, 0, 123, LWA_ALPHA);
end;end.后来又在网络上搜索了下发现有个更简单的：只要在窗体的创建中加入form1.AlphaBlend:=true;form1.AlphaBlendValue:=100;就行了。真晕！View Code
DELPHI 异形窗体
一定有很多人看到过一些奇形怪状的窗体，例如一些屏幕精灵。其实实现起来非常容易，做到三点就好啦。下面我使用Delphi做了一个VCL控件（TBmpShape），你只需要指定一幅图片就可以将窗体变成你的图片的形状。1。准备一幅位图图片，一定要BMP格式的2。将VCL控件放在你的窗体（FORM）上，注意不能是其他的容器，设置PICTURE属性，指定制作好的图片。3。设置图片的背景颜色，必须是你的图片的背景颜色准确值4。在本窗体的FormCreate事件中写一行代码BmpShape1.Apply;做到上面四点就可以了，编译运行你的窗体，是不是不一样啊。下面是具体的代码，不是太长吧。unit BmpShape;
{2002/08/22 by ultrared
根据BMP文件创建窗口
注意：
1. BMP文件最左上的一个点颜色作为背景色
2. BmpShape控件只能用在TForm容器上
3. BMP文件可以是256色或者24位色
4。大块背景色必须和背景色绝对相等才能获得正常效果
}
interfaceuses
Forms,Windows, Messages, SysUtils, Classes, Controls, ExtCtrls,Graphics;type
TBmpShape = class(TImage)
private
{ Private declarations }
BackColor:TColor;//背景颜色
FColorDither:boolean;//是否允许背景颜色有一定的抖动
function GetRegion:HRGN;//前景图片的区域
procedure setColorDither(cd:Boolean);
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner:TComponent);override;
procedure Apply;//使用效果
published
{ Published declarations }
property Dither:Boolean read FColorDither write setColorDither;
end;procedure Register;implementationprocedure Register;
begin
RegisterComponents('Samples', );
end;procedure TBmpShape.setColorDither(cd:Boolean);
begin
if cd<>FColorDither then
FColorDither:=cd;
end;constructor TBmpShape.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
BackColor:=RGB(0,0,0);
FColorDither:=FALSE;
end;//核心子程序，获得BMP图片的前景区域
function TBmpShape.GetRegion:HRGN;
var
i,j:integer;
rgn1,rgn2:HRGN;
StartY:integer;
r,g,b,r1,g1,b1:BYTE;
cc:TColor;
begin
if Picture.Bitmap<>nil then
begin
BackColor:=Picture.Bitmap.Canvas.Pixels[0,0];
rgn1:=CreateRectRgn(0,0,0,0);
for i:=0 to Picture.Bitmap.Width-1 do
begin
StartY:=-1;
for j:=0 to Picture.Bitmap.Height-1 do
begin
cc:=Picture.Bitmap.Canvas.Pixels[i,j];
if FColorDither then
begin
//允许和背景有一定的色差
r:=(cc and $FF0000) shr 16;
g:=(cc and $FF00) shr 8;
b:=cc and $FF;
r1:=(BackColor and $FF0000) shr 16;
g1:=(BackColor and $FF00) shr 8;
b1:=BackColor and $FF;
if (abs(r-r1)<10) and (abs(g-g1)<10) and (abs(b-b1)<10) then
begin
if (StartY>=0) and (j>=StartY) then
begin
rgn2:=CreateRectRgn(i,StartY,i+1,j);
CombineRgn(rgn1,rgn1,rgn2,RGN_OR);
StartY:=-1;
end;
end
else
begin
if Starty<0 then
StartY:=j
else if j=(Picture.Bitmap.Height-1) then //最下面一个点
begin
rgn2:=CreateRectRgn(i,StartY,i+1,j);
CombineRgn(rgn1,rgn1,rgn2,RGN_OR);
end;
end;
end
else //不允许色差
begin
if cc=BackColor then
begin
if (StartY>=0) and (j>=StartY) then
begin
rgn2:=CreateRectRgn(i,StartY,i+1,j);
CombineRgn(rgn1,rgn1,rgn2,RGN_OR);
StartY:=-1;
end;
end
else
begin
if Starty<0 then
StartY:=j
else if j=(Picture.Bitmap.Height-1) then //最下面一个点
begin
rgn2:=CreateRectRgn(i,StartY,i+1,j);
CombineRgn(rgn1,rgn1,rgn2,RGN_OR);
end;
end;
end;
end;
end;
result:=rgn1;
end
else
result:=0;
end;procedure TBmpShape.Apply;
begin
if Parent is TForm then
begin
Left:=0;
Top:=0;
Width:=Picture.Bitmap.Width;
Height:=Picture.Bitmap.Height;
with (Parent as Tform) do
begin
BorderStyle:=bsNone;
Width:=Self.Width;
Height:=Self.Height;
end;
SetWindowRgn(Parent.Handle,GetRegion,FALSE);
end;
end;end.View Code
Delphi磁性窗口
昨天要用到磁性窗口,就是两个窗口离得近到一个距离就吸附到一起.拖动主窗口,吸附窗体一块运动.
到网上搜了一下,基本没见到可以使用的.有个东东,还是收费的.没办法自己写了一个.
用法很简单,把你的窗口都改成从这个继承即可生效.例如
typeTForm3 = class(TCustomMagnetForm)private{ Private declarations }public{ Public declarations }end;varForm3: TForm3;
不多说了,上代码
{ ******************************************************* }
{ }
{ 磁性吸附窗口 }
{ }
{ 版权所有 (C) 2011 wr960204武稀松 }
{ }
{ ******************************************************* }unit MagnetForm;interfaceusesWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, Generics.Collections;typeTCustomMagnetForm = class(TForm)private typeTMagnetFormList = TList<TCustomMagnetForm>;class var// 吸附距离
FMagnetBuffer: Integer;var// 吸附子窗口容器
FMagnetClientList: TMagnetFormList;// 相对主窗口的位置
FMagnetPosOffset: TPoint;// 可否随主窗口移动
FEnableMagnetMoveClient: Boolean;// 移除子窗口procedure RemoveMagnetForm(AForm: TCustomMagnetForm);// 添加子窗口procedure AddMagnetForm(AForm: TCustomMagnetForm; Value: TPoint);// 处理子窗口吸附function ProcessClient(var ServerBound, ClientBound: TRect): Boolean;// 处理主窗口吸附function ProcessServer(var ServerBound, ClientBound: TRect;AClient: TCustomMagnetForm): Boolean;// 主窗口移动procedure ProcessServerMove();protectedprocedure WMWindowPosChanging(var Message: TWMWindowPosChanging);message WM_WINDOWPOSCHANGING;procedure WMMoving(var Message: TWMMoving); message WM_MOVING;procedure WMMove(var Message: TWMMove); message WM_MOVE;procedure DoClose(var Action: TCloseAction); override;procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;publicconstructor Create(AOwner: TComponent); override;destructor Destroy; override;class property MagnetBuffer: Integer read FMagnetBuffer write FMagnetBuffer;end;implementation{ TCustomMagnetForm }constructor TCustomMagnetForm.Create(AOwner: TComponent);
begininherited Create(AOwner);FMagnetClientList := TMagnetFormList.Create;
end;destructor TCustomMagnetForm.Destroy;
beginif Self <> Application.MainForm thenRemoveMagnetForm(Self);FMagnetClientList.Free;inherited Destroy;
end;procedure TCustomMagnetForm.DoClose(var Action: TCloseAction);
begininherited DoClose(Action);if Self <> Application.MainForm thenRemoveMagnetForm(Self);
end;function TCustomMagnetForm.ProcessClient(var ServerBound,ClientBound: TRect): Boolean;
varlspace, rspace, tspace, bspace: Integer;
beginResult := False;lspace := ABS(ClientBound.Right - ServerBound.Left);rspace := ABS(ClientBound.Left - ServerBound.Right);tspace := ABS(ClientBound.Bottom - ServerBound.Top);bspace := ABS(ClientBound.Top - ServerBound.Bottom);FMagnetPosOffset := Point(ClientBound.Left - ServerBound.Left,ClientBound.Top - ServerBound.Top);if (ClientBound.Bottom > ServerBound.Top) and(ClientBound.Top < ServerBound.Bottom) thenbeginif lspace < rspace thenbeginif lspace < FMagnetBuffer thenbeginAddMagnetForm(Self, Point(ClientBound.Left - ServerBound.Left,ClientBound.Top - ServerBound.Top));OffsetRect(ClientBound, (ServerBound.Left - ClientBound.Right), 0);Result := True;end;endelsebeginif rspace < FMagnetBuffer thenbeginAddMagnetForm(Self, Point(ClientBound.Left - ServerBound.Left,ClientBound.Top - ServerBound.Top));OffsetRect(ClientBound, (ServerBound.Right - ClientBound.Left), 0);Result := True;end;end;end;if (ClientBound.Right > ServerBound.Left) and(ClientBound.Left < ServerBound.Right) thenbeginif tspace < bspace thenbeginif tspace < FMagnetBuffer thenbeginAddMagnetForm(Self, Point(ClientBound.Left - ServerBound.Left,ClientBound.Top - ServerBound.Top));OffsetRect(ClientBound, 0, ServerBound.Top - ClientBound.Bottom);Result := True;end;endelsebeginif bspace < FMagnetBuffer thenbeginAddMagnetForm(Self, Point(ClientBound.Left - ServerBound.Left,ClientBound.Top - ServerBound.Top));OffsetRect(ClientBound, 0, ServerBound.Bottom - ClientBound.Top);Result := True;end;end;end;
end;function TCustomMagnetForm.ProcessServer(var ServerBound, ClientBound: TRect;AClient: TCustomMagnetForm): Boolean;
varlspace, rspace, tspace, bspace: Integer;
beginResult := False;lspace := ABS(ClientBound.Right - ServerBound.Left);rspace := ABS(ClientBound.Left - ServerBound.Right);tspace := ABS(ClientBound.Bottom - ServerBound.Top);bspace := ABS(ClientBound.Top - ServerBound.Bottom);FMagnetPosOffset := Point(ClientBound.Left - ServerBound.Left,ClientBound.Top - ServerBound.Top);if (ClientBound.Bottom > ServerBound.Top) and(ClientBound.Top < ServerBound.Bottom) thenbeginif lspace < rspace thenbeginif lspace < FMagnetBuffer thenbeginAddMagnetForm(AClient, Point(ClientBound.Left - ServerBound.Left,ClientBound.Top - ServerBound.Top));OffsetRect(ServerBound, -(ServerBound.Left - ClientBound.Right), 0);Result := True;end;endelsebeginif rspace < FMagnetBuffer thenbeginAddMagnetForm(AClient, Point(ClientBound.Left - ServerBound.Left,ClientBound.Top - ServerBound.Top));OffsetRect(ServerBound, -(ServerBound.Right - ClientBound.Left), 0);Result := True;end;end;end;if (ClientBound.Right > ServerBound.Left) and(ClientBound.Left < ServerBound.Right) thenbeginif tspace < bspace thenbeginif tspace < FMagnetBuffer thenbeginAddMagnetForm(AClient, Point(ClientBound.Left - ServerBound.Left,ClientBound.Top - ServerBound.Top));OffsetRect(ServerBound, 0, -(ServerBound.Top - ClientBound.Bottom));Result := True;end;endelsebeginif bspace < FMagnetBuffer thenbeginAddMagnetForm(AClient, Point(ClientBound.Left - ServerBound.Left,ClientBound.Top - ServerBound.Top));OffsetRect(ServerBound, 0, -(ServerBound.Bottom - ClientBound.Top));Result := True;end;end;end;
end;procedure TCustomMagnetForm.ProcessServerMove;
vari: Integer;p: TPoint;
beginInherited;if Self = Application.MainForm thenbeginif FMagnetClientList <> nil thenfor i := 0 to FMagnetClientList.Count - 1 dobeginif FMagnetClientList[i].FEnableMagnetMoveClient thenbeginp := FMagnetClientList[i].FMagnetPosOffset;FMagnetClientList[i].SetBounds(Left + p.X, Top + p.Y,FMagnetClientList[i].Width, FMagnetClientList[i].Height);end;end;end;
end;procedure TCustomMagnetForm.AddMagnetForm(AForm: TCustomMagnetForm;Value: TPoint);
varIndex: Integer;
beginif (Application.MainForm <> nil) and(Application.MainForm is TCustomMagnetForm) thenwith TCustomMagnetForm(Application.MainForm) doif FMagnetClientList <> nil thenbeginAForm.FMagnetPosOffset := Value;Index := FMagnetClientList.IndexOf(AForm);if Index < 0 thenbeginIndex := FMagnetClientList.Add(AForm);end;end;
end;procedure TCustomMagnetForm.RemoveMagnetForm(AForm: TCustomMagnetForm);
beginAForm.FEnableMagnetMoveClient := False;if (Application.MainForm <> nil) and(Application.MainForm is TCustomMagnetForm) thenwith TCustomMagnetForm(Application.MainForm) doif FMagnetClientList <> nil thenbeginif FMagnetClientList.IndexOf(AForm) >= 0 thenbeginFMagnetClientList.Remove(AForm);end;end;
end;procedure TCustomMagnetForm.WMMove(var Message: TWMMove);
beginProcessServerMove;
end;procedure TCustomMagnetForm.WMMoving(var Message: TWMMoving);
beginProcessServerMove;
end;procedure TCustomMagnetForm.WMSysCommand(var Message: TWMSysCommand);procedure SetAllClientEnableMove();vari: Integer;beginInherited;if Self = Application.MainForm thenbeginif FMagnetClientList <> nil thenfor i := 0 to FMagnetClientList.Count - 1 dobeginFMagnetClientList[i].FEnableMagnetMoveClient := True;end;end;end;beginInherited;if (Message.CmdType and SC_MOVE) = SC_MOVE thenbeginSetAllClientEnableMove();end;
end;procedure TCustomMagnetForm.WMWindowPosChanging(var Message: TWMWindowPosChanging);
varServerBound, ClientBound: TRect;lspace, rspace, tspace, bspace: Integer;MainForm: TCustomMagnetForm;oBound: TRect;i: Integer;
begininherited;if (Message.WindowPos^.flags and SWP_NOMOVE) = SWP_NOMOVE thenbeginExit;end;if (Application.MainForm = nil) or(not(Application.MainForm is TCustomMagnetForm)) thenExit;if (Application.MainForm = Self) thenbeginServerBound := Rect(Message.WindowPos^.X, Message.WindowPos^.Y,Message.WindowPos^.X + Message.WindowPos^.cx, Message.WindowPos^.Y +Message.WindowPos^.cy);for i := 0 to Screen.FormCount - 1 dobeginif (Screen.Forms[i] <> Self) and (Screen.Forms[i] is TCustomMagnetForm)and ((FMagnetClientList.IndexOf(TCustomMagnetForm(Screen.Forms[i])) < 0)or (not TCustomMagnetForm(Screen.Forms[i]).FEnableMagnetMoveClient)) thenbeginClientBound := Screen.Forms[i].BoundsRect;TCustomMagnetForm(Screen.Forms[i]).FEnableMagnetMoveClient := False;if ProcessServer(ServerBound, ClientBound,TCustomMagnetForm(Screen.Forms[i])) thenbeginMessage.WindowPos^.X := ServerBound.Left;Message.WindowPos^.Y := ServerBound.Top;Message.WindowPos^.cx := ServerBound.Right - ServerBound.Left;Message.WindowPos^.cy := ServerBound.Bottom - ServerBound.Top;break;end;end;end;endelsebeginMainForm := TCustomMagnetForm(Application.MainForm);MainForm.RemoveMagnetForm(Self);ServerBound := Application.MainForm.BoundsRect;ClientBound := Rect(Message.WindowPos^.X, Message.WindowPos^.Y,Message.WindowPos^.X + Message.WindowPos^.cx, Message.WindowPos^.Y +Message.WindowPos^.cy);ProcessClient(ServerBound, ClientBound);Message.WindowPos^.X := ClientBound.Left;Message.WindowPos^.Y := ClientBound.Top;Message.WindowPos^.cx := ClientBound.Right - ClientBound.Left;Message.WindowPos^.cy := ClientBound.Bottom - ClientBound.Top;FEnableMagnetMoveClient := True;end;
end;initializationTCustomMagnetForm.FMagnetBuffer := 10;finalizationend.View Code
绘制圆角矩形的窗体
制作圆角矩形的窗体：procedure TPortForm.FormCreate(Sender: Tobject); var hr :thandle; begin hr:=createroundrectrgn(0,0,width,height,20,20); setwindowrgn(handle,hr,true); end;如果不要窗体外框，则使用：01.procedure TPortForm.FormCreate(Sender: Tobject); 02.var hr :thandle; 03.begin 04.hr:=createroundrectrgn(1,1,width-2,height-2,20,20); 05.setwindowrgn(handle,hr,true); 06.end;由于第一段代码做出来的窗口，圆角部份会没有边框，使用下面的代码做出边框：01.procedure TForm1.FormPaint(Sender: TObject); 02.var 03.DC: HDC; 04.Pen: HPen; 05.OldPen: HPen; 06.OldBrush: HBrush; 07.begin 08.DC := GetWindowDC(Handle); 09.Pen := CreatePen(PS_SOLID, 1, clGray); 10.OldPen := SelectObject(DC, Pen); //载入自定义的画笔,保存原画笔 11.OldBrush := SelectObject(DC, GetStockObject(NULL_BRUSH));//载入空画刷,保存原画刷 12.RoundRect(DC, 0, 0, Width-1, Height-1,21,21); //画边框 13.SelectObject(DC,OldBrush);//载入原画刷 14.SelectObject(DC,OldPen); // 载入原画笔 15.DeleteObject(Pen); 16.ReleaseDC(Handle, DC); 17.end;
View Code
Delphi做异型窗体PNG透明
unit UnitYXForm; interface usesWindows, Forms, Classes, Graphics; //从文件加载PNG procedure YXForm_FromFile(AForm : TForm; AFileName : String); //从资源加载PNG procedure YXForm_FromResource(AForm : TForm; ResName : String; ResType : PWideChar; Instance : HINST = 0); //从图像对象加载 procedure YXForm_FromGraphic(AForm : TForm; AGraphic : TGraphic); implementation procedure YXForm_FromFile(AForm : TForm; AFileName : String); varwic : TWICImage; beginwic := TWICImage.Create;wic.LoadFromFile(AFileName);YXForm_FromGraphic(AForm, wic);wic.Free; end; procedure YXForm_FromResource(AForm : TForm; ResName : String;ResType : PWideChar; Instance : HINST); varwic : TWICImage;r : TResourceStream; beginif Instance = 0 thenInstance := HInstance;r := TResourceStream.Create(Instance, ResName, ResType);wic := TWICImage.Create;wic.LoadFromStream(r);YXForm_FromGraphic(AForm, wic);wic.Free;r.Free; end; procedure YXForm_FromGraphic(AForm : TForm; AGraphic : TGraphic); varptDst, ptSrc: TPoint;Size: TSize;BlendFunction: TBlendFunction;bmp : TBitmap; beginbmp := TBitmap.Create;bmp.Assign(AGraphic);ptDst := Point(AForm.Left, AForm.Top);ptSrc := Point(0, 0);Size.cx := AGraphic.Width;Size.cy := AGraphic.Height;BlendFunction.BlendOp := AC_SRC_OVER;BlendFunction.BlendFlags := 0;BlendFunction.SourceConstantAlpha := $FF; // 透明度BlendFunction.AlphaFormat := AC_SRC_ALPHA;SetWindowLong(AForm.Handle, GWL_EXSTYLE, GetWindowLong(AForm.Handle,GWL_EXSTYLE) or WS_EX_LAYERED);UpdateLayeredWindow(AForm.Handle,AForm.Canvas.Handle,@ptDst,@Size,bmp.Canvas.Handle,@ptSrc,0,@BlendFunction,ULW_ALPHA);bmp.Free(); end; end. 想要用的时候很简单,举个例子:ff := TForm2.Create(Self);YXForm_FromFile(ff, 'c:\a.png');ff.Show; 实现动画也很容易.只要不停地YXForm_FromFile(ff, 'c:\a.png');调用一套动作PNG就可以了.
View Code
delphi 半透明窗体类
{*******************************************************************************半透明窗体控件版本：1.0功能说明 :1.支持颜色和图片半透明2.暂时只能手动指定背景图片3.可调透明度(0..255)4.可控制是否可移动窗体联系方式： Email: mdejtoz@163.com
*******************************************************************************}
unit uTranslucentForm;interfaceusesWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, ActiveX, Gdiplus,GdipUtil,StdCtrls, XPMan, ExtCtrls;
typeTTranslucentForm = class(TComponent)privateFAlpha : 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);publicconstructor Create(AOwner: TComponent); override;destructor Destroy; override;publishedproperty AlphaValue : Byte read FAlpha write SetAlpha;property Background : TFileName read FBackground write SetBackground;property Move : Boolean read FMove write SetMove;end;procedure Register;
implementationprocedure Register;
beginRegisterComponents('MyControl', [TTranslucentForm]);
end;
{ TTranslucentForm }constructor TTranslucentForm.Create(AOwner: TComponent);
begininherited 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;
beginif not (csDesigning in ComponentState) thenbeginif Assigned(FOverlayerForm) thenbeginFOverlayerForm.WindowProc := FOldOverlayWndProc;FreeAndNil(FOverlayerForm);end;end; inherited Destroy;
end;procedure TTranslucentForm.InitOverForm;
beginFOverlayerForm := TForm.Create(nil);with FOverlayerForm dobeginLeft := 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 dobeginLeft := 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);
beginwith FOverlayerForm dobeginLeft := 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);
beginif Assigned(FOverlayerForm) and FMove thenbeginReleaseCapture;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);
beginif (Msg.Msg = WM_MOVE) and FMove thenbeginif Assigned(FOverlayerForm) thenbeginFOwner.Left := FOverlayerForm.Left ;FOwner.Top := FOverlayerForm.Top ;end;end;if Msg.Msg = CM_ACTIVATE thenbeginif FFirstTime then FOwner.Show;FFirstTime := False;end;FOldOverlayWndProc(Msg);
end;procedure TTranslucentForm.RenderForm(TransparentValue: Byte);
varzsize: 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;
beginif (csDesigning in ComponentState) then Exit;if not FileExists(FBackground) then //如果背景图不存在beginFGpBitmap := 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);endelsebegintry//读取背景图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);exceptExit;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);tryGPGraph.DrawImage(FGpBitmap, 0, 0, FGpBitmap.Width, FGpBitmap.Height);zsize.cx := FGpBitmap.Width;zsize.cy := FGpBitmap.Height;zpoint := Point(0, 0);with zbf dobeginBlendOp := 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);finallyGPGraph.ReleaseHDC(m_hdcMemory);ReleaseDC(0, hdcScreen);DeleteObject(hBMP);DeleteDC(m_hdcMemory);GPGraph.Free;end;FreeAndNil(FGpBitmap);
end;procedure TTranslucentForm.SetAlpha(const value : Byte);
beginFAlpha := Value;RenderForm(FAlpha);
end;procedure TTranslucentForm.SetBackground(const value: TFileName);
beginFBackground := value;RenderForm(FAlpha);
end;procedure TTranslucentForm.SetMove(const value: Boolean);
beginFMove := value;
end;end.View Code
delphi 窗体全透明，但窗体上的控件不透明
//窗体全透明，但窗体上的控件不透明 procedure TForm1.Button1Click(Sender: TObject); Var frmRegion, tempRegion: HRGN; i: Integer; Arect: TRect; Begin frmRegion := 0; For I:= 0 To ControlCount - 1 Do Begin aRect := Controls[i].BoundsRect; OffsetRect( aRect, clientorigin.x - left, clientorigin.y - top ); tempRegion := CreateRectRgnIndirect( aRect ); If frmRegion = 0 Then frmRegion := tempRegion Else Begin CombineRgn( frmRegion, frmRegion, tempRegion, RGN_OR ); DeleteObject( tempRegion ); End; End; tempregion := CreateRectRgn( 0, 0, Width, GetSystemMetrics( SM_CYCAPTION )+ GetSystemMetrics( SM_CYSIZEFRAME )+ GetSystemMetrics( SM_CYMENU ) * Ord(Menu <> Nil)); CombineRgn( frmRegion, frmRegion, tempRegion, RGN_OR ); DeleteObject( tempRegion ); SetWindowRgn( handle, frmRegion, true ); End;
View Code
delphi 透明
procedure TForm1.FormCreate(Sender: TObject);varrgn:HRGN;beginSelf.Color := clRed;BeginPath(Canvas.Handle);SetBkMode(Canvas.Handle,TRANSPARENT );Canvas.Font.Name:='宋体';Canvas.Font.Size:=100;Canvas.TextOut(20,20,'My Baby?');EndPath(Canvas.Handle);rgn:= PathToRegion(Canvas.Handle);SetWindowRgn(Handle,rgn,true);end;<pre class="delphi" name="code">unit Unit1;interfaceusesWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs;typeTForm1 = class(TForm)procedure FormCreate(Sender: TObject);private{ Private declarations }public{ Public declarations }end;varForm1: TForm1;const {An array of points for the star region} RgnPoints:array[1..10] of TPoint= ((x:203;y:22),(x:157;y:168),(x:3;y:168),(x:128;y:257), (x:81;y:402),(x:203;y:334),(x:325;y:422),(x:278;y:257), (x:402;y:168),(x:249;y:168));//确定顶点 LinePoints:array[1..11] of Tpoint= ((x:199;y:0),(x:154;y:146),(x:2;y:146),(x:127;y:235), (x:79;y:377),(x:198;y:308),(x:320;Y:396),(x:272;y:234), (x:396;y:146),(x:244;y:146),(x:199;Y:0));implementation{$R *.dfm}procedure TForm1.FormCreate(Sender: TObject);
var Rgn:HRGN;
beginSetwindowpos(Form1.Handle,HWND_TOPMOST,Form1.Left,form1.Top,Form1.Width,Form1.Height,0);Rgn:=CreatepolygonRgn(Rgnpoints,High(RgnPoints),ALTERNATE);SetWindowRgn(Handle,rgn,True);Form1.color:=clgreen;
end;end.</pre><pre class="delphi" name="code">以下是用Api实现透明窗体的代码,最的一次第三个参数为透明的程度,范围为0~255,0为完全透明,255完全不透明.具体可参考SetWindowLong(self.Handle,GWL_EXSTYLE,GetWindowLong(Self.Handle,GWL_EXSTYLE) xor $80000);SetLayeredWindowAttributes(Self.Handle,0,100,LWA_ALPHA);
</pre><br>
<br>
<pre></pre>
<pre></pre>View Code
半透明窗体
unit xDrawForm;interfaceuses Windows, Messages, SysUtils, Classes, Controls, Forms, Menus,Graphics,GDIPOBJ,GDIPAPI,GDIPUTIL;typeTwwGDIImage = classpublicn_Pos_X : Integer;n_Pos_Y : Integer;n_Width : Integer;n_Height : Integer;GPImageNormal : TGPImage;procedure CreateImageNormal(wsFileName: WideString;nPosX,nPosY,nW,nH:Integer);end;TwwGDIButton = class(TwwGDIImage)publicGPImageHot : TGPImage;GPImageDown : TGPImage;end;TwwCanvas = class(TObject)privatem_hdcMemory: HDC;hdcScreen: HDC;hBMP: HBITMAP;m_Blend: BLENDFUNCTION;// 事件
FGPGraph: TGPGraphics;FOnDrawImage: TNotifyEvent;procedure BeginDraw(); // 绘图前置工作procedure EndDraw(Handle:THandle); // 绘图收尾工作publicsizeWindow: SIZE;ptSrc: TPOINT;n_Handle : THandle;procedure RePaint(h:THandle);procedure InitCanvas(nx,ny:Integer);procedure wwDrawImage(wwGDIImage :TwwGDIImage);property GPGraph: TGPGraphics read FGPGraph write FGPGraph;property OnDrawImage: TNotifyEvent read FOnDrawImage write FOnDrawImage;end;implementation{ TwwCanvas }procedure TwwCanvas.BeginDraw;
begin// 获取桌面屏幕设备hdcScreen := GetDC(0);// 创建一个与指定设备兼容的内存设备上下文环境（DC）m_hdcMemory := CreateCompatibleDC(hdcScreen);// 创建与指定的设备环境相关的设备兼容的位图hBMP := CreateCompatibleBitmap(hdcScreen, sizeWindow.cx, sizeWindow.cy );// 选择一对象到指定的设备上下文环境中,该新对象替换先前的相同类型的对象
SelectObject(m_hdcMemory, hBMP);// 创建画布GPGraph := TGPGraphics.Create(m_hdcMemory);
end;procedure TwwCanvas.wwDrawImage(wwGDIImage: TwwGDIImage);
beginGPGraph.DrawImage(wwGDIImage.GPImageNormal,wwGDIImage.n_Pos_X,wwGDIImage.n_Pos_Y,wwGDIImage.n_Width,wwGDIImage.n_Height)
end;procedure TwwCanvas.EndDraw(Handle:THandle);
begin// 设置窗体风格SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED);// 执行透明混合UpdateLayeredWindow(Handle, hdcScreen, nil,@sizeWindow, m_hdcMemory, @ptSrc, 0, @m_Blend, ULW_ALPHA);// 设置窗体位置SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);// 各种释放就对了.. 不然画起来会糊
GPGraph.ReleaseHDC(m_hdcMemory);ReleaseDC(0, hdcScreen);hdcScreen := 0;DeleteObject(hBMP);DeleteDC(m_hdcMemory);m_hdcMemory := 0;GPGraph.Free;
end;procedure TwwCanvas.RePaint(h:THandle);
beginif Assigned(FOnDrawImage) thenbeginBeginDraw();FOnDrawImage(Self);EndDraw(h);end;
end;procedure TwwCanvas.InitCanvas(nx, ny: Integer);
beginm_Blend.BlendOp := AC_SRC_OVER; // the only BlendOp defined in Windows 2000m_Blend.BlendFlags := 0; // Must be zerom_Blend.AlphaFormat := AC_SRC_ALPHA; //This flag is set when the bitmap has an Alpha channelm_Blend.SourceConstantAlpha := 255;sizeWindow.cx := nx;sizeWindow.cy := ny;ptSrc := Point(0,0);
end;{ TwwGDIImage }procedure TwwGDIImage.CreateImageNormal(wsFileName: WideString;nPosX,nPosY,nW,nH:Integer);
beginSelf.GPImageNormal := TGPImage.Create(wsFileName);Self.n_Pos_X := nPosX;Self.n_Pos_Y := nPosY;Self.n_Width := nW;Self.n_Height:= nH;
end;end.unit uMainForm;interfaceusesWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, GDIPOBJ,GDIPAPI,GDIPUTIL;typeTForm1 = class(TForm)procedure FormCreate(Sender: TObject);procedure FormShow(Sender: TObject);private{ Private declarations }publicprocedure DrawImage(Sender: TObject);{ Public declarations }end;varForm1: TForm1;implementation
uses xDrawForm;
varwwCanvas : TwwCanvas = nil;img_BackGround: TwwGDIImage= nil; // 背景图
// img_ProgressBar1: TwwGDIImage= nil; // 上滚动条
// img_ProgressBar2: TwwGDIImage= nil; // 下滚动条
// img_Lighting: TwwGDIImage= nil; // 闪光点{$R *.dfm}procedure TForm1.DrawImage(Sender: TObject);
beginTwwCanvas(Sender).wwDrawImage(img_BackGround);
end;procedure TForm1.FormCreate(Sender: TObject);
beginDoubleBuffered := True;BorderStyle := bsNone;wwCanvas := TwwCanvas.Create();wwCanvas.InitCanvas(872,690);wwCanvas.OnDrawImage := Self.DrawImage;img_BackGround := TwwGDIImage.Create();img_BackGround.CreateImageNormal('BackGround.png',0,0,872,690);end;procedure TForm1.FormShow(Sender: TObject);
beginwwCanvas.RePaint(Self.Handle);
end;end.View Code
窗体嵌入桌面
窗体最前面的显示方式:
procedure Createparams(var params: TCreateParams);override;
procedure Createparams(var params: TCreateParams);
begininherited CreateParams(Params);with params dobeginStyle:=WS_POPUP;//ExStyle := WS_EX_TOPMOST OR WS_EX_ACCEPTFILES or WS_DLGFRAME;ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST or WS_EX_NOACTIVATE or WS_EX_WINDOWEDGE;WndParent :=GetDesktopwindow; //确实可以使用之为最前面end;
end;窗体贴在桌面的方法:
procedure WndProc(var Message: TMessage); override;
procedure FormCreate(Sender: TObject);
begin
windows.SetParent(Self.Handle,FindWindowEx(FindWindow('Progman',nil),0,'shelldll_defview',nil));//将窗口设置为屏幕的子窗口
//以下显示桌面
keybd_event(91,0,0,0);
keybd_event(77,0,0,0);
keybd_event(77,0,KEYEVENTF_KEYUP,0);
keybd_event(91,0,KEYEVENTF_KEYUP,0);
end;
procedure WndProc(var Message: TMessage);
beginif not ( (Message.Msg=WM_SYSCOMMAND) AND (Message.WParam=SC_MINIMIZE) )theninherited WndProc(Message);//最小化无效
end;View Code
使用PNG实现半透明的窗体
Delphi中标准控件是不支持png图片的，据说从Window2000后增加gdiplus.dll库处理更多的gdi图像，其中包括png。关键的几个apiGdipCreateBitmapFromFile()，从文件载入图像（不单只Bitmap）GdipCreateBitmapFromStreamICM()，从流中入图像GdipCreateHBITMAPFromBitmap()，获取图像的位图GdipDisposeImage()，释放图像资源开始直接调用GdipCreateBitmapFromFile没有成功，返回18的错误查一下资料这个错误是：“GdiplusNotInitialized”看来必须的初始化gdiplus。网上找到一套“TGPBitmap”相关的组件，封装了gdiplus的调用。可以参考其中的代码。png载入后，再取出其位图。特别注意，这个位图是32位的。包括了R、G、B、Alpha四个色值，其中Alpha就是透明度。UpdateLayeredWindow()API函数可以支持Alpha风格。如何从流中载入？如何将VCL的流处理成IStream？看看代码吧。效果图：cj7.JPG
准备一张Png图片，编写rc文件，然后加入到工程中。
代码：
CJ7.rc
Png_Cj7 PNG "CJ7.png"CJ7Unit.pas
unit CJ7Unit;
interface
usesWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs;
typeTFormCJ7 = class(TForm)procedure FormCreate(Sender: TObject);procedure FormMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);private{ Private declarations }public{ Public declarations }end;
varFormCJ7: TFormCJ7;
implementation
{$R *.dfm}
uses ActiveX;
typeDebugEventLevel = (DebugEventLevelFatal,DebugEventLevelWarning);TDebugEventLevel = DebugEventLevel;DebugEventProc = procedure(level: DebugEventLevel; message: PChar); stdcall;GdiplusStartupInput = packed recordGdiplusVersion: Cardinal;DebugEventCallback: DebugEventProc;SuppressBackgroundThread: BOOL;SuppressExternalCodecs: BOOL;end; TGdiplusStartupInput = GdiplusStartupInput;PGdiplusStartupInput = ^TGdiplusStartupInput;NotificationHookProc = function(out token: ULONG): Integer; stdcall;NotificationUnhookProc = procedure(token: ULONG); stdcall;GdiplusStartupOutput = packed recordNotificationHook : NotificationHookProc;NotificationUnhook: NotificationUnhookProc;end;TGdiplusStartupOutput = GdiplusStartupOutput;PGdiplusStartupOutput = ^TGdiplusStartupOutput;
function GdipCreateHBITMAPFromBitmap(bitmap: THandle; out hbmReturn: HBITMAP;background: Longword): Integer; stdcall; external 'gdiplus.dll';
function GdipCreateBitmapFromFile(filename: PWChar; out bitmap: THandle): Integer;stdcall; external 'gdiplus.dll';
function GdipCreateBitmapFromStreamICM(stream: ISTREAM;out bitmap: THandle): Integer; stdcall; external 'gdiplus.dll';
function GdipDisposeImage(image: THandle): Integer; stdcall;stdcall; external 'gdiplus.dll';
function GdiplusStartup(out token: ULONG; input: PGdiplusStartupInput;output: PGdiplusStartupOutput): Integer; stdcall; external 'gdiplus.dll';
procedure GdiplusShutdown(token: ULONG); stdcall; external 'gdiplus.dll';
procedure TFormCJ7.FormCreate(Sender: TObject);
varvGdip: THandle;vBitmap: HBITMAP;vOldBitmap: HBITMAP;vPoint1, vPoint2: TPoint;vSize: TSize;vBlendFunction: TBlendFunction;vDC: HDC;vBitmapInfo: TBitmapInfoHeader;vDIBSection: TDIBSection;vBuffer: PChar;vStream: IStream;vGlobal: THandle;
beginSetWindowLong(Handle, GWL_EXSTYLE,GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED);///Begin 从资源中载入 with TResourceStream.Create(HInstance, 'Png_Cj7', 'PNG') do tryvGlobal := GlobalAlloc(GHND, Size);if vGlobal = 0 then Exit;vBuffer := GlobalLock(vGlobal);if not Assigned(vBuffer) then Exit;tryRead(vBuffer^, Size);finallyGlobalUnlock(vGdip);end;if CreateStreamOnHGlobal(vGlobal, False, vStream) <> S_OK then Exit;if GdipCreateBitmapFromStreamICM(vStream, vGdip) <> S_OK then Exit;GlobalFree(vGlobal);finallyFree;end;///End 从资源中载入 if GdipCreateHBITMAPFromBitmap(vGdip, vBitmap, 0) <> S_OK then Exit;vBitmapInfo.biSize := SizeOf(vBitmapInfo);GetObject(vBitmap, SizeOf(vDIBSection), @vDIBSection);vPoint1 := Point(Left, Top);vPoint2 := Point(0, 0);vSize.cx := vDIBSection.dsBm.bmWidth;vSize.cy := vDIBSection.dsBm.bmHeight;vBlendFunction.BlendOp := AC_SRC_OVER;vBlendFunction.BlendFlags := 0;vBlendFunction.SourceConstantAlpha := $FF; // 透明度vBlendFunction.AlphaFormat := AC_SRC_ALPHA; //同上vDC := CreateCompatibleDC(Canvas.Handle);vOldBitmap := SelectObject(vDC, vBitmap);UpdateLayeredWindow(Handle, Canvas.Handle,@vPoint1, @vSize, vDC, @vPoint2, 0, @vBlendFunction, ULW_ALPHA);SelectObject(vDC, vOldBitmap);DeleteDC(vDC);DeleteObject(vBitmap);GdipDisposeImage(vGdip);
end;
procedure TFormCJ7.FormMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
beginReleaseCapture;Perform(WM_SYSCOMMAND, SC_MOVE or HTCLIENT, 0); // 拖动
end;
varvStartupInput: TGDIPlusStartupInput;vToken: ULONG;
initializationvStartupInput.DebugEventCallback := nil;vStartupInput.SuppressBackgroundThread := False;vStartupInput.SuppressExternalCodecs := False;vStartupInput.GdiplusVersion := 1;GdiplusStartup(vToken, @vStartupInput, nil);
finalizationGdiplusShutdown(vToken);
end.
想了解gdi+的资料可以参考：
http://msdn2.microsoft.com/en-us/library/ms533798.aspxView Code
异形窗体
unit Unit1;interfaceusesWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, StdCtrls, u360StyleButton,ActiveX;typeTForm1 = class(TForm)Btn360Style1: TBtn360Style;Button1: TButton;procedure FormCreate(Sender: TObject);private{ Private declarations }public{ Public declarations }end;varForm1: TForm1;implementationuses GDIPAPI, GDIPOBJ;
{$R *.dfm}
{$R '.\SkinRes.RES'}
procedure TForm1.FormCreate(Sender: TObject);
varvGdip: THandle;vBitmap: HBITMAP;vOldBitmap: HBITMAP;vPoint1, vPoint2: TPoint;vSize: TSize;vBlendFunction: TBlendFunction;vDC: HDC;vBitmapInfo: TBitmapInfoHeader;vDIBSection: TDIBSection;vBuffer: PChar;vStream: IStream;vGlobal: HGLOBAL;
begin{SetWindowLong(Handle,GWL_EXSTYLE,getwindowlong(handle,GWL_EXSTYLE)and (not WS_EX_APPWINDOW)or WS_EX_TOOLWINDOWor WS_EX_LAYERED);//从资源中载入with TResourceStream.Create(HInstance, 'Module_briangle_png', 'skin') do tryvGlobal := GlobalAlloc(GHND, Size);if vGlobal = 0 then Exit;vBuffer := GlobalLock(vGlobal);if not Assigned(vBuffer) then Exit;tryRead(vBuffer^, Size);finallyGlobalUnlock(vGdip);end;if CreateStreamOnHGlobal(vGlobal, False, vStream) <> S_OK thenExit;if GdipCreateBitmapFromStreamICM(vStream,pointer( vGdip)) <> OK then Exit;GlobalFree(vGlobal);finallyFree;end;if GdipCreateHBITMAPFromBitmap(pointer(vGdip), vBitmap, 0) <> OK thenExit;vBitmapInfo.biSize := SizeOf(vBitmapInfo);GetObject(vBitmap, SizeOf(vDIBSection), @vDIBSection);vPoint1 := Point(Left, Top);vPoint2 := Point(0, 0);vSize.cx := vDIBSection.dsBm.bmWidth;vSize.cy := vDIBSection.dsBm.bmHeight;vBlendFunction.BlendOp := AC_SRC_OVER;vBlendFunction.BlendFlags := 0;vBlendFunction.SourceConstantAlpha := $FF; // 透明度vBlendFunction.AlphaFormat := AC_SRC_ALPHA; //同上vDC := CreateCompatibleDC(Canvas.Handle);vOldBitmap := SelectObject(vDC, vBitmap);UpdateLayeredWindow(Handle, Canvas.Handle,@vPoint1, @vSize, vDC, @vPoint2, 0, @vBlendFunction, ULW_ALPHA);SelectObject(vDC, vOldBitmap);DeleteDC(vDC);DeleteObject(vBitmap);GdipDisposeImage(Pointer(vGdip));}
end;end.View Code
异形窗口 png
{*******************************************************}
{ }
{ 异形窗口 }
{ }
{ 2009.12.4 王 锐 }
{ }
{*******************************************************}unit UnitYXForm;interface
usesWindows, Forms, Classes, Graphics;//从文件加载PNG
procedure YXForm_FromFile(AForm : TForm; AFileName : String);
//从资源加载PNG
procedure YXForm_FromResource(AForm : TForm; ResName : String; ResType : PWideChar; Instance : HINST = 0);
//从图像对象加载
procedure YXForm_FromGraphic(AForm : TForm; AGraphic : TGraphic);implementationprocedure YXForm_FromFile(AForm : TForm; AFileName : String);
varwic : TWICImage;
beginwic := TWICImage.Create;wic.LoadFromFile(AFileName);YXForm_FromGraphic(AForm, wic);wic.Free;
end;procedure YXForm_FromResource(AForm : TForm; ResName : String;ResType : PWideChar; Instance : HINST);
varwic : TWICImage;r : TResourceStream;
beginif Instance = 0 thenInstance := HInstance;r := TResourceStream.Create(Instance, ResName, ResType);wic := TWICImage.Create;wic.LoadFromStream(r);YXForm_FromGraphic(AForm, wic);wic.Free;r.Free;
end;procedure YXForm_FromGraphic(AForm : TForm; AGraphic : TGraphic);
varptDst, ptSrc: TPoint;Size: TSize;BlendFunction: TBlendFunction;bmp : TBitmap;
beginbmp := TBitmap.Create;bmp.Assign(AGraphic);ptDst := Point(AForm.Left, AForm.Top);ptSrc := Point(0, 0);Size.cx := AGraphic.Width;Size.cy := AGraphic.Height;BlendFunction.BlendOp := AC_SRC_OVER;BlendFunction.BlendFlags := 0;BlendFunction.SourceConstantAlpha := $FF; // 透明度BlendFunction.AlphaFormat := AC_SRC_ALPHA;SetWindowLong(AForm.Handle, GWL_EXSTYLE, GetWindowLong(AForm.Handle,GWL_EXSTYLE) or WS_EX_LAYERED);UpdateLayeredWindow(AForm.Handle,AForm.Canvas.Handle,@ptDst,@Size,bmp.Canvas.Handle,@ptSrc,0,@BlendFunction,ULW_ALPHA);bmp.Free();
end;end.View Code
转载于:https://www.cnblogs.com/blogpro/p/11346105.html
delphi 异形窗体相关推荐
- delphi(XE2)实现图片异形窗体，支持摆放控件
网上有较多使用UpdateLayeredWindow函数实现美化的图片异形窗体的代码,一般使用此场景时,对软件界面要求较高.但是实现了图片窗体后,在窗体中摆放不了其他控件,导致这个功能很鸡肋.为解决此 ...
- C#WinForm制作异形窗体/控件
制作异形窗体或控件的思路一般都是想办法生成一个region,然后设置给指定的窗口或控件.生成region的方法有很多,最常用的就是从一幅图片生成,把该图片中的透明色部分"抠"掉,剩 ...
- linux qt绘框,Qt绘制异形窗体
异形窗体即不规则窗体,一般采用png图片,一般绘制异形窗体分两步: 1.设置遮罩区 2.绘制图片 使用png图片的透明部分作为遮罩区,然后绘制图片,这样我们就看到一个只绘制了非透明部分的图形,废话少说 ...
- 使用duilib开发半透明异形窗体程序（附源码和demo）
转载请说明原出处,谢谢~~:http://blog.csdn.net/zhuhongshu/article/details/43532791 半透明异形窗体的功能在之前维护的老版本的duilib里面已 ...
- 完美实现无毛边异形窗体
实现效果图1: 实现效果图2: 实现效果图3: 异形窗体的实现思路 (一).采用UpdateLayeredWindow这个api函数基于Png图alpha通道绘制异形窗口 优点: ...
- duilib设置透明窗口_使用duilib开发半透明异形窗体程序（补充）
距离上一篇半透明窗体的博客,已经过去一年,现在这几天又对Duilib进行了一些优化和修复.这次我把CRenderEngine的渲染函数都改成了基于Gdi+的.根据我的测试,因为Duilib所需的都是最 ...
- 异形窗体WinFrom
第一步:创建WinFrom窗体 第二部:属性:AutoScaleMode:Dpi 第三步:BackColor:White 第四步:FormBorderStyle:None 第五步:Transparen ...
- WinForm 无毛边异形窗体
WinForm 无毛边异形窗体 using System; using System.Collections.Generic; using System.ComponentModel; using S ...
- DSAPI显示PNG异形窗体
使用DSAPI实现PNG异形窗体,注意,该窗体为层样式窗体,以PNG或32位带透明通道的图像合成到屏幕,此方法不会触发窗体的重绘,故原窗体(包括其子控件)均不会显示,如果需要更新画面,需要重新用代码等 ...
最新文章
- Notepad2 一个很不错的记事本
- hdu 5277(最大团问题)
- when is One Order gt_plan_exets filled
- 平舌音 Z C S 的正确发音方式
- 【干货分享】流程DEMO-补打卡
- 华为5G又一黑科技曝光！中国通信技术将全球领先
- 52 - 算法 - LeetCode 28 - 实现 strStr() -kmp
- CREO：CREO软件之零件【模型】、【分析】、【注释】、【工具】【视图】、【柔性建模】、【编辑】、【造型】、【渲染】的简介及其使用方法之详细攻略
- Excel修改默认分页符（仅仅在特定行后可插入分页符）
- win10用linux命令关机,Win10使用PowerShell命令让局域网电脑重启关机操作
- java三三剩二五五剩三,大年三十彩灯悬，彩灯齐明光灿灿，三三数时能数尽，五五数时剩一盏，七七数时刚刚好，八八数时还缺三，...
- Android 如何优雅的实现控件计时功能
- Java面试题交流群
- CF 71A [字符串统计]
- 在计算机中 IDF MDF是什么意思?
- IOS 一些小知识点整理
- 怎么授权接入米多客小程序客服系统？
- ViT论文逐段精读【论文精读】-跟李沐学AI
- js的定时器 实现页面展示的异步刷新 多线程同步实现方式 附进度条js代码
- 分立器件和集成电路不都是芯片吗？它们有什么区别？
热门文章
- 一级造价工程师（安装）- 计量笔记 - 第五章第一节给排水、采暖、燃气工程
- 基于基姆拉尔森公式的日期到星期的转换推导
- 小明用计算机计算,小明计算器(科学计算软件)V4.2 最新免费版
- 30岁、高中学历、零基础、能不能自学Python？要多久？学到什么程度可以找到工作？
- 项目测试 | Pycharm+Pyqt5+Qt Designer6+Eric7实现逻辑与界面分离
- Ada-GNN: Adapting to Local Patterns for Improving Graph Neural Networks
- 底层公链展望之Nervos篇
- 天籁obd接口针脚定义_汽车标准OBDⅡ(自诊断接头)针脚定义
- Liunx网络配置三大方法：网卡配置文件、nmtui、nmcli
- “公共电子围栏”在京落地，有望进一步规范共享单车用户出行行为