TPopup OwnerDraw remove menu border
lazarus / 39-Graphics

----------------------------------------------------------------------
kinnon_2000 · 2021-02-06 00:40

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.h
tml#msg351924

However, 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:

Code: [Select]{
sources
https://forum.lazarus.freepascal.org/index.php/topic,48805.msg351924.h
tml#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

----------------------------------------------------------------------
flowCRANE · 2021-02-19 12:59

@jamie: why are you using a desktop DC, since you have access to the
popup window handle?

BTW: desktop is a single word, so Desktop, not DeskTop.