[SOLVED ]Vertical menu in Lazarus

[Wargan]

Hello!
How can I create a vertical menu like this?
(see attachment)

Please do not advise me to use Eye Candy Controls.
The TECImageMenu component is completely unsuitable for customization in another design (I use a dark theme for my application)

[Ñuño_Martínez]

You may use a list of buttons, or a TListBox with appropiate style and events.

[Handoko]

Both list of buttons and TListBox failed on my test on Linux. Buttons cannot have custom background color, TListBox.Color can be customized but will back to default if it has items.

---edit---
Buttons can have custom background color, but cannot omit border.

[Handoko]

Without writing a new component from scratch, the best thing I can do is using some TPanels + a TScrollBox. The result is not perfect, but at least it works on my Linux tests. You can download my test.zip to try.

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Buttons, StdCtrls,
9.   ExtCtrls;
10.  
11. type
12.  
13.   { TForm1 }
14.  
15.   TForm1 = class(TForm)
16.     btnStart: TButton;
17.     Panel1: TPanel;
18.     Panel2: TPanel;
19.     Panel3: TPanel;
20.     ScrollBox1: TScrollBox;
21.     procedure btnStartClick(Sender: TObject);
22.     procedure Panel1Click(Sender: TObject);
23.     procedure Panel2Click(Sender: TObject);
24.     procedure Panel3Click(Sender: TObject);
25.   private
26.     procedure ItemKeyPress(Sender: TObject; var Key: char);
27.     procedure ItemMouseEnter(Sender: TObject);
28.     procedure ItemMouseLeave(Sender: TObject);
29.     procedure ItemTabEnter(Sender: TObject);
30.     procedure ItemTabLeave(Sender: TObject);
31.   public
32.     { public declarations }
33.   end;
34.  
35. var
36.   Form1: TForm1;
37.  
38. implementation
39.  
40. type
41.   HackPanel = TWinControl;
42.  
43. {$R *.lfm}
44.  
45. { TForm1 }
46.  
47. procedure TForm1.btnStartClick(Sender: TObject);
48. begin
49.  
50.   btnStart.Enabled    := False;
51.  
52.   ScrollBox1.Enabled  := True;
53.   ScrollBox1.Color    := RGBToColor(40, 40, 40);
54.  
55.   Panel3.Align        := alTop;
56.   Panel3.Alignment    := taLeftJustify;
57.   Panel3.BevelOuter   := bvNone;
58.   Panel3.Caption      := '     About';
59.   Panel3.Font.Color   := clWhite;
60.   Panel3.Font.Style   := [fsBold];
61.   Panel3.TabStop      := True;
62.   Panel3.Top          := 0;
63.   Panel3.OnMouseEnter := @ItemMouseEnter;
64.   Panel3.OnMouseLeave := @ItemMouseLeave;
65.   Panel3.OnEnter      := @ItemTabEnter;
66.   Panel3.OnExit       := @ItemTabLeave;
67.   (Panel3 as HackPanel).OnKeyPress := @ItemKeyPress;
68.  
69.   Panel2.Align        := alTop;
70.   Panel2.Alignment    := taLeftJustify;
71.   Panel2.BevelOuter   := bvNone;
72.   Panel2.Caption      := '     Products';
73.   Panel2.Font.Color   := clWhite;
74.   Panel2.Font.Style   := [fsBold];
75.   Panel2.TabStop      := True;
76.   Panel2.Top          := 0;
77.   Panel2.OnMouseEnter := @ItemMouseEnter;
78.   Panel2.OnMouseLeave := @ItemMouseLeave;
79.   Panel2.OnEnter      := @ItemTabEnter;
80.   Panel2.OnExit       := @ItemTabLeave;
81.   (Panel2 as HackPanel).OnKeyPress := @ItemKeyPress;
82.  
83.   Panel1.Align        := alTop;
84.   Panel1.Alignment    := taLeftJustify;
85.   Panel1.BevelOuter   := bvNone;
86.   Panel1.Caption      := '     Home';
87.   Panel1.Font.Color   := clWhite;
88.   Panel1.Font.Style   := [fsBold];
89.   Panel1.TabStop      := True;
90.   Panel1.Top          := 0;
91.   Panel1.OnMouseEnter := @ItemMouseEnter;
92.   Panel1.OnMouseLeave := @ItemMouseLeave;
93.   Panel1.OnEnter      := @ItemTabEnter;
94.   Panel1.OnExit       := @ItemTabLeave;
95.   (Panel1 as HackPanel).OnKeyPress := @ItemKeyPress;
96.  
97. end;
98.  
99. procedure TForm1.Panel1Click(Sender: TObject);
100. begin
101.   Panel1.SetFocus;
102.   Panel1.OnMouseEnter(Panel1);
103.   Panel2.OnMouseLeave(Panel2);
104.   Panel3.OnMouseLeave(Panel3);
105.   ShowMessage('You have clicked "Home"');
106. end;
107.  
108. procedure TForm1.Panel2Click(Sender: TObject);
109. begin
110.   Panel2.SetFocus;
111.   Panel2.OnMouseEnter(Panel2);
112.   Panel1.OnMouseLeave(Panel1);
113.   Panel3.OnMouseLeave(Panel3);
114.   ShowMessage('You have clicked "Products"');
115. end;
116.  
117. procedure TForm1.Panel3Click(Sender: TObject);
118. begin
119.   Panel3.SetFocus;
120.   Panel3.OnMouseEnter(Panel3);
121.   Panel2.OnMouseLeave(Panel2);
122.   Panel1.OnMouseLeave(Panel1);
123.   ShowMessage('You have clicked "About"');
124. end;
125.  
126. procedure TForm1.ItemKeyPress(Sender: TObject; var Key: char);
127. begin
128.   if not(Sender is TPanel) then Exit;
129.   if (Key = #13) then (Sender as TPanel).OnClick(Sender);
130. end;
131.  
132. procedure TForm1.ItemMouseEnter(Sender: TObject);
133. begin
134.   if not(Sender is TPanel) then Exit;
135.   (Sender as TPanel).Color := RGBToColor(40, 160, 180);
136. end;
137.  
138. procedure TForm1.ItemMouseLeave(Sender: TObject);
139. begin
140.   if not(Sender is TPanel) then Exit;
141.   (Sender as TPanel).ParentColor := True;
142. end;
143.  
144. procedure TForm1.ItemTabEnter(Sender: TObject);
145. begin
146.   if not(Sender is TPanel) then Exit;
147.   with (Sender as TPanel) do
148.   begin
149.     Caption := '>' + RightStr(Caption, Length(Caption)-2);
150.   end;
151. end;
152.  
153. procedure TForm1.ItemTabLeave(Sender: TObject);
154. begin
155.   if not(Sender is TPanel) then Exit;
156.   with (Sender as TPanel) do
157.   begin
158.     Caption := '  ' + RightStr(Caption, Length(Caption)-1);
159.   end;
160. end;
161.  
162. end.

[ps]

Without writing a new component from scratch, the best thing I can do is using some TPanels + a TScrollBox.

This is working only on Windows/Linux.  Under MacOS scrollbox (and all scollbox based components) is broken for years (even in IDE)  https://mantis.freepascal.org/view.php?id=27449

[Handoko]

I haven't tested, but I think we can achieve the similar result if we change the TScrollBox -> TPanel.

[taazz]

Without writing a new component from scratch, the best thing I can do is using some TPanels + a TScrollBox.

This is working only on Windows/Linux.  Under MacOS scrollbox (and all scollbox based components) is broken for years (even in IDE)  https://mantis.freepascal.org/view.php?id=27449

erm the bug report says that the scrollbars are always visible not that they do not work. If I find some time later I might create a small scroll box component with custom scrollbar handling for testing.Until then have you tried to use a list box in lbownerdraw style and write your own on drawitem nad on measureitem events and see if that works?

[ps]

I'm using listbox because it's working well on all platforms.

Only TScrollBox is broken = always visible scrollbars = broken = don't work for me. In some scenarios there is only small visual problem (like in IDE), but in another scenarios it's big problem 

[howardpc]

You could perhaps adapt the TVerticalMenu class in the attached project to your needs, publish desired properties, put it in a package and install it in the component palette - or just use it as-is.

[Wargan]

Many thanks to all!
My problem is solved