unitcf.pas

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

    cvs.Free;
  end;
end;

procedure tButForm.wmnclbuttondblclk(var msg:TWMNCLButtonDblClk);
begin
  if msg.HitTest=htcaption then
     if windowstate<>wsMaximized then
        windowstate:=wsMaximized
        else
        windowstate:=wsnormal;
end;

procedure TButForm.FormResize(Sender: TObject);
var
  rgn1:HRGN;
  rgn:HRGN;
  pts:Array[0..2] of TPoint;

begin

pts[0]:=point(width-6,0);
pts[1]:=point(width,0);
pts[2]:=point(width,6);

  rgn1:=createpolygonrgn(pts,3,1);
  rgn:=CreateRectRgn(0,0,width,height);
  combinergn(rgn,rgn,rgn1,RGN_diff);
  setwindowrgn(handle,rgn,true);
  deleteobject(rgn1);
  mnuBarBK.Width :=width-40;
  mnubarbk.Left:=20;
  mnuBarBK.Top:=29;
  mnubar.Top:=-2;
  self.Constraints.MinWidth := 380; //最小宽度401，不然偶画那么多干哈
  self.Constraints.MinHeight := 38; //同上理，这个高度倒是无所谓，还可以小点的
  self.Constraints.MaxHeight :=getsystemmetrics(sm_cyfullscreen)+getsystemmetrics(sm_cycaption);
  self.Constraints.MaxWidth :=getsystemmetrics(sm_cxfullscreen);
  Invalidate; //这句很重要哦
end;

procedure TButForm.FormPaint(Sender: TObject);
begin
  DrawActivate;//在窗体的绘制中使用偶们的，主要是让它产生WM PAINT消息
               //以保持持久的外观显示
end;

procedure TButForm.FormCreate(Sender: TObject);
begin
  borderstyle:=bsnone;   //设置为BSNONE样式
 // font.Name :='宋体';
 // font.Charset :=GB2312_CHARSET;
 // SCALED:=FALSE;
 // 上面3句是给在2000/XP下设计界面到98下文字变形的解决方法
  if assigned(menu) then //如果有TMAINMENU
     begin
       mnuBarBK.Visible:=true;
       mnuBar.Menu :=Menu;
       Menu:=nil;
     end
  else                  //否则
     mnuBarBK.Visible :=false;

  FormResize(sender);
  MenueDrawItemX(Menu);
  application.Minimize;
  application.Restore;
end;

procedure tbutform.DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
    Selected: Boolean);
begin
    MenueDrawItem(Sender, ACanvas, ARect, Selected);
end;

procedure tbutform.MenueDrawItemX(xMenu: TMenu);
  var
    i: integer;
    B: TBitmap;
    FMenuItem: TMenuItem;
  begin
    B := TBitmap.Create;
    B.Width := 1;
    B.Height := 1;
    for i := 0 to ComponentCount - 1 do
      if Components[i] is TMenuItem then
        begin
          FMenuItem := TMenuItem(Components[i]);
          FMenuItem.OnDrawItem := DrawItem;
          if (FMenuItem.ImageIndex = -1) and
             (FMenuItem.Bitmap.width = 0) and (xMenu <> nil) then
            if FMenuItem.GetParentComponent.Name <> xMenu.Name then
              FMenuItem.Bitmap.Assign(b );
        end;
    B.Free;
    DrawMenuBar(handle);
end;

