asked on

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.

SOLUTION

mokule

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

mokule

Sorry You want SpeedButtons. It does't work.

Dennis_Treacy

ASKER

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?

SOLUTION

Mike Littlewood

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Member_2_248744

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

Member_2_248744

the fdStack is not well developed, it does not center the vertical text, you will have to use spaces to get the text centered

ASKER CERTIFIED SOLUTION

Member_2_248744

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Dennis_Treacy

ASKER

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.

Member_2_248744

????

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;