Vertikale TEdit / TLabel / TQRLabel

[Patrick Sack]

Hallo,
<br>
<br>Gibt es irgendwo die folgenden Vertikalenkomponenten:
<br>TEdit / TLabel / TQRLabel
<br>
<br>Habe hier im Forum zwar schon was gefunden (für Tlabel) aber das ist in C, kennt jemand vieleicht noch andere fertige Komponenten oder Sourcen in Delphi?
<br>
<br>Danke!
<br>
<br>mfg
<br>PS

[Torsten Grundke]

Hallo Patrick,

vor einiger Zeit war schon einmal eine ähnliche Frage zu einem Verticalen Label im Forum gestellt worden. Daraufhin hatte ich zur Demonstration des Prinzips eine Komponente "zusammengebastelt". Sie ist allerdings auf das Nötigste beschränkt.

<pre>unit VerticalLabel;
<p>
interface
<p>
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
<P>
type
TVerticalLabel = class(Tcustomlabel)
private
FFont: HFont;
FFontOriginal: HFont;
FLogFont: taglogfont;
FCaptionOriginal: string;
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
protected
procedure DoDrawText(var Rect: TRect; Flags: Longint); override;
public
constructor create(AOwner: TComponent); override;
destructor destroy; override;
published
property font;
property caption;
property enabled;
property color;
end;
<p>
procedure Register;
<p>
implementation
<p>
constructor TVerticalLabel.create(AOwner: TComponent);
begin
inherited;
FFontOriginal := 0;
Font.name := 'arial';
end;
<p>
destructor TVerticalLabel.destroy;
begin
Canvas.Font.Handle := FFontOriginal;
deleteobject(FFont);
inherited;
end;
<p>
procedure TVerticalLabel.CMFontChanged(var Message: TMessage);
begin
inherited;
FFontOriginal := Font.Handle;
if GetObject(FFontOriginal, SizeOf(FLogFont), @FLogFont) &lt;&gt; 0 then begin
<p>
<font color="#FF0000">{dieser Programmteil sorgt für die vertikale Ausrichtung}</font>
<p>
FLogFont.lfescapement := 900;
FFont := createfontindirect(Flogfont);
Canvas.Font.Handle := FFont;
<p>
<font color="#FF0000">{das Ganze funktioniert allerdings nur bei TrueType-Schriften}</font>
<p>
end;
end;
<p>
procedure TVerticalLabel.DoDrawText(var Rect: TRect; Flags: Longint);
var
Text: string;
breite,hoehe: integer;
begin
Text := GetLabelText;
breite := canvas.TextWidth(text);
hoehe := canvas.TextHeight(text);
height := breite + 4;
width := hoehe + 2;
Canvas.Font.Color := Font.Color;
if Flags and DT_CALCRECT &lt;&gt; 0 then exit;
if not Enabled then
begin
Canvas.Font.Color := clBtnHighlight;
Canvas.Textout(2,height-2, Text);
Canvas.Font.Color := clBtnShadow;
Canvas.Textout(1,height-3, Text);
end
else
Canvas.Textout(2, height-2, Text);
end;
<p>
procedure Register;
begin
RegisterComponents('Beispiele', [TVerticalLabel]);
end;
<p>
end.</pre>
<p>
Tschüß

Torste

[Patrick Sack]

Danke!
<br>
<br>mfg
<br>P