procedure MenueDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
    Selected: Boolean);
  var
    txt: string;
    B: TBitmap;
  
    IConRect, TextRect: TRect;
    FBackColor, FIconBackColor, FSelectedBkColor, FFontColor, FSelectedFontColor,
      FDisabledFontColor, FSeparatorColor, FCheckedColor: TColor;
  
    i, X1, X2: integer;
    TextFormat: integer;
    HasImgLstBitmap: boolean;
    FMenuItem: TMenuItem;
    FMenu: TMenu;
  
  begin
    FMenuItem := TMenuItem(Sender);
    FMenu := FMenuItem.Parent.GetParentMenu;
  
    FBackColor := $00f5f5f7;
    FIconBackColor :=clbtnface;
    FSelectedBkColor := $00e2f2f2;
  
    FFontColor := clBlack;
    FSelectedFontColor := clolive;
    FDisabledFontColor := clGray;
    FSeparatorColor :=clbtnface;
    FCheckedColor := clGray;
  
    if FMenu.IsRightToLeft then
      begin
        X1 := ARect.Right - 20;
        X2 := ARect.Right;
      end
    else
      begin
        X1 := ARect.Left;
        X2 := ARect.Left + 20;
      end;
    IConRect := Rect(X1, ARect.Top, X2, ARect.Bottom);
  
    TextRect := ARect;
    txt := ' ' + FMenuItem.Caption;
  
    B := TBitmap.Create;
  
    B.Transparent := True;
    B.TransparentMode := tmAuto;
    

    HasImgLstBitmap := false;
    if (FMenuItem.Parent.GetParentMenu.Images <>  nil) or
       (FMenuItem.Parent.SubMenuImages <> nil) then
      begin
        if FMenuItem.ImageIndex <> -1 then
          HasImgLstBitmap := true
        else
          HasImgLstBitmap := false;
      end;
  
    if HasImgLstBitmap then
      begin
        if FMenuItem.Parent.SubMenuImages <> nil then
          FMenuItem.Parent.SubMenuImages.GetBitmap(FMenuItem.ImageIndex, B)
        else
          FMenuItem.Parent.GetParentMenu.Images.GetBitmap(FMenuItem.ImageIndex, B)
      end
    else
      if FMenuItem.Bitmap.Width > 0 then
        B.Assign(TBitmap(FMenuItem.Bitmap));
  
    if FMenu.IsRightToLeft then
      begin
        X1 := ARect.Left;
        X2 := ARect.Right - 20;
      end
    else
      begin
        X1 := ARect.Left + 20;
        X2 := ARect.Right;
      end;
    TextRect := Rect(X1, ARect.Top+3, X2, ARect.Bottom);
  
    ACanvas.brush.color := FBackColor;

    ACanvas.FillRect(arect);


    if FMenu is TMainMenu then
      for i := 0 to FMenuItem.GetParentMenu.Items.Count - 1 do
        if FMenuItem.GetParentMenu.Items[i] = FMenuItem then
          begin
            ACanvas.brush.color := FIConBackColor;
            ACanvas.FillRect(ARect);
            if (FMenuItem.ImageIndex = -1) and (FMenuItem.Bitmap.width = 0) then
              begin
                TextRect := ARect;
                break;
              end;
          end;
  
    ACanvas.brush.color := FIconBackColor;
    ACanvas.FillRect(IconRect);
  
    if FMenuItem.Enabled then
      ACanvas.Font.Color := FFontColor
    else
      ACanvas.Font.Color := FDisabledFontColor;
  
    if Selected then
      begin
        ACanvas.brush.Style := bsSolid;
        ACanvas.brush.color := FSelectedBkColor;
        ACanvas.FillRect(arect);//TextRect);

        ACanvas.Pen.color := FSelectedFontColor;
acanvas.Font.Name := '宋体';
acanvas.Font.Size := 9;
acanvas.font.Color :=$00000031;
acanvas.Font.Charset := GB2312_CHARSET;
        ACanvas.Brush.Style := bsClear;
        ACanvas.RoundRect(TextRect.Left-20, TextRect.top-3, TextRect.Right,
                          TextRect.Bottom, 0, 0);
  
        if FMenuItem.Enabled then
          ACanvas.Font.Color := FSelectedFontColor;
      end;
  
    X1 := IConRect.Left + 2;
    if B <> nil then
      ACanvas.Draw(X1, IConRect.top + 1, B);
  
    if FMenuItem.Checked then
      begin
        ACanvas.Pen.color := FCheckedColor;
        ACanvas.Brush.Style := bsClear;
        ACanvas.RoundRect(IconRect.Left-20, IconRect.top, IconRect.Right,
                          IconRect.Bottom, 3, 3);
      end;
  
    if not FMenuItem.IsLine then
      begin
        SetBkMode(ACanvas.Handle, TRANSPARENT);
  
