xpbarmenu.pas

xpmenu,一个可以使界面美化的控件.你可以设置成你自己所喜欢的.

        TextRect.Left := TextRect.Left - 5;
    end
  end;
  /// Under Lines Add By Kingron,Fix Top MenuItem Bitmap Draw
  if FMenuItem.Bitmap <> nil then
    if FTopMenu then /// Top MenuItem
    begin
      Inc(TextRect.Left, B.Width); /// Adjust TextRect For Top MenuItem Bitmap
      IconRect.Top := TextRect.Top + (TextRect.Bottom - TextRect.Top - B.Height) div 4;
      if (TextRect.Bottom - TextRect.Top) < 20 then
        Dec(IconRect.Top, 3); /// Adjust For Low Height
    end
    else
    begin /// MenuItem
      if not HasImgLstBitmap then
      begin
        IconRect.Top := TextRect.Top + (TextRect.Bottom - TextRect.Top - FIconWidth div 2) div 4;
        if (TextRect.Bottom - TextRect.Top) >= FIconWidth then
          Dec(IconRect.Top, 3) /// Adjust For Low Height
      end
      else
      begin
        IconRect.Top := TextRect.Top + (TextRect.Bottom - TextRect.Top - FMenuItem.Parent.GetParentMenu.Images.Height div 2) div 4;
        if (TextRect.Bottom - TextRect.Top) <= FMenuItem.Parent.GetParentMenu.Images.Height then
          Dec(IconRect.Top, FMenuItem.Parent.GetParentMenu.Images.Height div 2) /// Adjust For Low Height
        else
          Dec(IconRect.Top, 4);
      end;
    end;
  /// Under Lines Fix The MenuItem IconRect Calc Err Bug under Win9x
  if not _IsOSoK and not FTopMenu and (HasImgLstBitmap or (FMenuItem.Bitmap.Width <20)) then
    Dec(IconRect.Top ,3);
  /// End Add

  if FTopMenu then
  begin
    ACanvas.brush.color := FFMenuBarColor;
    ACanvas.Pen.Color := FFMenuBarColor;

    ACanvas.FillRect(ARect);
  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;
      if (not FMenuItem.Enabled) and (Selected) then
      else
        ACanvas.FillRect(ARect);

      ACanvas.brush.color := FFIconBackColor;
      if (not FMenuItem.Enabled) and (Selected) then
      else
/// Under Line Modify by Kingron,To Fix the Gradient Bug under Win9x
/// Old : ACanvas.FillRect(IconRect);
        ACanvas.FillRect(Rect(IconRect.Left ,IconRect.Top -2,IconRect.Right,IconRect.Bottom +2));
    end;
//------------
  end;

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

  if Selected and FDrawSelect then
  begin
    ACanvas.brush.Style := bsSolid;
    if FTopMenu then
    begin
      DrawTopMenuItem(FMenuItem, ACanvas, ARect, FMenu.IsRightToLeft);
    end
    else
      //------
      if FMenuItem.Enabled then
      begin
        /// Under Lines Modify By Kingron,Frame 3D,IF Statement~~~~~~~
        if FFrame3D then
          DrawEdge(ACanvas.Handle, ARect, BDR_SUNKENOUTER, BF_RECT) /// Add By Kingron
        else begin /// Begin ... End == Old Code
          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;
      end;
      //-----

  end;

  DrawCheckedItem(FMenuItem, Selected, HasImgLstBitmap, ACanvas, CheckedRect);

//-----

  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 := FFIconBackColor;
      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}
    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 := FFIconBackColor;
      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

  else
    if FMenuItem.Bitmap.Width > 0 then
      B.Assign(TBitmap(FMenuItem.Bitmap));

  DrawIcon(FMenuItem, ACanvas, B, IconRect,
    Selected, 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, 5);
    end
    else
    begin
      TextFormat := 0;
      Inc(TextRect.Left, 5);
    end;

    DrawTheText(txt, ShortCutToText(FMenuItem.ShortCut),
      ACanvas, TextRect,
      Selected, FMenuItem.Enabled, FMenuItem.Default,
      FTopMenu, FMenu.IsRightToLeft, TextFormat);

//-----------
  end
  else
  begin
    if FMenu.IsRightToLeft then
    begin
      X1 := TextRect.Left;
      X2 := TextRect.Right - 7;
    end
    else
    begin
      /// Under Line Modified By Kingron
      /// Old: X1 := TextRect.Left + 7;
      X1 := TextRect.Left;
      X2 := TextRect.Right;
    end;

    ACanvas.Pen.Color := FFSeparatorColor;

    /// Under Lines Add By Kingron ,Adjust the Line Width!
    if FGradient then /// Adjust Width For Bar
      X1 := ARect.Left;
    /// End Add

    ACanvas.MoveTo(X1, TextRect.Top + Round((TextRect.Bottom - TextRect.Top) / 2));
    ACanvas.LineTo(X2, TextRect.Top + Round((TextRect.Bottom - TextRect.Top) / 2))
  end;

  B.free;

//------

  if not (csDesigning in ComponentState) then
  begin
    if (FFlatMenu) and (not FTopMenu) then
    begin
      hDcM := ACanvas.Handle;
      hWndM := WindowFromDC(hDcM);
      if hWndM <> FForm.Handle then
      begin
        DrawWindowBorder(hWndM, FMenu.IsRightToLeft);
      end;
    end;
  end;

//-----
  ActivateMenuItem(FMenuItem); // to check for new sub items
end;

{$IFDEF VER5U}

