Kombinierte Grafik-Bearbeitung

[DeathsShadow]

Hi Leute :hi:

Ich arbeite zur Zeit an meinem neuen Bildschrimschoner und habe ein Problem :( .Ich habe mir grade ein paar Algorithmen zusammen gesucht. Einzeln funktionieren sie einwandfrei, doch nachdem ich sie zusammen aufgerufen hab klappt es nicht mehr :( !

Wenn ich Button1 drücke, so wird das Bild bei ersten Mal gespiegelt, dies dauert ziemlich lang :shock: . Wenn ich erneut drauf drücke, so wird eine Fläche abgedunkelt, jedoch in einer Größe die ich nicht nachvollziehen kann :( . Dies dauert allerdings nur eine sehr kurzer Zeit. Ich habe keine Ahnung was da falsch läuft. Ich würde mich über Verbesserungsvorschläge und/oder Lösungen sehr freuen. Hier der Code:

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TRGBTripleArray = array[0..32768] of TRGBTriple;
  pRGBTripleArray = ^TRGBTripleArray;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Image2: TImage;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    procedure ResizeImage(newWidth,newHeight: Integer);
    procedure Helligkeit(const Bitmap: TBitmap);
    procedure Antialiasing(const DC: TCanvas; const Rectangle: TRect);
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Antialiasing(const DC: TCanvas; const Rectangle: TRect); // Weichzeichner, in diesem Fall denke ich, irrelevant.
var
  cx, cy: Smallint;
  r, g, b: Byte;
  Row1: pRGBTripleArray;
  Row2: pRGBTripleArray;
  Row3: pRGBTripleArray;
  TEMP: TBitmap;
  CurRect: TRect;
begin
  TEMP := TBitmap.Create;
  try
    with TEMP do begin
      Width := Rectangle.Right - Rectangle.Left;
      Height := Rectangle.Bottom - Rectangle.Top;
      CurRect := Rect(0, 0, Width, Height);
      PixelFormat := pf24Bit;
      Canvas.CopyRect(CurRect, DC, Rectangle);
      with Canvas do begin
        for cy := 1 to (Height - 2) do begin
          Row1 := ScanLine[cy - 1];
          Row2 := ScanLine[cy];
          Row3 := ScanLine[cy + 1];

          for cx := 1 to (Width - 2) do begin
            r := (Row1[cx - 1].rgbtRed+Row1[cx].rgbtRed+
            Row1[cx + 1].rgbtRed+
            Row2[cx - 1].rgbtRed+
            Row2[cx + 1].rgbtRed+
            Row2[cx - 1].rgbtRed+
            Row3[cx].rgbtRed+
            Row3[cx + 1].rgbtRed+
            Row3[cx].rgbtRed) div 9;

            g := (Row1[cx - 1].rgbtGreen+
            Row1[cx].rgbtGreen+
            Row1[cx + 1].rgbtGreen+
            Row2[cx - 1].rgbtGreen+
            Row2[cx + 1].rgbtGreen+
            Row2[cx - 1].rgbtGreen+
            Row3[cx].rgbtGreen+
            Row3[cx + 1].rgbtGreen+
            Row3[cx].rgbtGreen) div 9;

            b := (Row1[cx - 1].rgbtBlue+
            Row1[cx].rgbtBlue+
            Row1[cx + 1].rgbtBlue+
            Row2[cx - 1].rgbtBlue+
            Row2[cx + 1].rgbtBlue+
            Row2[cx - 1].rgbtBlue+
            Row3[cx].rgbtBlue+
            Row3[cx + 1].rgbtBlue+
            Row3[cx].rgbtBlue) div 9;
            Row2[cx].rgbtBlue := b;
            Row2[cx].rgbtGreen := g;
            Row2[cx].rgbtRed := r;
          end;
        end;
      end;
      DC.CopyRect(Rectangle, Canvas, CurRect);
    end;
  finally
    TEMP.Free;
  end;
end;

procedure TForm1.Helligkeit(const Bitmap: TBitmap); //Hier wird wohl, zumindest ein fehler sein x.X
var
  i,j: Integer;
  r,g,b: Integer;
  Reihe: ^TRGBTriple;
begin
  for i:= 0 to Bitmap.Height-1 do
  begin
    Reihe:= Bitmap.Scanline[i];
    for j:= 0 to Bitmap.Width-1 do
    begin
      r:=Round(Reihe^.rgbtred * 0.5);
      b:=Round(Reihe^.rgbtblue * 0.5);
      g:=Round(Reihe^.rgbtgreen * 0.5);
      if r>255 then r:=255;
      if g>255 then g:=255;
      if b>255 then b:=255;
       Reihe^.rgbtred   := r;
       Reihe^.rgbtBlue  := b;
       Reihe^.rgbtgreen := g;
       inc(Reihe);
    end;
  end;
  bitmap.Assign(Bitmap);
end;

procedure TForm1.ResizeImage(newWidth,newHeight: Integer); // Hier wird das Bild gespiegelt und gestaucht
begin
  SetStretchBltMode(Image2.Canvas.Handle, Halftone);
  StretchBlt(Image2.Canvas.Handle, 0,newheight,newwidth,-newheight,Image1.Canvas.Handle,0,0,Image1.Width,(Image1.Height),SRCCOPY);
end;

procedure TForm1.Button1Click(Sender: TObject); //Aufruf
var nw,nh : Integer; bmp : TBitmap;  Rect : TRect;
begin
with rect do
begin
Left := 0;
Top := 0;
Right := Image1.Picture.Bitmap.Width;
Bottom := Image1.Picture.Bitmap.Height;
end;

bmp := TBitmap.Create;
nw := image1.Picture.Width;
nh := image1.Picture.Bitmap.Height div 2;
ResizeImage(nw , nh);
bmp.Assign(Image2.Picture.Bitmap);
Helligkeit(bmp);
image2.Picture.Bitmap.Assign(bmp);
refresh;
Antialiasing(Image2.Canvas,Rect)
end;

procedure TForm1.FormCreate(Sender: TObject); //
begin
form1.DoubleBuffered := true;
end;

end.

Wem das zu viel ist, hier auch als Anhang.

[markus5766h]

Hallo

Delphi-Quellcode:

...
ResizeImage(nw , nh);
bmp.Assign(Image2.Picture.Bitmap);
Helligkeit(bmp);  
...

funktioniert beim ersten mal,
danach musst Du aber Dein Ergebnis
wieder nach Image1 kopieren, wenn
Du die Prozedur noch mal durchlaufen willst.
Deine Quelldatei für die Prozedur ResizeImage
ist ja in Image1.

und Dein bmp musst Du auch wieder freigeben:

Delphi-Quellcode:

bmp.Free;

[DeathsShadow]

Vielen Dank :-)

Ich habe das Problem gelöst , wobei mir aufgefallen ist, das ich antiallysing und Helligkeit auch vereinen kann :D

:mrgreen: