xpmenu.pas

这是一个门禁系统的应用程序,用 delphi编写,希望与大家交流.

  hWndM: HWND;
  hDcM: HDC;
  DrawTopMenuBorder: boolean;
  msg: TMSG; // +jt
  buff: TBitmap; // +jt
 OrigRect: TRect; // +jt
 OrigCanvas: TCanvas; // +jt
begin


  OrigCanvas:= nil;

  FTopMenu := false;
  FMenuItem := TMenuItem(Sender);

// +jt
  B := TBitmap.Create;
  buff := TBitmap.Create;
  try
   origrect:= ARect;
   Dec(origrect.Left,4);
   origcanvas:=ACanvas;
   ARect.Right:=(ARect.Right-ARect.Left)+4;
   ARect.Bottom:=ARect.Bottom-ARect.Top;
   ARect.Left:=4;
   ARect.Top:=0;
   buff.Width := ARect.Right;
   buff.Height := ARect.Bottom;
   ACanvas:=buff.Canvas;
  // +jt
  //SetGlobalColor(ACanvas);

  if FMenuItem.Caption = '-' then IsLine := true else IsLine := false;

  FMenu := FMenuItem.Parent.GetParentMenu;

  if FMenu is TMainMenu then
    for i := 0 to FMenuItem.GetParentMenu.Items.Count - 1 do
      if FMenuItem.GetParentMenu.Items[i] = FMenuItem then
      begin
        FTopMenu := True;
  // +jt
        ARect.Left:=0;
       Inc(origrect.Left,4);
       Dec(ARect.Right,4);
       buff.Width:=ARect.Right;
       Dec(ARect.Bottom,1);
  // +jt
        break;
      end;
  if(FColorsChanged) then SetGlobalColor(ACanvas); // +jt

  ACanvas.Font.Assign(FFont);

  Inc(ARect.Bottom, 1);
  TextRect := ARect;
  txt := ' ' + FMenuItem.Caption;

