Autor Téma: ImageList - načítání obrázků  (Přečteno 5844 krát)

Offline AlienStar

  • Plnoletý
  • ***
  • Příspěvků: 101
  • Karma: 2
ImageList - načítání obrázků
« kdy: 28-11-2012, 21:14:38 »
Přeji hezký den.
Řeším už delší dobu jeden problém s ImageListem .

Načítám do něj obrázky o rozměrech 200 x 100 pixelů a to takto:

Kód: Delphi [Vybrat]
  1.   for i := 1 to PocZaznamu do
  2.  Begin
  3.             try
  4.              bmp := TBitmap.Create;
  5.              bmp.LoadFromFile(Cesta + 'Data\' + StringGrid1.Cells[2,i] + '\Default.bmp');
  6.              ImageList1.Add(bmp,nil);
  7.             finally
  8.              bmp.Free;
  9.             end;
  10.           ...
  11.           ...
  12.  

a načítám je do StringGridu a to takto

Kód: Delphi [Vybrat]
  1. procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  2.   Rect: TRect; State: TGridDrawState);
  3. begin
  4.   ...
  5.       if (ACol=1) and (ARow>0) and (Obrazky = true) then
  6.       begin
  7.             ImageList1.Draw(Canvas,Rect.Left,Rect.Top,ARow-1);
  8.       end
  9.  ...
  10.  

.. a teď k mému problému ...

Potřebuji ve StringGridu zobrazovat poloviční obrázky tj. cca 100 x 50

Nevíte někdo jak je ve StringGridu změnit?


A Další otázka ...
Lze si vytvořit nějaký svůj ImageList, kde by se daly načítat obrázky větší jak 256 x 256 pixelů?


Za odpovědi předem mockrát děkuji



Offline pepak

  • Guru
  • *****
  • Příspěvků: 1429
  • Karma: 34
    • Pepak.net
Re:ImageList - načítání obrázků
« Odpověď #1 kdy: 28-11-2012, 21:40:38 »
Vykreslit do nějakého mezicanvasu a odtud do finálního pomocí StretchDraw?

Offline Radek Červinka

  • Administrátoři
  • Padawan
  • *****
  • Příspěvků: 2329
  • Karma: 102
    • Verze Delphi: D5,D2007, DXE, DXE2 + 2 poslední (Tokyo)
    • O Delphi v češtině
Re:ImageList - načítání obrázků
« Odpověď #2 kdy: 28-11-2012, 22:05:44 »
Lze si vytvořit nějaký svůj ImageList, kde by se daly načítat obrázky větší jak 256 x 256 pixelů?

Nejhloupejsi reseni je pouzit normalne TObjectList a pridavat do nej instance TBitmap.
Embarcadero MVP - Czech republic

Offline pepak

  • Guru
  • *****
  • Příspěvků: 1429
  • Karma: 34
    • Pepak.net
Re:ImageList - načítání obrázků
« Odpověď #3 kdy: 28-11-2012, 22:15:25 »
ImageList je omezený tím, že to je jen wrapper nad Windowsovskou komponentou, takže musí respektovat její limity. Nejsem si jistý, jestli mezi ně patří i velikost, ale nedivil bych se tomu. Mám pocit, že jsem sám u nějaké velikosti narazil, ale jestli to bylo 256x256 nebo 512x512, to si nepamatuju.

Offline TLama

  • Guru
  • *****
  • Příspěvků: 597
  • Karma: 31
    • Verze Delphi: 7, 2009, XE3
Re:ImageList - načítání obrázků
« Odpověď #4 kdy: 29-11-2012, 04:29:01 »
Lze si vytvořit nějaký svůj ImageList, kde by se daly načítat obrázky větší jak 256 x 256 pixelů?

Nejhloupejsi reseni je pouzit normalne TObjectList a pridavat do nej instance TBitmap.

