Access violation bei dynamischen Arrays

[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;