abmessungen eines PNG aus Datei auslesen

MSC · Verfasst: So 28.06.09 14:33

Hallo!

Ich habe ein Problem. Ich habe ein Programm geschieben was u.A. PNG Bilder aus 2 Ordnern (/ToDo und /Done) vergleichen soll über die Dateigröße und Abmessungen.

Das ganze geschiet indem ich per findfirst/findnext *.png faAnyfile suche, und dann die Dateigröße abfrage und das Bild öffne und in ein TImage lade und die Amessungen und anderen Informationen in ein Array speichere.

Das Problem an der Sache ist, wenn viele Dateien sind, dass das Programm pro Sekunde ca. 4 MB Ram frisst und bei 2 GB abstürzt.

Dahher die Frage: gibt es einen Weg, die Abmessungen des PNG direkt aus der Datei auszulesen?

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:

type
  FileProperties=record
    name   : String[255];
    dir    : String[4];
    width  : Integer;
    height : Integer;
    size   : Int64;
    DB     : Boolean;
  end;

  match=record
    left  : Integer;
    right : Integer;
  end;

[...]

var

  ControlFiles : array [0..10000] of FileProperties;
  FilesCount   : Integer;
  found        : match;

[...]

procedure TForm5.CollectFiles;
 var
  rec  : TSearchrec;
  Bild : TBitmap;