Proč nejhloupější ? Právě bych řekl že nejlepší. TObjectList<TBitmap> může OP použít jednak jako kontejner
a druhak mu odpadne starost s offscreen resizem bitmap, protože je může předávat přímo cílovému canvasu při
"zmenšování" pomocí StretchDraw. Navíc image list si se string gridem stejně nerozumí, takže tady TImageList
nemá žádný význam.

@AlienStar, kdyby ses rozhodl pro ten kontejner a potřeboval poradit s kódem, dej vědět. Akorát nezapomeň
uvést verzi Delphi, pro kterou to chceš. Jo a mezitím si posuň konstruktor bitmapy o jeden řádek nahoru ;):

Kód: Delphi [Vybrat]
  1. bmp := TBitmap.Create;
  2. try
  3.   bmp.LoadFromFile(Cesta + 'Data\' + StringGrid1.Cells[2, i] + '\Default.bmp');
  4.   ImageList1.Add(bmp, nil);
  5. finally
  6.   bmp.Free;
  7. end;
« Poslední změna: 11-12-2012, 15:52:07 od TLama »

Offline AlienStar

  • Plnoletý
  • ***
  • Příspěvků: 101
  • Karma: 2
Re:ImageList - načítání obrázků
« Odpověď #5 kdy: 29-11-2012, 05:30:09 »
Děkuji za odpovědi.

Mohl bych poprosit ještě o nějaký kousek kodu jak pracovat a používat  TObjectList  ?

Mám verzi Delphi XE2, XE3

moc děkuji

Offline pepak

  • Guru
  • *****
  • Příspěvků: 1429
  • Karma: 34
    • Pepak.net
Re:ImageList - načítání obrázků
« Odpověď #6 kdy: 29-11-2012, 06:03:41 »
Kód: Delphi [Vybrat]
  1. var L: TObjectList;
  2. begin
  3.   L := TObjectList.Create(True);
  4.   try
  5.     L.Add(TBitmap.Create);
  6.     L.Add(TForm.Create(nil));
  7.     L.Add(Button1);
  8.     // ...
  9.     for i := 0 to Pred(L.Count) do
  10.       if L[i] is TBitmap then
  11.         TBitmap(L[i]).SaveToFile('x.bmp')
  12.       else if L[i] is TForm then
  13.         TForm(L[i]).ShowModal
  14.       else
  15.         ShowMessage('Neznamy typ objektu');
  16.   finally
  17.     L.Free;
  18.     end;
  19. end;
Musí být hrozně těžké programovat, když ti provider blokuje Google, ale uděláme, co jde...

Offline TLama

  • Guru
  • *****
  • Příspěvků: 597
  • Karma: 31
    • Verze Delphi: 7, 2009, XE3
Re:ImageList - načítání obrázků
« Odpověď #7 kdy: 29-11-2012, 10:02:58 »
Musí být hrozně těžké programovat, když ti provider blokuje Google, ale uděláme, co jde...

:) No jinak tím  TObjectList<TBitmap> jsem se snažil naznačit (než byla známá verze, kterou OP používá),
že by nebylo špatné použít generika. Možno nějak takhle:

Kód: Delphi [Vybrat]
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7.   Dialogs, Grids, StdCtrls, Generics.Collections;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Button1: TButton;
  12.     StringGrid1: TStringGrid;
  13.     procedure FormCreate(Sender: TObject);
  14.     procedure Button1Click(Sender: TObject);
  15.     procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  16.       Rect: TRect; State: TGridDrawState);
  17.     procedure FormDestroy(Sender: TObject);
  18.   private
  19.     FImageList: TObjectList<TBitmap>;
  20.     procedure LoadImages(RecordCount: Integer);
  21.   public
  22.     { Public declarations }
  23.   end;
  24.  
  25. var
  26.   Form1: TForm1;
  27.  
  28. implementation
  29.  
  30. {$R *.dfm}
  31.  
  32. procedure TForm1.LoadImages(RecordCount: Integer);
  33. var
  34.   I: Integer;
  35.   Bitmap: TBitmap;
  36. begin
  37.   // tímto se vyprázdní kolekce a uvolní všechny bitmapy
  38.   FImageList.Clear;
  39.   // iterace, kterou jsi prováděl
  40.   for I := 1 to RecordCount do
  41.   begin
  42.     // vytvoříme objekt bitmapy
  43.     Bitmap := TBitmap.Create;
  44.     // nahrajeme obrázek z cesty podle nějakého zaklínadla
  45.     Bitmap.LoadFromFile('c:\Data\' + StringGrid1.Cells[2, I] + '\Default.bmp');
  46.     // a přidáme ho do kolekce; to je vše; o jeho uvolnění se postará kolekce,
  47.     // protože má momentálně nastaveno OwnsObjects na True, což znamená, že
  48.     // objekty, které do ní přidáme ona sama zniční při odstranění položky z
  49.     // kolekce; 4 z 5 doktorů však nedoporučují pokoušet se o jejich odstranění
  50.     // manuálně stylem -> FImageList[0].Free; <- toto nedělej, tobě stačí když
  51.     // zavoláš FImageList.Delete(0); a bitmapa se uvolní (to samé se stane mj. při
  52.     // vyprázdnění kolekce pomocí Clear nebo při jejím uvolnění) - zkrátka zapomeň
  53.     // na to, že se musíš starat o uvolnění těch bitmap, nech to koňovi, jak se říká :)
  54.     FImageList.Add(Bitmap);
  55.   end;
  56.   // pokud chceš, aby se ti načtené obrázky zobrazily, vynuť překreslení gridu
  57.   StringGrid1.Invalidate;
  58. end;
  59.  
  60. procedure TForm1.FormCreate(Sender: TObject);
  61. begin
  62.   // zapneme report memory leaků
  63.   ReportMemoryLeaksOnShutdown := True;
  64.   // vytvoříme kolekci pro bitmapy; pro všeobecný chaos se jmenuje FImageList
  65.   // a objekty vlastní, tj. má property OwnsObjects = True
  66.   FImageList := TObjectList<TBitmap>.Create;
  67. end;
  68.  
  69. procedure TForm1.FormDestroy(Sender: TObject);
  70. begin
  71.   // uvolníme kolekci bitmap; spolu s tím se odstraní všechny položky a spolu
  72.   // s nimi se uvolní všechny bitmapy - díky OwnsObjects
  73.   FImageList.Free;
  74. end;
  75.  
  76. procedure TForm1.Button1Click(Sender: TObject);
  77. begin
  78.   // načtení obrázků
  79.   LoadImages(1);
  80. end;
  81.  
  82. procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  83.   Rect: TRect; State: TGridDrawState);
  84. var
  85.   DestRect: TRect;
  86. begin
  87.   // FImageList.Count >= ARow je kontrola, zda máš v object listu dostatek
  88.   // obrázků; k jednotlivým instancím TBitmap se pak snadno dostaneš pomocí
  89.   // FImageList[x] kde x je jak bývá zvykem index počítaný od 0
  90.   if (ACol = 1) and (ARow > 0) and (FImageList.Count >= ARow) then
  91.   begin
  92.     // zkopírujem obdélník buňky do lokální proměnné obsahující cílový
  93.     // obdélník, kam se bude kreslit
  94.     DestRect := Rect;
  95.     // nastavíme mu šířku na polovinu šířky obrázku, který se bude kreslit
  96.     DestRect.Width := FImageList[ARow - 1].Width div 2;
  97.     // nastavíme mu výšku na polovinu výšky obrázku, který se bude kreslit
  98.     DestRect.Height := FImageList[ARow - 1].Height div 2;
  99.     // a vykreslíme obrázek pomocí metody StretchDraw do cílového obdélníku
  100.     TStringGrid(Sender).Canvas.StretchDraw(DestRect, FImageList[ARow - 1]);
  101.   end;
  102. end;
  103.  
  104. end.
« Poslední změna: 11-12-2012, 15:51:51 od TLama »

