unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TStringDynArray =
array of String;
TForm1 =
class(TForm)
Image1: TImage;
Image2: TImage;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Label1: TLabel;
Label2: TLabel;
OpenDialog1: TOpenDialog;
OpenDialog2: TOpenDialog;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Bmp1, Bmp2: TBitmap;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
sl: TStringList;
i1, i2, idx: Integer;
FBild1, FBild2:
array of Integer;
S1:
String;
begin
If (Label1.Caption = '
Bild1: * Kein Bild geladen *')
or (Label2.Caption = '
Bild2: * Kein Bild geladen *')
then
begin
Application.MessageBox('
Du hast nicht beide Bilder geladen.', '
Nicht beide Bilder geladen', MB_ICONERROR
or MB_OK);
Exit;
end;
sl := TStringList.Create;
S1 := '
';
// FBild1 initialisieren
// BGR 3 Byte x 8 = 24 Bit = 16777216 verschiedene Summen
SetLength(FBild1, 2
shl 24 + 1);
// zufälligen Inhalt des Arrays mit 0 löschen
FillChar(FBild1[0], SizeOf(FBild1[0]) * Length(FBild1), #0);
// das ganze noch mal für FBild2...
SetLength(FBild2, 2
shl 24 + 1);
FillChar(FBild2[0], SizeOf(FBild2[0]) * Length(FBild2), #0);
sl.Add('
*** Bild1 ***');
sl.Add('
');
for i1 := 0
to Bmp1.Height - 1
do
begin
for i2 := 0
to Bmp1.Width - 1
do
begin
// nur einmal auf Pixels zugreifen = doppelte Geschwindigkeit
idx := Bmp1.Canvas.Pixels[i1,i2];
FBild1[idx] := FBild1[idx] + 1;
// das ganze noch mal für Bild2...
idx := Bmp2.Canvas.Pixels[i1,i2];
FBild2[idx] := FBild2[idx] + 1;
end;
end;
For i1 := Low(FBild1)
to High(FBild1)
do
begin
If FBild1[i1] <> 0
then
sl.Add('
Farbwert: '+IntToStr(i1)+'
; Vorhanden: '+IntToStr(FBild1[i1])+'
x');
sl.SaveToFile('
C:\TestFile.txt');
end;
sl.Add('
');
sl.Add('
*** Bild2 ***');
sl.Add('
');
For i2 := Low(FBild2)
to High(FBild2)
do
begin
If FBild2[i2] <> 0
then
sl.Add('
Farbwert: '+IntToStr(i2)+'
; Vorhanden: '+IntToStr(FBild2[i2])+'
x');
end;
S1 := InputBox('
Vergleich erfolgreich abgeschlossen.'#10'
Wohin soll das Ergebnis gespeichert werden?', '
Vergleich abgeschlossen', '
C:\Bildervergleich\Ergebnisse\Vergleich 1.txt');
If ForceDirectories(ExtractFileDir(S1))
then
begin
sl.SaveToFile(S1);
ShowMessage('
Ergebnis wurder erfolgreich gespeichert!');
end
else
ShowMessage('
Ergebnis konnte nicht gespeichert werden.'#10'
Fehlermeldung: Pfad existiert nicht.');
sl.Free;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
If OpenDialog1.Execute
then
begin
Bmp1.LoadFromFile(OpenDialog1.FileName);
Label1.Caption := '
Bild1: '+ExtractFileName(OpenDialog1.FileName);
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
If OpenDialog2.Execute
then
begin
Bmp2.LoadFromFile(OpenDialog2.FileName);
Label2.Caption := '
Bild2: '+ExtractFileName(OpenDialog2.FileName);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Bmp1 := TBitmap.Create;
Bmp2 := TBitmap.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Bmp1.Free;
Bmp2.Free;
end;
end.