unitcf.pas

delphi进程管理源码示例免费下载,机会不多

unit UnitCF;
                                                                                                                                                                                                                                           { http://www.csdn.net http://www.delphibox.com  bob008 原创 2005-03-14 严禁未经许可的转载，出版}
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus, StdCtrls, Buttons, ComCtrls, ToolWin, ImgList;
type
  TButForm = class(TForm)
    img1: TImage;
    img2: TImage;
    img4: TImage;
    img5: TImage;
    imgmin: TImage;
    imgrestore: TImage;
    imgMax: TImage;
    imgclose: TImage;
    mnuBarBK: TCoolBar;
    mnuBar: TToolBar;
    imgMnuBar: TImage;
    Sysmnuil: TImageList;
    SysMnu: TPopupMenu;
    N1: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    procedure FormResize(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);

    procedure DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
      Selected: Boolean);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure S1Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
  private
    { Private declarations }
    shuai:boolean;
    Procedure DrawActivate;
    Procedure DrawDeactivate;

    procedure MenueDrawItemX(xMenu: TMenu);

   protected
      procedure wndproc(var message:Tmessage);override;
      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;
  public
    { Public declarations }
  end;
   procedure MenueDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
    Selected: Boolean);
var
  ButForm: TButForm;

implementation

{$R *.dfm}
{ DrawActivate}

procedure tbutform.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;
    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 TButForm.DrawActivate;
var
  ico: Hicon;
  i: Integer;
  cav: TCanvas;
  caprect: TRect;
  rcdw:integer;
  MyhDc:Hdc;
begin
  canvas.Lock;
  myhdc:=getwindowDc(Handle);
  setstretchbltmode(myhdc,STRETCH_DELETESCANS	);
  if mnubarbk.Visible then begin
     bitblt(myhdc,8,29,13,20,imgmnubar.Canvas.Handle,0,0,srccopy);
     bitblt(myhdc,(width-21),29,13,20,imgmnubar.Canvas.Handle,0,0,srccopy);
  end;
  Bitblt( myhdc, 0, 0, 7, 45, img1.Canvas.Handle, 0, 0,SRCcopy );
  bitblt(myhdc, 7, 0, 48, 29, img2.Canvas.Handle, 0, 0, SRCCopy);
  ico := Icon.Handle;
  Drawiconex(myhdc, 18, 6, ico, 16, 16, 0, 0, DI_Normal);
  i := Length(Caption) * 7-10;
  if width-200>i then
     i := Length(Caption) * 7-10
     else
     i:=150;
  stretchblt(myhdc, 55, 0, i, 29, img2.Canvas.Handle, 43, 0, 50, 29, SRCCopy);
  cav := TCanvas.Create;
  cav.Brush.Style := bsclear;
  cav.Handle := myhdc;

  caprect := rect(48, 8, i * 2 - 20, 26);
  cav.Font.Name := '宋体';
  cav.Font.Size := 9;
  cav.font.Color :=$00000031;
  cav.Font.Charset := GB2312_CHARSET;
  DrawText(cav.Handle, pchar(Caption), Length(Caption), caprect, DT_Left); ////
  cav.Destroy;
  bitblt(myhdc, i + 40, 0, 58, 29, img2.Canvas.Handle, 156, 0, SRCCopy);
  rcdw:=width-i-43-112-40;
  stretchblt(myhdc,I+83,0,rcdw,29,IMG2.Canvas.Handle ,200,0,51,29,SRCCOPY);
  bitblt(myhdc, (Width -112), 0, 112, 29, img2.Canvas.Handle, 256, 0, SRCCopy);
  bitblt(myhdc, (Width - 7), 0, 7, 45, img4.Canvas.Handle, 0, 0, SRCcopy);
  stretchblt(myhdc, 0,45, 7, (height - 24), img1.Canvas.Handle, 0, 46, 7, 232, SRCCopy);
  bitblt(myhdc, 0, (Height - 23), 7, 23, img1.Canvas.Handle, 0, 287, SRCcopy);
  stretchblt(myhdc, (Width - 7),45, 7, (height - 24), img4.Canvas.Handle, 0, 46, 7, 232, SRCCopy);
  bitblt(myhdc, (Width - 7), (Height - 23), 7, 23, img4.Canvas.Handle, 0, 287, SRCcopy);
  stretchblt(myhdc, 5, (Height - 9), (Width - 10), 9, img5.Canvas.Handle, 0, 0, 342, 8, SRCCopy);
  bitblt(myhdc, (Width - 31), 5, 24, 20, imgclose.Canvas.Handle, 0, 0, SRCCopy);
  if windowstate = wsMaximized then begin
    bitblt(myhdc, (Width - 56), 5, 24, 20, imgrestore.Canvas.Handle, 0, 0, SRCCopy);
  end
  else if windowstate = wsNormal then begin
    bitblt(myhdc, (Width - 56), 5, 24, 20, imgMax.Canvas.Handle, 0, 0, SRCCopy);
  end;
  bitblt(myhdc, (Width - 81), 5, 24, 20, imgmin.Canvas.Handle, 0, 0, SRCCopy);
  canvas.Unlock;
  Releasedc(handle,myhdc);
end;
{DrawDeactivate}
procedure TButForm.DrawDeactivate ;
var
  ico: Hicon;
  i: Integer;
  cav: TCanvas;
  caprect: TRect;
  rcdw:integer;
  MyhDc:Hdc;
begin
  canvas.Lock;
  myhdc:=getwindowDc(Handle);
  setstretchbltmode(myhdc,STRETCH_DELETESCANS	);
  Bitblt( myhdc, 0, 0, 7, 45, img1.Canvas.Handle, 7, 0,SRCcopy );
  bitblt(myhdc, 7, 0, 48, 29, img2.Canvas.Handle, 0, 29, SRCCopy);
  ico := Icon.Handle;
  Drawiconex(myhdc, 18, 6, ico, 16, 16, 0, 0, DI_Normal);
  i := Length(Caption) * 7-10;
    if width-200>i then
     i := Length(Caption) *7-10
     else
     i:=150;
  stretchblt(myhdc, 55, 0, i, 29, img2.Canvas.Handle, 43, 29, 50, 29, SRCCopy);
  cav := TCanvas.Create;
  cav.Brush.Style := bsclear;
  cav.Handle := myhdc;
  caprect := rect(48, 8, i * 2 - 20, 26);
  cav.Font.Name := '宋体';
  cav.Font.Size := 9;
  cav.font.Color :=clblack;//clolive;
  cav.Font.Charset := GB2312_CHARSET;
  DrawText(cav.Handle, pchar(Caption), Length(Caption), caprect, DT_Left); ////
  cav.Destroy;
  bitblt(myhdc, i + 40, 0, 58, 29, img2.Canvas.Handle, 156, 29, SRCCopy);
  rcdw:=width-i-40-112-40;
  stretchblt(myhdc,I+83,0,rcdw,29,IMG2.Canvas.Handle ,200,29,51,29,SRCCOPY);
  bitblt(myhdc, (Width -112), 0, 112, 29, img2.Canvas.Handle, 255, 29, SRCCopy);
  bitblt(myhdc, (Width - 6), 0, 7, 45, img4.Canvas.Handle, 7, 0, SRCcopy);
  stretchblt(myhdc, 0,45, 7, (height - 24), img1.Canvas.Handle, 7, 46, 7, 232, SRCCopy);
  bitblt(myhdc, 0, (Height - 23), 7, 23, img1.Canvas.Handle, 7, 287, SRCcopy);
  stretchblt(myhdc, (Width - 7),45, 7, (height - 24), img4.Canvas.Handle, 7, 46, 7, 232, SRCCopy);
  bitblt(myhdc, (Width - 7), (Height - 23), 7, 23, img4.Canvas.Handle, 7, 287, SRCcopy);
  stretchblt(myhdc, 5, (Height - 9), (Width - 10), 9, img5.Canvas.Handle, 0, 8, 342, 8, SRCCopy);
  bitblt(myhdc, (Width - 31), 5, 24, 20, imgclose.Canvas.Handle, 0, 0, SRCCopy);
  if windowstate = wsMaximized then begin
    bitblt(myhdc, (Width - 56), 5, 24, 20, imgrestore.Canvas.Handle, 72, 0, SRCCopy);
  end
  else if windowstate = wsNormal then begin
    bitblt(myhdc, (Width - 56), 5, 24, 20, imgMax.Canvas.Handle, 72, 0, SRCCopy);
  end;
  bitblt(myhdc, (Width - 81), 5, 24, 20, imgmin.Canvas.Handle, 72, 0, SRCCopy);
  canvas.Unlock;
  Releasedc(handle,myhdc); //释放设备场景
