unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Menus;
type
TForm1 = class(TForm)
img1: TImage; //left
img2: TImage; //Top
img3: TImage; //Caption
img4: TImage; //Right
img5: TImage; //Time Control
imgmin: TImage; //Minbutton
imgrestore: TImage; //RestoreSize
imgMax: TImage; //Maxbutton
imgclose: TImage; //Closebutton
//这些图片是WINBLANDS 4里面的CHIRSTMASTIME的窗口样式图片，修改一下就更完美了
//修改完后用PHOTOSHOP转为256色（100%）OK，开始把图片载入各IMAGE控件，准备开始
procedure FormResize(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
iStyle: Longint; //窗口样式
shuai: boolean; //状态的判断标志，用在NCMOUSEMOVE里
procedure DrawActivate; //活动时这样画
procedure DrawDeActivate; //不活动就这样画
protected
procedure wndproc(var message: Tmessage); override;//事实上下面的也都是OVERRIDE，这里我只处理
//了非NC开头的一个消息，你也可以自己照下面的样式写WM_ACTIVATE
procedure wmnchittest(var msg: TWMNCHITTEST); message WM_NCHITTEST;
procedure wmncmousemove(var msg: TWMNcMousemove); message wm_ncmousemove;
procedure wmnclbuttondown(var msg: Twmnclbuttondown); message wm_nclbuttondown;
procedure wmnclbuttondblclk(var msg: TWMNCLButtonDblClk); message wm_nclbuttondblclk;
procedure wmnclbuttonup(var msg: twmnclbuttonup); message wm_nclbuttonup;
procedure wmncpaint(var msg: twmncpaint); message wm_ncpaint;
public
{ Public declarations }
end;
var
Form1 : TForm1;
caprect : TRect;
pt : TPoint;
dci : integer;
implementation
{$R *.dfm}
//------------------------------------------------------------------------------
procedure TForm1.FormResize(Sender: TObject);
var
rgn : HRGN;
begin
//要保证窗口的外观效果，设置一下
Form1.Constraints.MinHeight := 40;
Form1.Constraints.MaxHeight := getsystemmetrics(SM_CYSCREEN) - getsystemmetrics(SM_CYMIN);
rgn := CreateRoundRectRgn(0, 0, width, height, 5, 5);
//这里的RGN，主要是应付WINDOWS XP的主题文件的，不要它，嘿，真TMD丑
setwindowrgn(handle, rgn, true);//设置窗口区域并重画，区域外的绘制不会显示
deleteobject(rgn); //用完了记得删除对象。
invalidate; //这句也很重要哦
end;
//------------------------------------------------------------------------------
//活动时这样画
//------------------------------------------------------------------------------
procedure TForm1.DrawActivate;
var
myhdc : HDC;
ico : HICON;
i : integer;
cav : TCanvas;
ACV : TCanvas;
caprect : TRect;
rcdw : integer;
j : integer;
K : integer;
begin
// canvas.Lock;
myhdc := getwindowDc(handle);
ACV := TCanvas.Create;
try
ACV.handle := myhdc;
setstretchbltmode(ACV.handle, STRETCH_DELETESCANS);
with ACV do
begin
Bitblt(ACV.handle, 0, 0, 4, 31, img1.canvas.handle, 0, 0, SRCcopy);
//左上角的那么点，宽4像素，高31像素 SRCxxxxx还有很多的哦
Bitblt(ACV.handle, 4, 0, 30, 31, img2.canvas.handle, 0, 0, SRCcopy);
//Draw Icon//马上就要画图标了，我们来给它准备好位置吧
ico := Icon.handle; //想偷懒就这样。^-^
Drawiconex(ACV.handle, 18, 6, ico, 16, 16, 0, 0, DI_Normal);
//这上面的画ICON也可以给很多朋友参考的，这样画就是和原来的ICON一样的，闪烁？没有
//好了，ICON画好了，我们要开始画标题文字了，先准备下,不然怎么知道画多少呢
i := Length(Caption) * 8 - 10;
//每个文字大概、怎么也差不多有8像素宽的吧
Bitblt(ACV.handle, 34, 0, 6, 31, img3.canvas.handle, 0, 0, SRCcopy);
//下面准备为CAPTION铺上红地毯，~新郎新娘入洞房啦--“扑通”一块砖头飞来，我晕~倒
stretchblt(ACV.handle, 40, 0, i, 31, img3.canvas.handle, 6, 0, 10, 31, SRCcopy);
//开始画CAPTION了，这里应该有许多朋友想解决的问题的参考
cav := TCanvas.Create;
cav.Brush.Style := bsclear;
cav.handle := myhdc;
caprect := rect(45, 10, i * 2 - 20, 26);
cav.Font.Name := '宋体';
cav.Font.Size := 9;
cav.Font.Color := clwhite;
cav.Font.Charset := GB2312_CHARSET;
DrawText(cav.handle, pchar(Caption), Length(Caption), caprect, DT_Left); ////
cav.free;
//好了，标题也画了，现在干啥子，接着画，还早着呢
//开始对标题栏封口啦
Bitblt(ACV.handle, i + 40, 0, 11, 31, img3.canvas.handle, 18, 0, SRCcopy);
//好了，口也灭了，现在该干啥了？？？接着画，郁闷。
//再这里对接,需要判断了，郁闷之极啊
rcdw := width - i - 51 - 94;
//如果需要画的地方没180就只画一下
if (rcdw <= 180) then
begin
Bitblt(ACV.handle, i + 51, 0, rcdw, 31, img2.canvas.handle, 40, 0, SRCcopy);
end
//不然才多画些，避免浪费资源
else if (rcdw > 180) then
begin
j := trunc(rcdw / 180);
for K := 0 to j - 1 do
begin
Bitblt(ACV.handle, i + 51 + (K) * 180, 0, 180, 31, img2.canvas.handle, 40, 0, SRCcopy);
end;
Bitblt(ACV.handle, i + 51 + j * 180, 0, (rcdw - j * 180), 31, img2.canvas.handle, 40, 0, SRCcopy);
end;
//要开个口子了，准备搞对接撒，这里用STRETCHBLT可就拉的丑了还是用BITBLT
Bitblt(ACV.handle, (width - 94), 0, 10, 31, img2.canvas.handle, 239, 0, SRCcopy);
//还留4个像素给右边的封口撒
Bitblt(ACV.handle, (width - 93), 0, 90, 31, img2.canvas.handle, 240, 0, SRCcopy);
//好了，上面的东东完成了，该封口了，55555，谁让偶这么好色呢，哎...,是不是很麻烦
Bitblt(ACV.handle, (width - 5), 0, 4, 31, img4.canvas.handle, 0, 0, SRCcopy);
//呵呵，上面画完了。开始画左边的 ，注意这里也要多搞几便的
Bitblt(ACV.handle, 0, 31, 4, 9, img1.canvas.handle, 0, 31, SRCcopy);
stretchblt(ACV.handle, 0, 40, 4, (height - 59), img1.canvas.handle, 0, 40, 4, 28, SRCcopy);
Bitblt(ACV.handle, 0, (height - 20), 4, 19, img1.canvas.handle, 0, 58, SRCcopy);
//哎，画到这里还是不怎么好看，赶快画右边的 ，COPY上面的就OK了
Bitblt(ACV.handle, (width - 5), 31, 4, 9, img4.canvas.handle, 0, 31, SRCcopy);
stretchblt(ACV.handle, (width - 5), 40, 4, (height - 58), img4.canvas.handle, 0, 40, 4, 28, SRCcopy);
Bitblt(ACV.handle, (width - 5), (height - 19), 4, 19, img4.canvas.handle, 0, 58, SRCcopy);
//再画下面的吧
Bitblt(ACV.handle, 4, (height - 10), 10, 9, img5.canvas.handle, 0, 0, SRCcopy);
stretchblt(ACV.handle, 14, (height - 10), (width - 28), 9, img5.canvas.handle, 10, 0, 21, 9, SRCcopy);
Bitblt(ACV.handle, (width - 15), (height - 10), 10, 9, img5.canvas.handle, 31, 0, SRCcopy);
//最小化BUTTON
Bitblt(ACV.handle, (width - 38), 1, 26, 29, imgclose.canvas.handle, 0, 0, SRCcopy);
//需要检查下有没有MAXBUTTON，CLOSEBUTTON偶就不检查了，既然要画肯定是要个CLOSEBUTTON的
//怎么检查？郁闷，算了，我可没空去管你最大化按键要不要。
//开始画上去再说,还要看FORM是不是最大化的
if windowstate = wsMaximized then
begin
//IMGRESTORE
Bitblt(ACV.handle, (width - 64), 1, 26, 29, imgrestore.canvas.handle, 0, 0, SRCcopy);
end
else if windowstate = wsNormal then
begin
//IMGMAX
Bitblt(ACV.handle, (width - 64), 1, 26, 29, imgMax.canvas.handle, 0, 0, SRCcopy);
end;
//画最小化BUTTON
Bitblt(ACV.handle, (width - 90), 1, 26, 29, imgmin.canvas.handle, 0, 0, SRCcopy);
//canvas.Unlock; //使用CANVAS.UNLOCK配对也是一样的效果，我这里写的是推荐的做法
end;
finally
releasedc(handle, ACV.handle); //释放设备场景
ACV.free;
end;
end;
//标题栏绘制的消息，看偶来偷天换日
procedure TForm1.wmncpaint(var msg: twmncpaint);
begin
DrawActivate; //换成偶民滴
end;
//------------------------------------------------------------------------------
//不活动时就该这样画了
//------------------------------------------------------------------------------
procedure TForm1.DrawDeActivate;
var
myhdc : HDC;
ico : HICON;
i : integer;
cav : TCanvas;
DCV : TCanvas;
caprect : TRect;
rcdw : integer;
j : integer;
K : integer;
begin
//canvas.Lock;
myhdc := getwindowDc(handle);
DCV := TCanvas.Create;
try
DCV.handle := myhdc;
setstretchbltmode(DCV.handle, STRETCH_DELETESCANS);
with DCV do
begin
Bitblt(DCV.handle, 0, 0, 4, 31, img1.canvas.handle, 4, 0, SRCcopy);
//左上角的那么点，宽4像素，高31像素 SRCxxxxx还有很多的哦
Bitblt(DCV.handle, 4, 0, 30, 31, img2.canvas.handle, 0, 31, SRCcopy);
//Draw Icon//马上就要画图标了，我们来给它准备好位置吧
ico := Icon.handle;
Drawiconex(DCV.handle, 18, 6, ico, 16, 16, 0, 0, DI_Normal);
//好了，ICON画好了，我们要开始画标题文字了，先准备下,不然怎么知道画多少呢
i := Length(Caption) * 8 - 10;
//计算下长度，好画撒
Bitblt(DCV.handle, 34, 0, 6, 31, img3.canvas.handle, 0, 31, SRCcopy);
//下面准备为CAPTION铺上红地毯，~新郎新娘入洞房啦--“扑通”一块砖头飞来，我晕~倒
stretchblt(DCV.handle, 40, 0, i, 31, img3.canvas.handle, 6, 31, 10, 31, SRCcopy);
//开始画CAPTION了
cav := TCanvas.Create;
cav.Brush.Style := bsclear; //刷子类型，~嘿嘿，偶也有两把烂刷子哦
cav.handle := myhdc;
caprect := rect(45, 10, i * 2 - 20, 26);
cav.Font.Name := '宋体';
cav.Font.Size := 9;
cav.Font.Color := clblack;
cav.Font.Charset := GB2312_CHARSET;
DrawText(cav.handle, pchar(Caption), Length(Caption), caprect, DT_Left); ////
cav.free;
//好了，标题也画了，现在干啥子，接着画，还早着呢
//开始对标题栏封口啦
Bitblt(DCV.handle, i + 40, 0, 11, 31, img3.canvas.handle, 18, 31, SRCcopy);
//好了，封好了，现在该干吗？？？接着画，郁闷。
//再这里对接,需要判断了，郁闷之极啊
rcdw := width - i - 51 - 94;
if (rcdw <= 180) then
begin
Bitblt(DCV.handle, i + 51, 0, rcdw, 31, img2.canvas.handle, 40, 31, SRCcopy);
end
else if (rcdw > 180) then
begin
j := trunc(rcdw / 180);
for K := 0 to j do
begin
Bitblt(DCV.handle, i + 51 + (K) * 180, 0, 180, 31, img2.canvas.handle, 40, 31, SRCcopy);
end;
Bitblt(DCV.handle, i + 51 + j * 180, 0, (rcdw - j * 180), 31, img2.canvas.handle, 40, 31, SRCcopy);
end;
//要开个口子了，准备搞对接撒，这里用STRETCHBLT可就拉的丑了还是用BITBLT
Bitblt(DCV.handle, (width - 94), 0, 10, 31, img2.canvas.handle, 239, 31, SRCcopy);
//还留4个像素给右边的封口撒
Bitblt(DCV.handle, (width - 93), 0, 90, 31, img2.canvas.handle, 240, 31, SRCcopy);
//好了，上面的东东完成了，该封口了，55555，谁让偶这么好色呢，哎...,是不是很麻烦
Bitblt(DCV.handle, (width - 5), 0, 4, 31, img4.canvas.handle, 4, 0, SRCcopy);
//----------------------------------------------------------------0--2
//呵呵，上面画完了。开始画左边的 ，注意这里也要多搞几便的
//--------------------------------------------------------------------
Bitblt(DCV.handle, 0, 31, 4, 9, img1.canvas.handle, 0, 31, SRCcopy);
stretchblt(DCV.handle, 0, 40, 4, (height - 59), img1.canvas.handle, 0, 40, 4, 28, SRCcopy);
Bitblt(DCV.handle, 0, (height - 18), 4, 19, img1.canvas.handle, 0, 58, SRCcopy);
//----------------------------------------------------------
//哎，画到这里还是不怎么好看，赶快画右边的 ，COPY上面的就OK了
//--------------------------------------------------------------------
Bitblt(DCV.handle, (width - 5), 31, 4, 9, img4.canvas.handle, 0, 31, SRCcopy);
stretchblt(DCV.handle, (width - 5), 40, 4, (height - 58), img4.canvas.handle, 0, 40, 4, 28, SRCcopy);
Bitblt(DCV.handle, (width - 5), (height - 18), 4, 18, img4.canvas.handle, 0, 58, SRCcopy);
Bitblt(DCV.handle, 4, (height - 10), 10, 9, img5.canvas.handle, 0, 9, SRCcopy);
stretchblt(DCV.handle, 14, (height - 10), (width - 28), 9, img5.canvas.handle, 10, 9, 21, 9, SRCcopy);
Bitblt(DCV.handle, (width - 14), (height - 10), 10, 9, img5.canvas.handle, 31, 9, SRCcopy);
Bitblt(DCV.handle, (width - 38), 1, 26, 30, imgclose.canvas.handle, 130, 0, SRCcopy);
if windowstate = wsMaximized then
begin
//IMGRESTORE
Bitblt(DCV.handle, (width - 64), 1, 26, 30, imgrestore.canvas.handle, 130, 0, SRCcopy);
end
else if windowstate = wsNormal then
begin
//IMGMAX
Bitblt(DCV.handle, (width - 64), 1, 26, 30, imgMax.canvas.handle, 130, 0, SRCcopy);
end;
Bitblt(DCV.handle, (width - 90), 1, 26, 30, imgmin.canvas.handle, 130, 0, SRCcopy);
//canvas.Unlock; //使用CANVAS.UNLOCK配对也是一样的效果，我这里写的是推荐的做法
end;
finally
releasedc(handle, DCV.handle);
DCV.free;
end;
end;
//标题栏鼠标左键按下的消息
procedure TForm1.wmnclbuttondown(var msg: Twmnclbuttondown);
var
dc : HDC;
cvs : TCanvas;
begin
dc := getwindowDc(handle);
cvs := TCanvas.Create;
try
cvs.handle := dc;
with cvs do
begin
if msg.HitTest = htminbutton then
begin
Bitblt(cvs.handle, (width - 90), 1, 26, 30, imgmin.canvas.handle, 26, 0, SRCcopy);
end
else if msg.HitTest = htmaxbutton then
begin
if windowstate = wsNormal then
begin
Bitblt(cvs.handle, (width - 64), 1, 26, 30, imgMax.canvas.handle, 26, 0, SRCcopy);
end
else if windowstate = wsMaximized then
begin
Bitblt(cvs.handle, (width - 64), 1, 26, 30, imgrestore.canvas.handle, 26, 0, SRCcopy);
end;
end
else if msg.HitTest = htclose then
begin
Bitblt(cvs.handle, (width - 38), 1, 26, 30, imgclose.canvas.handle, 26, 0, SRCcopy);
end
else
inherited;
end;
finally
releasedc(handle, cvs.handle);
cvs.free;
end;
end;
//标题栏鼠标左键松开
procedure TForm1.wmnclbuttonup(var msg: twmnclbuttonup);
begin
if msg.HitTest = htminbutton then
begin
application.Minimize;
end
else if msg.HitTest = htmaxbutton then
begin
if windowstate = wsNormal then
begin
windowstate := wsMaximized;
left := left + 6;
top := top + 3;
end
else if windowstate = wsMaximized then
begin
windowstate := wsNormal;
end;
end
else if msg.HitTest = htclose then
begin
application.Terminate;
end
else
inherited;
end;
procedure TForm1.wndproc(var message: Tmessage);
begin
inherited wndproc(message);
if message.msg = wm_activate then
begin
case message.WParamLo of
wa_active, wa_clickactive:
begin
DrawActivate;
shuai := true;
end;
wa_inactive:
begin
DrawDeActivate;
shuai := false;
end;
end;
end;
if message.msg = wm_ncactivate then
begin
message.Result := 1;//返回个固定值吧，免得老闪来闪去多画N次
end;
end;
//用这个来告诉消息最好不过了，好好利用先
procedure TForm1.wmnchittest(var msg: TWMNCHITTEST);
var
cprect : TRect; //定义标题栏的RECT（也就是一个正方形的区域）
minrect : TRect; //最小化按纽的RECT
maxrect : TRect; //最大化按纽的RECT
closerect : TRect; //关闭 按纽的RECT
pt : TPoint; //鼠标指针
begin
cprect := rect(36, -getsystemmetrics(SM_CYMIN) + 6, width - 98, 31); //设置RECT
minrect := rect((width - 90), -getsystemmetrics(SM_CYMIN) + 1, (width - 65), -getsystemmetrics(SM_CYMIN) + 29);
maxrect := rect((width - 64), -getsystemmetrics(SM_CYMIN) + 1, (width - 39), -getsystemmetrics(SM_CYMIN) + 29);
closerect := rect((width - 38), -getsystemmetrics(SM_CYMIN) + 1, (width - 13), -getsystemmetrics(SM_CYMIN) + 29);
pt.X := Screentoclient(mouse.CursorPos).X; //鼠标X
pt.Y := Screentoclient(mouse.CursorPos).Y; // Y值
//准备欺骗系统了 ，因为BSNONE样式的窗体是没有这些返回消息的
if PtInRect(minrect, pt)
then
msg.Result := htminbutton //告诉它在最小化按纽这里
else if PtInRect(maxrect, pt)
then
msg.Result := htmaxbutton //告诉它在最大化按纽这里
else if PtInRect(closerect, pt)
then
msg.Result := htclose //告诉它在关闭 按纽这里
else if PtInRect(cprect, pt)
then
msg.Result := htCaption //告诉它在标题栏这里
else if (pt.X < 5) and (pt.Y < -getsystemmetrics(SM_CYMIN) + 8) then
msg.Result := httopleft //告诉它在左上角
else if (pt.X > width - 13) and (pt.Y < -getsystemmetrics(SM_CYMIN) + 5) then
msg.Result := httopright //告诉它在右上角
else if (pt.X > width - 13) and (pt.Y > height - 5 - getsystemmetrics(SM_CYMIN)) then
msg.Result := htbottomright //告诉它在右下角
else if (pt.X < 5) and (pt.Y > height - 5 - getsystemmetrics(SM_CYMIN)) then
msg.Result := htbottomleft //告诉它在左下角
else if (pt.X < 5) then
msg.Result := htleft //偶是左派
else if (pt.Y < -getsystemmetrics(SM_CYMIN) + 5) then
msg.Result := httop //我在上面，低头不见抬头见
else if (pt.X > width - 9) then
msg.Result := htright //偶是右派
else if (pt.Y > height - 5 - getsystemmetrics(SM_CYMIN)) then
msg.Result := htbottom //偶是贫下中农
else
inherited; { http://www.csdn.net bob008 原创 2005-03-14，严禁未经许可的转载，出版}
end;
//标题栏双击消息，偶们来模拟一下
procedure TForm1.wmnclbuttondblclk(var msg: TWMNCLButtonDblClk);
begin
if msg.HitTest = htCaption then
if windowstate = wsMaximized then
windowstate := wsNormal
else if windowstate = wsNormal then
begin
windowstate := wsMaximized;
left := left + 6;
top := top + 3;
end;
end;
//标题栏上鼠标移动的消息
procedure TForm1.wmncmousemove(var msg: TWMNcMousemove);
var
dc : HDC;
cv : TCanvas;
begin
dc := getwindowDc(handle);
cv := TCanvas.Create;
try
cv.handle := dc;
with cv do
begin
if shuai = true then
begin
if msg.HitTest = htminbutton then
begin
Bitblt(cv.handle, (width - 90), 1, 26, 30, imgmin.canvas.handle, 52, 0, SRCcopy);
end
else
begin
Bitblt(cv.handle, (width - 90), 1, 26, 30, imgmin.canvas.handle, 0, 0, SRCcopy);
end;
if msg.HitTest = htmaxbutton then
begin
if windowstate = wsNormal then
begin
Bitblt(cv.handle, (width - 64), 1, 26, 30, imgMax.canvas.handle, 52, 0, SRCcopy);
end
else if windowstate = wsMaximized then
begin
Bitblt(cv.handle, (width - 64), 1, 26, 30, imgrestore.canvas.handle, 52, 0, SRCcopy);
end;
end
else if windowstate = wsNormal then
begin
Bitblt(cv.handle, (width - 64), 1, 26, 30, imgMax.canvas.handle, 0, 0, SRCcopy);
end
else if windowstate = wsMaximized then
begin
Bitblt(cv.handle, (width - 64), 1, 26, 30, imgrestore.canvas.handle, 0, 0, SRCcopy);
end;
if msg.HitTest = htclose then
begin
Bitblt(cv.handle, (width - 38), 1, 26, 30, imgclose.canvas.handle, 52, 0, SRCcopy);
end
else
begin
Bitblt(cv.handle, (width - 38), 1, 26, 30, imgclose.canvas.handle, 0, 0, SRCcopy);
end;
end;
end;
finally
releasedc(handle, cv.handle);
cv.free;
end;
end;
//------------------------------------------------------------------------------
//我们要做什么？
//那几个BUTTON让偶们要干掉它们，省得它们坏事
//当然把它们屏蔽后应该干啥，干自己的事情撒
//------------------------------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
var
hsizens : HICON; //好界面配上好光标才帅吗！用了WINDOWS变脸软件里的光标
hsizewe : HICON;
hsizeall : HICON;
hsizeall1 : HICON;
hsizenesw : Hicon;
hsizenwse : Hicon;
hwait : HICON;
happstart : HICON;
harrow : HICON;
hhandwriting : Hicon;
hhelp : HICON;
hno : HICON;
hcross : Hicon;
hibeam : Hicon;
hhand : Hicon;
hup : Hicon;
begin
hsizens:=loadcursorfromfile('cursors\sizens.ani');
hsizewe:=loadcursorfromfile('cursors\sizewe.ani');
hsizeall:=loadcursorfromfile('cursors\sizeall.cur');
hsizeall1:=loadcursorfromfile('cursors\sizeall1.cur');
hsizenesw:=loadcursorfromfile('cursors\sizenesw.ani');
hsizenwse:=loadcursorfromfile('cursors\sizenwse.ani');
hwait:=loadcursorfromfile('cursors\wait.ani');
happstart:=loadcursorfromfile('cursors\appstarting.ani');
harrow:=loadcursorfromfile('cursors\arrow.cur');
hhandwriting:=loadcursorfromfile('cursors\handwriting.ani');
hhelp:=loadcursorfromfile('cursors\help.ani');
hno:=loadcursorfromfile('cursors\no.ani');
hcross:=loadcursorfromfile('cursors\cross.ani');
hibeam:=loadcursorfromfile('cursors\ibeam.ani');
hhand:=loadcursorfromfile('cursors\hand.ani');
hup:=loadcursorfromfile('cursors\uparrow.ani');
setsystemcursor(harrow,ocr_normal);
setsystemcursor(hsizens,ocr_sizens);
setsystemcursor(hsizewe,ocr_sizewe);
setsystemcursor(hsizeall,ocr_sizeall);
setsystemcursor(hsizeall1,ocr_size);
setsystemcursor(hsizenesw,ocr_sizenesw);
setsystemcursor(hsizenwse,ocr_sizenwse);
setsystemcursor(hwait,ocr_wait);
setsystemcursor(happstart,ocr_appstarting);
setsystemcursor(hhandwriting,OIC_note);
setsystemcursor(hhelp, OCR_ICOCUR );
setsystemcursor(hno,ocr_no);
setsystemcursor(hcross,ocr_cross);
setsystemcursor(hibeam,ocr_ibeam);
setsystemcursor(hhand,OCR_HAND);
setsystemcursor(hup,ocr_up);
iStyle := setwindowlong(handle, gwl_style, getwindowlong(handle, gwl_style) and not ws_minimizebox and
not ws_maximizebox and not ws_sysmenu);//设置窗口样式有SYSMENU一样会有CLOSEBUTTON的，所
//以把SYSMENU也去掉，这样没有默认的按钮绘制会影响我们了
application.Minimize; //MS不知道是怎么搞的，窗体载入时的状态切换消息几乎没时间差异，哇，多压入一个
application.Restore; //设备场景的内存用量，大家NEW一个PROJECT看光1个窗体载入时3.2MB左右
//最小化后1.6MB左右，如果用户根本一直让你的软件工作在正常状态下（没有最小化）那么那多余的1.6MB
//左右的内存也就不会被释放，所以，我们似乎应该做些工作先
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
DrawActivate;//画偶们的
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
SystemParametersinfo(SPI_SETCURSORS,0,nil,SPIF_SENDCHANGE);//恢复系统光标
//呵呵，偶好自私，不让你们用偶的程序的鼠标样式
end;
end.
本文地址：http://com.8s8s.com/it/it4228.htm