//  B := TBitmap.Create;     //Leslie Cutting [e-mail]  Jul 8 2003
  HasBitmap := false;
  HasImgLstBitmap := false;


  if (FMenuItem.Parent.GetParentMenu.Images <> nil)
  {$IFDEF VER5U}
  or (FMenuItem.Parent.SubMenuImages <> nil)
  {$ENDIF}
  then
  begin
    if FMenuItem.ImageIndex <> -1 then
      HasImgLstBitmap := true
    else
      HasImgLstBitmap := false;
  end;

  if FMenuItem.Bitmap.Width  > 0 then
    HasBitmap := true;

  //-------
  if HasBitmap then
    begin
      B.Width := FMenuItem.Bitmap.Width;
      B.Height := FMenuItem.Bitmap.Height;
  // +jt
     //B.Canvas.Brush.Color := FTransparentColor; // ACanvas.Brush.Color;
     B.Canvas.Brush.Color := B.Canvas.Pixels[0, B.Height - 1];//"Todd Asher" <[e-mail]>
     B.Canvas.FillRect(Rect(0, 0, B.Width, B.Height));
     FMenuItem.Bitmap.Transparent := true;
     FMenuItem.Bitmap.TransparentMode := tmAuto;
      B.Canvas.Draw(0,0,FMenuItem.Bitmap);
  // +jt
    end;


  if HasImgLstBitmap then
  begin
  {$IFDEF VER5U}
    if FMenuItem.Parent.SubMenuImages <> nil then
    begin
      ImgListHandle := FMenuItem.Parent.SubMenuImages.Handle;
      ImgIndex := FMenuItem.ImageIndex;

      B.Width := FMenuItem.Parent.SubMenuImages.Width;
      B.Height := FMenuItem.Parent.SubMenuImages.Height;
     // B.Canvas.Brush.Color := FTransparentColor; // ACanvas.Brush.Color; // +jt
      B.Canvas.Brush.Color := B.Canvas.Pixels[0, B.Height - 1];//"Todd Asher" <[e-mail]>
      B.Canvas.FillRect(Rect(0, 0, B.Width, B.Height));
      ImageList_DrawEx(ImgListHandle, ImgIndex,
        B.Canvas.Handle, 0, 0, 0, 0, clNone, clNone, ILD_Transparent);

    end
    else
  {$ENDIF}
    if FMenuItem.Parent.GetParentMenu.Images <> nil then
    begin
      ImgListHandle := FMenuItem.Parent.GetParentMenu.Images.Handle;
      ImgIndex := FMenuItem.ImageIndex;

      B.Width := FMenuItem.Parent.GetParentMenu.Images.Width;
      B.Height := FMenuItem.Parent.GetParentMenu.Images.Height;
      //B.Canvas.Brush.Color := FTransparentColor; //ACanvas.Pixels[2,2]; // +jt
      B.Canvas.Brush.Color := B.Canvas.Pixels[0, B.Height - 1];//"Todd Asher" <[e-mail]>
      B.Canvas.FillRect(Rect(0, 0, B.Width, B.Height));
      ImageList_DrawEx(ImgListHandle, ImgIndex,
        B.Canvas.Handle, 0, 0, 0, 0, clNone, clNone, ILD_Transparent);

    end;

  end;

  //-----

  if FMenu.IsRightToLeft then
  begin
    X1 := ARect.Right - FIconWidth;
    X2 := ARect.Right;
  end
  else
  begin
    X1 := ARect.Left;
    X2 := ARect.Left + FIconWidth;
  end;
  IconRect := Rect(X1, ARect.Top, X2, ARect.Bottom);


  if HasImgLstBitmap or HasBitmap then
  begin
    CheckedRect := IconRect;
    Inc(CheckedRect.Left, 1);
    Inc(CheckedRect.Top, 2);
    Dec(CheckedRect.Right, 3);
    Dec(CheckedRect.Bottom, 2);
  end
  else
  begin
    CheckedRect.Left := IconRect.Left +
      (IConRect.Right - IconRect.Left - 10) div 2;
    CheckedRect.Top := IconRect.Top +
      (IConRect.Bottom - IconRect.Top - 10) div 2;
    CheckedRect.Right := CheckedRect.Left + 10;
    CheckedRect.Bottom := CheckedRect.Top + 10;
  end;

  if B.Width > FIconWidth then
    if FMenu.IsRightToLeft then
      CheckedRect.Left := CheckedRect.Right - B.Width
    else
      CheckedRect.Right := CheckedRect.Left + B.Width;

  if FTopMenu then Dec(CheckedRect.Top, 1);


  if FMenu.IsRightToLeft then
  begin
    X1 := ARect.Left;
    if not FTopMenu then
      Dec(X2, FIconWidth)
    else
      Dec(X2, 4);
    if (ARect.Right - B.Width) < X2 then
      X2 := ARect.Right - B.Width - 8;
  end
  else
  begin
    X1 := ARect.Left ;
    if not FTopMenu then
      Inc(X1, FIconWidth)
    else
      Inc(X1, 4);

    if (ARect.Left + B.Width) > X1 then
      X1 := ARect.Left + B.Width + 4;
    X2 := ARect.Right;
  end;

  TextRect := Rect(X1, ARect.Top, X2, ARect.Bottom);
  // +jt
  FillRect := ARect;
  Dec(FillRect.Left,4);
  // +jt

  if FTopMenu then
  begin
    if not (HasImgLstBitmap or HasBitmap) then
    begin
      TextRect := ARect;
    end
    else
    begin
      if FMenu.IsRightToLeft then
        TextRect.Right := TextRect.Right + 5
      else
        TextRect.Left := TextRect.Left - 5;
    end

  end;

  if FTopMenu then
  begin
    if FDrawMenuBar then
      FFMenuBarColor := FMenuBarColor;
    ACanvas.brush.color := FFMenuBarColor;
    ACanvas.Pen.Color := FFMenuBarColor;
  //    Inc(ARect.Bottom, 2);
    ACanvas.FillRect(ARect);

  //--
    if FDrawMenuBar then
    begin
      if FMenuItem.GetParentMenu.Items[FMenuItem.GetParentMenu.Items.Count-1] =
         FMenuItem then
      begin
        if FMenu.IsRightToLeft then
          ACanvas.Rectangle(3, ARect.Top, ARect.Right, ARect.Bottom)
        else
          ACanvas.Rectangle(ARect.Left, ARect.Top, TScrollingWinControl(FMenu.Owner).ClientWidth+5{FForm.ClientWidth+5},
           ARect.Bottom);
      end
      else
        if FMenu.IsRightToLeft then
          ACanvas.Rectangle(ARect.Left, ARect.Top, ARect.Right+7, ARect.Bottom);
    end;
  //--
  end
  else
  begin
    if (Is16Bit and FGradient) then
    begin
      inc(ARect.Right,2);  //needed for RightToLeft
      DrawGradient(ACanvas, ARect, FMenu.IsRightToLeft);
      Dec(ARect.Right,2);

    end
    else
    begin
      ACanvas.brush.color := FFColor;
      ACanvas.FillRect(FillRect); // +jt
      ACanvas.brush.color := FFIconBackColor;
      ACanvas.FillRect(IconRect);
    end;


  //------------
  end;


  if FMenuItem.Enabled then
    ACanvas.Font.Color := FFont.Color
  else
    ACanvas.Font.Color := FDisabledColor;

  DrawTopMenuBorder := false;
  if Selected and FDrawSelect then
  begin
    ACanvas.brush.Style := bsSolid;
    if FTopMenu then
    begin
      DrawTopMenuItem(FMenuItem, ACanvas, ARect, FMenuBarColor, FMenu.IsRightToLeft);
    end
    else
    if FMenuItem.Enabled then
    begin
      Inc(ARect.Top, 1);
      Dec(ARect.Bottom, 1);
      if FFlatMenu then
        Dec(ARect.Right, 1);
      ACanvas.brush.color := FFSelectColor;
      ACanvas.FillRect(ARect);
      ACanvas.Pen.color := FFSelectBorderColor;
      ACanvas.Brush.Style := bsClear;
      ACanvas.RoundRect(Arect.Left, Arect.top, Arect.Right, Arect.Bottom, 0, 0);
      Dec(ARect.Top, 1);
      Inc(ARect.Bottom, 1);
      if FFlatMenu then
        Inc(ARect.Right, 1);
    end;
    DrawTopMenuBorder := true;
  end

  // Draw the menubar in XP Style when hovering over an main menu item
  else
  begin
    //if FMenuItem.Enabled and FTopMenu and IsMouseInRect( TScrollingWinControl(FMenu.Owner), ARect) then
    if FMenuItem.Enabled and FTopMenu and IsWNT and
       IsMouseInRect( TScrollingWinControl(FMenu.Owner), origrect) then // +jt
    begin
      ACanvas.brush.Style := bsSolid;
      ACanvas.brush.color := FFSelectColor;
      DrawTopMenuBorder := true;
      ACanvas.Pen.color := FFSelectBorderColor;
      ACanvas.Rectangle(ARect.Left, ARect.Top, ARect.Right - 7, ARect.Bottom);
    end;
  end;


  if (FMenuItem.Checked) or (FMenuItem.RadioItem ) then  //x
    DrawCheckedItem(FMenuItem, Selected, FMenuItem.Enabled, HasImgLstBitmap or HasBitmap,
                    ACanvas, CheckedRect);

  if (B <> nil) and (B.Width > 0) then  // X
    DrawIcon(FMenuItem, ACanvas, B, IconRect,
      Selected or DrawTopMenuBorder, false, FMenuItem.Enabled, FMenuItem.Checked,
      FTopMenu, FMenu.IsRightToLeft);



  if not IsLine then
  begin

    if FMenu.IsRightToLeft then
    begin
      TextFormat := DT_RIGHT + DT_RTLREADING;
      Dec(TextRect.Right, 3);
    end
    else
    begin
      TextFormat := 0;
      Inc(TextRect.Left, 3);
    end;
    TextRect.Top := TextRect.Top +
        ((TextRect.Bottom - TextRect.Top) - ACanvas.TextHeight('W')) div 2;
    DrawTheText(FMenuItem, txt, ShortCutToText(FMenuItem.ShortCut),
      ACanvas, TextRect,
      Selected, FMenuItem.Enabled, FMenuItem.Default,
      FTopMenu, FMenu.IsRightToLeft, FFont, TextFormat);

  end
  else
  begin
    if FMenu.IsRightToLeft then
    begin
      X1 := TextRect.Left;
      X2 := TextRect.Right - 7;
    end
    else
    begin
      X1 := TextRect.Left + 7;
      X2 := TextRect.Right;
    end;

    ACanvas.Pen.Color := FFSeparatorColor;
    ACanvas.MoveTo(X1,
      TextRect.Top +
      Round((TextRect.Bottom - TextRect.Top) / 2));
    ACanvas.LineTo(X2,
      TextRect.Top +
      Round((TextRect.Bottom - TextRect.Top) / 2))
  end;

  // +jt
    BitBlt(origcanvas.Handle,origrect.Left,origrect.Top,buff.Width,buff.Height,ACanvas.Handle,0,0,SRCCOPY);
  finally
   B.free;
   buff.free;
   ACanvas := OrigCanvas;
   ARect:=origrect;
  end;
