Delphi-PRAXiS
Seite 2 von 4     12 34      

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)
-   -   GetJPGSize Funktion (wollen wir sie verbessern?) (https://www.delphipraxis.net/203339-getjpgsize-funktion-wollen-wir-sie-verbessern.html)

jus 12. Feb 2020 16:34

AW: GetJPGSize Funktion (wollen wir sie verbessern?)
 
Hallo,

mal eine ketzerische Frage, und zwar warum nicht einfach die fertigen JPEG Funktionen nehmen? Warum alles komplett neu erfinden. Bei Exif oder Icc verstehe ich das ja noch, da es in diesem Bereich nicht viel gibt, aber bei der Bildgrösse :gruebel: ?

Delphi-Quellcode:
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses Vcl.Imaging.jpeg;

procedure getJpegDimensions(const FileName: String; var Width: Integer; var Height: Integer);
var
  jpg:TJpegImage;
begin
  jpg:=TJpegImage.Create;
   try
     jpg.loadFromFile(FileName);
     Width := jpg.width;
     Height := jpg.height;
   finally
     jpg.free;
   end;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  Width: Integer;
  Height: Integer;
begin
  getJpegDimensions('test.jpg', Width, Height);
  Memo1.Lines.Add('Width: '+Width.ToString);
  Memo1.Lines.Add('Height: '+Height.ToString);
end;

end.

himitsu 12. Feb 2020 17:19

AW: GetJPGSize Funktion (wollen wir sie verbessern?)
 
Vermutlich um "schnell" und speichersparend die Größe zu bekommen?
Das Bild erst in den RAM zu laden und den komplette Inhalt zu entziffern, um an Ende 99% der geladenen Infos nicht zu verwenden...

MicMic 12. Feb 2020 20:57

AW: GetJPGSize Funktion (wollen wir sie verbessern?)
 
Zitat:

Zitat von himitsu (Beitrag 1457320)
Vermutlich um "schnell" und speichersparend die Größe zu bekommen?
Das Bild erst in den RAM zu laden und den komplette Inhalt zu entziffern, um an Ende 99% der geladenen Infos nicht zu verwenden...

So ist es :)
Ich brauche das, weil ich eine Dateiliste anzeigen will, mit Infos. Mit "LoadFromFile" könnte ich wohl ein Kaffee dabei trinken, bis alles gelesen ist.

himitsu 13. Feb 2020 09:53

AW: GetJPGSize Funktion (wollen wir sie verbessern?)
 
Nja, bei Verzeichnissen mit vielen Dateien dauert das auslesen auch ewig lang, und das nur für das Listing, (versuch mal WinSxS aufzulisten)
oder wenn der Datenträger/Netzlaufwerk hängt und auf den Timeout wartet.

Man kann die Dateiliste in einem Thread erstellen, bereits schonmal in die GUI pushen, dann die weiteren Dateiinfos holen und Diese dann im Nachgang, auch Stück für Stück, in der GUI nachtragen.

HolgerX 14. Feb 2020 07:06

AW: GetJPGSize Funktion (wollen wir sie verbessern?)
 
Hmm..

Hab mir die letzte Version angeschaut..

Wieso gehst Du erst den kompletten Header durch, um dann wieder von vorne anzufangen, um nur die Pakete mit $C0 bis $C2 zu suchen.

Das lesen der Größe gibt bei mir bei einigen Bildern auch eine falsche Größe wieder...

Deshalb habe ich das mal aufgeräumt und überarbeitet:

Delphi-Quellcode:
type
  TByteArr = array of Byte;

  TJFIFSegment = packed record
    Fix : Byte;
    Kind : Byte;
  end;

  TSOFData = packed record
    SamplePrecision : Byte;
    Height : WORD;           // Number of lines
    Width : WORD;            // Number of samples per line
    Comp : Byte;             // Number of image components in frame
//    Data : TByteArr;
  end;
  PSOFData = ^TSOFData;

// Irgendwo aus dem Netz kopiert..
function ReverseWord(w: word): word;
asm
   {$IFDEF CPUX64}
   mov rax, rcx
   {$ENDIF}
   xchg  al, ah
end;

function ReadWORD(FS : TFileStream; out AWord : WORD):boolean;
begin
  Result := (FS.Read(AWord,SizeOf(AWord)) = SizeOf(AWord));
  AWord := ReverseWord(AWord);
