[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1448
  • Last Modified:

Speed buttons on toolbar aligned left side of screen

I am using Delphi 7 and want to add some 'pop-out' forms to appear and that can be closed by the user. Creating the forms and closing them is not the problem.

To trigger the forms,  I want to add a tool bar the the parent form, align it to the left side and add some speedbuttons that can then be used to trigger the form displays.

My problem is that when you add speedbuttons to a toolbar which is aligned down the left side of the screen, the buttons appear as if the tool bar is horizontal, both in terms of their caption and relative positions.

I want the captions and their relative positions to run the same direction as the tool bar, vertically. Any idea's on how to do this.

 

0
Dennis_Treacy
Asked:
Dennis_Treacy
  • 4
  • 2
  • 2
  • +1
3 Solutions
 
mokuleCommented:
Set ToolBar Align property after adding ToolButtons.
Does it solve Your problem?

procedure TForm1.Button1Click(Sender: TObject);
var
  tbr: TToolBar;
begin
  tbr := TToolBar.Create(self);
  with tbr do
    begin
    Parent := self;
    end;
  with TToolButton.Create(tbr) do
    begin
    Parent := tbr;
    end;
  with TToolButton.Create(tbr) do
    begin
    Parent := tbr;
    end;
  with TToolButton.Create(tbr) do
    begin
    Parent := tbr;
    end;
  with TToolButton.Create(tbr) do
    begin
    Parent := tbr;
    end;
  tbr.Align := alLeft;
end;
0
 
mokuleCommented:
Sorry You want SpeedButtons. It does't work.
0
 
Dennis_TreacyAuthor Commented:
Using toolbuttons instead of speedbuttons is ok.

Putting the tool buttons on the tool bar before aligning the tool bar to the left side does place the tool buttons one on top of the other, but I need the buttons to be standing vertical, with vertical text running up the side of the screen, not horizontal, so the button text can be read while keeping the toolbar is of minimal width across the screen. Is that possible?
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
mikelittlewoodCommented:
I dont think you can do vertical text on the buttons as a normal property

A cheat way to do it (but I SURE someone could come up with a better suggestion) might be to actually create the vertical text on the buttons outside of delphi, say in paint or something, save them as a standard size image so they are all the same, then add the text as an image to the button.

This all depends if you want other images on the buttons or not.

This is probably not a great workaround like I said, but I cant think of another way.
0
 
Slick812Commented:
hello  Dennis_Treacy, First, I wonder why you would have TSpeedButtons on a TToolBar? ?, If you use Speed buttons, then you do not have any of the Tool Bar properties used for the speed buttons? Shouldn. you just place the speed buttons on a TPanel instead of a Tool bar? ? Maybe I'm missing something though?


Anyway, as to having some speed buttons with vertical text, Here is some code to do a TSpeed button decendent  called TVerButton, I did not spend much time on this but it seems to work for non-large speed buttons

 code for TVerButton - -



type
  TFontDirection = (fdDown, fdUp, fdStack);

  TVerButton = class(TSpeedButton)
    protected
    FText: String;
    FFontD: TFontDirection;
    procedure setText(Value: String);
    procedure Paint; overRide;

    published
    property FontDirection: TFontDirection read FFontD write FFontD;
    property Text: String read FText write setText;
    end;


  TForm1 = class(TForm)



- - - - - - - - - -  - - - - - - - -  - - - - - - - - - - - - - -  -


procedure TForm1.FormCreate(Sender: TObject);
begin
with TVerButton.Create(Self) do
  begin
  Parent := Self;
  // do NOT use Caption for vertical text, use the Text property
  Text := 'Second';
  FontDirection := fdUp;
  Left := 39;
  Top := 15;
  Height := 88;
  Width := 24;
  Font.Name := 'Arial';
  // You must assign a True Type Font. or will not do right
  end;
end;


 = = = = = = = = = = = = = = = = = = = = =

I did NOT spend the time on this to hammer it to be a fail safe thing, Do not use the Caption for vertical text, use the new "Text" property for vertical tect output. . . AND I do not try and detect a True Type font, so you will be responsible for assining a True Type Font to the TVerButton or vertical text will Not work. . . there are 3 choices for text direction fdUp, fdDown and fdStack, I hope the names give you some Idea of what the text will look like. . .
Ask Questions if you need more info
0
 
Slick812Commented:
the fdStack is not well developed, it does not center the vertical text, you will have to use spaces to get the text centered
0
 
Slick812Commented:
code for the TVerButton  -



procedure TVerButton.setText(Value: String);
begin
if Value = FText then Exit;
FText := Value;
Invalidate;
end;

procedure TVerButton.Paint;
var
FontLog1: TLogFont;
hFont: THandle;
i: Integer;
Size1: TSize;
begin
inherited Paint;
ZeroMemory(@FontLog1, SizeOf(FontLog1));
if FFontD = fdStack then
  begin
  Canvas.Font := Self.Font;
  GetTextExtentPoint32(Canvas.Handle, PChar('Mik'), 1, Size1);
  Size1.cx := (Width div 2)- (Size1.cx div 3)-1;
  Size1.cy := Round(Size1.cy * 0.87);
  for i := 1 to Length(FText) do
    begin
    Canvas.TextOut(Size1.cx,(Size1.cy * (i-1))+3,FText[i]);
    end;
  Exit;
  end;

with FontLog1 do
  begin
  lfHeight := -13;
  if fsBold in Self.Font.Style then
    lfWeight := 700;
  if FFontD = fdUp then
     lfEscapement := 900 else
     lfEscapement := 2700;
  {this font is rotated 90 degrees}
  lfOrientation := lfEscapement;
  lfPitchAndFamily := VARIABLE_PITCH or FF_SWISS;
  StrCopy(lfFaceName , PChar(Self.Font.Name));
  end;
hFont := CreateFontIndirect(FontLog1);
{if hFont = 0 then
  begin
  FontLog1.lfFaceName := 'Arial';
  hFont := CreateFontIndirect(FontLog1);
  end;}
if hFont = 0 then Exit;
SelectObject(Canvas.Handle, hFont);
GetTextExtentPoint32(Canvas.Handle, PChar(FText), Length(FText), Size1);
if FFontD = fdUp then
  begin
  i := Size1.cx;
  Size1.cx := (Width div 2)- (Size1.cy div 2)-1;
  Size1.cy := (Height div 2)+ (i div 2);
  end else
  begin
  i := Size1.cx;
  Size1.cx := (Width div 2)+ (Size1.cy div 2);
  Size1.cy := (Height div 2)- (i div 2);
  end;

TextOut(Canvas.Handle,Size1.cx,Size1.cy, PChar(FText), Length(FText));
{if FFontD = fdUp then
  TextOut(Canvas.Handle,2,Height-2, PChar(FText), Length(FText))
  else
  TextOut(Canvas.Handle,14,12, PChar(FText), Length(FText));}
  DeleteObject(hFont);
end;
0
 
Dennis_TreacyAuthor Commented:
I had a comment to add when I accepted the answers, but it did not appear, I think, so will try again.

It seems there is no simple button property to do the job. I don't want to do much in the way of workarounds so will find another way to tackle the issue, even if its a 3rd party component specially designed for the job.

I split the points because all three answers helped in some way.
0
 
Slick812Commented:
????

you want a component? Here's a TVerButton -



unit VerButton;

interface

uses
  Buttons;

type
  TTextDirection = (fdDown, fdUp, fdStack);

  TVerButton = class(TSpeedButton)
    protected
    FvCap: String;
    FTextD: TTextDirection;
    procedure setVCap(Value: String);
    procedure setTextD(Value: TTextDirection);
    procedure Paint; overRide;

    published
    property Caption: String read FvCap write setVCap;
    property TextDirection: TTextDirection read FTextD write setTextD;
    end;


procedure Register;

implementation

uses Windows, Classes, SysUtils, Graphics;

procedure Register;
begin
RegisterComponents('Samples', [TVerButton]);
end;


procedure TVerButton.setVCap(Value: String);
begin
if Value = FvCap then Exit;
FvCap := Value;
Invalidate;
end;

procedure TVerButton.setTextD(Value: TTextDirection);
begin
if Value = FTextD then Exit;
FTextD := Value;
Invalidate;
end;

procedure TVerButton.Paint;
var
FontLog1: TLogFont;
hFont: THandle;
i, yOff, yHt, Wid: Integer;
Size1: TSize;
nStr: String;
begin
inherited Paint;
if FTextD = fdStack then
  begin
  Canvas.Font := Self.Font;
  GetTextExtentPoint32(Canvas.Handle, PChar('Mik'), 1, Size1);
  yHt := Round(Size1.cy * 0.752);
  yOff := (Height div 2) - ((yHt * Length(FvCap)) div 2)-2;
  Wid := (Width div 2)-1;
  if FState = bsDown then
    begin
    Inc(Wid);
    Inc(yOff);
    end;

  for i := 1 to Length(FvCap) do
    begin
    nStr := FvCap[i]+FvCap[i];
    GetTextExtentPoint32(Canvas.Handle, PChar(nStr), 2, Size1);
    if FState = bsDisabled then
      begin
      SetTextColor(Canvas.Handle,GetSysColor(COLOR_BTNHIGHLIGHT));
      Canvas.TextOut(Wid - (Size1.cx div 4)-1,yOff+(yHt * (i-1))-1,FvCap[i]);
      SetTextColor(Canvas.Handle,GetSysColor(COLOR_BTNSHADOW));
      end;
    Canvas.TextOut(Wid - (Size1.cx div 4),yOff+(yHt * (i-1)),FvCap[i]);
    end;
  Exit;
  end;

ZeroMemory(@FontLog1, SizeOf(FontLog1));
with FontLog1 do
  begin
  lfHeight := Font.Height;
  if fsBold in Font.Style then
    lfWeight := 700;
  if fsItalic in Font.Style then
    lfItalic := 1;
  if fsUnderline in Font.Style then
    lfUnderline := 1;
  if fsStrikeOut in Font.Style then
    lfStrikeOut := 1;
  if FTextD = fdUp then
     lfEscapement := 900 else
     lfEscapement := 2700;
  lfOrientation := lfEscapement;
  lfOutPrecision := OUT_TT_PRECIS;
  lfQuality := ANTIALIASED_QUALITY;
  lfPitchAndFamily := VARIABLE_PITCH or FF_SWISS;
  if Lowercase(Self.Font.Name) = 'ms sans serif' then
    lfFaceName := 'Arial' else
    if Lowercase(Self.Font.Name) = 'ms serif' then
    lfFaceName := 'Times New Roman' else
    if Lowercase(Self.Font.Name) = 'courier' then
    begin
    lfFaceName := 'Courier New';
    if lfHeight < 0 then Inc(lfHeight) else Dec(lfHeight);
    end else
    StrCopy(lfFaceName , PChar(Self.Font.Name));
  end;
hFont := CreateFontIndirect(FontLog1);

if hFont = 0 then Exit;
SelectObject(Canvas.Handle, hFont);
GetTextExtentPoint32(Canvas.Handle, PChar(FvCap), Length(FvCap), Size1);
if FTextD = fdUp then
  begin
  i := Size1.cx;
  Size1.cx := (Width div 2)- (Size1.cy div 2)-1;
  Size1.cy := (Height div 2)+ (i div 2);
  end else
  begin
  i := Size1.cx;
  Size1.cx := (Width div 2)+ (Size1.cy div 2);
  Size1.cy := (Height div 2)- (i div 2);
  end;

if FState = bsDown then
  begin
  Inc(Size1.cx);
  Inc(Size1.cy);
  end;

if FState = bsDisabled then
  begin
  SetTextColor(Canvas.Handle,GetSysColor(COLOR_BTNHIGHLIGHT));
  TextOut(Canvas.Handle,Size1.cx-1,Size1.cy-1, PChar(FvCap), Length(FvCap));
  SetTextColor(Canvas.Handle,GetSysColor(COLOR_BTNSHADOW));
  end;

TextOut(Canvas.Handle,Size1.cx,Size1.cy, PChar(FvCap), Length(FvCap));
DeleteObject(hFont);
end;

end.

 = = = = = = = = = = = = = = = = = = = = = = = = = = =


VerButton1 := TVerButton.Create(Self);
with VerButton1 do
  begin
  Parent := Self;
  Caption := 'Ver Button';
  TextDirection := fdUp;
  Left := 3;
  Top := 6;
  Height := 100;
  Width := 24;
  Font.Name := 'Arial';
 Font.Size := 13;
  Font.Color := clRed;
  OnClick := SpeedButton2Click;
  end;
0

Featured Post

Vote for the Most Valuable Expert

It’s time to recognize experts that go above and beyond with helpful solutions and engagement on site. Choose from the top experts in the Hall of Fame or on the right rail of your favorite topic page. Look for the blue “Nominate” button on their profile to vote.

  • 4
  • 2
  • 2
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now