TCheckListBox, OwnerDraw zeichnet immer neu

[LeoDD]

Hallo ihr Delphigötter,

nach langem Suchen im Netz habe ich immer noch keine wirkliche Lösung für mein Problem gefunden. Daher frage ich hier mal direkt.

Ich verwende eine TCheckListbox mit dsOwnerDrawFixed. Ein Item wird mit dieser Routine gezeichnet:

Delphi-Quellcode:

procedure TASManForm.ListBox_ASDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
{
  Zeichnen eines Items
}
var
  ASStruc: TTC7AutoStartStruc;
  ASPointer: PTC7AutoStartStruc;
  FileIcon: TBitmap;
  Text1, Text2, Text3: string; //für die dreizeilige Ausgabe
  TextRect: TRect;
begin

  ASPointer := AutoStarts.Items[Index];
  ASStruc := ASPointer^;

  with (Control as TCheckListBox) do begin

    Canvas.Brush.Color := clWhite;
    Canvas.FillRect(Rect);

    TextRect := Rect;
    TextRect.Left := Rect.Left + 50;

    case ASStruc.AutoStartDangerLevel of
      dlLow: Canvas.Brush.Color := Color_ASMan_DangerLow;
      dlMiddle: Canvas.Brush.Color := Color_ASMan_DangerMiddle;
      dlHigh: Canvas.Brush.Color := Color_ASMan_DangerHigh;
    end;
    Canvas.FillRect(TextRect);

    FileIcon := TBitmap.Create;

    case ASStruc.EntryType of

      asBinaryFile, asTextFile: begin

        if FileExists(ASStruc.FileData.FileName) then begin
          FileIcon := ConvertIconToBmp(GetIconFromFile(ASStruc.FileData.FileName, 0));
        end else begin
          FileIcon := BmpFromIcoFile(AppDir + Icon_ASMan_FileNotFound);
        end;

        Text1 := ExtractFileName(ASSTruc.FileData.FileName);
        Text2 := format(_asmanListTextFilePath, [IncludeTrailingPathDelimiter(ExtractFilePath(ASSTruc.FileData.FileName))]);
        Text3 := '';
        if ASStruc.EntryType = asBinaryFile then begin
          Text3 := _asmanListTextIsBinary;
        end else begin
          Text3 := format(_asmanListTextLineCount, [FormatThousands(ASSTruc.FileData.FileTextLineCount)]);
        end;
        Text3 := Text3 + ', ' + format(_asmanListTextSize, [FormatThousands(ASStruc.FileData.FileSize)]);
        if ASStruc.FileData.FileAttr and faHidden > 0 then begin
          Text3 := Text3 + ', ' + _asmanListTextHidden;
        end;

      end;


      asRegistryKey: begin
        FileIcon := BmpFromIcoFile(AppDir + Icon_ASMan_Reg);
      end;


      asRegistryValue: begin

        if ASStruc.RegData.ResultFile<>'' then begin
          FileIcon := ConvertIconToBmp(GetIconFromFile(ASStruc.RegData.ResultFile, 0));
        end else begin
          FileIcon := BmpFromIcoFile(AppDir + Icon_ASMan_Reg);
        end;

        Text1 := ASStruc.RegData.Key;
        Text2 := format(_asmanListTextRegPfad, [ASStruc.RegData.MainKey, ASStruc.RegData.Path]);
        Text3 := format(_asmanListTextRegValue, [ASStruc.RegData.Value]); 

      end;

    end; //case ASStruc.EntryType of

    //todo: nur für Debugzwecke!!!!
    Text3 := Text3 + ' (' + ASStruc.UniqueID + ')';

    Canvas.Draw(Rect.Left + 10, Rect.Top + 11, FileIcon);

    Canvas.Font.Color := clBlack;
    Canvas.Font.Size := 8;
    Canvas.Font.Style := [fsBold];
    Canvas.TextOut(Rect.Left + 55, Rect.Top + 7, Text1);

    Canvas.Font.Color := RGB($33, $33, $33);
    Canvas.Font.Size := 7;
    Canvas.Font.Style := [];
    Canvas.TextOut(Rect.Left + 65, Rect.Top + 26, Text2);

    Canvas.Font.Size := 7;
    Canvas.Font.Style := [];
    Canvas.TextOut(Rect.Left + 65, Rect.Top + 41, Text3);


  end;

  
end;

Das funktioniert auch sehr prächtig, allerdings habe ich ein Performanceproblem und denke, dass es mit "State: TOwnerDrawState" zu tun hat. Die Items sollen nur gezeichnet werden, wenn es nötig ist. Derzeit werden sie immer gemalt, auch wenn nur eine MessageBox drüberliegt und diese dann geschlossen wird. Das resultiert in einem unschönen Flackern z.B. beim Scrollen oder eben bei einer MessageBox.

Habt ihr eine Idee, wie ich die Routine dahingehend optimieren kann?

Danke schonmal voraus :)

[toms]

Hallo, vielleicht hilft BitBlt

[LeoDD]

Hm, muss ich mal probieren. Auf jeden Fall ist der Hinkefuß das Icon, was aus der Datei extrahiert wird. Diese Routinen dauern einfach zu lange.

Ich denke, ich muss da einen Cachemechanismus schaffen, damit das Icon vorgehalten wird und nicht jedesmal aufs Neue aus der Datei geholt wird.

[NickelM]

Nihm doch einfach ne ImageList und füg das Icon rein und überschreib den Index wieder wenn sich der eintrag ändert.
Damit musst du die Icxons nicht immer lesen :mrgreen:

[DeddyH]

Jepp. Und wenn die Icons nicht gleich groß sind, kann man sich zur Not mit einer TObjectList behelfen.

[LeoDD]

Jup, ich nehm dafür eine TList und halte da die Icons vor :)