Ik was de laatste tijd op zoek naar de mogelijkheid om een tekst verticaal weer te geven.
Er waren een paar mooie bij maar die werkte niet bij OnCreate en zo verder.
Ik heb toen ook gezien dat het lastig is om dat goed te maken.
Hierbij een klein componentje wat goed werkt.
Je moet wel prop Text gebruiken. Caption leeg laten.
Code:
unit EdVLabel;
interface
uses Graphics,
Types, Messages, Windows, SysUtils, Classes, Controls, StdCtrls;
type
TEdVLabel = class(TLabel)
private
{ Private declarations }
fText: String;
Procedure SetText(aValue: String);
procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
procedure CMFontChanged(var msg: TMessage); message CM_FONTCHANGED;
//procedure AngleTextOut(aCanvas: TCanvas; Angle, X, Y: Integer; Str: String);
procedure AngleTextOut(Angle, X, Y: Integer; Str: String);
protected
{ Protected declarations }
procedure Paint; override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
property Text: String read fText write SetText;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TEdVLabel]);
end;
constructor TEdvLabel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Autosize := False;
Transparent := False;
Color := clMoneyGreen;
Height := 180;
Width := 20;
Font.Color := clBlack;
fText := 'Voorbeeld';
{}
end;
destructor TEdvLabel.Destroy;
begin
{}
inherited Destroy;
end;
procedure TEdvLabel.AngleTextOut(Angle, X, Y: Integer; Str: string);
var
LogRec: TLogFont;
OldFontHandle,
NewFontHandle: hFont;
begin
GetObject(Font.Handle, SizeOf(LogRec), Addr(LogRec));
LogRec.lfEscapement := Angle*10;
NewFontHandle := CreateFontIndirect(LogRec);
OldFontHandle := SelectObject(Canvas.Handle, NewFontHandle);
Canvas.TextOut(X, Y, Str);
NewFontHandle := SelectObject(Canvas.Handle, OldFontHandle);
DeleteObject(NewFontHandle);
end;
procedure TEdvLabel.Paint;
begin
inherited;
Canvas.Font := Font;
AngleTextOut(90, 0, (Height + 1), fText);
end;
{------------------------------------------------------------------------------}
procedure TEdvLabel.CMTextChanged(var Message: TMessage);
begin
inherited;
Invalidate;
end;
procedure TEdvLabel.CMColorChanged(var Message: TMessage);
begin
inherited;
Invalidate;
end;
procedure TEdvLabel.CMFontChanged(var msg: TMessage);
begin
inherited;
Invalidate;
end;
{------------------------------------------------------------------------------}
procedure TEdvLabel.SetText(aValue : String);
Begin
If (aValue <> fText) Then Begin
fText := aValue;
Invalidate;
End;
End;
end.
Bookmarks