Nahled jpg obrazku, miniatur, v ListView – Delphi – Fórum – Programujte.com
 x   TIP: Přetáhni ikonu na hlavní panel pro připnutí webu
Reklama
Reklama

Nahled jpg obrazku, miniatur, v ListView – Delphi – Fórum – Programujte.comNahled jpg obrazku, miniatur, v ListView – Delphi – Fórum – Programujte.com

 

Hledá se programátor! Plat 1 800 € + bonusy (firma Boxmol.com)
dyžon0
Stálý člen
25. 8. 2012   #1
-
0
-

Zdravim,
jak jsem psal v predchazejicim vlakne, zalozil jsem tohle nove pro jednak lepsi prehled a druhak kvuli presnejsimu nazvu.

Problem ovsem zustava.

Jak psal zlz:

A zkoušel jsi číst dokumentaci?

TListView.LargeImages obsahuje obrázky. Ty v něm máš načtené systémové ikony.
TListItem.ImageIndex určuje index obrázku ^^. Ty ho nastavuješ na index systémové ikony.

Jestli chceš zobrazovat náhledy, tak si místo ikon načti ty náhledy a nastav odpovídající index. Na získání náhledů zase můžeš použít funkce shellu, konkrétně to umí třeba IExtractImage interface, nebo funkce Delphi (TBitmap?).

koukal jsem se na ty stranky a ac to vypada vsechno jednoduse, tak vlastni zapis jsem do kupy nedal.

zkousel jsem hledat i kody pro Delphi,kde by bylo obsazeno IExtractImage, ale taky marne.

Mam tedy tenhle kod: 

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, ShellAPI, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ImgList, StdCtrls;

type
  TForm1 = class(TForm)
    DirEdit: TEdit;
    ShowBtn: TButton;
    LargeFileImages: TImageList;
    FileView: TListView;
    procedure ShowBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  SFI: TSHFileInfo;

implementation

{$R *.dfm}

procedure TForm1.ShowBtnClick(Sender: TObject);
var
  Found: Integer;
  SearchRec: TSearchRec;
begin
  // odstraníme všechny položky
  FileView.Items.Clear;
  // zahájíme hledání
  Found := FindFirst(DirEdit.Text + '\*.jpg', faAnyFile - faVolumeID, SearchRec);
  // opakujeme, dokud existují vyhovující soubory
  while Found = 0 do
  begin
    if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
      with FileView.Items.Add do // přidíme položku
      begin
        SHGetFileInfo(
          PChar(DirEdit.Text + '\' + SearchRec.Name), // cesta k souboru
          0,                                          // atributy - žádné
          SFI, SizeOf(SFI),                           // struktura TSHFileInfo
          // vlajky: chceme získat index velké ikony a jméno souboru
          SHGFI_SYSICONINDEX + SHGFI_LARGEICON + SHGFI_DISPLAYNAME
        );
        Caption := SFI.szDisplayName; // nastavíme název
        ImageIndex := SFI.iIcon;      // a index ikony
      end;
    Found := FindNext(SearchRec);
  end;
  // konec hledání
  FindClose(SearchRec);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  LargeFileImages.Handle := SHGetFileInfo(
    PChar(Application.ExeName), // jelikož nám jde o handle ImageListu,
    0,                          // můžeme použít libovolný soubor - třeba
    SFI, SizeOf(SFI),           // "exáč" aplikace
    SHGFI_SYSICONINDEX + SHGFI_LARGEICON
  );
end;
end.

a chtel bych Vas poprosit, pokud by jste mi pomohli ho predelat tak jak pise zlz pomoci IExtractImage tak aby se mi misto ikon zobrazovaly ty nahledy fotek.jpg.

Co smazat uz zhruba vim, ale nevim, co vepsat misto toho.
Nebo aspon odkaz na nejakej kod, kde se IExtractImage pouziva, me se nepodarilo nic najit.

Predem dekuji za trpelivost s mym nymandstvim ...

Nahlásit jako SPAM
IP: 89.102.38.–
Reklama
Reklama
liborb
~ Redaktor
+18
Guru
28. 8. 2012   #2
-
0
-

Původně jsem tě chtěl navigovat stejným směrem (spletl jsem názvy rozhraní :)), ale tohle není cesta pro tebe. Pro tebe je jednodušší, když půjdeš cestou Delphi fičurek.

