Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   GUI-Design mit VCL / FireMonkey / Common Controls (https://www.delphipraxis.net/18-gui-design-mit-vcl-firemonkey-common-controls/)
-   -   Delphi TListView zeichnet wild auf dem Bildschirm (https://www.delphipraxis.net/55057-tlistview-zeichnet-wild-auf-dem-bildschirm.html)

franz 15. Okt 2005 23:44


TListView zeichnet wild auf dem Bildschirm
 
Liste der Anhänge anzeigen (Anzahl: 1)
Hi,

ich weiß, dass es so eine ähnliche Frage schon einmal gab, habe das Thema aber leider nicht mehr gefunden.

Ich möchte in einer ListView Vorschaublider anzeigen. Dabei sollen aber nur die Bilder gezeichnet werden, die gerade benötigt werden. Dazu habe ich folgendes geschrieben:

Delphi-Quellcode:
procedure TfrmMain.ListViewFilesCustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
  if (FImgLoadKind <> imkLoadCustom) or (not Assigned(Item)) then
     Exit;

  if Item.ImageIndex = -1 then
     CreatePreviewImage(Item.SubItems[1], nil, Item.Index);
end;
CreatePreviewImage() zeichnet das Bild, legt es in einer ImageList ab und ordnet es zu.


Allerdings zeichnet Windows wild auf dem Bildschirm. (Siehe Attachement). Ich habe schon so viel versucht und komme einfach nicht auf die Lösung. Was mache ich nur falsch?

Christian Seehase 15. Okt 2005 23:47

Re: TListView zeichnet wild auf dem Bildschirm
 
Moin Franz,

sieht ja fast so aus, als würden die falschen Koordinaten verwendet.
Wie sieht denn CreatePreviewImage aus?

franz 16. Okt 2005 00:00

Re: TListView zeichnet wild auf dem Bildschirm
 
Zitat:

Zitat von Christian Seehase
Wie sieht denn CreatePreviewImage aus?

Nicht schockiert sein. Der Quelltext wurde von Version 1.0 übernommen und mehrmals erweitert.

Delphi-Quellcode:
procedure TfrmMain.CreatePreviewImage(FileName: TFileName; FileList: TStringList; ItemIndex: Integer = -1);
var
  mIcon:   TIcon;
  mBitmap, mBmpCanvas: TBitmap;
  mJPEG:   TJPEGImage;
  S:       String;
  mRatio:  Single;
  mRect:   TRect;
  ix:      Integer;
begin
  mIcon     := TIcon.Create;
  mBitmap   := TBitmap.Create;
  mBmpCanvas := TBitmap.Create;
  mJPEG     := TJPEGImage.Create;
  try
    // Botschaften verarbeiten
    Application.ProcessMessages;

    // Zeichenfläche vorbereiten
    mBmpCanvas.Width := ImageListFiles.Width;
    mBmpCanvas.Height := ImageListFiles.Height;
    mBmpCanvas.Canvas.Pen.Color := clGray;
    mBmpCanvas.Canvas.Rectangle(0,0,ImageListFiles.Width,ImageListFiles.Height);
    try
      // Bild in der Disk Manager Grafikbibliothek suchen
      if Assigned(FileList) then
         begin
           ix := 0;
           while ix < FileList.Count do
             begin
               Application.ProcessMessages;

               if (AnsiPos(ExtractFileName(FileName),FileList[ix]) > 0) and
                  (AnsiPos('\Graphics',FileList[ix]) > 0) then
                  begin
                    FileName := FileList[ix];
                    Break;
                  end;

               Inc(ix);
             end;
         end;

      // Wenn das Bild nicht vorhanden ist
      if not FileExists(FileName) then
         begin
           mIcon.Handle := ExtractShellIconHandle(ShellIconConfirmation);
           mBmpCanvas.Canvas.Draw(Trunc((ImageListFiles.Width - mIcon.Width)/2),
                                  Trunc((ImageListFiles.Height - mIcon.Height)/2), mIcon);
           mBmpCanvas.Canvas.TextOut(1,1,ExtractFileName(FileName));
         end;

      // Das Bild ist ein Symbol
      if (LowerCase(ExtractFileExt(FileName)) = '.ico') and
         (FileExists(FileName)) then
         begin
           FileSetAttr(FileName, 0000);
           mIcon.LoadFromFile(FileName);
           mBmpCanvas.Canvas.Draw(Trunc((ImageListFiles.Width - mIcon.Width)/2),
                                  Trunc((ImageListFiles.Height - mIcon.Height)/2),mIcon);
         end;

      // Das Bild ist ein Bitmap oder ein JPEG
      S := LowerCase(ExtractFileExt(FileName));
      if ((S = '.bmp') or (S = '.jpg') or (S = '.jpeg')) and
         (FileExists(FileName)) then
         begin
           if S = '.bmp' then
              begin
                FileSetAttr(FileName, 0000);
                mBitmap.LoadFromFile(FileName)
              end
           else
             begin
               FileSetAttr(FileName, 0000);
               mJPEG.LoadFromFile(FileName);
               mBitmap.Assign(mJPEG);
             end;

           // Bild ausrichten
           mRatio := 1;
           if (mBitmap.Width > mBitmap.Height) or
              (mBitmap.Width = mBitmap.Height) then
              begin
                mRatio := (ImageListFiles.Width - 2) / mBitmap.Width;
                if (mBitmap.Height * mRatio) > (ImageListFiles.Height - 2) then
                   mRatio := (ImageListFiles.Height - 2) / mBitmap.Height;
              end;

           if mBitmap.Height > mBitmap.Width then
              begin
                mRatio := (ImageListFiles.Height - 2) / mBitmap.Height;
                if (mBitmap.Width * mRatio) > (ImageListFiles.Width - 2) then
                   mRatio := (ImageListFiles.Width - 2) / mBitmap.Width;
              end;

           // Zeichnen
           mRect.Left  := Trunc((ImageListFiles.Width - mBitmap.Width * mRatio)/2);
           mRect.Top   := Trunc((ImageListFiles.Height - mBitmap.Height * mRatio)/2);
           mRect.Right := mRect.Left + Trunc(mBitmap.Width * mRatio);
           mRect.Bottom := mRect.Top + Trunc(mBitmap.Height * mRatio);

           if mRect.Left = 0 then
              begin
                mRect.Left := 1; mRect.Right := mRect.Right + 1;
              end;

           if mRect.Top = 0 then
              begin
                mRect.Top := 1; mRect.Bottom := mRect.Bottom + 1;
              end;

           mBmpCanvas.Canvas.StretchDraw(mRect,mBitmap);
         end;

      // Das Bild hat ein anderes Format
      S := LowerCase(ExtractFileExt(FileName));
      if (S <> '.bmp') and (S <> '.jpg') and (S <> '.jpeg') and (S <> '.ico') and
         (CanConvertImageToBitmap(FileName)) then
         begin
           if ConvertImageToBitmap(FileName, mBitmap, false) then
              begin
                // Bild ausrichten
                mRatio := 1;
                if (mBitmap.Width > mBitmap.Height) or
                   (mBitmap.Width = mBitmap.Height) then
                begin
                  mRatio := (ImageListFiles.Width - 2) / mBitmap.Width;
                  if (mBitmap.Height * mRatio) > (ImageListFiles.Height - 2) then
                     mRatio := (ImageListFiles.Height - 2) / mBitmap.Height;
                end;

                if mBitmap.Height > mBitmap.Width then
                   begin
                     mRatio := (ImageListFiles.Height - 2) / mBitmap.Height;
                     if (mBitmap.Width * mRatio) > (ImageListFiles.Width - 2) then
                        mRatio := (ImageListFiles.Width - 2) / mBitmap.Width;
                   end;

                // Zeichnen
                mRect.Left  := Trunc((ImageListFiles.Width - mBitmap.Width * mRatio)/2);
                mRect.Top   := Trunc((ImageListFiles.Height - mBitmap.Height * mRatio)/2);
                mRect.Right := mRect.Left + Trunc(mBitmap.Width * mRatio);
                mRect.Bottom := mRect.Top + Trunc(mBitmap.Height * mRatio);

                if mRect.Left = 0 then
                   begin
                     mRect.Left := 1; mRect.Right := mRect.Right + 1;
                   end;

                if mRect.Top = 0 then
                   begin
                     mRect.Top := 1; mRect.Bottom := mRect.Bottom + 1;
                   end;

                mBmpCanvas.Canvas.StretchDraw(mRect,mBitmap);
              end;
         end;

      // Bild dem Album zuordnen, wenn dem Album noch kein Bild zugeorndet ist
      if ListViewAlbum.SelCount > 0 then
         if Length(ListViewAlbum.Selected.SubItems[1]) = 0 then
            ListViewAlbum.Selected.SubItems[1] := FileName;
    except
      // Wenn beim Zeichnen ein Fehler aufgetreten ist
      on E: Exception do
         begin
           mIcon.Handle := ExtractShellIconHandle(ShellIconError);

           with mBmpCanvas.Canvas do
             begin
               Draw(Trunc((ImageListFiles.Width - mIcon.Width)/2),
                    Trunc((ImageListFiles.Height - mIcon.Height)/2), mIcon);

               TextOut(1,1,ExtractFileName(FileName));
               Pen.Color := clRed;
               TextOut(1,14,E.Message);
             end;
         end;
    end;

    // Bild der Bilderliste hinzufügen und der Dateiliste zuordnen
    if (ItemIndex = -1) then
       begin
         with ListViewFiles.Items do
           Item[Count-1].ImageIndex := ImageListFiles.Add(mBmpCanvas,nil);

         with ImageListFilesSmall do
           begin
             mBmpCanvas.Canvas.StretchDraw(Rect(0, 0, Width, Height), mBmpCanvas);
             mBmpCanvas.Width := Width;
             mBmpCanvas.Height := Height;
             Add(mBmpCanvas,nil);
           end;
       end
    else
      begin
        ListViewFiles.Items.Item[ItemIndex].ImageIndex := ImageListFiles.Add(mBmpCanvas,nil);

        with ImageListFilesSmall do
          begin
            mBmpCanvas.Canvas.StretchDraw(Rect(0, 0, Width, Height), mBmpCanvas);
            mBmpCanvas.Width  := Width;
            mBmpCanvas.Height := Height;
            Add(mBmpCanvas,nil);
          end;
      end;

    with StatusBarMain do
      if ListViewFiles.Items.Count = 1 then
         Panels[1].Text := '1 Bild' else Panels[1].Text := IntToStr(ListViewFiles.Items.Count) + ' Bilder';
  finally
    mIcon.Free;
    mBitmap.Free;
    mBmpCanvas.Free;
    mJPEG.Free;
  end;
end;


Alle Zeitangaben in WEZ +1. Es ist jetzt 02:10 Uhr.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz