GetPixel schneller machen bzw. ersatz

[xZise]

Kennt ihr einen Ersatz für GetPixels oder eine möglichkeit es schneller zu machen?

So ist es bisher. Wenn der Wert "seZoom.Value" Größer als 10 ist, dann läufts noch gut (16-31 ms), aber dann wirds richtig langsam (Bei 10 max 47 ms und bei 2 haben wir 700 ms).

Diese Funktion wird durch einen Timer alle 33 ms aufgerufen:

Delphi-Quellcode:

procedure TForm1.Timer1Timer(Sender: TObject);
var
  StartTime, TimeDiff : Cardinal;
  Pixel : TColor;
  i, j : Byte;
begin
  if Visible then begin
    StartTime := GetTickCount;
    if OnMouse then begin
      Left := Mouse.CursorPos.X + 4;
      Top := Mouse.CursorPos.Y + 4;
    end;

    lMousePos.Caption := IntToStr(Mouse.CursorPos.X) + ' - ' + IntToStr(Mouse.CursorPos.Y);

    Pixel := GetPixel(DC, Mouse.CursorPos.X, Mouse.CursorPos.Y);

    lColor.Caption := IntToStr(GetRValue(Pixel)) + ' ' + IntToStr(GetGValue(Pixel)) + ' ' + IntToStr(GetBValue(Pixel));
    lDelphi.Caption := ColorToString(Pixel);

    iZoom.Canvas.Brush.Style := bsSolid;
    // Create Image
    for i := 0 to Round(iZoom.Width / seZoom.Value) do begin
      for j := 0 to Round(iZoom.Height / seZoom.Value) do begin
        iZoom.Canvas.Pen.Color := GetPixel(DC, Mouse.CursorPos.X + (i - 3), Mouse.CursorPos.Y + (j - 3));
        iZoom.Canvas.Brush.Color := GetPixel(DC, Mouse.CursorPos.X + (i - 3), Mouse.CursorPos.Y + (j - 3));
        iZoom.Canvas.Rectangle(i * seZoom.Value, j * seZoom.Value, (i + 1) * seZoom.Value, (j + 1) * seZoom.Value);
      end;
    end;

    iZoom.Canvas.Brush.Style := bsClear;
    iZoom.Canvas.Pen.Color := clBlack;
    iZoom.Canvas.Rectangle(Round(Round(iZoom.Width / seZoom.Value) / 2) - Round(seZoom.Value / 2), Round(Round(iZoom.Width / seZoom.Value) / 2) - Round(seZoom.Value / 2),Round(Round(iZoom.Width / seZoom.Value) / 2) - Round(seZoom.Value / 2),Round(Round(iZoom.Width / seZoom.Value) / 2) - Round(seZoom.Value / 2));

    lNeedTime.Font.Style := [];

    TimeDiff := GetTickCount - StartTime;
    if TimeDiff <= 20 then
      lNeedTime.Font.Color := clGreen
    else if (TimeDiff > 20) and (TimeDiff <= 30) then
      lNeedTime.Font.Color := clYellow
    else begin
      lNeedTime.Font.Color := clRed;
      if TimeDiff > 33 then
        lNeedTime.Font.Style := [fsBold];
    end;

    lNeedTime.Caption := IntToStr(TimeDiff) + ' ms';
  end;
end;

DC setzte ich übrigends im Create.

[Flocke]

Warum nimmst du nicht einfach StretchBlt, um vom Quell- in den Ziel-DC zu kopieren? Das sollte wesentlich schneller sein.

[xZise]

Cool! Ist ja richtig schnell... danke