Access violation bei dynamischen Arrays

[Destroyer446]

Hi!
Ich hab ein Problem: Mein Delphi sagt Access violation bei 2 dynamischen Arrays.
Mein Quelltext:

Delphi-Quellcode:

var
 sl: TStringList;
 FBild1, FBild2: Array of TColor;
 i1, i2: Integer;
begin
 sl := TStringList.Create;
 sl.Add('*** Bild1 ***');
 sl.Add('');
 For i1 := 0 to Image1.Picture.Width do
 begin
  For i2 := 0 to Image1.Picture.Height do
  begin
   FBild1[Image1.Picture.Bitmap.Canvas.Pixels[i1,i2]] := FBild1[Image1.Picture.Bitmap.Canvas.Pixels[i1,i2]]+1;
   FBild2[Image2.Picture.Bitmap.Canvas.Pixels[i1,i2]] := FBild2[Image2.Picture.Bitmap.Canvas.Pixels[i1,i2]]+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');
 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;
 ShowMessage(sl.GetText);
 sl.Free;

Ist da ein Fehler drinn?
Das Programm soll ausgeben, wieviel Farbwerte in 2 Bildern sind.

Danke ;)

[mkinzler]

Wo tritt der Fehler auf?

[DeddyH]

Wo ist denn das SetLength?

[Destroyer446]

@mkinzler: Der Fehler tritt bei "FBild1[Image1.Picture.Bitmap.Canvas.Pixels[i1,i2]] := FBild1[Image1.Picture.Bitmap.Canvas.Pixels[i1,i2]]+1;" auf.

@DeddyH: Muss es ein SetLength geben? und wenn ja - wo kann ich es einbauen?

[guinnes]

Zitat:

Zitat von Destroyer446 (Beitrag 1106178)

@DeddyH: Muss es ein SetLength geben? und wenn ja - wo kann ich es einbauen?

Bevor du deine Arrays benutzt. Und es muß nicht nur eines, sondern 2 geben ( je eines für jedes Array )
Woher sollte Delphi sonst wissen, wie groß die Arrays sind ?

Dazu solltest du deine Adressierung überdenken, so wie du es machst, brauchst du Array, die > 4 Milliarden Bytes groß sind

Ich rate dir zu 2 TLists

[Bjoerk]

Bei einem 32 Bit Bild bist du bei SetLength(FBild, 2^32). Da FBild eine Anzahl aufsummiert, muß dieses auch nicht vom Typ TColor sein. Und das ShowMessage(SL.GetText) durfte ungefair so groß werden wie deine Wohnzimmerwand. :-D

[Neutral General]

Zitat:

Zitat von Bjoerk (Beitrag 1106220)

Bei einem 32 Bit Bild bist du bei SetLength(FBild, 2^32). Da FBild eine Anzahl aufsummiert, muß dieses auch nicht vom Typ TColor sein. Und das ShowMessage(SL.GetText) durfte ungefair so groß werden wie deine Wohnzimmerwand. :-D

Ich bin mir insgesamt noch nicht 100%ig sicher was das alles bringen soll, aber SetLength(FBild, 2^32) ist Schwachsinn. Wenn schon, dann Länge*Breite*(SizeOf(TColor) = 4)

[Blup]

Da nur 24 Bit Farbtiefe unterstützt wird, sind es nur 16 Millionen Farben.
Das verkraftet der Speicher noch.

Delphi-Quellcode:

// in den Arrays werden keine Farben gespeichert sondern Summen je Farbe
FBild1, FBild2: array of Integer;
idx: Integer;

// FBild1 initialisieren
// BGR 3 Byte x 8 = 24 Bit = 16777216 verschiedene Summen
SetLength(FBild1, 2 shl 24);
// 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


// Größe des Images nicht überschreiten !
for i1 := 0 to Image1.Picture.Height - 1 do
begin
  for i2 := 0 to Image1.Picture.Width - 1 do
  begin
    // nur einmal auf Pixels zugreifen = doppelte Geschwindigkeit
    idx := Image1.Picture.Bitmap.Canvas.Pixels[i1,i2];
    FBild1[idx] := FBild1[idx] + 1;
    //
    idx := Image2.Picture.Bitmap.Canvas.Pixels[i1,i2];
    FBild2[idx] := FBild2[idx] + 1;
  end;
end;

