Was mache ich hier falsch (Ownerdraw TToolbar)?

[Harry Stahl]

Ich brauch mal Hilfe.

Ich möchte nicht die VCL-Styles verwenden, sondern ein Hauptmenü nach meinen Vorstellungen zeichnen. Ich habe dazu eine TToolbar benutzt, deren Menu-Eigenschaft ich das Mainmenu zugewiesen habe.

Von Toolbar1 nutze ich das Event "OnCustomDraw", um die Toolbar / das Menü zu zeichnen.

Was mir nicht gelingt, ist die Fontfarbe auf clBlack zu setzen (verwende Canvas.pen.color, das hat aber keine Auswirkungen), wenn das Menü ausgewählt ist. Bleibt immer weiß. Auch das Setzen von Toolbar1.font.color := clBlack hat keine Auswirkungen.

So sieht die Routine aus, anliegend auch ein Screenshot:

Delphi-Quellcode:

procedure THauptformular.ToolBar1CustomDraw(Sender: TToolBar;
  const ARect: TRect; var DefaultDraw: Boolean);
var
  L, P: Integer;
  S: string;
  r, ar: TREct;
  tp: TPoint;
  oc, pc: TColor;
begin
  if (DontUseMenuOwnerDraw) or (Screen.PixelsPerInch >= 120) then begin
    exit;
  end;

  DefaultDraw := false;
  Toolbar1.Canvas.Font.Color := clWhite;
  Toolbar1.Canvas.Font.Name := 'Arial';
  Toolbar1.Canvas.Font.Style := [fsBold];
  Toolbar1.Canvas.Font.size := 9;

  ar := arect;
  oc := Toolbar1.Canvas.brush.color;
  pc := Toolbar1.Canvas.Pen.Color;
  Toolbar1.Canvas.FillRect(arect);

  P := 0;
  r := Arect;
  inc (r.Top, 4);

  // Alle Menüs-Einträge normal zeichnen
  for L := 0 to MainMenu1.Items.Count - 1 do begin
    if MainMenu1.Items[L].Visible then begin
      s := ' ' + MainMenu1.Items[L].Caption;

      ar.Right := ar.Left + Toolbar1.Canvas.TextWidth(s)+2;

      DrawText (Toolbar1.Canvas.Handle, Pchar (s), -1, r, DT_Left + DT_VCenter);
      inc (P, Toolbar1.Canvas.TextWidth(s)-1);

      r.Left := P;
      ar.Left:= p;
    end;
  end;

  ar := arect;
  P := 0;
  r := Arect;
  inc (r.Top, 4);

  // Wo ist die Maus?
  tp := Toolbar1.ScreenToClient(point (mouse.CursorPos.X, mouse.CursorPos.y));

  for L := 0 to MainMenu1.Items.Count - 1 do begin
    if MainMenu1.Items[L].Visible then begin
      s := ' ' + MainMenu1.Items[L].Caption;

      ar.Right := ar.Left + Toolbar1.Canvas.TextWidth(s)+2;

      // Ist Maus über einem Menüeintrag?
      if MouseInRect(tp.X, tp.y, ar.Left-5, r.Top, ar.Right-5, ar.Bottom) then begin
        Toolbar1.Canvas.Pen.Color := clBlack;
        Toolbar1.Canvas.brush.Color := DesColMenuSel;

        DrawText (Toolbar1.Canvas.Handle, Pchar (s), -1, r, DT_Left + DT_VCenter);

        Toolbar1.Canvas.brush.color := oc;
        Toolbar1.Canvas.Pen.Color := pc;
        break;
      end;

      inc (P, Toolbar1.Canvas.TextWidth(s)-1);

      r.Left := P;
      ar.Left:= p;
    end;
  end;

end;

[Volker Z.]

Hallo,

Zitat:

Was mir nicht gelingt, ist die Fontfarbe auf clBlack zu setzen (verwende Canvas.pen.color, das hat aber keine Auswirkungen), wenn das Menü ausgewählt ist. Bleibt immer weiß. Auch das Setzen von Toolbar1.font.color := clBlack hat keine Auswirkungen.

Mit Canvas.Pen.Color kann das nix werden (in der Eigenschaft Pen wird festgelegt, wie Linien und Umrisse gezeichnet werden). Das Setzen von Toolbar1.font.color hätte schon Auswirkungen - zwar nicht wirklich die, von Dir gewünschte -, wenn da nicht die Zuweisung Toolbar1.Canvas.Font.Color := clWhite; in der 6. Zeile der Zeichenroutine wäre.

Die Textfarbe für das MenuItem unter dem Mauszeiger wird über Toolbar1.Canvas.Font.Color festgelegt. Also so (gekürzt):

Delphi-Quellcode:

procedure THauptformular.ToolBar1CustomDraw(Sender: TToolBar; const ARect: TRect; var DefaultDraw: Boolean);
var
  fc : TColor;
begin
  fc := Toolbar1.Canvas.Font.Color;
   
  for L := 0 to MainMenu1.Items.Count - 1 do begin
     
    if MouseInRect(tp.X, tp.y, ar.Left-5, r.Top, ar.Right-5, ar.Bottom) then begin
      Toolbar1.Canvas.Font.Color := clBlack;

      DrawText (Toolbar1.Canvas.Handle, Pchar (s), -1, r, DT_Left + DT_VCenter);

      Toolbar1.Canvas.Font.Color := fc;
      break;
    end;
  end;
end;

Gruß

[Sir Rufo]

Vorteilhafter ist es gleich mit TFontRecall oder auch TRecall zu arbeiten, dann kann man völlig frei am Font ändern was man möchte und am Ende wird es wieder auf die Originalwerte zurückgesetzt

Delphi-Quellcode:

procedure THauptformular.ToolBar1CustomDraw(Sender: TToolBar; const ARect: TRect; var DefaultDraw: Boolean);
var
  LFontRecall : TFontRecall;
begin
  LFontRecall := TFontRecall.Create( Toolbar1.Canvas.Font );
  try
   
    for L := 0 to MainMenu1.Items.Count - 1 do 
    begin
     
      if MouseInRect(tp.X, tp.y, ar.Left-5, r.Top, ar.Right-5, ar.Bottom) then 
      begin
        Toolbar1.Canvas.Font.Color := clBlack;

        DrawText (Toolbar1.Canvas.Handle, Pchar (s), -1, r, DT_Left + DT_VCenter);

        break;
      end;
    end;
  finally
    // die originalen Font-Eigenscshaften werden zurückgeschrieben
    LFontRecall.Free;
  end;
end;

[Harry Stahl]

Manchmal sieht man den Wald vor lauter Bäumen nicht.

Herzlichen Dank Volker für die Lösung und Danke Sir Rufo für diesen Tipp!

[Volker Z.]

Hallo,

Zitat:

[...] Danke Sir Rufo für diesen Tipp!

japp, da hänge ich mich mal dran - wieder was dazugelernt - danke schön!

Gruß