Náhledy potřebuješ někam uložit, a to něco je TImageList. Do něj se ukládají TBitmap, ale tou JPG nenačteš. Podle všeho je tu třída TJPEGImage, která umí načítat JPG. No a když to budeš mít načtené, tak se z toho dá udělat bitmapa, kterou pak jenom zmenšíš na rozměr, který si zvolíš (rozměr, který bude uchovávat TImageList). A když si to takhle hezky uložíš, tak budeš znát index obrázku v TImageList, který nastavíš té položce v ListView (ImageIndex).

 Načtení JPG do TBitmap:

bmp: TBitmap;
jpg: TJPEGImage; 

...

jpg := TJpegImage.Create;
jpg.LoadFromFile('cesta k jpg souboru'); 

bmp := TBitmap.Create;
bmp.Assign(jpg);

// a mame z JPG bitmapu :)

A tady kupříkladu funkce na změnu velikosti bitmapy.

No a pak jenom u instance třídy TImageList zavoláš Add a jako parametr mu předáš tu zmenšenou bitmapu. On ti vrátí index, který má ta bitmapa v image listu. Ten image list bude přiřazený do ListView a té konkrétní položce přidáš tento konkrétní index :)

Jestli to budeš chtít mít o něco lepší, tak si to asi budeš muset štosovat lépe, aby sis pamatoval, které obrázky už si načítal a které ne (když se vrátíš do adresáře apod.), aby si je nemusel načítat pořád znovu a znovu. Ale na to je času dost :).

Nahlásit jako SPAM
IP: 78.80.52.–
dyžon0
Stálý člen
31. 8. 2012   #3
-
0
-

#2 liborb
to je super, ...

zkusil jsem napsat toto: (je to jen zatim slepena vec z nekolika ruznych veci a jsou tam i komponenty,treba jako label1 a pod jen kvuli kontrole. Az to bude fungovat, tak to prepisu,nebo orezu na nutny veci)


{$R *.dfm}

function ResizeBmp(bmp: TBitmap; wid, hei: Integer): Boolean;
var 
  TmpBmp: TBitmap;
  ARect: TRect;
begin
  Result := False;
  try
    TmpBmp := TBitmap.Create;
    try
      TmpBmp.Width  := wid;
      TmpBmp.Height := hei;
      ARect := Rect(0,0, wid, hei);
      TmpBmp.Canvas.StretchDraw(ARect, bmp);
      bmp.Assign(TmpBmp);
    finally
      TmpBmp.Free;
    end;
    Result := True;
  except
    Result := False;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
const
  sPath = 'd:\Delphi\Obrazky\';
var
  bmp: TBitmap;
  jpg: TJPEGImage;
  i: integer;
  SearchRec: TSearchRec;
  ListItem:  TListItem;
  FileInfo:  SHFILEINFO;
begin
  ListView1.SmallImages := ImageList1;
  ListView1.ViewStyle  := vsReport;
  ListView1.Columns.add.Width:= 150;
  Icon := TIcon.Create;
  try
    ListView1.items.BeginUpdate;
    i := FindFirst(sPath + '*.jpg', faAnyFile, SearchRec);
    while i = 0 do
      begin
        application.ProcessMessages;
        with ListView1 do
        begin
        if ((SearchRec.Attr and FaDirectory <> FaDirectory) and (SearchRec.Attr and FaVolumeId <> FaVolumeID)) then
        begin
          ListItem := ListView1.items.add;
          SHGetFileInfo(PChar(sPath + SearchRec.Name), 0, FileInfo, SizeOf(FileInfo), SHGFI_DISPLAYNAME);

          Listitem.Caption := FileInfo.szDisplayName;
          Label1.Caption:= sPath + FileInfo.szDisplayName;

          jpg := TJpegImage.Create;
          jpg.LoadFromFile(sPath + FileInfo.szDisplayName);
          bmp := TBitmap.Create;
          bmp.Assign(jpg);
          ResizeBmp(bmp,97,73);
        end;
      end;
      i := FindNext(SearchRec);
    end;
  finally
    ListView1.items.EndUpdate;
  end;
end;

end.

ale mam problem s tim, ze u prevodu z jpg na bmp  skoncim s promennou bmp, jenze nevim, jak ji dal pouzit.
treba...   Image1.Picture.LoadFromFile(bmp) nefunguje coz je jasny, ale jak to teda napsat ??
no ale hlavne to co potrebuji je, ze pri prekladu mi to hodi chybu pri volani funkce ResizeBmp( bmp,97,73) tady to bmp je taky spatne pouzity ..
poradis mi s tim jeste prosim ...
jinak potom uz priradim zresizovany fotky do  ImageList2 a nejak se prokousu tim, abych je zobrazil v ListView2.
ale prvne musim vyresit tohle, jinak me to dal nepusti ..

Nahlásit jako SPAM
IP: 89.102.38.–
liborb
~ Redaktor
+18
Guru
31. 8. 2012   #4
-
0
-