// +jt
  if not (csDesigning in ComponentState) then
  begin
    if (FFlatMenu) and (not FTopMenu) then
    begin
      hDcM := ACanvas.Handle;
      hWndM := WindowFromDC(hDcM);
// +jt
      if (hWndM=0) and (Application.Handle<>0) then
     begin
       if not PeekMessage(msg,Application.Handle,WM_DRAWMENUBORDER,WM_DRAWMENUBORDER2,PM_NOREMOVE) then
         PostMessage(Application.Handle,WM_DRAWMENUBORDER,0,Integer(FMenuItem));
     end
     else
     if hWndM <> FForm.Handle then
     begin
       if not PeekMessage(msg,Application.Handle,WM_DRAWMENUBORDER,WM_DRAWMENUBORDER2,PM_NOREMOVE) then
         PostMessage(Application.Handle,WM_DRAWMENUBORDER2,integer(FMenu.IsRightToLeft),Integer(hWndM));
     end;
   end;
  end;

//-----

end;

{$IFDEF VER5U}
procedure TXPMenu.ToolBarDrawButton(Sender: TToolBar;
  Button: TToolButton; State: TCustomDrawState; var DefaultDraw: Boolean);

var
  ACanvas: TCanvas;

  ARect, HoldRect: TRect;
  B: TBitmap;
  HasBitmap: boolean;
  {Sylvain ...}
  HasHotBitMap : Boolean;
  HasDisBitMap : Boolean;
  ImglstHand   : THandle;
  CanDraw      : Boolean;
  {... Sylvain}
  BitmapWidth: integer;
  TextFormat: integer;
  XButton: TToolButton;
  HasBorder: boolean;
  HasBkg: boolean;
  IsTransparent: boolean;
  FBSelectColor: TColor;

  procedure DrawBorder;
  var
    BRect, WRect: TRect;
    procedure DrawRect;
    begin
      ACanvas.Pen.color := FFSelectBorderColor;
      ACanvas.MoveTo(WRect.Left, WRect.Top);
      ACanvas.LineTo(WRect.Right, WRect.Top);
      ACanvas.LineTo(WRect.Right, WRect.Bottom);
      ACanvas.LineTo(WRect.Left, WRect.Bottom);
      ACanvas.LineTo(WRect.Left, WRect.Top);
    end;

  begin
    BRect := HoldRect;
    Dec(BRect.Bottom, 1);
    Inc(BRect.Top, 1);