end;

Procedure TButForm.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;
end;

procedure TButForm.wmnchittest(var msg: TWMNCHitTest);
var
  cprect    :Trect; //定义标题栏的RECT（也就是一个正方形的区域）
  minrect   :Trect; //最小化按纽的RECT
  maxrect   :Trect; //最大化按纽的RECT
  closerect :Trect; //关闭  按纽的RECT
  pt        :Tpoint;//鼠标指针
begin
  inherited ;
  cprect    := rect(43,  1,    width-112, 29);    //设置RECT
  minRect   := rect((Width - 81),5, (Width - 57), 20);
  MaxRect   := rect((Width - 56),1, (Width - 32), 20);
  CloseRect := rect((Width - 31),1, (Width - 7), 20);
  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<5) then
     msg.Result:=httopleft            //告诉它在左上角
  else
  if (pt.x>width-5) and (pt.y<5) then
     msg.Result:=httopright           //告诉它在右上角
  else
  if (pt.x >width-5) and (pt.y>height-5) then
     msg.Result:=htbottomright        //告诉它在右下角
  else
  if (pt.x<5) and (pt.y>height-5) then
     msg.Result:=htbottomleft         //告诉它在左下角
  else
  if (pt.x<5) then
     msg.Result:=htleft               //偶是左派
  else
  if (pt.y<5) then
     msg.Result:=httop                //我在上面，低头不见抬头见
  else
  if (pt.x>width-5) then
     msg.Result:=htright              //偶是右派
  else
  if (pt.y>height-5) then
     msg.Result:=htbottom             //偶是贫下中农
                                                                                                                                                         { http://www.csdn.net http://www.delphibox.com  bob008 原创 2005-03-14，严禁未经许可的转载，出版}
end;

procedure tButForm.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(dc, (width - 81), 5, 24, 20, imgmin.canvas.handle, 48, 0, SRCcopy);
        end
        else begin
          Bitblt(dc, (width - 81), 5, 24, 20, imgmin.canvas.handle, 0, 0, SRCcopy);
        end;
        if msg.HitTest = htmaxbutton then
        begin
          if windowstate = wsNormal then
          begin
            Bitblt(dc, (width - 56), 5, 24, 20, imgMax.canvas.handle, 48, 0, SRCcopy);
          end
          else if windowstate = wsMaximized then
          begin
            Bitblt(dc, (width - 56), 5, 24, 20, imgrestore.canvas.handle, 48, 0, SRCcopy);
          end;
        end
        else begin
          if windowstate = wsNormal then
          begin
            Bitblt(dc, (width - 56), 5, 24, 20, imgMax.canvas.handle, 0, 0, SRCcopy);
          end
          else if windowstate = wsMaximized then
          begin
            Bitblt(dc, (width - 56), 5, 24, 20, imgrestore.canvas.handle,0, 0, SRCcopy);
          end;
        end;
        //close
        if msg.HitTest = htclose then
        begin
          Bitblt(dc, (width - 31), 5, 24, 20, imgclose.canvas.handle, 48, 0, SRCcopy);
        end
        else begin
          Bitblt(dc, (width - 31), 5, 24, 20, imgclose.canvas.handle, 0, 0, SRCcopy);
        end;
      end;
    end;
  finally
    Releasedc(handle, cv.handle);
    cv.Free;
  end;
end;

procedure tButForm.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 - 81), 5, 24, 20, imgmin.Canvas.Handle, 24, 0, SRCCopy);
  end
  else
  if msg.HitTest=htmaxbutton then
    begin
    if WindowState = wsNormal then begin
      bitblt(cvs.Handle , (Width - 56), 5, 24, 20, imgMax.Canvas.Handle, 24, 0, SRCCopy);
    end
    else if WindowState = wsMaximized then begin
     bitblt(cvs.Handle , (Width - 56), 5, 24, 20, imgrestore.Canvas.Handle, 24, 0, SRCCopy);
    end;
  end
  else
  if msg.HitTest=htclose then
  begin
    bitblt(cvs.Handle , (Width - 31),5, 24, 20, imgclose.Canvas.Handle, 24, 0, SRCCopy);
  end
  else inherited;
  end;
  finally
    releasedc(handle,cvs.Handle);