Popupmenü: unerklärlicher Fehler

[Nils_13]

Hi,

ich habe bei einem Tray Icon ein Popupmenü angebunden. Ich will dem Popupmenü, wie dem Rest der Anwendung einen Skin verpassen. Dazu benutze ich OwnerDraw und den folgenden Code:

Delphi-Quellcode:

// pm = PopupMenu
// Tray = TrayIcon
// DrawItem = Gehört zu OwnerDraw
procedure TfrmMain.pmTrayDrawItem(Sender: TObject; ACanvas: TCanvas;
  ARect: TRect; Selected: boolean);
var
  mycaption: string;
  myrect: TRect;
begin
  mycaption := (Sender as TMenuItem).Caption;
  with ACanvas do
  begin
    if (Selected) then
    begin
      Brush.Color := pmTrayOver;     // Die Brushcolor von Over = $00DDEEFF
      Font.Color  := pmTrayOverFont; // Die Schriftfarbe von Over = clBlack
    end
    else
    begin
      Brush.Color := pmTrayBg;   // Die NICHTOVER Hintergrundfarbe = clBlack
      Font.Color  := pmTrayFont; // Die NICHTOVER Schriftfarbe = $00DDEEFF
    end;
    FillRect(ARect);
    myRect := ARect;
    myRect.Left := myRect.Left + 5;
    DrawText(Handle, PChar(mycaption), Length(mycaption),
      myRect, DT_SINGLELINE or DT_VCENTER);
  end;
end;

Wenn ich mit der Mouse über ein Item gehe, verwandelt sich das Item in die Farbe "$00DDEEFF" und die Schriftfarbe wird schwarz. So soll das auch sein. Gehe ich nicht über ein Item drüber, ist die Hintergrundfarbe schwarz, aber die Schriftfarbe ist auch schwarz. Das verstehe ich nicht. So werden die Farben geladen:

Delphi-Quellcode:

pmTrayFont := StringToColor(Skin.ReadString('Tray', 'Font', 'clRed'));
pmTrayBg   := StringToColor(Skin.ReadString('Tray', 'BgColor', '$00FF0301'));
pmTrayOver := StringToColor(Skin.ReadString('Tray', 'OverColor', 'clBlack'));
pmTrayFont := StringToColor(Skin.ReadString('Tray', 'OverFont', '$00000000'));

Ich habe noch ein weiteres Problem, da es auch damit zusammenhängt, poste ich es gleich dazu (ich weiß, dass man eigentlich nur eine Frage pro Thread postet, aber das ist finde ich in dem Fall übertrieben):
Ich weise jedem Item (nicht SubItem!) diese Prozedur zu. Das mache ich so:

Delphi-Quellcode:

for i := 0 to pmTray.Items.Count - 1 do
begin
  pmTray.Items[i].OnDrawItem := pmTrayDrawItem;
end;

Das funktioniert, bis auf den Zeichenfehler, auch.

Wenn ich allerdings alle Subitems zuweisen will, kommt die Meldung "Listindex out of bounds":

Delphi-Quellcode:

for j := 0 to pmTray.Items[3].Items[j].Count - 1 do
begin
  pmTray.Items[3].Items[j].OnDrawItem := pmTrayDrawItem;
end;

Da ihr sowieso bald die Dateien einsehen könnt, ist hier der komplette Code eines Skins:

Code:

; Alle angaben, außer [Skin]Name und [Runningtext]File, sind Farbwerte
; Every values, except [Skin]Name and [Runningtext]File, are colors
[Skin]
Name=Black/Gray

[Top]
Font=$00DDEEFF
Dark=$00000000
Face=$00222222
Grad=$00000000
Light=$00222222

[Backgrnd]
Dark=$00000000
Face=$00000000
Grad=$00000000
Light=$00000000

[Misc]
Border=$00222222
Font=$00DDEEFF

[Playlist]
Backgrnd=$00000000
Font=$00DDEEFF
Border=$00DDEEFF
;$00333333

[Buttons]
Font=$00000000
Border=$00FFFFFF
Dark=$00FFFFFF
Face=$00FFFFFF
FocusRect=$00000000
Grad=$00FFFFFF
Light=$00FFFFFF
DownBorder=$00DDDDDD
DownDark=$00DDDDDD 
DownFace=$00DDDDDD
DownGrad=$00DDDDDD
DonwLight=$00DDDDDD
DownText=$00222222
OverBorder=$00BBBBBB
OverDark=$00BBBBBB
OverFace=$00BBBBBB
OverGrad=$00BBBBBB
OverLight=$00BBBBBB
OverText=$00444444
DisabledBorder=$00999999
DisabledDark=$00999999
DisabledFace=$00999999
DisabledGrad=$00999999
DisabledLight=$00999999
DisabledText=$00666666

[Trackbars]
ThumbBorder=$00777777
ThumbFace=$00AAAAAA
ThumbGrad=$00AAAAAA
Tick=$00999999
SlideBorder=$00777777
SlideFace=$00AAAAAA
SlideGrad=$00AAAAAA
DownThumbBorder=$00AAAAAA
DownThumbFace=$00999999
DownThumbGrad=$00999999
OverThumbBorder=$00AAAAAA
OverThumbFace=$00BBBBBB
OverThumbGrad=$00BBBBBB
DisabledThumbBorder=$00333333
DisabledThumbFace=$00666666
DisabledThumbGrad=$00666666
DisabledTick=$00333333
DisabledSlideBorder=$00333333
DisabledSlideFace=$00666666
DisabledSlideGrad=$00666666

[Tray]
Font=$00DDEEFF
BgColor=clBlack
OverColor=$00DDEEFF
OverFont=clBlack

[Vis]
Color=$00DDEEFF
Peak=$00DDEEFF
Font=$00DDEEFF

[Runningtext]
; Der Lauttext benötigt eine Skindatei
; The running text need a skinfile
File=skins\rt_blck.bmp

[Neutral General]

Delphi-Quellcode:

procedure TForm1.FormCreate(Sender: TObject);
var i: Integer;
begin
 for i:= 0 to PopUpMenu1.Items.Count-1 do begin
  PopUpMenu1.Items[i].OnDrawItem := MyDraw;
 end;
 for i:= 0 to Popupmenu1.Items[3].Count-1 do
 begin
  PopUpMenu1.Items[3].Items[i].OnDrawItem := MyDraw;
 end;
end;

procedure TForm1.MyDraw(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
  Selected: Boolean);
var ACaption: TCaption;
begin
  ACaption := TMenuItem(Sender).Caption;
  with ACanvas do
  begin
    if Selected then
    begin
     Brush.Color := $00DDEEFF;
     Font.Color := clblack;
    end
    else
    begin
     Brush.Color := clblack;
     Font.Color := $00DDEEFF;
    end;
    FillRect(ARect);
    ARect.Left := ARect.Left + 5;
    DrawText(Handle, PChar(acaption), Length(acaption),
      aRect, DT_SINGLELINE or DT_VCENTER);
  end;
end;

So müsstes gehn :)

Gruß
Neutral General