// Stringlisten mit Summen für 16 Millionen Farben füllen ;)

Bei einer Bildauflösung von 1024 * 768 können jetzt so bis ca. 700000 Zeilen im Dialog angezeigt werden ... :stupid:

[guinnes]

Zitat:

Zitat von Neutral General (Beitrag 1106229)

Ich bin mir insgesamt noch nicht 100%ig sicher was das alles bringen soll, aber SetLength(FBild, 2^32) ist Schwachsinn. Wenn schon, dann Länge*Breite*(SizeOf(TColor) = 4)

Der TE möchte die Anzahl der Farben im Bild zählen, also muß das Array für jede mögliche Farbe einen Platz haben. Also 2^32 wäre schon richtig.
Darum habe ich auch zu 2 TLists geraten

[Destroyer446]

Erstmal Danke für die Antworten!

Ich probiere gerade die Möglichkeit von Blup aus ma gucken was draus wird ;)
// Edit: Es hat funktioniert ;) Ich schreib die Farben aber jetzt in eine Datei sons wirds echt zu viel xD

@Neutral General: Es soll bringen die Anzahl der Farben aus 2 Bildern iwo aufzuschreiben, danach sie zu vergleichen und danach auch bei kleinen unterschieden sie zu vergleichen.

MFG

[Bjoerk]

Zitat:

Zitat von Neutral General (Beitrag 1106229)

Zitat:

Zitat von Bjoerk (Beitrag 1106220)

Bei einem 32 Bit Bild bist du bei SetLength(FBild, 2^32). Da FBild eine Anzahl aufsummiert, muß dieses auch nicht vom Typ TColor sein. Und das ShowMessage(SL.GetText) durfte ungefair so groß werden wie deine Wohnzimmerwand. :-D

Ich bin mir insgesamt noch nicht 100%ig sicher was das alles bringen soll, aber SetLength(FBild, 2^32) ist Schwachsinn. Wenn schon, dann Länge*Breite*(SizeOf(TColor) = 4)

Gut gebrüllt, Löwe. -> Siehe Guinness

[Destroyer446]

Gehört zwar nicht zum Thema aber: Wie kann ich alle fehlenden Pfade erstellen?
Z.b. so stelle ich es mir vor:

Delphi-Quellcode:

Pfad := 'C:\Testpfad1\Testpfad2\Testpfad3\Test.txt';
ErstellePfad(Pfad);

Und dass danach Testpfad1 - 3 erstellt sind.
Wie bekomme ich das hin?
Hier meine versuchs-Funktion:

Delphi-Quellcode:

procedure ErstellePfade(Pfad: String);
var
  StringArray  : TStringDynArray; // Eigentlich nur ein Array of String
  i1, i2       : Integer;
  S1           : String;
begin
  StringArray := Explode('\', Pfad);
  For i1 := 0 to Length(StringArray) - 1 do
  begin
   If i1 > 0 then
   begin
    S1 := 'C:';
    If i1 > 1 then
    For i2 := 1 to i1-1 do
    begin
     S1 := S1 + '\' + StringArray[i2];
     ShowMessage('Zwischenpfad: ' + S1);
    end
    else
    S1 := S1 + '\';
    For i2 := 1 to Length(StringArray) - 1 do
    begin
     If not DirectoryExists(S1 + StringArray[i2]) then
      CreateDir(S1 + StringArray[i2]);
     ShowMessage('Created: '+ S1 + StringArray[i2]);
    end;
   end;
  end;
end;

Da erstellt er mir aber nur unter C:\ die ganzen Ordner...
Wie mache ich das anders?
Achso, hier noch die Explode funktion:

Delphi-Quellcode:

function Explode(const Separator, S: string; Limit: Integer = 0):
  TStringDynArray;
var
  SepLen       : Integer;
  F, P         : PChar;
  ALen, Index  : Integer;
begin
  SetLength(Result, 0);
  if (S = '') or (Limit < 0) then
    Exit;
  if Separator = '' then
  begin
    SetLength(Result, 1);
    Result[0] := S;
    Exit;
  end;
  SepLen := Length(Separator);
  ALen := Limit;
  SetLength(Result, ALen);

  Index := 0;
  P := PChar(S);
  while P^ <> #0 do
  begin
    F := P;
    P := StrPos(P, PChar(Separator));
    if (P = nil) or ((Limit > 0) and (Index = Limit - 1)) then
      P := StrEnd(F);
    if Index >= ALen then
    begin
      Inc(ALen, 5); // mehrere auf einmal um schneller arbeiten zu können
      SetLength(Result, ALen);
    end;
    SetString(Result[Index], F, P - F);
    Inc(Index);
    if P^ <> #0 then
      Inc(P, SepLen);
  end;
  if Index < ALen then
    SetLength(Result, Index); // wirkliche Länge festlegen
end;

MFG

[p80286]

versuch es doch mal mit ForceDirectories

Gruß
K-H

[Destroyer446]

Danke für die schnelle Antwort ;)
Hast du auch eine Idee, wie ich egal wie große Bilder vergleichen kann ohne sie anzuzgeigen?
momentan mach ich das so, dass ich sie in eine TImage-Kompo lade und da vgl...
Aber dass muss doch auch anders gehn?
Jetzt sagt er mir nämlich wieder Access violation wenn die Bilder zu groß sind also nicht aufs Image passen ...

