AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Sprachen und Entwicklungsumgebungen Object-Pascal / Delphi-Language GetJPGSize Funktion (wollen wir sie verbessern?)
Thema durchsuchen
Ansicht
Themen-Optionen

GetJPGSize Funktion (wollen wir sie verbessern?)

Ein Thema von MicMic · begonnen am 7. Feb 2020 · letzter Beitrag vom 10. Mär 2020
Antwort Antwort
Seite 2 von 4     12 34      
jus

Registriert seit: 22. Jan 2005
344 Beiträge
 
Delphi 2007 Professional
 
#11

AW: GetJPGSize Funktion (wollen wir sie verbessern?)

  Alt 12. Feb 2020, 17:34
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 ?

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.

Geändert von jus (12. Feb 2020 um 17:39 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
44.184 Beiträge
 
Delphi 12 Athens
 
#12

AW: GetJPGSize Funktion (wollen wir sie verbessern?)

  Alt 12. Feb 2020, 18:19
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...
$2B or not $2B
  Mit Zitat antworten Zitat
MicMic

Registriert seit: 26. Mai 2018
296 Beiträge
 
Delphi 10.2 Tokyo Starter
 
#13

AW: GetJPGSize Funktion (wollen wir sie verbessern?)

  Alt 12. Feb 2020, 21:57
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.
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
44.184 Beiträge
 
Delphi 12 Athens
 
#14

AW: GetJPGSize Funktion (wollen wir sie verbessern?)

  Alt 13. Feb 2020, 10:53
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.
$2B or not $2B
  Mit Zitat antworten Zitat
HolgerX

Registriert seit: 10. Apr 2006
Ort: Leverkusen
972 Beiträge
 
Delphi 6 Professional
 
#15

AW: GetJPGSize Funktion (wollen wir sie verbessern?)

  Alt 14. Feb 2020, 08:06
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 )
(Ja ich Verwende Delphi 6 Pro und will NICHT wechseln!)
  Mit Zitat antworten Zitat
freimatz

Registriert seit: 20. Mai 2010
1.456 Beiträge
 
Delphi 11 Alexandria
 
#16

AW: GetJPGSize Funktion (wollen wir sie verbessern?)

  Alt 14. Feb 2020, 08:28
(Außerdem ist es meiner Meinung nach besser lesbar )
Definitiv
  Mit Zitat antworten Zitat
Benutzerbild von dummzeuch
dummzeuch

Registriert seit: 11. Aug 2012
Ort: Essen
1.623 Beiträge
 
Delphi 10.2 Tokyo Professional
 
#17

AW: GetJPGSize Funktion (wollen wir sie verbessern?)

  Alt 14. Feb 2020, 09:59
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.
Thomas Mueller
  Mit Zitat antworten Zitat
HolgerX

Registriert seit: 10. Apr 2006
Ort: Leverkusen
972 Beiträge
 
Delphi 6 Professional
 
#18

AW: GetJPGSize Funktion (wollen wir sie verbessern?)

  Alt 14. Feb 2020, 11:01
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 ?
(Ja ich Verwende Delphi 6 Pro und will NICHT wechseln!)
  Mit Zitat antworten Zitat
MicMic

Registriert seit: 26. Mai 2018
296 Beiträge
 
Delphi 10.2 Tokyo Starter
 
#19

AW: GetJPGSize Funktion (wollen wir sie verbessern?)

  Alt 14. Feb 2020, 13:12
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.
  Mit Zitat antworten Zitat
MicMic

Registriert seit: 26. Mai 2018
296 Beiträge
 
Delphi 10.2 Tokyo Starter
 
#20

AW: GetJPGSize Funktion (wollen wir sie verbessern?)

  Alt 14. Feb 2020, 13:27
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)
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;
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 2 von 4     12 34      


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 00:13 Uhr.
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