* * *

Author Topic: [SOLVED ]Vertical menu in Lazarus  (Read 1315 times)

Wargan

  • New member
  • *
  • Posts: 42
    • 'This way' site
[SOLVED ]Vertical menu in Lazarus
« on: July 13, 2017, 12:02:46 pm »
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)
« Last Edit: July 14, 2017, 07:44:22 am by Wargan »
Lazarus 1.6.4 stable + FPC 3.0.2.
Windows XP SP3, RAM 1 Gb - testing and commissioning programs for old computers.

Ñuño_Martínez

  • Hero Member
  • *****
  • Posts: 636
    • Burdjia
Re: Vertical menu in Lazarus
« Reply #1 on: July 13, 2017, 01:29:53 pm »
You may use a list of buttons, or a TListBox with appropiate style and events.

Handoko

  • Hero Member
  • *****
  • Posts: 1644
  • My goal: build my own game engine using Lazarus
Re: Vertical menu in Lazarus
« Reply #2 on: July 13, 2017, 01:59:46 pm »
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.
« Last Edit: July 13, 2017, 02:18:12 pm by Handoko »

Handoko

  • Hero Member
  • *****
  • Posts: 1644
  • My goal: build my own game engine using Lazarus
Re: Vertical menu in Lazarus
« Reply #3 on: July 13, 2017, 03:56:10 pm »
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

  • New member
  • *
  • Posts: 41
Re: Vertical menu in Lazarus
« Reply #4 on: July 13, 2017, 05:54:39 pm »
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
IDE:  Lazarus 1.8 RC3/Trunk, Delphi XE OS:Windows 10, Ubuntu

Handoko

  • Hero Member
  • *****
  • Posts: 1644
  • My goal: build my own game engine using Lazarus
Re: Vertical menu in Lazarus
« Reply #5 on: July 13, 2017, 05:57:25 pm »
I haven't tested, but I think we can achieve the similar result if we change the TScrollBox -> TPanel.

taazz

  • Hero Member
  • *****
  • Posts: 4340
Re: Vertical menu in Lazarus
« Reply #6 on: July 13, 2017, 07:50:02 pm »
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?
Good judgement is the result of experience … Experience is the result of bad judgement.

OS : Windows 7 64 bit
Laz: Lazarus 1.4.4 FPC 2.6.4 i386-win32-win32/win64

ps

  • New member
  • *
  • Posts: 41
Re: Vertical menu in Lazarus
« Reply #7 on: July 13, 2017, 09:01:02 pm »
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  :'(

« Last Edit: July 13, 2017, 11:36:20 pm by ps »
IDE:  Lazarus 1.8 RC3/Trunk, Delphi XE OS:Windows 10, Ubuntu

howardpc

  • Hero Member
  • *****
  • Posts: 2328
Re: Vertical menu in Lazarus
« Reply #8 on: July 13, 2017, 11:35:13 pm »
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

  • New member
  • *
  • Posts: 42
    • 'This way' site
Re: Vertical menu in Lazarus
« Reply #9 on: July 14, 2017, 07:43:54 am »
Many thanks to all!
My problem is solved :) 8)
Lazarus 1.6.4 stable + FPC 3.0.2.
Windows XP SP3, RAM 1 Gb - testing and commissioning programs for old computers.

 

Recent

Get Lazarus at SourceForge.net. Fast, secure and Free Open Source software downloads Open Hub project report for Lazarus