delphi - 图像处理需要很长时间并导致应用程序一段时间没有响应

Question

我使用这种方法来处理图像，但是如果包含高分辨率图像，超过1000 x 1000像素，图像处理需要很长的时间并导致应用程序一段时间没有响应，如何克服它.

处理高分辨率图像时，总是出现“无响应”消息，如图所示。

type
   TRGBArray = array[0..0] of TRGBTriple;
   pRGBArray = ^TRGBArray;

var
   ARL, ALL, AOL : pRGBarray;
   TOGfx, TRGfx, TLGfx : TBitmap;


procedure TFZN.GfXColorProcessor;
var
   X, Y : integer;
begin
   TOGfx.Assign(TRGfx);
for Y := 0 to TRGfx.Height - 1 do
begin
   ARL := TOGfx.Scanline[Y];
   AOL := TLGfx.Scanline[Y];
//-------------------------
for x := 0 to TRGfx.Width - 1 do
begin
   ARL[x].RGBtRed := AOL[X].RGBtRed;
   IBG.Picture.bitmap.Assign(TOGfx);
end;

end;

end;

Answer 1

您应该按照 TLama 的建议使用 ScanLine()，如果处理图像仍然需要很长时间，您可以使代码线程化并继续应用程序的正常流程，或者显示进度条并强制用户等待。 请记住，在主线程之外使用 VCL 控件不是线程安全的，因此最好向用户显示某种通知，告知他应该等待处理完成。

以下是进行处理的简单线程的示例代码:

unit uImageProcessingThread;

interface

uses
  Winapi.Windows, System.Classes, Vcl.Graphics;

type
  TImageProcessingThread = class(TThread)
  private
    FBitmap: TBitmap;

  protected
    procedure Execute; override;

  public
    constructor Create(const ABitmap: TBitmap);

  end;

implementation

constructor TImageProcessingThread.Create(const ABitmap: TBitmap);
begin
  inherited Create(TRUE);

  FBitmap := ABitmap;
end;

procedure TImageProcessingThread.Execute;
var
  GC  : LongInt;
  H, W: Integer;
begin
  for H := 0 to FBitmap.Height do
  begin
    for W := 0 to FBitmap.Width do
    begin
      GC := ColorToRGB(FBitmap.Canvas.Pixels[W, H]);
      FBitmap.Canvas.Pixels[W, H] := RGB(GC, GC, GC);
    end;
  end;
end;

end.