unit1.pas

BarMenus230.zip

procedure TForm1.MnuNewClick(Sender: TObject);
begin
  ShowMessage(PChar('You clicked item "' + TMenuItem(Sender).Caption + '"'));
end;

procedure TForm1.Downloadlatestversion1Click(Sender: TObject);
begin
  ShellExecute(Handle, 'open',
    'http://Mintus.Codefield.com/download/BarMenus.zip', nil, nil, SW_NORMAL);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  { setup selection colors for ownerdrawn items }
  mnuCustom1.Tag := clBlack;
  mnuCustom2.Tag := clRed;
  mnuCustom3.Tag := clGreen;
  mnuCustom4.Tag := clNavy;
  mnuCustom5.Tag := clPurple;
  mnuCustom6.Tag := clOlive;
  mnuCustom7.Tag := clTeal;
end;

procedure TForm1.BcBarPopupMenu3BeforeDrawBar(Sender: TObject;
  ACanvas: TCanvas; ARect: TRect; var DefaultDraw: Boolean);
begin
  DefaultDraw := False; { do not allow default drawing }
  with ACanvas do
  begin
    { background color }
    Brush.Color := clBtnFace;
    FillRect(ARect);

    { fill the bar with something }
    Brush.Bitmap := AllocPatternBitmap(clRed, clYellow);
    Pen.Color := clBlack;
    RoundRect(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom,
      (ARect.Right - ARect.Left), (ARect.Bottom - ARect.Top) div 8);
  end;
end;

procedure TForm1.BcBarPopupMenu1AfterDrawBar(Sender: TObject;
  ACanvas: TCanvas; ARect: TRect);
begin
  with Image1.Canvas do
  begin
    { empty the image }
    Brush.Color := Form1.Color;
    FillRect(Rect(0, 0, Image1.Width, Image1.Height));
    { copy the menu bar to the image1 }
    CopyRect(ARect, ACanvas, ARect);
  end;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  BcBarMainMenu1.Bar.Visible := not TCheckBox(Sender).Checked;
end;

procedure TForm1.CheckBox2Click(Sender: TObject);
begin
  MnuFile.Visible := not TCheckBox(Sender).Checked;
  BcBarMainMenu1.FlushDoubleBuffer;
end;

procedure TForm1.CheckBox3Click(Sender: TObject);
begin
  MnuNew.Visible := not TCheckBox(Sender).Checked;
  BcBarMainMenu1.FlushDoubleBuffer;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  BcBarPopupMenu1.FlushDoubleBuffer;
  BcBarPopupMenu2.FlushDoubleBuffer;
  BcBarPopupMenu3.FlushDoubleBuffer;
  BcBarMainMenu1.FlushDoubleBuffer;
  Image1.Picture.Graphic := nil;

  FreeAndNil(FDrawBuffer); // free this too
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  FontDialog1.Font.Assign(BcBarPopupMenu3.MenuFont);
  if FontDialog1.Execute then
    BcBarPopupMenu3.MenuFont.Assign(FontDialog1.Font);
end;

procedure TForm1.CheckBox4Click(Sender: TObject);
begin
  Button2.Enabled := not TCheckBox(Sender).Checked;
  BcBarPopupMenu3.UseSystemFont := TCheckBox(Sender).Checked;
end;

procedure TForm1.Inthismenu1MeasureItem(Sender: TObject; ACanvas: TCanvas;
  var Width, Height: Integer);
begin
  Width := 350;
end;

procedure TForm1.BcBarPopupMenu2MeasureMenuItem(Sender: TObject;
  AMenuItem: TMenuItem; ACanvas: TCanvas; var Width, Height: Integer;
  ABarVisible: Boolean; var DefaultMeasure: Boolean);
begin
  DefaultMeasure := False;
  if not (AMenuItem.Caption = cLineCaption) then
  begin
    Height := 22;
    Width := Width + 32;
  end;
end;

procedure TForm1.BcCustomDrawModule1DrawMenuItem(Sender: TObject;
  AMenuItem: TMenuItem; ACanvas: TCanvas; ARect: TRect;
  State: TOwnerDrawState; ABarVisible: Boolean; var DefaultDraw: Boolean);
var
  R: TRect;
  ImageList: TCustomImageList;

  procedure DrawCheckedPattern(Inflate: Boolean);
  begin
    if odChecked in State then
    begin
      if Inflate then InflateRect(R, -2, -2);
//      ACanvas.Brush.Bitmap := AllocPatternBitmap(clBtnFace, clWhite);
//      ACanvas.FillRect(R);
      ACanvas.Brush.Color := clBlack;
      ACanvas.FrameRect(R);
      if Inflate then InflateRect(R, 2, 2);
    end;
  end;

begin
  DefaultDraw := False;
  { menuitem drawing }
  if (AMenuItem.Caption = cLineCaption) then
  begin
    { background }
    DrawGradient(ACanvas, ARect, clWhite, clBtnFace, gsHorizontal);

    { align the text and draw it }
    R := ARect;
    R.Left := R.Right - ACanvas.TextWidth(AMenuItem.Hint) - 15;
    ACanvas.Brush.Style := bsClear;
    DrawText(ACanvas.Handle,
      PChar(AMenuItem.Hint), Length(AMenuItem.Hint),
      R, 0);

    { draw the line so that it won't draw over text }
    R := ARect;
    Inc(R.Top, (R.Bottom - R.Top) div 2);
    R.Bottom := R.Top + 1;
    Dec(R.Right, ACanvas.TextWidth(AMenuItem.Hint) + 10 + 10);
    ACanvas.Brush.Color := clGray;
    ACanvas.FillRect(R);
  end else
  begin
    { use default drawing for mainmenu top items }
    if IsInTopMainMenu(AMenuItem) then
    begin
      DefaultDraw := True;
      Exit;
    end;
    with ACanvas do
    begin
      R := ARect;
      if odSelected in State then
      begin
        { draw frame and selection gradient }
        Brush.Color := clGray;
        FrameRect(R);
        InflateRect(R, -2, -2);
        DrawGradient(ACanvas, R, clWhite, AMenuItem.Tag, gsDiagonalLeftRight);
        DrawCheckedPattern(False);
        { adjust rect so that text will be aligned to right }
        R.Left := R.Right - TextWidth(AMenuItem.Caption) - 5;
        Pen.Color := clWhite; // caption color
      end else
      begin
        { draw background gradient }
        DrawGradient(ACanvas, R, clWhite, clBtnFace, gsHorizontal);
        DrawCheckedPattern(True);
        { leave space for menuitem image }
        Inc(R.Left, 38);
        Pen.Color := clBlack; // caption color
      end;

      { draw caption }
      InflateRect(R, 0, -(
        (R.Bottom - R.Top - TextHeight(AMenuItem.Caption) - 1)
         div 2));
      Brush.Style := bsClear;
      DrawText(Handle,
        PChar(AMenuItem.Caption), Length(AMenuItem.Caption),
        R, 0);

      { draw menuitem image }
      with AMenuItem do
      begin
        ImageList := GetImageList;
        if (ImageIndex <> -1) and Assigned(ImageList) then
          ImageList.Draw(ACanvas, ARect.Left + 11,
            ARect.Top + (ARect.Bottom - ARect.Top - ImageList.Height) div 2, ImageIndex);
      end;
    end;
  end;
end;

function TForm1.GetDrawBuffer: TBitmap;
begin
  if not Assigned(FDrawBuffer) then
    FDrawBuffer := TBitmap.Create;
  Result := FDrawBuffer;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FDrawBuffer);
end;

procedure TForm1.CheckBox8Click(Sender: TObject);
begin
  if TCheckBox(Sender).Checked then
    BcBarMainMenu1.DrawModule := BcCustomDrawModule1
  else
    BcBarMainMenu1.DrawModule := nil;
end;

procedure TForm1.CheckBox7Click(Sender: TObject);
begin
  if TCheckBox(Sender).Checked then
    BcBarPopupMenu1.DrawModule := BcCustomDrawModule1
  else
    BcBarPopupMenu1.DrawModule := nil;
end;

procedure TForm1.CheckBox5Click(Sender: TObject);
begin
  if TCheckBox(Sender).Checked then
    BcBarPopupMenu2.DrawModule := BcCustomDrawModule1
  else
    BcBarPopupMenu2.DrawModule := nil;
end;

procedure TForm1.CheckBox6Click(Sender: TObject);
begin
  if TCheckBox(Sender).Checked then
    BcBarPopupMenu3.DrawModule := BcCustomDrawModule1
  else
    BcBarPopupMenu3.DrawModule := nil;
end;

end.