Hello,
I've been making a little Windows app with custom popup menu.
thanks to the following topic I've made progress customising the look of the popup menu:
https://forum.lazarus.freepascal.org/index.php/topic,48805.msg351924.html#msg351924However, no matter what I do, I cant get rid of the popup menu bevelled border. I want my menu to be completely flat and borderless.
I think the issue is the OnDrawItem only deals with the items, and not the menu they are contained in; so I'm hoping theres a solution I just havent found yet, other than making a custom TPopupMenu
.
Example zip has been attached.
My example unit based on the one in the topic above is as follows:
{
sources
https://forum.lazarus.freepascal.org/index.php/topic,48805.msg351924.html#msg351924
https://www.tweaking4all.com/forum/delphi-lazarus-free-pascal/delphilazarus-how-to-make-a-tcolor-lighter-or-darker/
https://stackoverflow.com/questions/596216/formula-to-determine-brightness-of-rgb-color
}
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Menus, LCLType,
StdCtrls, ActnList, ExtCtrls, Windows, GraphUtil;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Fnt: TFontDialog;
MenuItem1: TMenuItem;
MenuItem2: TMenuItem;
MenuItem3: TMenuItem;
MenuItem4: TMenuItem;
MenuItem5: TMenuItem;
MenuItem6: TMenuItem;
N1: TMenuItem;
MenuItem8: TMenuItem;
MenuItem9: TMenuItem;
PopupMenu1: TPopupMenu;
procedure Button2Click(Sender: TObject);
procedure CheckBox1Change(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure MnuDrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; AState: TOwnerDrawState);
procedure fontUpdate;
private
public
end;
var
Form1: TForm1;
bgClr, highlightClr:TColor;
implementation
{$R *.lfm}
uses
Types, ImgList;
{ TForm1 }
function Darker(MyColor:TColor; Percent:Byte):TColor;
var r,g,b:Byte;
begin
MyColor:=ColorToRGB(MyColor);
r:=GetRValue(MyColor);
g:=GetGValue(MyColor);
b:=GetBValue(MyColor);
r:=r-muldiv(r,Percent,100); //Percent% closer to black
g:=g-muldiv(g,Percent,100);
b:=b-muldiv(b,Percent,100);
result:=RGB(r,g,b);
end;
function Lighter(MyColor:TColor; Percent:Byte):TColor;
var r,g,b:Byte;
begin
MyColor:=ColorToRGB(MyColor);
r:=GetRValue(MyColor);
g:=GetGValue(MyColor);
b:=GetBValue(MyColor);
r:=r+muldiv(255-r,Percent,100); //Percent% closer to white
g:=g+muldiv(255-g,Percent,100);
b:=b+muldiv(255-b,Percent,100);
result:=RGB(r,g,b);
end;
function getClrBrightness(clr:TColor):Integer;
var r, g, b:Integer;
l:real;
begin
r:=red(clr);
g:=green(clr);
b:=blue(clr);
l:=(0.2126*r + 0.7152*g + 0.0722*b);
result:=round(l);
end;
procedure TForm1.fontUpdate;
var thisLbl: TLabel;
i, l:Integer;
begin
// pick a background colour
bgClr:=invertColor(fnt.Font.Color);
l:=getClrBrightness(bgClr);
if l<50 then begin
// dark bg colour, so pick light highlight
highlightClr:=lighter(bgclr,20);
end else begin
// light bg, pick dark bg highlight
highlightClr:=darker(bgclr,20);
end;
end;
procedure TForm1.CheckBox1Change(Sender: TObject);
begin
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if Fnt.Execute then begin
fontUpdate;
end;
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
fontUpdate;
end;
procedure TForm1.MnuDrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; AState: TOwnerDrawState);
var
s: string;
gutter:Integer;
begin
gutter:=48;
ACanvas.Font:=Fnt.font;
if AState * [odSelected, odFocused]=[] then begin
ACanvas.Brush.Color := bgClr;
ACanvas.Pen.Color:=bgClr;
end
else begin
ACanvas.Brush.Color := highlightClr;
ACanvas.Pen.Color:=highlightClr;
ACanvas.Font.Style := [fsBold];
end;
s := (Sender as TMenuItem).Caption;
ACanvas.Rectangle(ARect);
ACanvas.TextOut(gutter, ARect.Top + 2 , s);
end;
end.
Thanks in advance for any advice,
Al