Ty už ji máš v paměti, takže by mělo stačit nebo jako Image1.Picture.Assign(bmp).

No a jakou chybu ti hlásí ta změna velikosti bitmapy?

Zasláno z mobilního telefonu.

Nahlásit jako SPAM
IP: 82.145.211.–
dyžon0
Stálý člen
31. 8. 2012   #5
-
0
-

#4 liborb
tady je vypis vsech zprav pri prelozeni ..

zastavi se to na radku ResizeBmp(bmp, .....   a kurzor je prave za bmp.

Build
  [Hint] Unit1.pas(38): Value assigned to 'ResizeBmp' never used
  [Warning] Unit1.pas(79): Symbol 'faVolumeID' is specific to a platform
  [Warning] Unit1.pas(79): Symbol 'faVolumeID' is specific to a platform
  [Error] Unit1.pas(93): Too many actual parameters
  [Error] Unit1.pas(93): Too many actual parameters
  [Error] Unit1.pas(19): Unsatisfied forward or external declaration: 'TForm1.ResizeBmp'
  [Fatal Error] Project2.dpr(5): Could not compile used unit 'Unit1.pas'

tech chyb je tam vic, ale jak rikam, az to zfunkcnim, budu to jeste orezavat a upravovat ....

Nahlásit jako SPAM
IP: 89.102.38.–
dyžon0
Stálý člen
31. 8. 2012   #6
-
0
-

mel jsem spatne zapsanou tu funkci, opravil jsem to, pouzil to tvoje prirazeni a uz to funguje ...
omlouvam se, ze jsem mystifikoval, byla to moje hloupost ..
tak ted jdu na to vykresleni miniatury do ListView2

Nahlásit jako SPAM
IP: 89.102.38.–
dyžon0
Stálý člen
31. 8. 2012   #7
-
0
-

tak jsem to nejak sesmolil, ale je to hrozne pomaly ..
tady je code:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Jpeg, StdCtrls, ShellApi, ImgList, ComCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    Label1: TLabel;
    ImageList1: TImageList;
    ImageList2: TImageList;
    Button1: TButton;
    ListView2: TListView;
    Image1: TImage;
    Image2: TImage;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function ResizeBmp(bmp1: TBitmap; wid, hei: Integer): Boolean;
var 
  TmpBmp: TBitmap;
  ARect: TRect;
begin
  Result := False;
  try
    TmpBmp := TBitmap.Create;
    try
      TmpBmp.Width  := wid;
      TmpBmp.Height := hei;
      ARect := Rect(0,0, wid, hei);
      TmpBmp.Canvas.StretchDraw(ARect, bmp1);
      bmp1.Assign(TmpBmp);
    finally
      TmpBmp.Free;
    end;
    Result := True;
  except
    Result := False;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
const
  sPath = 'd:\Delphi\Obrazky\';
var
  bmp: TBitmap;
  jpg: TJPEGImage;
  i: integer;
  SearchRec: TSearchRec;
  ListItem,ListItem2:  TListItem;
  FileInfo:  SHFILEINFO;
begin
//  ListView1.SmallImages := ImageList1;
//  ListView1.ViewStyle  := vsReport;
//  ListView1.Columns.add.Width:= 150;
  ListView2.Columns.Add;
  Icon := TIcon.Create;
  try
//    ListView1.items.BeginUpdate;
    ListView2.Items.BeginUpdate;
    i := FindFirst(sPath + '*.jpg', faAnyFile, SearchRec);
    while i = 0 do
      begin
        application.ProcessMessages;
//        with ListView1 do
          with ListView2 do
        begin
        if ((SearchRec.Attr and FaDirectory <> FaDirectory) and (SearchRec.Attr and FaVolumeId <> FaVolumeID)) then
        begin
//          ListItem := ListView1.items.add;
          ListItem2:= ListView2.Items.Add;
          SHGetFileInfo(PChar(sPath + SearchRec.Name), 0, FileInfo, SizeOf(FileInfo), SHGFI_DISPLAYNAME);
          ListItem2.Caption:= FileInfo.szDisplayName;
//          Listitem.Caption := FileInfo.szDisplayName;
          Label1.Caption:= sPath + FileInfo.szDisplayName;

          jpg := TJpegImage.Create;
          jpg.LoadFromFile(sPath + FileInfo.szDisplayName);
          bmp := TBitmap.Create;
          bmp.Assign(jpg);
          Image1.Picture.Assign(bmp);
          ResizeBmp(bmp , 97 , 73);
          Image2.Picture.Assign(bmp);
          ImageList1.Insert(i,bmp,nil);
          ListItem2.ImageIndex:= ImageList1.AddImage(ImageList1,i);

      end;
      end;
      i := FindNext(SearchRec);
    end;
  finally
    ListView2.Items.EndUpdate;
//    ListView1.items.EndUpdate;
  end;
end;

end.

Nahlásit jako SPAM
IP: 89.102.38.–
dyžon0
Stálý člen
31. 8. 2012   #8
-
0
-

tady je vysledek

Nahlásit jako SPAM
IP: 89.102.38.–
liborb
~ Redaktor
+18
Guru
31. 8. 2012   #9
-
+1
-
Zajímavé

Na mobilu nevidím, jestli tam je nějaká "brzda", ale jinak cos čekal? :)