end;

function ReadSegmentHeader(FS : TFileStream; out Seg : TJFIFSegment):boolean;
begin
  Result := (FS.Read(Seg,SizeOf(Seg)) = SizeOf(Seg));
end;

function ReadData(FS : TFileStream; const ALength:WORD; var Data : TByteArr):boolean;
begin
  SetLength(Data, ALength);
  Result := (FS.Read(Data[0],ALength) = ALength);
end;


function GetJPEGImageSize(const AFileName : string; out AHeight, AWidth : integer):boolean;
var
  FS : TFileStream;
  SOI : WORD;
  SEG : TJFIFSegment;
  SegSize : WORD;

  C0 : PSOFData;
  tmpData : TByteArr;
begin
  Result := False;
  FS := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
  try
    if ReadWORD(FS, SOI) and (SOI = $FFD8) then begin // Start Of Image = Magic Bytes zur Erkennung von JPG

      While ReadSegmentHeader(FS, SEG) and (SEG.Fix = $FF) do begin

        if SEG.Kind = $DA then break; // Start of Scan = End of Header, danach nur noch Imagedaten

        if ReadWORD(FS, SegSize) then begin
          SegSize := SegSize -2; // Längenangaben um die 2 Byte für die Längenangaben selber reduziert
          case SEG.Kind of
            $C0,   // Baseline DCT
            $C1,   // Extended sequential DCT, Huffman coding
            $C2,   // Progressive DCT, Huffman coding
            $C3,   // Lossless (sequential), Huffman coding
            $C9,   // Extended sequential DCT, arithmetic coding
            $CA,   // Progressive DCT, arithmetic coding
            $CB :  // Lossless (sequential), arithmetic coding
                  begin
                    // SOFx, im SOF steht am Anfang die Größe des Bildes, anschließend Daten zur Dekodierung
                    if ReadData(FS, SegSize, tmpData) then begin
                      C0 := PSOFData(@tmpData[0]);
                      AHeight := ReverseWord(C0.Height);
                      AWidth := ReverseWord(C0.Width);
                      Result := True;
                      Break;
                    end;
                  end;
           else
             FS.Position := FS.Position + SegSize; // Zum nächsten Segment, die weiteren werden nicht gebraucht.
          end;
        end;
      end;
    end;
  finally
    FS.Free;
  end;
end;

Das funktioniert nun auch mit den anders kodierten JPGs ($C3,$C9..) und liefert schnell die richtige Größe zurück.

(Außerdem ist es meiner Meinung nach besser lesbar ;) )

freimatz 14. Feb 2020 07:28

AW: GetJPGSize Funktion (wollen wir sie verbessern?)
 
Zitat:

Zitat von HolgerX (Beitrag 1457452)
(Außerdem ist es meiner Meinung nach besser lesbar ;) )

Definitiv :thumb:

dummzeuch 14. Feb 2020 08:59

AW: GetJPGSize Funktion (wollen wir sie verbessern?)
 
Eigentlich schon fast ideal. Allerdings hätte ich, wie schon am Anfang jemand vorschlug, statt einzelner Bytes einen Buffer gelesen und diesen durchsucht. Das bringt in der Regel einiges an Geschwindigkeit. Insbesondere kann man hier vermutlich einen Buffer wählen, der von Anfang an groß genug ist, um den kompletten Header zu lesen, so dass nur ein einziger Lesevorgang notwendig ist.

HolgerX 14. Feb 2020 10:01

AW: GetJPGSize Funktion (wollen wir sie verbessern?)
 
Hmm..

Das Problem ist leider, das der Header zwischen nur wenigen Bytes bis hin zu KB (mit XML-EXIF Daten) aufgeblasen werden kann.
Meist stehen diese dann noch am Anfang und die $Cx kommen zum Schluss des Headers....

Ich weiß auch nicht zu 100% wie der FileStream dies intern händelt..
Puffert dieser, oder liest gleich Blockweise ?

MicMic 14. Feb 2020 12:12

AW: GetJPGSize Funktion (wollen wir sie verbessern?)
 
Zitat:

