Seltsames Grafik-Phänomen - oder wie ich lernte, DELPHI zu "lieben"...

[hathor]

Seltsames Grafik-Phänomen - oder wie ich lernte, DELPHI zu "lieben"...

Eine kleine Grafik soll 80 x kopiert werden.
Das dauert etwa 12 sec auf meinem Notebook.
Wenn die fertige Grafik gelöscht wird mit FloodFill, dann dauert der Neu-Aufbau nur etwa 3 sec.

Hat jemand eine Erklärung dafür?

Im Anhang ist die EXE:
Bedienung:
Start: baut die Grafik auf
CheckBox SpeedUp beschleunigt den Grafik-Aufbau.
Reset: löscht die Grafik

Delphi-Quellcode:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    ProgressBar1: TProgressBar;
    Button3: TButton;
    Memo1: TMemo;
    cbSpeedUp: TCheckBox;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure TerminatedProc(Sender:TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormShow(Sender: TObject);

  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

   type
      TCopyThread = Class(TThread)
      private
        FPoint:TPoint;
        procedure UpdateProgressBar;
      protected
        procedure Execute;Override;
      public
        Constructor Create(p:TPoint);
      End;

var
  Form1: TForm1;
  CopyThread:TCopyThread;
  BitMap1 : TBitMap;
  GTC1, GTC2 : Cardinal;

implementation

{$R *.dfm}

procedure MM(s:string); begin Form1.Memo1.Lines.Add(s); end;

procedure TForm1.Button1Click(Sender: TObject);
var p:TPoint;
begin
if Button1.Tag=1 then Button3.Click; Button1.Tag:= 1;
if cbSpeedUp.Checked then
BEGIN
  Self.Canvas.FloodFill(ClientWidth div 2, ClientHeight div 2, clBlack, fsBorder);
  Self.Canvas.Draw(0,0,BitMap1);
END;

GTC1:= GetTickCount;
  p.X:= BitMap1.Width;
  P.Y:= 0;
  CopyThread:=TCopyThread.Create(p);
  CopyThread.OnTerminate:= TerminatedProc;
  ProgressBar1.Max:= BitMap1.Width*80 * BitMap1.Height;
  ProgressBar1.Position:= 0;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin if Assigned(CopyThread) then begin CopyThread.Terminate; end; end;

procedure TForm1.Button3Click(Sender: TObject);
var MyWindow : cardinal;
begin
  ProgressBar1.Position:= 0;
  Form1.WindowState:= wsMinimized;
  Sleep(100);
  MyWindow := FindWindow( Nil, PWIDECHAR('GRAFIKDEMO-201501'));
  If MyWindow <> 0 Then
  Begin
    ShowWindow(MyWindow, SW_Normal);
    SetForeGroundWindow(MyWindow);
  End;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin BitMap1:= TBitmap.Create; BitMap1.LoadFromFile('BG_Kacheln1.bmp'); end;

procedure TForm1.FormDestroy(Sender: TObject); begin BitMap1.Free; end;

procedure TForm1.FormPaint(Sender: TObject);
begin Self.Canvas.Draw(0,0,BitMap1); end;

procedure TForm1.FormShow(Sender: TObject);
begin Application.Title := 'GRAFIKDEMO-201501'; end;

procedure TForm1.TerminatedProc;
begin
GTC2:= GetTickCount;
MM(' Dauer: '+ INTTOSTR(GTC2-GTC1)+' ms');
Sleep(100); WinApi.Windows.Beep(1800,100);
end;

{ TCopyThread }
constructor TCopyThread.Create(p: TPoint);
begin FPoint:=p; inherited Create(False); end;

procedure TCopyThread.Execute;
var
  i,j:Integer;
  dot:TColorRef;
  DC:HDC;
begin
  FreeOnTerminate:=True;
  DC:=GetDC(Form1.Handle);
  for i := 0 to BitMap1.Width * 80 - 1 do
    for j := 0 to BitMap1.Height - 1 do
      if not Terminated then
         begin
           dot:=GetPixel(DC,i,j);
           SetPixel(DC,i + FPoint.X,j + FPoint.Y,dot);
           Synchronize(UpdateProgressBar);
         end;
end;

procedure TCopyThread.UpdateProgressBar;
begin Form1.ProgressBar1.Position:= Form1.ProgressBar1.Position +1; end;

end.