begin
  Lbl_left.Caption  := '';
  Lbl_right.Caption := '';
  Label1.Caption    := '';
  FilesCount        := 0;
  Bild:=TBitmap.Create;
  Application.ProcessMessages;
  try
    if findfirst('ToDo\*.png', faAnyfile, rec) = 0 then begin
      repeat
        try
          ControlFiles[FilesCount].name   := rec.name;
          ControlFiles[FilesCount].dir    := 'ToDo';
          ControlFiles[FilesCount].size   := GetFileSize(GetCurrentDir + '\ToDo\' + rec.name);
          PictureConvert.ConvertPicture2Image('ToDo\' + rec.name,ptBMP,Preview);
          ControlFiles[FilesCount].width  := Preview.Picture.Bitmap.width;
          ControlFiles[FilesCount].height := Preview.Picture.Bitmap.height;
          ControlFiles[FilesCount].db     := false;
          FilesCount := FilesCount + 1;
        except
          MoveFile(PChar(GetCurrentDir + '\ToDo\' + rec.name),PChar(GetCurrentDir + '\ToDo\Manuell\' + rec.name));
          DeleteFile(GetCurrentDir + '\ToDo\' + rec.name);
        end;
      until findnext(rec)<> 0;
    end;

    if findfirst('Done\*.png', faAnyfile, rec) = 0 then begin
      repeat
        try
          ControlFiles[FilesCount].name   := rec.name;
          ControlFiles[FilesCount].dir    := 'Done';
          ControlFiles[FilesCount].size   := GetFileSize(GetCurrentDir + '\Done\' + rec.name);
          PictureConvert.ConvertPicture('Done\' + rec.name,'working\temp.bmp',ptBMP);
          Bild.LoadFromFile('working\temp.bmp');
          Preview.Picture.Assign(Bild);
          DeleteFile('working\temp.bmp');
          ControlFiles[FilesCount].width  := Preview.Picture.Bitmap.width;
          ControlFiles[FilesCount].height := Preview.Picture.Bitmap.height;
          ControlFiles[FilesCount].db     := true;
          FilesCount := FilesCount + 1;
        except
          MoveFile(PChar(GetCurrentDir + '\Done\' + rec.name),PChar(GetCurrentDir + '\ToDo\Manuell\' + rec.name));
          DeleteFile(GetCurrentDir + '\Done\' + rec.name);
        end;
      until findnext(rec)<> 0;
    end;
  finally
    FreeAndNil(Bild);
  end;
  CheckImages;
end;

[...]

MfG MSC

jaenicke · Verfasst: So 28.06.09 14:36

Verstehe ich das richtig? Du liest die Bilder in ein TImage ein und konvertierst in eine Bitmap? :shock:

Warum verwendest du nicht direkt TPngImage bzw. wie die Klasse bei dir heißt (je nach Framework, D2009, GraphicEx, PNG Delphi, ...)?
Die reine Größe ließe sich vermutlich auch im Dateiheader finden, wo müsste ich auch erst in der Spezifikation nachlesen.

// EDIT:
Ich habe gerade die Spezifikation überflogen, das steht im IHDR Chunk in 2 Integers (je 4 Byte) direkt am Anfang, siehe Spezifikation:
www.w3.org/TR/REC-png

MSC · Verfasst: So 28.06.09 17:49

Ah vielen Dank, das hilft mir sehr Weiter!

THX MSC

MSC · Verfasst: So 28.06.09 19:33

Nochmal vielen Dank, nunb ist garkein Speicheranstieg mehr und eine deutliche Geschwindigkeitsoptimierung zu verzeichnen.

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:

procedure TForm5.CollectFiles;
 var
  rec  : TSearchrec;
  Bild : TBitmap;

  fs: TFileStream;
  b: array of Byte;
  iLoop: Integer;
  temp: String;
begin
  Lbl_left.Caption  := '';
  Lbl_right.Caption := '';
  Label1.Caption    := '';
  FilesCount := 0;
  Bild:=TBitmap.Create;
  Application.ProcessMessages;
  try
    if findfirst('ToDo\*.png', faAnyfile, rec) = 0 then begin
      repeat
        try
          ControlFiles[FilesCount].name   := rec.name;
          ControlFiles[FilesCount].dir    := 'ToDo';
          ControlFiles[FilesCount].size   := GetFileSize(GetCurrentDir + '\ToDo\' + rec.name);

          fs := TFileStream.Create(GetCurrentDir + '\ToDo\' + rec.name,fmOpenRead);
          Setlength(b,23);
          for iLoop := 0 to 23 do begin
            fs.Read(b[iLoop], SizeOf(byte));
            case iLoop of
              16: temp := BaseToBase(DectoBin(ord(Char(b[iLoop]))), 2, 16);
              17: temp := temp + BaseToBase(DectoBin(ord(Char(b[iLoop]))), 2, 16);
              18: temp := temp + BaseToBase(DectoBin(ord(Char(b[iLoop]))), 2, 16);
              19: ControlFiles[FilesCount].width := StrToInt(BaseToBase(temp + BaseToBase(DectoBin(ord(Char(b[iLoop]))), 2, 16), 16,10));

              20: temp := BaseToBase(DectoBin(ord(Char(b[iLoop]))), 2, 16);
              21: temp := temp + BaseToBase(DectoBin(ord(Char(b[iLoop]))), 2, 16);
              22: temp := temp + BaseToBase(DectoBin(ord(Char(b[iLoop]))), 2, 16);
              23: ControlFiles[FilesCount].height := StrToInt(BaseToBase(temp + BaseToBase(DectoBin(ord(Char(b[iLoop]))), 2, 16), 16,10));
            end;
          end;
          fs.Free;
          ControlFiles[FilesCount].db     := false;
          FilesCount := FilesCount + 1;
        except
          MoveFile(PChar(GetCurrentDir + '\ToDo\' + rec.name),PChar(GetCurrentDir + '\ToDo\Manuell\' + rec.name));
          DeleteFile(GetCurrentDir + '\ToDo\' + rec.name);
        end;
      until findnext(rec)<> 0;
    end;

    if findfirst('Done\*.png', faAnyfile, rec) = 0 then begin
      repeat
        try
          ControlFiles[FilesCount].name   := rec.name;
          ControlFiles[FilesCount].dir    := 'Done';
          ControlFiles[FilesCount].size   := GetFileSize(GetCurrentDir + '\Done\' + rec.name);
          fs := TFileStream.Create(GetCurrentDir + '\ToDo\' + rec.name,fmOpenRead);
          Setlength(b,23);
          for iLoop := 0 to 23 do begin
            fs.Read(b[iLoop], SizeOf(byte));
            case iLoop of
              16: temp := BaseToBase(DectoBin(ord(Char(b[iLoop]))), 2, 16);
              17: temp := temp + BaseToBase(DectoBin(ord(Char(b[iLoop]))), 2, 16);
              18: temp := temp + BaseToBase(DectoBin(ord(Char(b[iLoop]))), 2, 16);
              19: ControlFiles[FilesCount].width := StrToInt(BaseToBase(temp + BaseToBase(DectoBin(ord(Char(b[iLoop]))), 2, 16), 16,10));

              20: temp := BaseToBase(DectoBin(ord(Char(b[iLoop]))), 2, 16);
              21: temp := temp + BaseToBase(DectoBin(ord(Char(b[iLoop]))), 2, 16);
              22: temp := temp + BaseToBase(DectoBin(ord(Char(b[iLoop]))), 2, 16);
              23: ControlFiles[FilesCount].height := StrToInt(BaseToBase(temp + BaseToBase(DectoBin(ord(Char(b[iLoop]))), 2, 16), 16,10));
            end;
          end;
          fs.Free;
          ControlFiles[FilesCount].db     := true;
          FilesCount := FilesCount + 1;
        except
          MoveFile(PChar(GetCurrentDir + '\Done\' + rec.name),PChar(GetCurrentDir + '\ToDo\Manuell\' + rec.name));
          DeleteFile(GetCurrentDir + '\Done\' + rec.name);
        end;
      until findnext(rec)<> 0;
    end;
  finally
    FreeAndNil(Bild);
  end;
  CheckImages;
end;

MfG MSC

jaenicke · Verfasst: So 28.06.09 20:21

Du machst das aber reichlich kompliziert (langsam ;-)

) und ohne Überprüfung... ;-)

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:

function GetPngSize(AFile: string): TPoint;
var
  i: Integer;
  MyFile: TFileStream;
  Signature: Integer;
begin
  MyFile := TFileStream.Create(AFile, fmOpenRead);
  try
    if MyFile.Size < 24 then
      raise Exception.Create('Dateiformat unbekannt');
    MyFile.Position := 12;
    MyFile.ReadBuffer(Signature, SizeOf(Signature));
    if Signature <> $52444849 then
      raise Exception.Create('Dateiformat unbekannt');
    for i := 3 downto 0 do
      MyFile.ReadBuffer(LongRec(Result.X).Bytes[i], 1);
    for i := 3 downto 0 do
      MyFile.ReadBuffer(LongRec(Result.Y).Bytes[i], 1);
  finally
    MyFile.Free;
  end;
end;

var
  Size: TPoint;
begin
  Size := GetPngSize(DATEINAME);
  ShowMessage(IntToStr(Size.X) + ' breit, ' + IntToStr(Size.Y) + ' hoch');

MSC · Verfasst: Mo 29.06.09 16:03

Ah vielen dank, das hat nochmal ne verbesserung in der Geschwindigkeit gebracht.

Ich hab mich mit Pointern bissher nicht auseinander gesetzt, ich weiss auch nicht wirklich die das genau abläuft, aber ich merke, das ist ein besserer Weg ^_^

MfG MSC