[Delphi] canvas.StrechDraw ve vlakně

[MiosR]

Ahoj,
potřebuji ve vlákně (používám Task) vytvořit změnšeninu obrázku pro vykreslování náhledu.
Vím, že se musí Canvas Locknout při hrabání z vlákna, ale jelikož obrázek může mít různý formát, k jeho načtení používám TPicture a pak se jaksi nedostanu na canvas.

Zde kód prováděný taskem

Kód: Vybrat vše

var pic := TPicture.Create;
try
  pic.LoadFromFile(self.soubor);
  var bmpNahled := TBitmap.Create;
  bmpNahled.Width := 200;
  bmpNahled.Height := Round(Pic.Height / (Pic.Width / bmpNahled.Width));
  bmpNahled.Canvas.Lock;
  bmpNahled.Canvas.StretchDraw(Rect(0, 0, bmpNahled.Width, bmpNahled.Height), Pic.Graphic);
  bmpNahled.Canvas.Unlock;
  self.bmpNahled := bmpNahled;
finally
  pic.free;
end;


Potřeboval bych zavolat něco jako

Kód: Vybrat vše

Pic.Graphic.canvas.lock;


Takto se mi občas staně, že je náhled prázdný.
Obdobně pak při tisku samozřejmě.
Pro 20 obrázků se čas použitím vláken zkrátí ze 40s na 5s.

Popř. kdyby jste někdo používal nějakou knihovnu, která by toto zvládla.
Poslední možností je to přepsat do javy třeba, ale výhoda Delphi je prostě ta, že "exáč, kterej poklikají a jede"

Díky

[Just_jo]

Zde nic nezamykají.

https://stackoverflow.com/a/45919886

[Wikan]

Tam to také nedělají v jiném vlákně.

[Just_jo]

Můžu se zeptat jak je pracováno s miniaturami?

Mohu poskytnout kód, který mi soubory přeukládá - mám jich 48 a i když nemám zapnutý timer, tak je převod ve vteřině.

Používám prostý TThread

[MiosR]

Miniatury se zobrazují jen v GUI a kreslí se do náhledu.
Při tisku se již vykresluje plný soubor.

Našel jsem Skia4Delphi a Delphi 12 má již integrováno. Z komunity edition odstranili commandline překladač, tak mi to nešlo nainstalovat do Alexandrie.

Každopádně když vemu nějakých 24 obrázků (mobilem fotka potraviny), tak přes TPicture zmenčeniny kódem výše cca 1,5s. Skia to má za 250ms.

Takže zatím předělám na Skiu jen to zmenšení a až se to naučím, asi celé, protože výkonostně úplně jinde.

Jedná se o program na tisk kartiček (obrázek + název). Dcera je autistka a hodně nám pomohlo, když ještě nemluvila, nalepit na ledničku kartičky na suchý zip a ona utrhla co chtěla, donesla a my jsme mohli podat ... žádné vztekání, pláč atd.

Paní z rané péče se mě ptala, čím jsem to tisknul no a tak jsem to chtěl trošku dodělat, protože já vím, že to třeba na 10s zamrzne a počkám, ale tak abych se za to nemusel stydět

Ještě doplním kód, kdyby se někomu hodilo

Kód: Vybrat vše

TTask.Create(
         procedure
             function GetResizedImage(const AImage: ISkImage; const ANewWidth, ANewHeight: Integer): ISkImage;
             var LSurface: ISkSurface;
             begin
               LSurface := TSkSurface.MakeRaster(ANewWidth, ANewHeight);
               LSurface.Canvas.Clear(TAlphaColors.Null);
               LSurface.Canvas.Scale(ANewWidth / AImage.Width, ANewHeight / AImage.Height);
               LSurface.Canvas.DrawImage(AImage, 0, 0, TSkSamplingOptions.High);
               Result := LSurface.MakeImageSnapshot;
             end;
         begin
           try
             var LImage: ISkImage;
             LImage := TSkImage.MakeFromEncodedFile(self.soubor);
             LImage := GetResizedImage(LImage, 200, Round(LImage.Height / (LImage.Width / 200)));

             TThread.Synchronize(nil,
             procedure
             begin
               self.bmpNahled := SkImageToBitmap(LImage);
             end);


[Just_jo]

Tak super

Třeba do budoucna - webovku k aplikaci, třeba i s nějakou databází obrázků a třeba to i hodit na nějaké software weby ( třeba slunečnici ) s popisem a ono se to roznese a pomůže v širším okolí

A díky za info k D12 - čekal jsem, že brzy bude