Dikey Başlık

~~*MeLeK*~~ · 28-01-2008, 13:16

type
TForm1 = class(TForm)
procedure FormResize(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
procedure VerticalTitleBar(Texto: string; Size: Integer);
end;

const
MY_TITLE_TEXT = 'Ne Mutlu Türküm Diyene';
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 := clRed;
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.

Konu Araçları
Yazdırılabilir şekli göster Sayfayı E-Mail olarak gönder
Stil
Normal Hybrid-şeklinde gösterime geç Ağaç şeklinde gösterime geç

Benzer Konular
Konu	Konuyu Başlatan	Forum	Cevaplar	son Mesaj
Başlık yok =) İtemler hoş =) !	ßahadır	KO Resim ve Videoları	0	20-07-2008 20:04
Bölüm İndexi(Her Başlık Bir Arada)	ßandida$	Oyun Klavuzları	1	12-07-2008 23:19
bana bir başlık yaz sana şiirini yazayım	Ghost_Leaf	Aşk & Sevgi	0	28-04-2008 13:06
Noel Dayılanın Videoları Tek 1 Başlık Altında	UzAkDuR	Komik Videolar	5	23-03-2008 16:24