带阴影的浮动窗体的实现

   昨天设计部要求在软件的浮动小窗口的四周添加上阴影，本来以为很好做，直接拿一张带阴影的图像文件贴上去了。运行 起来完全不是那么回事，在不同的背景下看起来完全不一样，因为阴影是由黑到白渐变的，在白背景下慢慢溶入背景看起来很好，可是在深色背景下看起来四周的阴影看起来就没有渐变效果了，只是一圈灰边。
  在网上搜下关于窗体阴影的解决方案，还真不多，搜到两种。第一是在http://www.codeproject.com/KB/dialog/FrameShadow.aspx这个开源网站上，一个中国哥们用C＋＋实现的仿vista阴影，主要采用UpdateLayeredWindow() 等API在窗体上画出比窗体大小更大的阴影，并且色彩等可任意调整。第二种是http://d.download.csdn.net/down/901180/yy0692下载的一个delphi源代码，是一个使用两个窗体模拟窗体阴影的例子。使用一个窗体放置普通的图片，使用另一个窗体绘制阴影，绘制阴影时直接使用编译到资源文件里的一个png图片。
  经研究，我决定使用第二种方式，原因嘛，语言合适，不用翻译。第二，使用图片方式对我来说方便，我可不想使用代码调整阴影颜色。将第二个哥们写的代码copy到我们的项目里，再将代码做一些改动：将窗体的父窗口设置为桌面、将窗体风格加上WS_EX_TOOLWINDOW、将两个窗体的显示与隐藏绑定到一起，然后大功告成。代码如下：

//背景图片单元 unit ufmSwimBack; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs,GDIPAPI, GDIPOBJ; type TfmSwimBack = class(TForm) procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormCreate(Sender: TObject); procedure CreateParams(var Params: TCreateParams); override; private m_Blend: BLENDFUNCTION; procedure SetTransparent(lpSkinFile: WideString; nTran: integer); { Private declarations } published constructor Create(AOwner: TComponent); override; { Public declarations } end; var fmSwimBack: TfmSwimBack; implementation uses uSwim; {$R *.dfm} {$R SwimBG.res} function GetWinTempPath: string; var TempDir: array[0..255] of char; begin GetTempPath(255, @TempDir); Result := strPas(TempDir); end; procedure MusicResToFile(const ResName, ResType, FileName: string); var Res: TResourceStream; Temp: string; begin Temp := GetWinTempPath; Res := TResourceStream.Create(HInstance, ResName, PChar(ResType)); Res.SaveToFile(Temp + FileName); //将资源保存为文件，即还原文件 Res.Free; end; procedure TfmSwimBack.SetTransparent(lpSkinFile: WideString; nTran: integer); var GPImage: TGPImage; GPGraph: TGPGraphics; m_Image: TGPImage; m_hdcMemory: HDC; hdcTemp: HDC; hdcScreen: HDC; hBMP: HBITMAP; sizeWindow: SIZE; dwExStyle: DWORD; rct: TRECT; ptWinPos: TPOINT; ptSrc: TPOINT; begin // Use GDI+ load image GPImage := TGPImage.Create(); m_Image := GPImage.FromFile(lpSkinFile); // Change Form size Width := m_Image.GetWidth(); Height := m_Image.GetHeight(); // Create Compatible Bitmap hdcTemp := GetDC(0); m_hdcMemory := CreateCompatibleDC(hdcTemp); hBMP := CreateCompatibleBitmap(hdcTemp, m_Image.GetWidth(), m_Image.GetHeight()); SelectObject(m_hdcMemory, hBMP); // Alpha Value if (nTran < 0) or (nTran > 100) then nTran := 100; m_Blend.SourceConstantAlpha := round(nTran * 2.55); // 1~255 hdcScreen := GetDC(0); GetWindowRect(Handle, rct); ptWinPos.X := rct.Left; ptWinPos.Y := rct.Top; GPGraph := TGPGraphics.Create(m_hdcMemory); GPGraph.DrawImage(m_Image, 0, 0, m_Image.GetWidth(), m_Image.GetHeight()); sizeWindow.cx := m_Image.GetWidth(); sizeWindow.cy := m_Image.GetHeight(); ptSrc.x := 0; ptSrc.y := 0; // Set Window style dwExStyle := GetWindowLong(Handle, GWL_EXSTYLE); if ((dwExStyle and 80000) <> $80000) then SetWindowLong(Handle, GWL_EXSTYLE, dwExStyle xor $80000); // perform the alpha blend UpdateLayeredWindow(Handle, hdcScreen, @ptWinPos, @sizeWindow, m_hdcMemory, @ptSrc, 0, @m_Blend, 2); //Release resources GPGraph.ReleaseHDC(m_hdcMemory); ReleaseDC(0, hdcScreen); hdcScreen := 0; ReleaseDC(0, hdcTemp); hdcTemp := 0; DeleteObject(hBMP); DeleteDC(m_hdcMemory); m_hdcMemory := 0; m_Image.Free; GPGraph.Free; end; procedure TfmSwimBack.FormClose(Sender: TObject; var Action: TCloseAction); begin frmSwim.close; end; procedure TfmSwimBack.FormCreate(Sender: TObject); begin MusicResToFile('SwimBG', 'PngImage', 'SwimBG.png'); BorderStyle := bsNone; m_Blend.BlendOp := 0; // the only BlendOp defined in Windows 2000 m_Blend.BlendFlags := 0; // nothing else is special ... m_Blend.AlphaFormat := 1; // ... m_Blend.SourceConstantAlpha := 255; // AC_SRC_ALPHA if (FileExists(GetWinTempPath + 'SwimBG.png')) then SetTransparent(WideString(GetWinTempPath + 'SwimBG.png'), 100); // Stay on top //SetWindowPos(Handle, HWND(-2) , 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE ); end; procedure TfmSwimBack.CreateParams(var Params: TCreateParams); begin inherited; with Params do begin //悬浮窗 Params.ExStyle := Params.ExStyle or WS_EX_TOOLWINDOW; WndParent := GetDesktopWindow(); end; end; constructor TfmSwimBack.Create(AOwner: TComponent); begin inherited; Caption := ''; //不然在任务管理器中出现一个假进程 DoubleBuffered := True; SetWindowLong(Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW or WS_EX_LAYERED or WS_EX_TOPMOST); //悬浮窗 end; end.