Nebo jinak, jak se ta pomalost projevuje? Kolik máš souborů jpg? Jak jsou velké?

A samozřejmě to načítání musíš udělat na pozadí ve vlákně a ještě si musíš udělat vlastní seznam (jméno souboru - index v ImageList), kde si budeš kontrolovat, jestli už daný obrázek náhodou nemáš v paměti, aby si je nenačítal stále dokola, když se do nějaké adresáře opakovaně vrátíš.

Zasláno z mobilního telefonu.

Nahlásit jako SPAM
IP: 82.145.209.–
dyžon0
Stálý člen
31. 8. 2012   #10
-
0
-

necekal jsem zazraky, ... :o))   ale tohle je hodne pomaly ..
urcite ted prectu neco o vlaknech,snad zjistim o co jde,trochu tusim, a uvidim ...

rozhodne to nejaky zrychleni chce ...

a samozrejme dikec.

Nahlásit jako SPAM
IP: 89.102.38.–
dyžon0
Stálý člen
1. 9. 2012   #11
-
0
-

jsem zapomel, ..  pomalost je prave u procesu resize, ...

Chci ten program pouzit na prohlizeni fotek a tech mam moc.

V kazdym adresari je jich treba 30 a jsou velky zhruba 3 - 5 Mb

Nahlásit jako SPAM
IP: 89.102.38.–
Sniper
~ Anonymní uživatel
184 příspěvků
1. 9. 2012   #12
-
0
-

Ten resize neni pomalej, ten je prostě výpočetně náročnej. Jak tu bylo zmíněno, jediný kloudný řešení jsou vlákna, tak s chutí do nich 

Nahlásit jako SPAM
IP: 90.179.201.–
liborb
~ Redaktor
+18
Guru
1. 9. 2012   #13
-
0
-

Stejně tě ty vlákna neminou a jen tak mimochodem pokud to udeláš chytře, tak to bude na vícejádrovém procesoru i mnohem rychlejší. Ale teď můžeš zkusit změnit nastavení toho resize. Jsou minimálně 2 režimy: v jednom se barva každého pixelu počítá z dané oblasti a druhý - mnohem rychlejší - tam se prostě berou jen vybrané a zbytek se zahodí. Ale jak to pomůže s takovým billboardem, to netuším :)

Zasláno z mobilního telefonu.

Nahlásit jako SPAM
IP: 82.145.217.–
Zjistit počet nových příspěvků

Přidej příspěvek

Toto téma je starší jak čtvrt roku – přidej svůj příspěvek jen tehdy, máš-li k tématu opravdu co říct!

Ano, opravdu chci reagovat → zobrazí formulář pro přidání příspěvku

×Vložení zdrojáku

×Vložení obrázku

Vložit URL obrázku Vybrat obrázek na disku
Vlož URL adresu obrázku:
Klikni a vyber obrázek z počítače:

×Vložení videa

Aktuálně jsou podporována videa ze serverů YouTube, Vimeo a Dailymotion.
×
 
Podporujeme Gravatara.
Zadej URL adresu Avatara (40 x 40 px) nebo emailovou adresu pro použití Gravatara.
Email nikam neukládáme, po získání Gravatara je zahozen.
-
Pravidla pro psaní příspěvků, používej diakritiku. ENTER pro nový odstavec, SHIFT + ENTER pro nový řádek.
Sledovat nové příspěvky (pouze pro přihlášené)
Sleduj vlákno a v případě přidání nového příspěvku o tom budeš vědět mezi prvními.
Reaguješ na příspěvek:

Uživatelé prohlížející si toto vlákno

Uživatelé on-line: 0 registrovaných, 21 hostů

 

Hostujeme u Českého hostingu       ISSN 1801-1586       ⇡ Nahoru Webtea.cz logo © 20032016 Programujte.com
Zasadilo a pěstuje Webtea.cz, šéfredaktor Lukáš Churý