لمن لا يعرف TiltelBar يجرب البرنامج التالي ,
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TForm1 = class(TForm)
procedure FormResize(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
procedure VerticalTitleBar(Texto: string; Size: integer);
public
end;
const
TITLETEXT = 'ÃáÝÑíÞ ÇáÚÑÈí ááÈÑãÌÉ';
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(TITLETEXT, 17);
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
VerticalTitleBar(TITLETEXT, 17);
end;
end.
وشكرا
(*)