Вертикальный TitleBar

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Оформил: DeeCo

Автор: http://www.swissdelphicenter.ch

type

TForm1 = class(TForm)

procedure FormResize(Sender: TObject);

procedure FormPaint(Sender: TObject);

private

procedure VerticalTitleBar(Texto: string; Size: Integer);

end;

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.

{/codecitation}

Добавить комментарий