Bilder laden ohne anzuzeigen - keine Größen vorgabe

[Destroyer446]

// Edit: Bereichsprüfung aktiviert. - Ergebnis: "ERangeError with message 'Range check error'."
Wieso überschreitet er Array wenn ich Low() - High() abfrage?
// Edit2: Er bricht bei idx := Bmp1.Canvas.Pixels[i1,i2];
FBild1[idx] := FBild1[idx] + 1; ab?

Kompletter Code:

Delphi-Quellcode:

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.

Button1 = Bilder vergleichen
Button2 = Bild 1 laden
Button3 = Bild 2 laden

Ich find da kein Fehler^^

[Bjoerk]

Weil idx -1 sein kann (wenn er den Pixel nicht auslesen kann) und du dir damit dein array abschießt.

Weil du kein setLength(Fbild,0) hast und du damit MegaByteweise Speicherlöcher produzierst.

Mal so unter uns, bist du beratungsresistent?
Ich habe dir im letzten Thread eine Lösung auf dem Präsentierteller serviert.

[CCRDude]

@Bjoerk: Auch wenns nicht zum eigentlichen Topic gehört: ich bin ja auch so einer, der jedes dynamische Array zum Schuss wieder auf Länge Null setzt, meine aber irgendwo schon mal gehört zu haben, daß dies nicht nötig sei (zumindest lokal wie hier), und das sogar mit FastMM getestet zu haben. Hast Du mehr Infos dazu, daß das wirklich Speicherlöcher produziert?

[Deep-Sea]

Natürlich produziert so etwas keine Speicherlöcher. Sobald die letzte Referenz auf ein dyn. Array (oder einen Record) weg ist - was hier beim verlassen der Prozedur der Fall ist - wird der Speicher freigegeben (außer ich reserviere ihn mir selbst mittels GetMem, New, etc.). Eigentlich bekannt?!

[himitsu]

Interfaces, dyn. Arrays und Strings unterliegen einer Referenzzählung, welche es dann automatisch freigibt.
Records und static Arrays liegen direkt in der Variable und werden zusammen mit dieser entsorgt.

[CCRDude]

Danke

Da war doch mal so ein älterer Bug (Delphi 2006 evtl.? Wo es die Ausnahme gab, daß die Referenzzählung im initialization-Teil von Units nicht korrekt funktionierte?) bin ich da etwas sensibel. Gut zu wissen daß ich nicht falsch lag

[himitsu]

Der Delphicompiler umgibt die Funktions/Procedur/Methoden-Rümpfe mit einem Try-Finally, wenn derartige Typen in den lokalen Variablen, bzw. als Parameter (außer bei Const und Var) liegen.