[DeddyH]

Das hat jetzt aber nichts mehr mit dem ursprünglichen Thema zu tun, mach doch besser einen neuen Thread auf.

[Destroyer446]

OK dann bis gleich im neuen Thread ;D

MFG

[Bjoerk]

Destroyer,

so läuft es wenigstens mal durch.

Delphi-Quellcode:

type
  TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    procedure BitBtn1Click(Sender: TObject);
  end;

 TIntegerList = class(TObject)
    procedure Add(const Value: integer);
    function IndexOf(const Value: integer): integer; 
    procedure IncItem(const Index: integer);
  private
    FItems: array of integer;
    FCount: integer;
  protected
    procedure SetCount(const NewCount: integer);
    function GetItem(Index: integer): integer;
    procedure SetItem(Index: integer; const Value: integer);
  public
    constructor Create;
    destructor Destroy; override;
    property Count: integer Read FCount;
    property Item[Index: integer]: integer Read GetItem Write SetItem;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TIntegerList.SetCount(const NewCount: integer);
begin
  FCount:= NewCount;
  SetLength(FItems, FCount);
end;

function TIntegerList.GetItem(Index: integer): integer;
begin
  Result:= FItems[Index];
end;

procedure TIntegerList.SetItem(Index: integer; const Value: integer);
begin
  FItems[Index]:= Value;
end;

procedure TIntegerList.Add(const Value: integer);
begin
  SetCount(FCount+1);
  SetItem(FCount-1, Value);
end;

function TIntegerList.IndexOf(const Value: integer): integer;
var
  I: integer;
begin
  Result:= -1;
  for I:= 0 to FCount-1 do
    if FItems[I] = Value then
    begin
      Result:= I;
      Break;
    end;
end;

procedure TIntegerList.IncItem(const Index: integer);
begin
  FItems[Index]:= FItems[Index]+1;
end;

constructor TIntegerList.Create;
begin
  inherited Create;
  SetCount(0);
end;

destructor TIntegerList.Destroy;
begin
  SetCount(0);
  inherited Destroy;
end;

procedure GetBmpColors (const Bmp: TBitmap; const SL: TStringList);
var
  Farben, Anzahl: TIntegerList;
  I, J, Index, idx: integer;
begin
  Farben:= TIntegerList.Create;
  Anzahl:= TIntegerList.Create;
  for I:= 0 to Bmp.Height-1  do
  begin
    for J:= 0 to Bmp.Width-1 do
    begin
      idx:= Bmp.Canvas.Pixels[I, J];
      Index:= Farben.IndexOf(idx);
      if Index = -1 then
      begin
        Farben.Add(idx);
        Anzahl.Add(1);
      end
      else
        Anzahl.IncItem(Index);
    end;
  end;
  for I:= 0 to Farben.Count-1 do
    SL.Add('Farbwert: ' + IntToStr(Farben.GetItem(I))
    + '; Vorhanden: ' + IntToStr(Anzahl.GetItem(I)) + 'x');
  Farben.Free;
  Anzahl.Free;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  SL: TStringlist;
  Bmp: TBitmap;
begin
  SL:= TStringlist.Create;
  Bmp:= TBitmap.Create;
  Bmp.LoadFromFile('..');
  GetBmpColors (Bmp, SL);
  SL.SaveToFile('..');
  Bmp.Free;
  SL.Free;
end;