WEB开发网
开发学院软件开发Delphi 来点实用的,自己画带标题栏窗体,可当模态窗体样... 阅读

来点实用的,自己画带标题栏窗体,可当模态窗体样继承

 2006-02-04 14:00:35 来源:WEB开发网   
核心提示: unit Unit1;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, Menus;type TForm1 = class(T
 

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.

Tags:实用 自己 标题

编辑录入:爽爽 [复制链接] [打 印]
赞助商链接