昨天设计部要求在软件的浮动小窗口的四周添加上阴影,本来以为很好做,直接拿一张带阴影的图像文件贴上去了。运行 起来完全不是那么回事,在不同的背景下看起来完全不一样,因为阴影是由黑到白渐变的,在白背景下慢慢溶入背景看起来很好,可是在深色背景下看起来四周的阴影看起来就没有渐变效果了,只是一圈灰边。
在网上搜下关于窗体阴影的解决方案,还真不多,搜到两种。第一是在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、将两个窗体的显示与隐藏绑定到一起,然后大功告成。代码如下:
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.
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.