Offline Radek Červinka

  • Administrátoři
  • Padawan
  • *****
  • Příspěvků: 2329
  • Karma: 102
    • Verze Delphi: D5,D2007, DXE, DXE2 + 2 poslední (Tokyo)
    • O Delphi v češtině
Re:ImageList - načítání obrázků
« Odpověď #8 kdy: 29-11-2012, 10:38:05 »
Proč nejhloupější ? Právě bych řekl že nejlepší. TObjectList<TBitmap> může OP použít jednak jako kontejner
...

No špatně jsem zvolil slovo, myslel jsem nejjednodušší. Jinak se hodně používá jedna velká bitmapa, a z ní se vyřezávají (resp. vykopírovávají) data (např. textury) přímo pro zobrazení (má to výhody i nevýhody).
Ale pro tazatele je opravdu asi nejlepší řešení s TObjectList.
Embarcadero MVP - Czech republic

Offline AlienStar

  • Plnoletý
  • ***
  • Příspěvků: 101
  • Karma: 2
Re:ImageList - načítání obrázků
« Odpověď #9 kdy: 29-11-2012, 12:28:28 »
@TLama - tak to je excelentní ,,, mockrát děkuji za kod  ,, vyzkouším a poreferuji ....
Ještě jednou mockrát díky všem

Offline AlienStar

  • Plnoletý
  • ***
  • Příspěvků: 101
  • Karma: 2
Re:ImageList - načítání obrázků
« Odpověď #10 kdy: 29-11-2012, 13:12:31 »
@TLama - vše funguje úplně parádně,, ještě jednou mockrát děkuji.
Musím ještě pochálit SUPER okomentování kodu.
Děkuji

A ještě jedna otázka,, dá se použít TJpeg místo TBitmap bez uprav kodu,, a nebo bez prevodu z Jpegu do Bitmapy?
ještě jednou díky

Offline TLama

  • Guru
  • *****
  • Příspěvků: 597
  • Karma: 31
    • Verze Delphi: 7, 2009, XE3
Re:ImageList - načítání obrázků
« Odpověď #11 kdy: 29-11-2012, 14:06:25 »
@TLama - vše funguje úplně parádně,, ještě jednou mockrát děkuji.
Musím ještě pochálit SUPER okomentování kodu.
Děkuji

A ještě jedna otázka,, dá se použít TJpeg místo TBitmap bez uprav kodu,, a nebo bez prevodu z Jpegu do Bitmapy?
ještě jednou díky

Není zač a díky za pochvalu :)!

Jinak k otázce, v kódu co jsem postnul takhle:

- do uses přidej unitu JPEG
- pomocí CTRL + R nahraď slovo TBitmap za TJPEGImage a název proměnné Bitmap třeba za JPEGImage

« Poslední změna: 11-12-2012, 15:48:59 od TLama »

Offline AlienStar

  • Plnoletý
  • ***
  • Příspěvků: 101
  • Karma: 2
Re:ImageList - načítání obrázků
« Odpověď #12 kdy: 29-11-2012, 22:33:14 »
vše funguje jak má ,,,,, mockrát děkuji za vyřešení problému   :)

Offline AlienStar

  • Plnoletý
  • ***
  • Příspěvků: 101
  • Karma: 2
Re:ImageList - načítání obrázků
« Odpověď #13 kdy: 30-11-2012, 18:03:00 »
Přeji hezký den.

ještě jsem narazil na nejasnost.

Jak si manuálně načtu obrázek z FImageList do Image1

něco jako Image1.Picture := FImageList.Items[2];   // což je blbost :-)


děkuji

Offline Ondřej Pokorný

  • Guru
  • *****
  • Příspěvků: 815
  • Karma: 59
    • Verze Delphi: Primárně Lazarus, jinak D7 až aktuální
    • Kluug.net
Re:ImageList - načítání obrázků
« Odpověď #14 kdy: 30-11-2012, 21:31:21 »
Žeby Assign?
Embarcadero Technology Partner