delphi – 如何在后台加载来自磁盘的图像(多线程)[AKA:TBitmap不是线程安全的]

我想快速显示一些图像(jpg,png等)作为缩略图.因为解码和调整大小过程是懒惰的,所以我要在一个或多个线程中完成它.

但是,使用TBitmap和TJpeg画布的it looks like并不是多线程安全的.

在这种情况下,我的问题是:
1.如果不完全重写GIF / PNG / BMP / JPG库,怎么办呢?
2.有人知道Embarcadero的Gif和Png libs是否也不安全?
3.如果我使用Lock锁定画布不会破坏性能,因为调整大小部分访问画布并占用大部分CPU周期?

我发现这让我很烦恼:

David HAROUCHE wrote: That is not correct. The really confusing part
is that even local TBitmap are not thread safe unless you lock them.
This is because every TBitmap registers itself to the global
BitmapCanvasList list in graphics.pas. And when the DC garbage
collection FreeMemoryContexts()

http://www.codenewsfast.com/cnf/thread/0/permalink.thr-ng1908q2024

最佳答案
将GDI与CreateCompatibleDC和CreateBitmap一起使用将涵盖许多图像格式并避免画布线程问题.
这只是一个示例实现,可能会被修改.
GDI API将需要三个单元,无需安装,例如可以从http://www.progdigy.com/获得

unit ScaleImageThread;
// 2013 Thomas Wassermann
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls
  ,GDIPAPI, GDIPOBJ, StdCtrls;
Type
  TScaleImageThread=Class(TThread)
    FBMP:TBitMap;
    FMemDC:HDC;
    FMemBMP:HBitmap;
    Procedure Execute;Override;
  private
    Ffn:String;
    FDestWidth,FDestHeight:Integer;
    procedure SyncFinished;
    Public
    Constructor Create(aBitMap:TBitmap;const fn:String);overload;
    property BMP:TBitmap read FBMP;
    Property FileName:String read Ffn;
  End;
implementation
{ TGDIThread }
Procedure ScaleOneImage(Const source:String;aHDC:HDC;DestWidth,DestHeight:Integer;Qual:Integer=92;WithOutMargins:Boolean=false;BgColor:TColor=ClWhite;DoNotUpScale:Boolean=false);
var
  graphics : TGPGraphics;
  image: TGPImage;
  width, height: UINT;
  faktor:Double;
  destx,desty:Double;
  rct:TGPRectF;
  Ext:String;
begin

  image:= TGPImage.Create(source);
  width  := image.GetWidth;
  height := image.GetHeight;


    if (DestWidth / width) < (DestHeight/Height) then faktor  := (DestWidth / width) else faktor:= (DestHeight/Height);
    destx :=  (DestWidth - faktor * width) / 2;
    desty :=  (DestHeight - faktor * Height) / 2;
    graphics := TGPGraphics.Create(aHDC);
    graphics.SetInterpolationMode(InterpolationModeHighQualityBicubic);

    graphics.DrawImage(
      image,
      MakeRect(destx,  desty , faktor * width, faktor * height),  // destination rectangle
      0, 0,        // upper-left corner of source rectangle
      width,       // width of source rectangle
      height,      // height of source rectangle
      UnitPixel);
    image.Free;
    graphics.Free;
end;

constructor TScaleImageThread.Create(aBitMap: TBitmap;const fn:String);
begin
  inherited create(False);
  Ffn :=fn;
  FreeOnTerminate := true;
  FBmp := aBitMap;
  FMemDC := CreateCompatibleDC(FBmp.Canvas.Handle);
  FMemBMP := CreateBitmap(FBmp.Width ,FBmp.Height ,1,GetDeviceCaps(FBmp.Canvas.Handle, BITSPIXEL),nil);
  SelectObject(FMemDC, FMemBMP);
  FDestWidth :=FBMP.Width;
  FDestHeight:=FBMP.Height;
end;


procedure TScaleImageThread.Execute;
begin
  inherited;
  ScaleOneImage(Ffn,FMemDC,FDestWidth,FDestHeight);
  Synchronize(SyncFinished);
end;

procedure TScaleImageThread.SyncFinished;
begin
 BitBlt(FBmp.Canvas.Handle, 0, 0, FBmp.Width, FBmp.Height, FMemDC, 0, 0, SRCCOPY);
 DeleteObject(FMemBMP);
 DeleteDC (FMemDC);
end;

end.

实施测试

uses ScaleImageThread;
{$R *.dfm}

procedure TForm1.ThreadTerminate(Sender: TObject);
begin
  Canvas.Draw(FX, FY, TGDIThread(Sender).BMP);
  TGDIThread(Sender).BMP.Free;
  FX := FX + 70;
  if FX > 500 then
    begin
    FX := 0;
    FY := FY + 70;
    end;

end;

procedure TForm1.Button1Click(Sender: TObject);
const
  C_DIM = 64;
var
  i: Integer;
  Function GetNewBitMap: TBitMap;
  begin
    Result := TBitMap.Create;
    Result.Width := C_DIM;
    Result.Height := C_DIM;
  end;

begin
  ReportMemoryLeaksOnShutDown := true;
  for i := 1 to 10 do
    With TGDIThread.Create(GetNewBitMap,
      'C:\temp\bild ' + intToStr(i) + '.png') do
      OnTerminate := ThreadTerminate;

  for i := 1 to 10 do
    With TGDIThread.Create(GetNewBitMap,
      'C:\Bilder\Kids' + intToStr(i) + '.jpg') do
      OnTerminate := ThreadTerminate;


end;

转载注明原文:delphi – 如何在后台加载来自磁盘的图像(多线程)[AKA:TBitmap不是线程安全的] - 代码日志