Interpolation bei canvas.stretchdraw deaktivieren...

[corpsman]

Guten Morgen allerseits.

Ansich finde ich das Interpolieren / Glätten der canvas.Stretchdraw Funktion ja gut.

Aber ich habe hier ein Programm geschrieben / von Delphi nach Lazarus Portiert, welches darauf angewiesen ist, dass nicht interpoliert wird.

Auch nach längerem Suchen ist es mir nicht gelungen diese Funktion ab zu schalten. Könnt ihr mir weiterhelfen ?

Zur Verdeutlichung seien die beiden Dateianhänge.

B1.png zeigt das Bild wie es durch Lazarus entsteht
b2.png zeigt das Bild wie es durch Delphi 5 entsteht.

In beiden Fällen wird eine Tbitmap die Width = 2 und Height = 2 hat auf das Panel via

Code: Alles auswählen

panel1.canvas.stretchdraw(0,0,panel1.width, panel1.height, bm);

gezeichnet.

Zum testen hier mal ein kleiner Code :

Code: Alles auswählen

Procedure TForm1.Button1Click(Sender: TObject);
Var
  b: Tbitmap;
Begin
  b := Tbitmap.create;
  b.width := 2;
  b.height := 2;
  b.canvas.Pixels[0, 0] := clwhite;
  b.canvas.Pixels[1, 0] := clwhite;
  b.canvas.Pixels[1, 1] := clblack;
  b.canvas.Pixels[0, 1] := clwhite;
  b.Canvas.AntialiasingMode := amOff;
  form1.canvas.AntialiasingMode := amOff;
  form1.canvas.StretchDraw(rect(100, 100, 200, 200), b);
  b.free;
End;

[Edit]

Update :

Also nu hab ich dann doch was gefunden:
http://www.mail-archive.com/lazarus@lis ... 08563.html

Es Scheint als ob AntialiasingModefür gtk und gtk2 nicht implementiert ist ...

[corpsman]

Nicht unbedingt elegant, aber hier ist meine bisherige Lösung für das Problem, schön wäre natürlich, wenn man das Interpolieren wie oben abschalten könnte ..

Code: Alles auswählen

Type
  TInterpolationMode = (imNearestNeighbour, imBilinear);
 
Procedure Stretchdraw(Const Dest: TBitmap; Destrect: Trect; Const Source: Tbitmap; Mode: TInterpolationMode = imNearestNeighbour (* GTK Default wäre imBilinear *));
Type
  TintPoint = Record
    x, y: Integer;
  End;
Var
  Source_intf, Dest_intf: TLazIntfImage;
  DestBM: Tbitmap;
  DestHandle, DestMaskHandle: HBitmap;
  w, h: Integer;
  i, j, k: Integer;
  CurColor2, CurColor: TFPColor;
  u, v: Single;
  rx, ry: Single;
  nx, ny: Integer;
  p: Array[0..3] Of TintPoint;
  c: Array[0..3] Of TFPColor;
Begin
  // Berechnen der Zieldimensionen
  w := abs(Destrect.Right - Destrect.Left);
  h := abs(Destrect.Bottom - Destrect.Top);
  // Wenn nichts sichtbar ist, können wir uns die Arbeit auch sparen.
  If (w = 0) Or (h = 0) Then exit;
  // Erstellen der Arbeitsvariablen
  Destbm := TBitmap.Create;
  destbm.Width := w;
  destbm.Height := h;
  destbm.Canvas.Brush.color := clwhite;
  destbm.Canvas.rectangle(0, 0, 100, 100);
  Dest_intf := TLazIntfImage.Create(0, 0);
  Dest_intf.LoadFromBitmap(DestBM.Handle, DestBM.MaskHandle);
  Source_intf := TLazIntfImage.Create(0, 0);
  Source_intf.LoadFromBitmap(source.Handle, Source.MaskHandle);
  // So nun wird von Source_intf gelesen und in Dest_intf geschrieben
  // Das Ganze geschieht in der Granularität von Dest_intf und mit dem gewählten Interpolationsmode
  For i := 0 To w - 1 Do Begin
    u := i / (w - 1); // U - Wert bleibt für alle j Gleich
    For j := 0 To h - 1 Do Begin
      v := j / (h - 1); // V - Wert
      nx := Trunc(u * Source.width);
      ny := Trunc(v * Source.Height);
      nx := min(Source.width - 1, nx); 
      ny := min(Source.height - 1, ny); 
      Case Mode Of
        imNearestNeighbour: Begin
            CurColor := Source_intf.Colors[nx, ny];
          End;
        (*
        Eigentlich wäre es Schwachsinn imBilinear zu benutzen, dann wäre die Funktion Quasi gleich Stretchdraw
        *)
        imBilinear: Begin
            p[0].x := nx;
            p[0].y := ny;
            P[1].x := p[0].x + 1;
            P[1].y := p[0].y;
            P[2].x := p[0].x + 1;
            P[2].y := p[0].y + 1;
            P[3].x := p[0].x;
            P[3].y := p[0].y + 1;
            For k := 0 To 3 Do Begin
              P[k].x := min(Source.width - 1, P[k].x);
              P[k].y := min(Source.height - 1, P[k].y);
            End;
            // Hohlen der RGB Werte an den Entsprechenden Pixelpositionen
            For k := 0 To 3 Do Begin
              c[k] := Source_intf.colors[P[k].x, p[k].y];
            End;
            rx := (u * Source.width) - nx; // Den Nachkommateil berechnen
            ry := (v * Source.Height) - ny; // Den Nachkommateil berechnen
            // Durchführen der Interpolation Waagrecht
            CurColor.red := round(c[1].red * rx + c[0].red * (1 - rx));
            CurColor.green := round(c[1].green * rx + c[0].green * (1 - rx));
            CurColor.blue := round(c[1].blue * rx + c[0].blue * (1 - rx));
            CurColor2.red := round(c[2].red * rx + c[3].red * (1 - rx));
            CurColor2.green := round(c[2].green * rx + c[3].green * (1 - rx));
            CurColor2.blue := round(c[2].blue * rx + c[3].blue * (1 - rx));
            CurColor.red := round(CurColor2.red * ry + CurColor.red * (1 - ry));
            CurColor.green := round(CurColor2.green * ry + CurColor.green * (1 - ry));
            CurColor.blue := round(CurColor2.blue * ry + CurColor.blue * (1 - ry));
            CurColor.alpha := 0;
          End;
      End;
      Dest_intf.Colors[i, j] := CurColor;
    End;
  End;
  // Zurückschreiben, und ohne Stretch in Dest Zeichnen
  Dest_intf.CreateBitmaps(DestHandle, DestMaskHandle, false);
  DestBM.Handle := DestHandle;
  DestBM.MaskHandle := DestMaskHandle;
  dest.Canvas.Draw(min(Destrect.Right, Destrect.Left), min(Destrect.Bottom, Destrect.Top), DestBM);
  // Alles wieder Freigeben
  Source_intf.free;
  Dest_intf.free;
  destbm.free;
End;