AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Programmieren allgemein Delphi Seltsames Grafik-Phänomen - oder wie ich lernte, DELPHI zu "lieben"...
Thema durchsuchen
Ansicht
Themen-Optionen

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

Ein Thema von hathor · begonnen am 30. Jan 2015 · letzter Beitrag vom 1. Feb 2015
 
hathor
(Gast)

n/a Beiträge
 
#1

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

  Alt 30. Jan 2015, 16:14
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.
Angehängte Dateien
Dateityp: zip GRAFIKCOPY.zip (599,8 KB, 8x aufgerufen)

Geändert von hathor (30. Jan 2015 um 20:56 Uhr)
  Mit Zitat antworten Zitat
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 18:05 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz