Text in Titelzeile eines Formulars positionieren

[eddy]

Hallo Leute,

ich möchte auf die Anordnung des Textes in der Titelzeile von Formularen Einfluß nehmen.

Links soll der von mir vergebene Programmname stehen, rechtsbündig soll ein ca. 30 Zeichen langer Text stehen und in dem dazwischen befindlichen Platz, ein variabler Text, z.B. LW:\Pfad\Filename der geöffneten Datei (mit gekürztem Pfadname, falls der Platz zu eng wird).

Hat jemand eine Idee, wie das realisiert werden könnte?

mfg
eddy

[phlux]

Dazu musst du ein Handle auf deine Titelleiste kriegen und sie dann selbst zeichnen, was allerdings nicht mehr so toll aussieht.

mfg phlux

[Dagon]

Du kannst es ja auch von "Hand" machen (mit Leerschlägen).

[Luckie]

Text in der Titelzeile zentieren:

Delphi-Quellcode:

procedure TForm1.WMNCPAINT(var Msg: TMessage);
var
  rect: TRect;
  dc: HDC;
  MyCaption: String;
begin
  Inherited;
  if Msg.Msg = WM_NCPAINT then
  begin
    dc := GetWindowDC(Handle);
    rect.Left := GetSystemmetrics(SM_CXEDGE);
    rect.Top := GetSystemmetrics(SM_CYEDGE)+2;
    rect.Right := Form1.Width-GetSystemmetrics(SM_CXEDGE);
    rect.Bottom := GetSystemmetrics(SM_CYCAPTION)+GetSystemmetrics(SM_CYEDGE);
    SetBkMode(dc, TRANSPARENT);
    SetTextColor(dc, RGB(255,255,255));
    MyCaption := 'Meine zentrirte Fenster-Caption';
    DrawText(dc, @MyCaption[1], lstrlen(@MyCaption[1]), rect, DT_CENTER or DT_VCENTER);
    ReleaseDc(Handle, dc);
  end;
end;

[eddy]

Hallo Luckie,

kannst Du mir auch noch ein Beispiel zukommen lassen, aus dem hervorgeht, wie ich die von Dir geschickte Procedure verwende.

mfg
eddy

[Luckie]

Delphi-Quellcode:

type
  TForm1 = class(TForm)
  private
    { Private-Deklarationen }
    procedure WMNCPAINT(var Msg: TMessage); Message WM_NCPAINT;
  public
    { Public-Deklarationen }
  end;

Jetzt klar?

[eddy]

Hallo Luckie,

vielen Dank für die Tip's.

Klappt prinzipiell, sogar mehrere Texte. Sobald ich auf eine andere Anwendung gehe oder selbst dann, wenn in der laufenden Anwendung ein ShowMessage aufgerufen wird, verschwindet der gesamte Text aus der Titelzeile. Manchmal kommt er wieder, manchmal nicht.

Hast Du einen Tip, wie ich das noch in den Griff bekomme?

mfg
eddy

[Luckie]

Oder besser:

Delphi-Quellcode:

type
  TForm1 = class(TForm)
  private
    { Private-Deklarationen }
    procedure WMNCPAINT(var Msg: TMessage); Message WM_NCPAINT;
    procedure WMNCACTIVATE(var msg: TMessage); Message WM_NCACTIVATE;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

const
  MYCAPTION = 'Meine zentrierte Fenster-Caption';

procedure PaintCaption(hWnd: THandle; WndCaption: String);
var
  dc : HDC;
  CaptRect, WndRect: TRect;
begin
  dc := GetWindowDC(hWnd);
  GetWindowRect(hWnd, WndRect);
  CaptRect.Left := GetSystemMetrics(SM_CXEDGE);
  CaptRect.Top := GetSystemMetrics(SM_CYEDGE)+2;
  CaptRect.Right := WndRect.right-WndRect.Left-GetSystemMetrics(SM_CYEDGE);
  CaptRect.Bottom := GetSystemMetrics(SM_CYCAPTION)+GetSystemMetrics(SM_CYEDGE);
  SetBkMode(dc, TRANSPARENT);
  SetTextColor(dc, RGB(255, 255, 255));
  DrawText(dc, @WndCaption[1], lstrlen(@WndCaption[1]), CaptRect, DT_CENTER or DT_VCENTER);
  ReleaseDC(hWnd, dc);
end;

procedure TForm1.WMNCPAINT(var Msg: TMessage);
begin
  Inherited;
  if msg.Msg = WM_NCPAINT then
  begin
    PaintCaption(Self.Handle, MyCaption);
  end;
end;

procedure TForm1.WMNCACTIVATE(var msg: TMessage);
begin
  Inherited;
  if msg.Msg = WM_NCACTIVATE then
    PaintCaption(Form1.Handle, MyCaption);
end;

[eddy]

Hallo Luckie,

habe mich durchgekämpft und noch ein paar Änderungen vorgenommen. Jetzt funktioniert das so, wie ich mir das vorgestellt hatte.

Delphi-Quellcode:

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;

Einige Dinge sind noch nicht perfekt.

1. den kfakt = Korrekturfaktor habe ich empirisch ermittelt vermutlich gibt es da eine Abhängikeit zur Schriftgröße

2. Form1.Canvas.TextWidth wollte ich ersetzen durch ein tempCanvas, da ich das nur für die Ermittlung der Anzahl der Pixel in x-Richtung benötige.

3. Form1.Width +- 1 läßt sich hoffentlich auch noch eleganter lösen

mfg
eddy

[edit=Daniel B]Delphi-Tags korrigiert. Mfg, Daniel B[/edit]

[Luckie]

Bei aktivieren Luna Style unter XP dürfte das alles etwas aus den Fugen geraten. Die Icon Größe usw. Kann man auch noch abfragen. Entweder mit GetSystemMetrics oder SystemParametersInfo oder wie das heißt.