Delphi如何制造透明背景窗体
在Delphi中制作的程序都十分的“丑陋”,利用第三方插件可以让界面美观一点,但是如何制造透明窗体?一般背景是淡灰色的,在Form的Color属性上可以选择背景颜色,可是...
在Delphi中制作的程序都十分的“丑陋”,利用第三方插件可以让界面美观一点,但是如何制造透明窗体?一般背景是淡灰色的,在Form的Color属性上可以选择背景颜色,可是都不是透明色的。Form1.AlphaBlend:=true;
Form1.AlphaBlendValue:=0;可以透明,但是把所有的全部设置为透明了…… 求教 展开
Form1.AlphaBlendValue:=0;可以透明,但是把所有的全部设置为透明了…… 求教 展开
4个回答
博思aippt
2024-07-20 广告
2024-07-20 广告
博思AIPPT是基于ai制作PPT的智能在线工具,它提供了4种AI制作PPT的方式,包括AI生成大纲、AI直接生成PPT、文本生成PPT、AI提炼文档生成PPT,一站式集成多种AI生成PPT的方式,可满足办公用户的不同需求和使用场景。ai生...
点击进入详情页
本回答由博思aippt提供
展开全部
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.
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.
本回答被网友采纳
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
同意2楼的说法。
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
利用API可以实现,我以前见过这种程序,不过很久以前了忘了怎么弄了!
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询