acanvas.Font.Name := '宋体';
acanvas.Font.Size := 9;
acanvas.font.Color :=$00000031;
acanvas.Font.Charset := GB2312_CHARSET;
        if FMenu.IsRightToLeft then
          ACanvas.Font.Charset := ARABIC_CHARSET;
  
        if FMenu.IsRightToLeft then
          TextFormat := DT_RIGHT + DT_RTLREADING
        else
          TextFormat := 0;
  
  
        if FMenuItem.Default then
          begin
            Inc(TextRect.Left, 1);
            Inc(TextRect.Right, 1);
            Inc(TextRect.Top, 1);
            ACanvas.Font.color := clGray;
            DrawtextEx(ACanvas.Handle,
                       PChar(txt),
                       Length(txt),
                       TextRect, TextFormat, nil);
  
            Dec(TextRect.Left, 1);
            Dec(TextRect.Right, 1);
            Dec(TextRect.Top, 1);

            ACanvas.Font.color := FFontColor;
          end;
  
        DrawtextEx(ACanvas.Handle,
                   PChar(txt),
                   Length(txt),
                   TextRect, TextFormat, nil);
  
        txt := ShortCutToText(FMenuItem.ShortCut) +  ' ';
  
        if FMenu.IsRightToLeft then
          TextFormat := DT_LEFT
        else
          TextFormat := DT_RIGHT;
  
        DrawtextEx(ACanvas.Handle,
                   PChar(txt),
                   Length(txt),
                   TextRect, TextFormat, nil);
      end
    else
      begin
        ACanvas.Pen.Color := FSeparatorColor;
        ACanvas.MoveTo(ARect.Left + 10,
                       TextRect.Top +
                       Round((TextRect.Bottom - TextRect.Top) / 2));
        ACanvas.LineTo(ARect.Right - 2,
                       TextRect.Top +
                       Round((TextRect.Bottom - TextRect.Top) / 2))
      end;
  

    B.free;
end;

procedure TButForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  pt     :Tpoint;
  synrect:Trect;
  ax,ay  :Integer;
begin
  ax:=x;ay:=y;
  pt:=clienttoscreen(point(ax,ay));
  synrect:=rect((left+18),(top+5),(left+36),(top+25));
  if ptinrect(synrect,pt) and (button=mbleft) then
  begin
    sysmnu.Popup(pt.x,pt.y);
  end;
end;

procedure TButForm.N1Click(Sender: TObject);
begin
  sendmessage(handle,wm_syscommand,sc_restore, 0);
end;

procedure TButForm.N2Click(Sender: TObject);
begin
   sendmessage(handle,wm_syscommand,sc_move, 0);
end;

procedure TButForm.S1Click(Sender: TObject);
begin
  sendmessage(handle,wm_syscommand,sc_size, 0);
end;

procedure TButForm.N3Click(Sender: TObject);
begin
   sendmessage(handle,wm_syscommand,SC_MINIMIZE, 0);
end;

procedure TButForm.N4Click(Sender: TObject);
begin
  sendmessage(handle,wm_syscommand,SC_MAXIMIZE, 0);
end;

procedure TButForm.N6Click(Sender: TObject);
begin
  sendmessage(handle,wm_syscommand,SC_close, 0);
end;
{
好了，至此，这个可继承的窗体就制作完成了
重装系统，还没来得及装个代码整理工具，将就看看吧

我不是郭靖~我不会武功~我只要蓉妹妹~完美的爱情~

泡泡堂之一二：
     1. 兔子和乌龟赛跑，兔子跑在前面，乌龟在后面慢慢爬，突然乌龟掏出一只墨镜
        嗖的一下冲到了兔子的前面，兔子在乌龟后面气的破口大骂：王8蛋，你TMD用道具

     2. 昨日，小乖和某螃蟹玩泡泡，好不容易泡到他鸟，正准备抓回来煮了吃，不料螃蟹
        掏出一支吗啡狠狠的扎在self 上，迅速逃脱鸟小乖的try，嘴里还念到：“这年头
        的吗啡好贵呀，真可惜，看我的~小李飞镖”，小乖大怒，夺命飞镖连发一十二回，
        终于扎到螃蟹无力反抗，小乖恨道：小样，和你祖宗玩小李飞镖，吃了你。螃蟹说
        道：靠，要不是偶只有12支吗啡，你能抓住偶偶让你煮着吃。

最后说句话：
    抽的烟钱找哪位大哥报啊？
}
end.