delphi – 如何在后台加载来自磁盘的图像(多线程)[AKA：TBitmap

将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,// 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,FBmp.Width,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:tempbild ' + intToStr(i) + '.png') do
      OnTerminate := ThreadTerminate;

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


end;