分享
 
 
 

来点实用的,自己画带标题栏窗体,可当模态窗体样继承 bob008原创在CSDN 发表于2005-04-04

王朝delphi·作者佚名  2006-01-09
窄屏简体版  字體: |||超大  

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.

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有