procedure TXPBarMenu.ToolBarDrawButton(Sender: TToolBar;
  Button: TToolButton; State: TCustomDrawState; var DefaultDraw: Boolean);

var
  ACanvas           : TCanvas;

  ARect, HoldRect   : TRect;
  B                 : TBitmap;
  HasBitmap         : boolean;
  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);
    Dec(BRect.Right, 1);

    WRect := BRect;
    if Button.Style = tbsDropDown then
    begin
      Dec(WRect.Right, 13);
      DrawRect;

      WRect := BRect;
      Inc(WRect.Left, WRect.Right - WRect.Left - 13);
      DrawRect;
    end
    else
    begin

      DrawRect;
    end;
  end;

begin

  B := nil;

  HasBitmap := (TToolBar(Button.Parent).Images <> nil) and
    (Button.ImageIndex <> -1) and
    (Button.ImageIndex <= TToolBar(Button.Parent).Images.Count - 1);

  IsTransparent := TToolBar(Button.Parent).Transparent;

  ACanvas := Sender.Canvas;

  SetGlobalColor(ACanvas);

  if (Is16Bit) and (not UseSystemColors) then
    FBSelectColor := NewColor(ACanvas, FSelectColor, 68)
  else
    FBSelectColor := FFSelectColor;

  HoldRect := Button.BoundsRect;

  ARect := HoldRect;

  {Causing problem when activiting the component at run time
  if FUseSystemColors then
  begin
    if (Button.MenuItem <> nil) then
    begin
      if (TToolBar(Button.Parent).Font.Name <> FFont.Name) or
         (TToolBar(Button.Parent).Font.Size <> FFont.Size) then
      begin

        TToolBar(Button.Parent).Font.Assign(FFont);
        Button.AutoSize := false;
        Button.AutoSize := true;

      end;
    end
  end;
  }
  if Is16Bit then
    ACanvas.brush.color := NewColor(ACanvas, clBtnFace, 16)
  else
    ACanvas.brush.color := clBtnFace;

  if not IsTransparent then
    ACanvas.FillRect(ARect);

  HasBorder := false;
  HasBkg := false;

  if (cdsHot in State) then
  begin
    if (cdsChecked in State) or (Button.Down) or (cdsSelected in State) then
      ACanvas.Brush.Color := FCheckedAreaSelectColor
    else
      ACanvas.brush.color := FBSelectColor;
    HasBorder := true;
    HasBkg := true;
  end;

  if (cdsChecked in State) and not (cdsHot in State) then
  begin
    ACanvas.Brush.Color := FCheckedAreaColor;
    HasBorder := true;
    HasBkg := true;
  end;

  if (cdsIndeterminate in State) and not (cdsHot in State) then
  begin
    ACanvas.Brush.Color := FBSelectColor;
    HasBkg := true;
  end;

  if (Button.MenuItem <> nil) and (State = []) then
  begin
    ACanvas.brush.color := FFMenuBarColor;
    if not IsTransparent then
      HasBkg := true;
  end;

  Inc(ARect.Top, 1);

  if HasBkg then
    ACanvas.FillRect(ARect);

  if HasBorder then
    DrawBorder;

  if (Button.MenuItem <> nil)
    and (cdsSelected in State) then
  begin
    DrawTopMenuItem(Button, ACanvas, ARect, false);
    DefaultDraw := false;
  end;

  ARect := HoldRect;
  DefaultDraw := false;

  if Button.Style = tbsDropDown then
  begin
    ACanvas.Pen.Color := clBlack;
    DrawArrow(ACanvas, (ARect.Right - 14) + ((14 - 5) div 2),
      ARect.Top + ((ARect.Bottom - ARect.Top - 3) div 2) + 1);
  end;

  BitmapWidth := 0;
  if HasBitmap then
  begin

    try
      B := TBitmap.Create;

      B.Width := TToolBar(Button.Parent).Images.Width;
      B.Height := TToolBar(Button.Parent).Images.Height;
      B.Canvas.Brush.Color := ACanvas.Brush.Color;
      B.Canvas.FillRect(Rect(0, 0, B.Width, B.Height));
      ImageList_DrawEx(TToolBar(Button.Parent).Images.Handle, Button.ImageIndex,
        B.Canvas.Handle, 0, 0, 0, 0, clNone, clNone, ILD_Transparent);

      BitmapWidth := b.Width;

      if Button.Style = tbsDropDown then
        Dec(ARect.Right, 12);

      if TToolBar(Button.Parent).List then
      begin

        if Button.BiDiMode = bdRightToLeft then
        begin
          Dec(ARect.Right, 3);
          ARect.Left := ARect.Right - BitmapWidth;

        end
        else
        begin
          Inc(ARect.Left, 3);
          ARect.Right := ARect.Left + BitmapWidth
        end

      end
      else
        ARect.Left := Round(ARect.Left + (ARect.Right - ARect.Left - B.Width) / 2);

      inc(ARect.Top, 2);
      ARect.Bottom := ARect.Top + B.Height + 6;

      DrawIcon(Button, ACanvas, B, ARect, (cdsHot in State),
        (cdsSelected in State), Button.Enabled, (cdsChecked in State), false,
        false);
    finally
      B.Free;
    end;
    ARect := HoldRect;
    DefaultDraw := false;
  end;
//-----------

  if TToolBar(Button.Parent).ShowCaptions then
  begin

    if Button.Style = tbsDropDown then
      Dec(ARect.Right, 12);

    if not TToolBar(Button.Parent).List then
    begin
      TextFormat := DT_Center;
      ARect.Top := ARect.Bottom - ACanvas.TextHeight(Button.Caption) - 3;
    end