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

收购各种树木6

收购各种树木6

2016-02-19 19:32

今天图老师小编给大家展示的是来点实用的自己画带标题栏窗体可当模态窗体样继承,精心挑选的内容希望大家多多支持、多多分享,喜欢就赶紧get哦!
 

  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;

(本文来源于图老师网站,更多请访问https://m.tulaoshi.com/bianchengyuyan/)

  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('cursorssizens.ani');
    hsizewe:=loadcursorfromfile('cursorssizewe.ani');
    hsizeall:=loadcursorfromfile('cursorssizeall.cur');
    hsizeall1:=loadcursorfromfile('cursorssizeall1.cur');
    hsizenesw:=loadcursorfromfile('cursorssizenesw.ani');
    hsizenwse:=loadcursorfromfile('cursorssizenwse.ani');
    hwait:=loadcursorfromfile('cursorswait.ani');
    happstart:=loadcursorfromfile('cursorsappstarting.ani');
    harrow:=loadcursorfromfile('cursorsarrow.cur');
    hhandwriting:=loadcursorfromfile('cursorshandwriting.ani');
    hhelp:=loadcursorfromfile('cursorshelp.ani');
    hno:=loadcursorfromfile('cursorso.ani');
    hcross:=loadcursorfromfile('cursorscross.ani');
    hibeam:=loadcursorfromfile('cursorsibeam.ani');
    hhand:=loadcursorfromfile('cursorshand.ani');
    hup:=loadcursorfromfile('cursorsuparrow.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

(本文来源于图老师网站,更多请访问https://m.tulaoshi.com/bianchengyuyan/)

  //左右的内存也就不会被释放,所以,我们似乎应该做些工作先

  end;

  procedure TForm1.FormPaint(Sender: TObject);
  begin
    DrawActivate;//画偶们的
  end;

  procedure TForm1.FormDestroy(Sender: TObject);
  begin
  SystemParametersinfo(SPI_SETCURSORS,0,nil,SPIF_SENDCHANGE);//恢复系统光标
  //呵呵,偶好自私,不让你们用偶的程序的鼠标样式
  end;

  end.

  

展开更多 50%)
分享

猜你喜欢

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

编程语言 网络编程
来点实用的自己画带标题栏窗体可当模态窗体样继承

窗体问题--拖动无标题栏的窗体

电脑网络
窗体问题--拖动无标题栏的窗体

s8lol主宰符文怎么配

英雄联盟 网络游戏
s8lol主宰符文怎么配

可拖动的无标题栏窗体

电脑网络
可拖动的无标题栏窗体

闪动标题栏

Delphi
闪动标题栏

lol偷钱流符文搭配推荐

英雄联盟 网络游戏
lol偷钱流符文搭配推荐

移动无标题栏窗口

编程语言 网络编程
移动无标题栏窗口

怎样去掉QQ空间的标题栏?

电脑入门
怎样去掉QQ空间的标题栏?

lolAD刺客新符文搭配推荐

英雄联盟
lolAD刺客新符文搭配推荐

win7升级密钥不小心输入错误要怎么办

win7升级密钥不小心输入错误要怎么办

让ReportBuilder彻底支持Oracle

让ReportBuilder彻底支持Oracle
下拉加载更多内容 ↓