* * *

Author Topic: Button with vertical text  (Read 915 times)

tudi_x

  • Hero Member
  • *****
  • Posts: 524
Button with vertical text
« on: January 04, 2018, 02:58:54 pm »
hi All,
please advise if there is an option/component i could use to have a button with vertical text as in attached.
(cross platform even better)
thank you
Lazarus 1.8.4 64b on MX Linux "Horizon"

ASerge

  • Hero Member
  • *****
  • Posts: 941
Re: Button with vertical text
« Reply #1 on: January 04, 2018, 07:06:11 pm »
Code: Pascal  [Select]
  1. uses {$IFDEF WINDOWS}Windows, {$ENDIF}LazUnicode;
  2.  
  3. procedure MakeTextVertical(InButton: TButtonControl);
  4. var
  5.   Ch: string;
  6.   L: TStringList;
  7. begin
  8. {$IFDEF WINDOWS}
  9.   SetWindowLong(InButton.Handle, GWL_STYLE,
  10.     GetWindowLong(InButton.Handle, GWL_STYLE) or BS_MULTILINE);
  11. {$ENDIF}
  12.   L := TStringList.Create;
  13.   try
  14.     for Ch in InButton.Caption do
  15.       L.Append(Ch);
  16.     InButton.Caption := L.Text;
  17.   finally
  18.     L.Free;
  19.   end;
  20. end;
  21.  
  22. procedure TForm1.Button1Click(Sender: TObject);
  23. begin
  24.   MakeTextVertical(Button1);
  25. end;

Thaddy

  • Hero Member
  • *****
  • Posts: 6889
Re: Button with vertical text
« Reply #2 on: January 04, 2018, 09:48:23 pm »
The force is brute  O:-) Must be another more elegant way.
Ada's daddy wrote this:"Fools are my theme, let satire be my song."

howardpc

  • Hero Member
  • *****
  • Posts: 2779
Re: Button with vertical text
« Reply #3 on: January 04, 2018, 10:32:03 pm »
I don't find ASerge's code inelegant. You could extend it thus:

Code: Pascal  [Select]
  1. procedure MakeTextVertical(InButton: TButtonControl);
  2. var
  3.   Ch: string;
  4.   L: TStringList;
  5.   cnv: TControlCanvas;
  6.   sz, maxSz: TSize;
  7. begin
  8.   if not Assigned(InButton.Parent) then
  9.     Exit;
  10. {$IFDEF WINDOWS}
  11.   SetWindowLong(InButton.Handle, GWL_STYLE,
  12.     GetWindowLong(InButton.Handle, GWL_STYLE) or BS_MULTILINE);
  13. {$ENDIF}
  14.   L := TStringList.Create;
  15.   InButton.AutoSize:=False;
  16.   try
  17.     cnv := TControlCanvas.Create;
  18.     cnv.Control := InButton.Parent;
  19.     maxSz.Create(0, 0);
  20.     try
  21.       for Ch in InButton.Caption do begin
  22.         L.Append(Ch);
  23.         sz := cnv.TextExtent(ch);
  24.         if sz.cx > maxSz.cx then
  25.           maxSz.cx := sz.cx;
  26.         if sz.cy > maxSz.cy then
  27.           maxSz.cy := sz.cy;
  28.       end;
  29.       InButton.SetBounds(InButton.Left, InButton.Top, maxSz.cx + 14, maxSz.cy*L.Count+3);
  30.       InButton.Caption := L.Text;
  31.     finally
  32.       cnv.Free;
  33.     end;
  34.   finally
  35.     L.Free;
  36.   end;
  37. end;

 

Recent

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