Schnelleres LineTo

[ChrisE]

Zum Drüberschauen:

Delphi-Quellcode:

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    PaintBox1: TPaintBox;
    Label1: TLabel;
    lTime: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    cbMitBMP: TCheckBox;
    bMoveToLineTo: TButton;
    bPolyLine: TButton;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ZeichnenClick(Sender: TObject);
  private
    { Private-Deklarationen }
    FBMP: TBitmap;
    FStart: Int64;
    FStop: Int64;
    FFreq: Int64;
    procedure Start;
    function Stop:string;
    function TestMoveToLineTo(ACanvas: TCanvas; ACount, w, h: Integer): Integer;
    function TestPolyLine(ACanvas: TCanvas; ACount, w, h: Integer): Integer;      
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


procedure TForm1.FormCreate(Sender: TObject);
begin
  FBMP := TBitmap.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if Assigned(FBMP) then FreeAndNil(FBMP);
end;

procedure TForm1.Start;
begin
  QueryPerformanceFrequency(FFreq);
  QueryPerformanceCounter(FStart);
end;

function TForm1.Stop:string;
begin
  QueryPerformanceCounter(FStop);
  result := FloatToStrF((FStop-FStart)/FFreq * 1000, ffFixed, 10, 4); // ms
end;

function TForm1.TestMoveToLineTo(ACanvas: TCanvas; ACount, w, h: Integer): Integer;
var
  i : Integer;
  kette : string;
begin
  Start;
  result := 0;
  with ACanvas do 
  begin
    Pen.Color := clRed;
    MoveTo(10,10);
    for i := 0 to (ACount -1) div 2 do 
    begin
      LineTo(w-10,h-10);
      LineTo(10,10);
      result := result +2;  // result = Anzahl von LineTo
    end;
  end;
  kette := Stop;  // wie lang hat es gedauert ...
  lTime.Caption := kette; // Label auf der Oberfläche -> Zeit in ms anzeigen
end;

function TForm1.TestPolyLine(ACanvas: TCanvas; ACount, w, h: Integer): Integer;
var
  Points: Array of TPoint;
  kette : string;
  i     : Integer;
begin
  SetLength(Points, ACount); //Setlength nicht mit in die Zeitmessung
  Start;
  result := 0;
  for i := 0 to (ACount -1) div 2 do 
  begin
    Points[i*2].X := 10;
    Points[i*2].Y := H-10;
    Points[i*2+1].X := W-10;
    Points[i*2+1].Y := 10;    
    result := result +2;  // result = Anzahl der Punkt
  end;
  ACanvas.Pen.Color := clGreen;
  ACanvas.Polyline(Points);
  kette := Stop; // wie lang hat es gedauert ...
  lTime.Caption := kette; // Label auf der Oberfläche -> Zeit in ms anzeigen 
end;

procedure TForm1.ZeichnenClick(Sender: TObject);
var
  ACanvas: TCanvas;
  wdh: Integer;
  w,h: Integer;
  i: Integer;
  pFromSL, pToSL: PByteArray;
begin
  // Canvas auswählen
  if cbMitBMP.Checked then ACanvas := FBMP.Canvas
                      else ACanvas := PaintBox1.Canvas;
  // Bitmap anpassen (Resize von Form & PaintBox1.Align = alClient)
  FBMP.Width := PaintBox1.Width;
  FBMP.Height := PaintBox1.Height;
  wdh := StrToInt(Edit1.Text);
  w := PaintBox1.Width;
  h := PaintBox1.Height;
  // Hintergrund übermalen
  with ACanvas do
  begin
    Brush.Color := clWhite;
    Pen.Color := clBlack;
    Rectangle(0,0,w,h);
  end;
  // Sender entscheidet über Methode
  if Sender = bMoveToLineTo then Caption := IntToStr(TestMoveToLineTo(ACanvas, wdh, w, h))
  else if Sender = bPolyLine then Caption := IntToStr(TestPolyLine(ACanvas, wdh, w, h));
  
  // Wenn auf das Bitmap gezeichnet wurde, dann auf Paintbox übertragen
  if ACanvas = FBMP.Canvas then BitBlt(PaintBox1.Canvas.Handle, 0, 0, w, h, FBMP.Canvas.Handle, 0,0, SRCCOPY);
end;

[Edit:]Sourcen im Anhang