//浮动窗口 unit uSwim; interface uses Windows, Messages, Classes, Controls, Forms, ExtCtrls, StdCtrls, SysUtils, DropTarget, Graphics, Downloader, IniFiles, Menus, XPMenu, DragDropInternet, ImgList, DragDrop, RzPanel; const WM_SWIM = WM_USER + 805; SWIM_WIDTH = 35; SWIM_HEIGHT = 35; type TfrmSwim = class(TForm) DropURLTarget1: TDropURLTarget; PopupMenu0: TPopupMenu; ShowHideMain1: TMenuItem; N9: TMenuItem; LoadUrl1: TMenuItem; ShowSwimform1: TMenuItem; Option1: TMenuItem; N12: TMenuItem; Exit1: TMenuItem; igMenu: TImageList; XPMenu1: TXPMenu; imgplatform: TImage; lbInfo: TLabel; procedure imgBackMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure DropURLTarget1Drop(Sender: TObject; ShiftState: TShiftState; Point: TPoint; var Effect: Integer); procedure imgBackDblClick(Sender: TObject); procedure miClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormShow(Sender: TObject); procedure FormCanResize(Sender: TObject; var NewWidth, NewHeight: Integer; var Resize: Boolean); procedure imgplatformMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure FormHide(Sender: TObject); private FMainHwnd: HWND; FswimValue: Boolean; FUILogic: IDownloadUILogic; procedure CreateParams(var Params: TCreateParams); override; procedure SetSwimValue(const Value: Boolean); //记忆位置memorySwim procedure sgetSwim(frm: TForm; b: Boolean = True); procedure AdjustBackFormPosition; //true setProxy WriteINI;false getProxy ReadINI published constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure MySwim(var msg: TMessage); message WM_SWIM; property swimValue: Boolean read FswimValue write SetSwimValue; property UILogic: IDownloadUILogic read FUILogic write FUILogic; end; var frmSwim: TfrmSwim; implementation uses uGlobal, ufmSwimBack; {$R *.dfm} constructor TfrmSwim.Create(AOwner: TComponent); begin inherited; Caption := ''; DoubleBuffered := True; Width := SWIM_WIDTH; Height := SWIM_HEIGHT; lbInfo.Width := Width; FUILogic := nil; DropURLTarget1.Register(Self); //Url拖动 SetWindowLong(Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW or WS_EX_LAYERED or WS_EX_TOPMOST); //悬浮窗 sgetSwim(Self as TForm, False); //fixme if Option.Swim and not Visible then Show; Show; end; procedure TfrmSwim.sgetSwim(frm: TForm; b: Boolean = True); //true setProxy WriteINI;false getProxy ReadINI const dis = 20; begin with TIniFile.Create(GetAppDataPath + g_SoftWareName + '.ini') do begin if b then begin if frm.Left <> readInteger('Swim', 'Left', 0) then //仅点击悬浮窗,不拖曳 WriteInteger('Swim', 'Left', frm.Left); if frm.top <> readInteger('Swim', 'Top', 0) then WriteInteger('Swim', 'Top', frm.top); end else begin frm.Left := readInteger('Swim', 'Left', Screen.Width - frm.Width - dis); frm.top := readInteger('Swim', 'Top', dis); if frm.Left < dis then frm.Left := dis else if frm.Left > Screen.Width - frm.Width - dis then frm.Left := Screen.Width - frm.Width - dis; if frm.top < dis then frm.top := dis else if frm.top > Screen.Height - frm.Height - dis then frm.top := Screen.Height - frm.Height - dis; end; Free; end; end; destructor TfrmSwim.Destroy; begin inherited; DropURLTarget1.Unregister(Self); end; procedure TfrmSwim.CreateParams(var Params: TCreateParams); begin inherited; with Params do begin //悬浮窗 {Style := Style and not WS_CAPTION; Style := Style or WS_POPUP; //or WS_CLIPCHILDREN or WS_THICKFRAME ExStyle := ExStyle or WS_EX_TOPMOST; ExStyle := ExStyle or WS_EX_LAYERED;} WndParent := GetDesktopWindow(); end; end; procedure TfrmSwim.imgBackMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin ReleaseCapture; //释放鼠标的捕获状态； Perform(WM_SYSCOMMAND, $F012, 0); //向窗体发送移动消息； sgetSwim(Self as TForm); //悬浮窗记忆位置 end; procedure TfrmSwim.DropURLTarget1Drop(Sender: TObject; ShiftState: TShiftState; Point: TPoint; var Effect: Integer); begin if FUILogic = nil then Exit; FUILogic.NewTask(PChar(UTF8Encode(DropURLTarget1.URL))); end; procedure TfrmSwim.MySwim(var msg: TMessage); const text_color_arr: array[0..7] of TColor = ($FF0006, $858116, $B20366, $5903B2, $0F4502, $454002, $0000FF, $FF0000); var p: TColor; begin if msg.LParam = -1 then begin Visible := not Visible; end else begin swimValue := msg.LParam <> 1000; if Visible then begin lbInfo.Caption := Format('%.1f%%', [msg.LParam / 10.0]); repeat p := text_color_arr[Random(6)]; //随机颜色 until lbInfo.Font.Color <> p; lbInfo.Font.Color := p; end; end end; procedure TfrmSwim.imgBackDblClick(Sender: TObject); begin miClick(ShowHideMain1); end; procedure TfrmSwim.SetSwimValue(const Value: Boolean); begin FswimValue := Value; if lbInfo.Visible <> Value then lbInfo.Visible := Value; end; procedure TfrmSwim.miClick(Sender: TObject); begin PostMessage(FMainHwnd, WM_SWIM, 0, (Sender as TMenuItem).Tag); end; procedure TfrmSwim.FormCreate(Sender: TObject); begin //FIXME // SetWindowRgn(Handle, CreateRoundRectRgn(0, 0, Width + 1, Height + 1, 10, 10), // True); //设置圆角矩形 FMainHwnd := SendMessage(FindWindow('TfrmMain', g_SoftWareName), WM_SWIM, Handle, -1); //解决主窗体响应了SC_MINIMIZE后FindWindow找不到正确的handle问题 end; procedure TfrmSwim.FormShow(Sender: TObject); begin //frmSwim.Top := 0; //frmSwim.Left := Screen.Width - 400; AdjustBackFormPosition; fmSwimBack.show; end; procedure TFrmSwim.AdjustBackFormPosition(); begin fmSwimBack.Left := frmSwim.left - 6; fmSwimBack.Top := frmSwim.Top - 6; end; procedure TfrmSwim.FormCanResize(Sender: TObject; var NewWidth, NewHeight: Integer; var Resize: Boolean); begin AdjustBackFormPosition; end; procedure TfrmSwim.imgplatformMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin AdjustBackFormPosition; end; procedure TfrmSwim.FormHide(Sender: TObject); begin fmswimBack.Hide; end; end.