Einzelnen Beitrag anzeigen

busybyte

Registriert seit: 15. Sep 2006
165 Beiträge
 
#14

Re: Delphi Programm zeichnen

  Alt 6. Apr 2008, 20:17
Ansatz:
Delphi-Quellcode:
**********************************************
* grüße and ahmet von smallsmoker *
* differenzbild prozedur von alleinherrscher *
**********************************************}
unit uDifferenzbild;

interface

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

type
  TForm1 = class(TForm)
    imDiff: TImage;
    imScr1: TImage;
    imScr2: TImage;
    btnScr1: TButton;
    btnDiff: TButton;
    btnScr2: TButton;
    imNew: TImage;
    btnNew: TButton;
    procedure btnScr1Click(Sender: TObject);
    procedure btnScr2Click(Sender: TObject);
    procedure btnDiffClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnNewClick(Sender: TObject);
  private
    { Private-Deklarationen }
    scr1,scr2,diff:tbitmap;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
// Die Screenshot prozedur
procedure ScreenShot(DestBitmap:TBitmap; bmpxfr:integer);
var dc : HDC;
begin
  try
  dc := getdc(getdesktopwindow);
  destbitmap.width := getdevicecaps (dc, horzres);
  destbitmap.height := getdevicecaps (dc, vertres);
  if bmpxfr= 4 then destbitmap.pixelformat:=pf4bit
  else if bmpxfr=8 then destbitmap.pixelformat:=pf8bit
  else if bmpxfr=16 then destbitmap.pixelformat:=pf16bit
  else if bmpxfr=24 then destbitmap.pixelformat:=pf24bit
  else if bmpxfr=32 then destbitmap.pixelformat:=pf32bit;
  bitblt(destbitmap.canvas.handle,
         0,
         0,
         destbitmap.width,
         destbitmap.height,
         dc,
         0,
         0,
         srccopy);
  except
    exit;
  end;
end;

// Die prozedur die das differenzbild erzeugt
procedure GetDifference(ZielDC,DC1,DC2:HDC;DCwidth:integer;DCheight:integer);
begin
BitBlt(ZielDC,0,0,DCwidth,DCheight,DC2,0,0,SRCCOPY);
BitBlt(ZielDC,0,0,DCwidth,DCheight,DC1,0,0,SRCINVERT);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
scr1 := tbitmap.create;
scr2 := tbitmap.create;
diff := tbitmap.create;
end;

// Der erste Screenshot wird gemacht und in scr1 gespeichert, das wiederum wird in imscr1 angezeigt
procedure TForm1.btnScr1Click(Sender: TObject);
begin
screenshot(scr1,32);
imscr1.picture.bitmap := scr1;
imscr1.Repaint;
btnscr2.Enabled := true;
end;

// Der zweite Screenshot wird gemacht und in scr2 gespeichert, das wiederum wird in imscr2 angezeigt
procedure TForm1.btnScr2Click(Sender: TObject);
begin
screenshot(scr2,32);
imscr2.picture.bitmap := scr2;
imscr2.Repaint;
btndiff.Enabled := true;
end;

// Der Differenzbild von scr1 und scr2 wird erstellt
procedure TForm1.btnDiffClick(Sender: TObject);
begin
diff := tbitmap.Create;
  try
  diff.Width := min(scr1.Width, scr2.Width);
  diff.Height := min(scr1.height, scr2.height);
  GetDifference(diff.Canvas.Handle,
                Scr1.Canvas.handle,
                scr2.Canvas.handle,
                diff.Width,
                diff.Height);
  imDiff.Picture.bitmap := diff;
  imDiff.Repaint;
  btnnew.Enabled := true;
  finally
    scr2.Free;
  end;
end;

// scr1 wird in newpic kopiert, und das differenzbild wird auf newpic gelegt
procedure TForm1.btnNewClick(Sender: TObject);
var newpic:tbitmap;
begin
newpic := tbitmap.Create;
  try
  newpic := scr1;
  newpic.Width := diff.Width;
  newpic.Height := diff.height;
  bitblt(newpic.Canvas.handle,
          0,
          0,
          diff.Width,
          diff.Height,
          diff.Canvas.handle,
          0,
          0,
          SRCINVERT);
  imnew.Picture.bitmap := newpic;
  imnew.Repaint;
  finally
    scr1.free;
    diff.Free;
  end;
end;

end.
I love DiscCat
  Mit Zitat antworten Zitat