procedure PaintCaption(hWnd: THandle; WndTitel, WndCaption, WndCopyright:
String);
const
kfakt = 1.4;
// Korrektur-Faktor
ficonwidth = 28;
// FormIcon - Breite
biconwidth = 60;
// BorderIcon - Breite bei [biSystemMenu,biMinimize,biMaximize]
var
dc : HDC;
CaptRect, WndRect: TRect;
x1, x2,
i : integer;
fn :
string;
begin
dc := GetWindowDC(hWnd);
SetBkMode(
dc, TRANSPARENT);
GetWindowRect(hWnd, WndRect);
CaptRect.Top := GetSystemMetrics(SM_CYEDGE)+2;
CaptRect.Bottom := GetSystemMetrics(SM_CYCAPTION)+GetSystemMetrics(SM_CYEDGE);
// links soll der Titel der Anwendung stehen
i := trunc(Form1.Canvas.TextWidth(WndTitel) * kfakt);
CaptRect.Left := GetSystemMetrics(SM_CXEDGE)+ficonwidth;
CaptRect.Right := CaptRect.Left + i;
// FillRect(dc, CaptRect, GetStockObject(DKGRAY_BRUSH)); //nur für Test
x1 := CaptRect.Right;
SetTextColor(
dc,
RGB(255, 255, 255));
// weiß
DrawText(
dc, @WndTitel[1], lstrlen(@WndTitel[1]), CaptRect, DT_LEFT);
// rechts soll mein Copyright stehen
CaptRect.Right := WndRect.right-WndRect.Left-GetSystemMetrics(SM_CYEDGE)-biconwidth;
i := trunc(Form1.Canvas.TextWidth(WndCopyright) * kfakt);
CaptRect.Left := CaptRect.Right - i;
x2 := CaptRect.Left;
// FillRect(dc, CaptRect, GetStockObject(DKGRAY_BRUSH)); //nur für Test
if x2 < x1
then begin // nur wenn Fenster breit genug ist
x2 := x1 + 5;
CaptRect.Left := x2;
end;
SetTextColor(
dc,
RGB(0, 0, $80));
// dunkles Blau
DrawText(
dc, @WndCopyright[1], lstrlen(@WndCopyright[1]), CaptRect, DT_LEFT);
//DT_RIGHT);
// WndCaption sollte lw:\verzeichnis\datei.ext enthalten
if WndCaption <> '
'
then begin
fn := ExtractFileName(WndCaption);
i := trunc(Form1.Canvas.TextWidth(fn) * kfakt);
// kleiner ist sinnlos, da nicht mal der Dateiname dargestellt wird
if x2 > x1 + i
then begin
CaptRect.Left := x1;
CaptRect.Right := x2;
SetTextColor(
dc,
RGB(255, 255, 0));
//gelb
// FillRect(dc, CaptRect, GetStockObject(GRAY_BRUSH)); // nur für Test
//uses FileCtrl
fn := MinimizeName(WndCaption, Form1.canvas, Trunc((x2 - x1)/kfakt));
if fn <> '
'
then begin
DrawText(
dc, @fn[1], lstrlen(@fn[1]), CaptRect, DT_CENTER
or DT_VCENTER);
end;
// else Exception
end;
end;
ReleaseDC(hWnd,
dc);
end;
procedure TForm1.WMNCPAINT(
var Msg: TMessage);
begin
Inherited;
if msg.Msg = WM_NCPAINT
then PaintCaption(Self.Handle, ProgrammTitel, MyCaption, ProgrammCopyright);
end;
procedure TForm1.WMNCACTIVATE(
var msg: TMessage);
begin
Inherited;
if msg.Msg = WM_NCACTIVATE
then PaintCaption(Self.Handle, ProgrammTitel, MyCaption, ProgrammCopyright);
end;
procedure TForm1.sbClick(Sender: TObject);
begin
OpenDialog1.InitialDir := '
c:\tmp';
OpenDialog1.Filter := '
DB-Tabellen (*.db,*.dbf)|*.db*'+'
|'
+ '
alle Dateien (*.*)|*.*';
if OpenDialog1.Execute
then begin
myCaption := OpenDialog1.filename;
end
else begin
myCaption := '
';
end;
// wenn nachfolgende Anweisung fehlt, wird die Änderung nicht dargestellt
Form1.Width := Form1.Width - 1 ;
Form1.Width := Form1.Width + 1;
//zum Rückgängigmachen der 1. Anweisung
end;