征战者二觉补丁:Delphi如何制造透明背景窗体

来源:百度文库 编辑:杭州交通信息网 时间:2024/05/01 10:04:11
在Delphi中制作的程序都十分的“丑陋”,利用第三方插件可以让界面美观一点,但是如何制造透明窗体?一般背景是淡灰色的,在Form的Color属性上可以选择背景颜色,可是都不是透明色的。Form1.AlphaBlend:=true;
Form1.AlphaBlendValue:=0;可以透明,但是把所有的全部设置为透明了…… 求教

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.

用TransformColor属性就可以调透明色
然后把Transform属性设为true
这样你指定的颜色就能成透明的

利用API可以实现,我以前见过这种程序,不过很久以前了忘了怎么弄了!

同意2楼的说法。