WoW-Info — информационный World of Warcraft портал

const
MY_TITLE_TEXT = 'Vertical Text';
var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.VerticalTitleBar(TexTo: string; Size: Integer);
var
LogFont: TLogFont;
tmpCanvas: TCanvas;
tmpRect: TRect;
x1, x2, y1, y2: integer;
begin
tmpCanvas := TCanvas.Create;
tmpCanvas.Handle := GetWindowDc(Handle);
try
GetObject(Canvas.Font.Handle, SizeOf(LogFont), @LogFont);
with LogFont do
begin
lfEscapement := 90 * 10;
lfOrientation := 90 * 10;
lfOutPrecision := OUT_TT_ONLY_PRECIS;
lfFaceName := 'Arial';
lfHeight := Size;
lfWeight := FW_BOLD;
lfQuality := PROOF_QUALITY;
end;
with tmpCanvas do
begin
Font.Handle := CreateFontIndirect(LogFont);
Font.Color := clWhite;
Brush.Color := clNavy;
end;
x1 := GetSystemMetrics(SM_CXEDGE) + GetSystemMetrics(SM_CXBORDER);
x2 := 20;
y1 := GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYEDGE) +
GetSystemMetrics(SM_CYBORDER) + 1;
y2 := Height - GetSystemMetrics(SM_CYEDGE) - GetSystemMetrics(SM_CYBORDER);
tmpRect := Rect(x1, y1, x2, y2);
tmpCanvas.FillRect(tmpRect);
DrawText(tmpCanvas.Handle, PChar(Texto), - 1, tmpRect, DT_BOTTOM or
DT_SINGLELINE);
finally
tmpCanvas.Free;
end;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
VerticalTitleBar(MY_TITLE_TEXT, 12);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
VerticalTitleBar(MY_TITLE_TEXT, 12);
end;

end.