Zitat von himitsu (Beitrag 1457369)
Nja, bei Verzeichnissen mit vielen Dateien dauert das auslesen auch ewig lang, und das nur für das Listing, (versuch mal WinSxS aufzulisten)
oder wenn der Datenträger/Netzlaufwerk hängt und auf den Timeout wartet.

Man kann die Dateiliste in einem Thread erstellen, bereits schonmal in die GUI pushen, dann die weiteren Dateiinfos holen und Diese dann im Nachgang, auch Stück für Stück, in der GUI nachtragen.

Wenn man eine Dateiliste schon sortiert (Name, Datum, Größe etc.) einlesen könnte, wäre das klasse. Da dies jedoch nicht geht, sieht's optisch ein wenig doof aus (auch wenn es schnell geht), wenn man schon angezeigte Dateinamen am Bildschirm hat, diese dann plötzlich verschwinden und durch andere ausgetauscht werden.

MicMic 14. Feb 2020 12:27

AW: GetJPGSize Funktion (wollen wir sie verbessern?)
 
Zitat:

Zitat von HolgerX (Beitrag 1457452)
Hmm..
Hab mir die letzte Version angeschaut..
Wieso gehst Du erst den kompletten Header durch, um dann wieder von vorne anzufangen, um nur die Pakete mit $C0 bis $C2 zu suchen.
Das lesen der Größe gibt bei mir bei einigen Bildern auch eine falsche Größe wieder...
Deshalb habe ich das mal aufgeräumt und überarbeitet:
Delphi-Quellcode:
type
  TByteArr = array of Byte;
  TJFIFSegment = packed record
    Fix : Byte;
    Kind : Byte;
  end;
… gekürzt... (weiter oben im Thread komplett)

Zitat:

Zitat von HolgerX (Beitrag 1457452)
Das funktioniert nun auch mit den anders kodierten JPGs ($C3,$C9..) und liefert schnell die richtige Größe zurück.
(Außerdem ist es meiner Meinung nach besser lesbar ;) )


Das muss ich wohl bei mir noch $C9 dazu machen.
Wie findest du denn meine (bzw. eine gefundene von mir abgeänderte Version)? (hier im Thread irgendwo auch weiter oben; aber füge sie mal unten hinzu) Abgesehen vom "besser lesbarem". Hab sie halt gekürzt.
Ich verstehe aber noch nicht so ganz den While Block. Also der Bereich " If Not (BD In [$01,$D0,$D1,$D2,$D3,$D4,$D5,$D6,$D7])" Bin mir da nicht so ganz klar, wie viel/lange er liest. Geht aber jedenfalls gut und schnell. Auch noch keine JPG gefunden, die hier falsche Werte (Breite/Höhe) liefert.
Delphi-Quellcode:
Procedure GetJPGSize(sFile: String; Out WW, WH: DWord);
Var
  FS: TFileStream;
  BD: Byte;
  WD : Word;
  RL: LongInt;
  HW : Array[0..3] Of Byte;
  LE : Array[0..1] Of Byte;
Begin
  sFile := '\\?\'+SFile;
  WW := 0;
  WH := 0;
  FS := TFileStream.Create(sFile, fmShareDenyNone);
  Try
    RL := FS.Read(WD, 2);
    If (Lo(WD) <> $FF) And (Hi(WD) <> $D8) Then RL := 0;
    If RL > 0 Then
    Begin
      RL := FS.Read(BD, 1);
      While (BD = $FF) and (RL > 0) Do
      Begin
        RL := FS.Read(BD, 1);
        If BD <> $FF Then
        Begin
          If BD In [$C0,$C1,$C2] Then
          Begin
            FS.Seek(3,1);
            FS.Read(HW,4);
            WH := HW[0] Shl 8 + HW[1];
            WW := HW[2] Shl 8 + HW[3];
          End Else
          Begin
            If Not (BD In [$01,$D0,$D1,$D2,$D3,$D4,$D5,$D6,$D7]) Then
            Begin
              FS.Read(Le,2);
              WD := LE[0] Shl 8 + Le[1];
              FS.Seek(WD - 2, 1);
              FS.Read(BD, 1);
            End Else BD := $FF;
          End;
        End;
      End;
    End;
  Finally
    FS.Free;
  End;
End;


Alle Zeitangaben in WEZ +1. Es ist jetzt 06:33 Uhr.
Seite 2 von 4     12 34      

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz