XE2 erreur avec les images JPEG

**ALEX77** · 19/08/2012, 20h42

Bonjour,

Je migre doucement vers XE2 mes applications et je suis tombé sur une erreur assez embarrassante. Voilà j'utilisais comme depuis toujours, les unités ijpegs.pas, ijl.pas et la dll d'intel : ijl15.dll
Grâce à cela, le chargement des mes JPEG était beaucoup plus rapide qu'avec l'unité jpeg de la VCL. Environ 4 fois plus vite !
En passant à XE2, ce jeu d'unité ne fonctionne plus... j'obtiens une erreur "Error reading JPEG file".

Voici mon code source d'un petit exemple qui illustre cette erreur :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
unit Unit1;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
 
  ijpeg, Vcl.StdCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure LoadJPEGToBitmap(bmp : TBitmap; filename : string);
var AJPEG : TJPEGImage;
begin
 AJPEG:= TJPEGImage.Create;
 try
  try
   AJPEG.LoadFromFile(filename);
   bmp.Assign(AJPEG);
  except
   ShowMessage('Erreur JPEG : '+filename);
  end;
 finally
  AJPEG.Free;
 end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var bmp : TBitmap;
    filename : string;
begin
 bmp:= TBitmap.Create;
 try
  filename:= 'mon_image.jpg';
  LoadJPEGToBitmap(bmp,filename);
 finally
  bmp.Free;
 end;
end;
 
end.

Les unités que j'ai cité plus haut sont disponibles ici sur le site Phidels
http://www.phidels.com/php/index.php...ip.php3&id=356

Merci pour votre aide

**tourlourou** · 19/08/2012, 22h48

Où survient l'erreur ?

**ALEX77** · 19/08/2012, 22h57

Salut tourlourou
L'erreur survient à la ligne 36 au moment d'assigner le JPEG au bitmap.

Chose curieuse car avec delphi 2007 cela fonctionnait très bien je n'avais pas ce genre de problème. Cela a toujours fonctionné depuis delphi 6...

**exoseven** · 20/08/2012, 09h09

surement un problème d'unicode, il va falloir que tu retouches ta librairie ijpeg.pas

le plus simple serait de remplacer tous les string par des ansistring

**Paul TOTH** · 20/08/2012, 12h31

en effet le programme exploite une DLL qui attend des PAnsiChar et non des PWideChar (ce que sont devenus les PChar).

**ALEX77** · 20/08/2012, 12h48

Salut exoseven

Effectivement il y avait bien une question de AnsiString j'ai donc effectué quelques modifications de string en AnsiString et ça donne ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
 
unit IJpeg;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, ijl;
 
type
  TJPEGScale = (jsFullSize, jsHalf, jsQuarter, jsEighth);
  TJPEGPixelFormat = (jf24Bit, jf8Bit);
  TJPEGQualityRange = 1..100;
  TJPEGPerformance = (jpBestQuality, jpBestSpeed);
 
  TIJpeg = class(TGraphic)
  private
    { Private declarations }
    FScale: TJPEGScale;
    FBitmap: TBitmap;
    FPixelFormat: TJPEGPixelFormat;
    FCompressionQuality: TJPEGQualityRange;
    FProgressiveEncoding: Boolean;
    FProgressiveDisplay: Boolean;
    FPerformance: TJPEGPerformance;
    FComment: AnsiString;
    JpgFileName: AnsiString;
    JpgStream: TStream;
    BFromFile: Boolean;
    BFromStream: Boolean;
    FDecodeBeforePaint: Boolean;
    Decoded: Boolean;
    procedure Decode;
    procedure SetScale(const Value: TJPEGScale);
    procedure GetScaleSize(var iWidth: Integer; var iHeight: Integer; S: TJPEGScale);
  protected
    { Protected declarations }
  public
    { Public declarations }
    property CompressionQuality: TJPEGQualityRange read FCompressionQuality write FCompressionQuality;
    property Comment: AnsiString read FComment write FComment;
    property DecodeBeforePaint: Boolean read FDecodeBeforePaint write FDecodeBeforePaint;
    property Scale: TJPEGScale read FScale write SetScale;
    property Performance: TJPEGPerformance read FPerformance write FPerformance;
    property PixelFormat: TJPEGPixelFormat read FPixelFormat write FPixelFormat;
    property ProgressiveDisplay: Boolean read FProgressiveDisplay write FProgressiveDisplay; // just for compatibility with TJpegImage
    property ProgressiveEncoding: Boolean read FProgressiveEncoding write FProgressiveEncoding;
    procedure Assign(Source: TPersistent); override;
    procedure AssignTo(Dest: TPersistent); override;
    constructor Create; override;
    destructor Destroy; override;
    procedure Draw(ACanvas: TCanvas; const ARect: TRect); override;
    function Equals(Graphic: TGraphic): Boolean; override;
    function GetEmpty: Boolean; override;
    function GetHeight: Integer; override;
    function GetPalette: HPALETTE; override;
    function GetTransparent: Boolean; override;
    function GetWidth: Integer; override;
    procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle; APalette: HPALETTE); override;
    procedure LoadFromFile(const FileName: string); override;
    procedure LoadFromResourceID(Instance: THandle; ResID: Integer; ResType: PChar);
    procedure LoadFromResourceName(Instance: THandle; const ResName: AnsiString; ResType: PChar);
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle; var APalette: HPALETTE); override;
    procedure SaveToFile(const FileName: string); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure SetHeight(Value: Integer); override;
    procedure SetWidth(Value: Integer); override;
    procedure WriteData(Stream: TStream); override;
  published
    { Published declarations }
  end;
 
  TJpegImage = TIJpeg;
 
implementation
 
{ TIJpeg }
 
procedure TIJpeg.Assign(Source: TPersistent);
var
  TmpJpg: TIJpeg;
begin
  Decoded := True;
 
  if Source = nil then
    FreeAndNil(FBitmap)
  else if (Source is TIJpeg) and (Source <> Self) then
  begin
    FreeAndNil(FBitmap);
    FBitmap := TBitmap.Create;
 
    TmpJpg := TIJpeg(Source);
    FBitmap.Assign(TmpJpg.FBitmap);
    FDecodeBeforePaint := TmpJpg.DecodeBeforePaint;
    BFromFile := TmpJpg.BFromFile;
    BFromStream := TmpJpg.BFromStream;
    JpgFileName := TmpJpg.JpgFileName;
 
    if Assigned(TmpJpg.JpgStream) then
      JpgStream.CopyFrom(TmpJpg.JpgStream, TmpJpg.JpgStream.Size);
 
    FScale := TmpJpg.Scale;
    Decoded := TmpJpg.Decoded;
    Width := TmpJpg.Width;
    Height := TmpJpg.Height;
    FComment := TmpJpg.Comment;
    FCompressionQuality := TmpJpg.CompressionQuality;
    FPixelFormat := TmpJpg.PixelFormat;
    FProgressiveEncoding := TmpJpg.ProgressiveEncoding;
    FProgressiveDisplay := TmpJpg.ProgressiveDisplay;
    FPerformance := TmpJpg.Performance;
  end
  else if Source is TBitmap then
  begin
    FreeAndNil(FBitmap);
    FBitmap := TBitmap.Create;
    FBitmap.Assign(TBitmap(Source));
  end
  else
    inherited Assign(Source);
end;
 
procedure TIJpeg.AssignTo(Dest: TPersistent);
begin
  if Dest is TIJpeg then
    Dest.Assign(Self)
  else if Dest is TGraphic then
  begin
    if not Decoded then
      Decode;
    if Empty then
      Dest.Assign(nil)
    else
      (Dest as TGraphic).Assign(FBitmap);
  end
  else
    inherited AssignTo(Dest);
end;
 
constructor TIJpeg.Create;
begin
  inherited Create;
 
  FBitmap := TBitmap.Create;
  with FBitmap do
  begin
    Width := 0;
    Height := 0;
    Palette := 0;
    PixelFormat := pf24bit;
  end;
 
  FCompressionQuality := 100;
  FComment := '';
  BFromFile := False;
  BFromStream := False;
  JpgFileName := '';
  FDecodeBeforePaint := True;
  //FDecodeBeforePaint := False;
  Decoded := False;
end;
 
procedure TIJpeg.Decode;
var
  iWidth, iHeight: Integer;
  iStatus: integer;
  jcprops: TJPEG_CORE_PROPERTIES;
  DIB: TDIBSection;
  Buff: AnsiString;
begin
  if not Decoded then
  begin
    // Initialise the JPEG library
    FillChar (jcprops, SizeOf (jcprops), 0);  // Just to be sure...
    iStatus := ijlInit (@jcprops);
 
    if iStatus = IJL_OK then
    try
      SetLength(FComment, 1024);
      jcprops.jprops.jpeg_comment := PChar(FComment);
      jcprops.jprops.jpeg_comment_size := 1024;
 
      //***** Parametres pour décodage ******************
      if BFromFile then
        jcprops.JPGFile := PChar (JpgFileName);
 
      if BFromStream then
      begin
        SetLength(Buff, JpgStream.Size);
        JpgStream.Read(Buff[1], JpgStream.Size);
 
        with jcprops do
        begin
          JPGFile := nil;
          JPGBytes := PByte(Buff);
          JPGSizeBytes := JpgStream.Size;
        end;
      end;
      //*************************************************
 
      iStatus := ijlRead (@jcprops, IJL_JFILE_READPARAMS);
      if iStatus = IJL_OK then
        begin
        iWidth := jcprops.JPGWidth;
        iHeight := jcprops.JPGHeight;
        GetScaleSize(iWidth, iHeight, FScale);
 
        case jcprops.JPGChannels of
          1:
            begin
              jcprops.JPGColor    := IJL_G;
              jcprops.DIBChannels := 3;
              jcprops.DIBColor    := IJL_BGR;
            end;
 
          3:
            begin
              jcprops.JPGColor    := IJL_YCBCR;
              jcprops.DIBChannels := 3;
              jcprops.DIBColor    := IJL_BGR;
            end;
 
          4:
            begin
              jcprops.JPGColor    := IJL_YCBCRA_FPX;
              jcprops.DIBChannels := 4;
              jcprops.DIBColor    := IJL_RGBA_FPX;
            end;
          else
            begin
              jcprops.DIBColor := TIJL_COLOR(IJL_OTHER);
              jcprops.JPGColor := TIJL_COLOR(IJL_OTHER);
              jcprops.DIBChannels := jcprops.JPGChannels;
            end;
        end;
 
        with FBitmap do
        begin
          if jcprops.DIBChannels = 1 then
            PixelFormat := pf8Bit
          else
            PixelFormat := pf24Bit;
 
          Width := iWidth;
          Height := iHeight;
        end;
 
        Width := iWidth;
        Height := iHeight;
 
        FillChar (DIB, SizeOf (DIB), 0);
        iStatus := GetObject (FBitmap.Handle, SizeOf (DIB), @DIB);
        if iStatus <> 0 then
        begin
          with jcprops do
          begin
            DIBWidth := iWidth;
            DIBHeight := -iHeight;
            DIBPadBytes := IJL_DIB_PAD_BYTES(jcprops.DIBWidth, jcprops.DIBChannels);
            DIBBytes := PByte (DIB.dsBm.bmBits);
          end;
 
          if BFromFile then
          begin
            case FScale of
              jsHalf: iStatus := ijlRead (@jcprops, IJL_JFILE_READONEHALF);
              jsQuarter: iStatus := ijlRead (@jcprops, IJL_JFILE_READONEQUARTER);
              jsEighth: iStatus := ijlRead (@jcprops, IJL_JFILE_READONEEIGHTH);
            else
              iStatus := ijlRead (@jcprops, IJL_JFILE_READWHOLEIMAGE);
            end;
          end;
 
          if BFromStream then
          begin
            case FScale of
              jsHalf: iStatus := ijlRead (@jcprops, IJL_JBUFF_READONEHALF);
              jsQuarter: iStatus := ijlRead (@jcprops, IJL_JBUFF_READONEQUARTER);
              jsEighth: iStatus := ijlRead (@jcprops, IJL_JBUFF_READONEEIGHTH);
            else
              iStatus := ijlRead (@jcprops, IJL_JBUFF_READWHOLEIMAGE);
            end;
          end;
 
          if iStatus >= 0 then
            FBitmap.Modified := True;
 
          SetLength(FComment, Length(FComment));
        end;
      end;
 
      if iStatus <> IJL_OK then
      begin
        if BFromFile then
          raise (EReadError.Create ('Error reading JPEG from file'));
 
        if BFromStream then
          raise (EReadError.Create ('Error reading JPEG from stream'));
      end;
 
    finally
      ijlFree (@jcprops);
    end;
  end;
 
  Decoded := True;
  BFromFile := False;
  BFromStream := False;
  JpgFileName := '';
  if BFromStream then
    JpgStream.Free;
end;
 
destructor TIJpeg.Destroy;
begin
  if FBitmap <> nil then
  begin
 
    if FBitmap.Palette <> 0 then
      DeleteObject(FBitmap.Palette);
    FBitmap.Free;
  end;
 
  inherited Destroy;
end;
 
procedure TIJpeg.Draw(ACanvas: TCanvas; const ARect: TRect);
begin
  if not Decoded and FDecodeBeforePaint then
    Decode;
 
  if FBitmap <> nil then
    ACanvas.StretchDraw(ARect, FBitmap);
end;
 
function TIJpeg.Equals(Graphic: TGraphic): Boolean;
begin
  if FBitmap = nil then
    Result := Graphic = nil
  else
    Result := (Graphic is TIJpeg) and (FBitmap = TIJpeg(TIJpeg).FBitmap);
end;
 
function TIJpeg.GetEmpty: Boolean;
begin
  Result := FBitmap = nil;
end;
 
function TIJpeg.GetHeight: Integer;
begin
  if FBitmap <> nil then
    Result := FBitmap.Height
  else
    Result := -1;
end;
 
function TIJpeg.GetPalette: HPALETTE;
begin
  if FBitmap <> nil then
    Result := FBitmap.Palette
  else
    Result := 0;
end;
 
function TIJpeg.GetTransparent: Boolean;
begin
  if FBitmap <> nil then
    Result := FBitmap.Transparent
  else
    Result := False;
end;
 
function TIJpeg.GetWidth: Integer;
begin
  if FBitmap <> nil then
    Result := FBitmap.Width
  else
    Result := -1;
end;
 
procedure TIJpeg.LoadFromClipboardFormat(AFormat: Word; AData: THandle;
  APalette: HPALETTE);
begin
  if FBitmap <> nil then
    FBitmap.LoadFromClipboardFormat(AFormat, AData, APalette);
end;
 
procedure TIJpeg.LoadFromFile(const FileName: string);
var
  iWidth, iHeight: Integer;
  iStatus: integer;
  jcprops: TJPEG_CORE_PROPERTIES;
begin
  JpgFileName := FileName;
  BFromFile := True;
  BFromStream := False;
 
  if FDecodeBeforePaint then
  begin
    // Initialise the JPEG library
    FillChar (jcprops, SizeOf (jcprops), 0);  // Just to be sure...
    iStatus := ijlInit (@jcprops);
 
    if iStatus = IJL_OK then
    try
      SetLength(FComment, 1024);
      jcprops.jprops.jpeg_comment := PChar(FComment);
      jcprops.jprops.jpeg_comment_size := 1024;
 
      jcprops.JPGFile := PChar(JpgFileName);
      iStatus := ijlRead (@jcprops, IJL_JFILE_READPARAMS);
      if iStatus = IJL_OK then
      begin
        iWidth := jcprops.JPGWidth;
        iHeight := jcprops.JPGHeight;
        GetScaleSize(iWidth, iHeight, FScale);
 
        Width := iWidth;
        Height := iHeight;
 
        SetLength(FComment, Length(FComment));
      end;
 
    finally
      ijlFree (@jcprops);
    end;
  end
  else
    Decode;
end;
 
procedure TIJpeg.LoadFromResourceID(Instance: THandle; ResID: Integer;
  ResType: PChar);
var
  Stream: TStream;
begin
  Stream := TResourceStream.CreateFromID(Instance, ResId, ResType);
  Self.LoadFromStream(Stream);
  Stream.Free;
end;
 
procedure TIJpeg.LoadFromResourceName(Instance: THandle;
  const ResName: AnsiString; ResType: PChar);
var
  Stream: TStream;
begin
  Stream := TResourceStream.Create(Instance, ResName, ResType);
  Self.LoadFromStream(Stream);
  Stream.Free;
end;
 
procedure TIJpeg.LoadFromStream(Stream: TStream);
var
  iWidth, iHeight: Integer;
  iStatus: integer;
  jcprops: TJPEG_CORE_PROPERTIES;
  Buff: AnsiString;
begin
  BFromStream := True;
  BFromFile := False;
  JpgStream := TStream.Create;
 
  if FDecodeBeforePaint then
    begin
    // Initialise the JPEG library
    FillChar (jcprops, SizeOf (jcprops), 0);  // Just to be sure...
    iStatus := ijlInit (@jcprops);
 
    if iStatus = IJL_OK then
    try
      SetLength(Buff, Stream.Size);
      Stream.Read(Buff[1], Stream.Size);
 
      with jcprops do
      begin
        JPGFile := nil;
        JPGBytes := PByte(Buff);
        JPGSizeBytes := Stream.Size;
      end;
 
      jcprops.jprops.jpeg_comment := PChar(FComment);
      jcprops.jprops.jpeg_comment_size := 1024;
 
      iStatus := ijlRead(@jcprops, IJL_JBUFF_READPARAMS);
      if iStatus = IJL_OK then
      begin
        iWidth := jcprops.JPGWidth;
        iHeight := jcprops.JPGHeight;
        GetScaleSize(iWidth, iHeight, FScale);
 
        Width := iWidth;
        Height := iHeight;
 
        SetLength(FComment, Length(FComment));
      end;
    finally
      ijlFree (@jcprops);
    end;
  end
  else
    Decode;
end;
 
procedure TIJpeg.SaveToClipboardFormat(var AFormat: Word;
  var AData: THandle; var APalette: HPALETTE);
begin
  if FBitmap <> nil then
    FBitmap.SaveToClipboardFormat(AFormat, AData, APalette);
end;
 
procedure TIJpeg.SaveToFile(const FileName: string);
var
  jcprops : TJPEG_CORE_PROPERTIES;
  iWidth, iHeight, iNChannels : Integer;
  iStatus, err: integer;
  DIB: TDIBSection;
  B: Boolean;
begin
  if not Decoded then
    Decode;
 
  B := True;
  FBitmap.PixelFormat := pf24bit;
  // Initialise the JPEG library
  FillChar (jcprops, SizeOf (jcprops), 0);  // Just to be sure...
  iStatus := ijlInit (@jcprops);
 
  if iStatus = IJL_OK then
  try
    FillChar (DIB, SizeOf(DIB), 0);
    GetObject (FBitmap.Handle, SizeOf (DIB), @DIB);
    iWidth  := DIB.dsBm.bmWidth;
    iHeight := DIB.dsBm.bmHeight;
    case FPixelFormat of
      jf8bit: iNChannels := 1;
      jf24bit: iNChannels := 3;
    else
      Raise EInvalidOperation.Create ('Cannot save bitmap as JPEG with specified PixelFormat');
    end;
 
    with jcprops do
    begin
      DIBWidth := iWidth;
      DIBHeight := -iHeight;
      DIBChannels := iNChannels;
      case FPixelFormat of
        jf8bit: DIBColor := IJL_G;
        jf24bit: DIBColor := IJL_BGR;
      end;
      DIBPadBytes := IJL_DIB_PAD_BYTES(jcprops.DIBWidth,jcprops.DIBChannels);
      DIBBytes := PByte (DIB.dsBm.bmBits);
 
      JPGFile := PChar (FileName);
      JPGWidth := iWidth;
      JPGHeight := iHeight;
      JPGChannels := 3;
      JPGColor := IJL_YCBCR;
      jquality := CompressionQuality;
 
      jprops.jpeg_comment_size := Length(FComment) + 1;
      jprops.jpeg_comment := PChar(FComment);
 
      if FProgressiveEncoding then
        jprops.progressive_found := 1;
    end;
 
    err := ijlWrite (@jcprops, IJL_JFILE_WRITEWHOLEIMAGE);
    B := IJL_OK = err;
 
    ijlFree (@jcprops);
  except
  end;
 
  if not B then
    raise (EWriteError.Create ('Error writing JPEG to file. ' + ijlErrorStr(Err)));
end;
 
procedure TIJpeg.SaveToStream(Stream: TStream);
var
  jcprops : TJPEG_CORE_PROPERTIES;
  iWidth, iHeight, iNChannels : Integer;
  iStatus: Integer;
  B: Boolean;
  Buff: AnsiString;
  BufSize: Integer;
  Err: Integer;
  DIB: TDIBSection;
begin
  if not Decoded then
    Decode;
 
  B := True;
 
  FBitmap.PixelFormat := pf24bit;
  // Initialise the JPEG library
  FillChar (jcprops, SizeOf (jcprops), 0);  // Just to be sure...
  iStatus := ijlInit (@jcprops);
 
  if iStatus = IJL_OK then
  try
    FillChar (DIB, SizeOf(DIB), 0);
    GetObject (FBitmap.Handle, SizeOf (DIB), @DIB);
    iWidth  := DIB.dsBm.bmWidth;
    iHeight := DIB.dsBm.bmHeight;
 
    BufSize := iWidth * iHeight * 3;
    SetLength(Buff, BufSize);
 
    case FPixelFormat of
      jf8bit: iNChannels := 1;
      jf24bit: iNChannels := 3;
    else
      Raise EInvalidOperation.Create ('Cannot save bitmap as JPEG with specified PixelFormat');
    end;
 
    with jcprops do
    begin
      DIBWidth := iWidth;
      DIBHeight := -iHeight;
      DIBBytes := PByte (DIB.dsBm.bmBits);;
      DIBChannels := iNChannels;
      case FPixelFormat of
        jf8bit: DIBColor := IJL_G;
        jf24bit: DIBColor := IJL_BGR;
      end;
      DIBPadBytes := IJL_DIB_PAD_BYTES(jcprops.DIBWidth, jcprops.DIBChannels);
 
      JPGWidth := iWidth;
      JPGHeight := iHeight;
      JPGFile := nil;
      JPGBytes := PByte(Buff);
      JPGSizeBytes := BufSize;
      JPGChannels := 3;
      JPGColor := IJL_YCBCR;
      //JPGSubsampling := IJL_411;
      jquality := CompressionQuality;
 
      jprops.jpeg_comment_size := Length(FComment) + 1;
      jprops.jpeg_comment := PChar(FComment);
 
      if FProgressiveEncoding then
        jprops.progressive_found := 1;
    end;
 
    Err := ijlWrite (@jcprops, IJL_JBUFF_WRITEWHOLEIMAGE);
    B := IJL_OK = Err;
 
    if B then
      Stream.Write(Buff[1], BufSize);
 
    ijlFree (@jcprops);
  except
  end;
 
  if not B then
    raise (EWriteError.Create ('Error writing JPEG to stream. ' + ijlErrorStr(Err)));
end;
 
procedure TIJpeg.SetHeight(Value: Integer);
begin
  if FBitmap <> nil then
  begin
    FBitmap.Height := Value;
    Changed(Self);
  end;
end;
 
procedure TIJpeg.SetScale(const Value: TJPEGScale);
var
  tmpWidth, tmpHeight: Integer;
begin
  FScale := Value;
  if FDecodeBeforePaint then
  begin
    tmpWidth := Width;
    tmpHeight := Height;
    GetScaleSize(tmpWidth, tmpHeight, FScale);
    Width := tmpWidth;
    Height := tmpHeight;
  end;
end;
 
procedure TIJpeg.SetWidth(Value: Integer);
begin
  if FBitmap <> nil then
  begin
    FBitmap.Width := Value;
    Changed(Self);
  end;
end;
 
procedure TIJpeg.WriteData(Stream: TStream);
begin
  SaveToStream(Stream);
end;
 
procedure TIJpeg.GetScaleSize(var iWidth: Integer; var iHeight: Integer; S: TJPEGScale);
begin
  case S of
    jsHalf: begin
             iWidth := (iWidth + 1) shr 1;
             iHeight := (iHeight + 1) shr 1;
             end;
    jsQuarter: begin
             iWidth := (iWidth + 3) shr 2;
             iHeight := (iHeight + 3) shr 2;
             end;
    jsEighth: begin
             iWidth := (iWidth + 7) shr 3;
             iHeight := (iHeight + 7) shr 3;
             end;
  end;
end;
 
{**************************************************}
 
initialization
  RegisterClass(TIJpeg);
  TPicture.RegisterFileFormat('jpg', 'JPEG Image', TIJpeg);
 
finalization
  TPicture.UnRegisterGraphicClass(TIJpeg);
 
end.

Donc ça fonctionne pour ce qui est du LoadFromFile sans problème (pas encore testé avec du LoadFromStream). Donc j'arrive bien à charger un jpeg, à le transférer dans un bitmap jusque là ça fonctionne.

Mais c'est l'opération inverse, à savoir le SaveToFile qui ne fonctionne pas correctement. A la ligne 567 le procédure ijlWrite qui est doit normalement écrire un beau fichier JPEG renvoie un fichier dans le même dossier que mon .exe et d'une simple lettre. Par exemple si je veux sauvegarder "c:\mon image", il me renverra un fichier nommé simplement "c" dans le même dossier que mon .exe. Donc je pense aussi à un problème de string/pchar/etc... mais je ne vois pas comment faire.

Aurais-tu une idée ? Merci d'avance j'ai déjà résolu une partie du problème grâce à toi.

**Linkin** · 20/08/2012, 13h44

Il faut changer tous les types string en AnsiString
(SaveToFile est encore avec string)

**ALEX77** · 20/08/2012, 13h56

il y a juste SaveToFile(filename : string) qui est un override donc impossible de faire SaveToFile(filename : AnsiString) !

ça bloque ailleurs à mon avis

**Linkin** · 20/08/2012, 16h36

ça bloque justement à cause du passage Ansi/Unicode.

Essaie de changer aussi les PChar en PAnsiChar dans les deux unités.

**ALEX77** · 20/08/2012, 18h48

J'ai enfin réussi et ça fonctionne. Voici pour ceux que ça intéresse le code source des deux unités modifiées :

IJpeg.pas

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
 
unit IJpeg;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, ijl;
 
type
  TJPEGScale = (jsFullSize, jsHalf, jsQuarter, jsEighth);
  TJPEGPixelFormat = (jf24Bit, jf8Bit);
  TJPEGQualityRange = 1..100;
  TJPEGPerformance = (jpBestQuality, jpBestSpeed);
 
  TIJpeg = class(TGraphic)
  private
    { Private declarations }
    FScale: TJPEGScale;
    FBitmap: TBitmap;
    FPixelFormat: TJPEGPixelFormat;
    FCompressionQuality: TJPEGQualityRange;
    FProgressiveEncoding: Boolean;
    FProgressiveDisplay: Boolean;
    FPerformance: TJPEGPerformance;
    FComment: AnsiString;
    JpgFileName: AnsiString;
    JpgStream: TStream;
    BFromFile: Boolean;
    BFromStream: Boolean;
    FDecodeBeforePaint: Boolean;
    Decoded: Boolean;
    procedure Decode;
    procedure SetScale(const Value: TJPEGScale);
    procedure GetScaleSize(var iWidth: Integer; var iHeight: Integer; S: TJPEGScale);
  protected
    { Protected declarations }
  public
    { Public declarations }
    property CompressionQuality: TJPEGQualityRange read FCompressionQuality write FCompressionQuality;
    property Comment: AnsiString read FComment write FComment;
    property DecodeBeforePaint: Boolean read FDecodeBeforePaint write FDecodeBeforePaint;
    property Scale: TJPEGScale read FScale write SetScale;
    property Performance: TJPEGPerformance read FPerformance write FPerformance;
    property PixelFormat: TJPEGPixelFormat read FPixelFormat write FPixelFormat;
    property ProgressiveDisplay: Boolean read FProgressiveDisplay write FProgressiveDisplay; // just for compatibility with TJpegImage
    property ProgressiveEncoding: Boolean read FProgressiveEncoding write FProgressiveEncoding;
    procedure Assign(Source: TPersistent); override;
    procedure AssignTo(Dest: TPersistent); override;
    constructor Create; override;
    destructor Destroy; override;
    procedure Draw(ACanvas: TCanvas; const ARect: TRect); override;
    function Equals(Graphic: TGraphic): Boolean; override;
    function GetEmpty: Boolean; override;
    function GetHeight: Integer; override;
    function GetPalette: HPALETTE; override;
    function GetTransparent: Boolean; override;
    function GetWidth: Integer; override;
    procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle; APalette: HPALETTE); override;
    procedure LoadFromFile(const FileName: string); override;
    procedure LoadFromResourceID(Instance: THandle; ResID: Integer; ResType: PChar);
    procedure LoadFromResourceName(Instance: THandle; const ResName: AnsiString; ResType: PChar);
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle; var APalette: HPALETTE); override;
    procedure SaveToFile(const FileName: string); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure SetHeight(Value: Integer); override;
    procedure SetWidth(Value: Integer); override;
    procedure WriteData(Stream: TStream); override;
  published
    { Published declarations }
  end;
 
  TJpegImage = TIJpeg;
 
implementation
 
{ TIJpeg }
 
procedure TIJpeg.Assign(Source: TPersistent);
var
  TmpJpg: TIJpeg;
begin
  Decoded := True;
 
  if Source = nil then
    FreeAndNil(FBitmap)
  else if (Source is TIJpeg) and (Source <> Self) then
  begin
    FreeAndNil(FBitmap);
    FBitmap := TBitmap.Create;
 
    TmpJpg := TIJpeg(Source);
    FBitmap.Assign(TmpJpg.FBitmap);
    FDecodeBeforePaint := TmpJpg.DecodeBeforePaint;
    BFromFile := TmpJpg.BFromFile;
    BFromStream := TmpJpg.BFromStream;
    JpgFileName := TmpJpg.JpgFileName;
 
    if Assigned(TmpJpg.JpgStream) then
      JpgStream.CopyFrom(TmpJpg.JpgStream, TmpJpg.JpgStream.Size);
 
    FScale := TmpJpg.Scale;
    Decoded := TmpJpg.Decoded;
    Width := TmpJpg.Width;
    Height := TmpJpg.Height;
    FComment := TmpJpg.Comment;
    FCompressionQuality := TmpJpg.CompressionQuality;
    FPixelFormat := TmpJpg.PixelFormat;
    FProgressiveEncoding := TmpJpg.ProgressiveEncoding;
    FProgressiveDisplay := TmpJpg.ProgressiveDisplay;
    FPerformance := TmpJpg.Performance;
  end
  else if Source is TBitmap then
  begin
    FreeAndNil(FBitmap);
    FBitmap := TBitmap.Create;
    FBitmap.Assign(TBitmap(Source));
  end
  else
    inherited Assign(Source);
end;
 
procedure TIJpeg.AssignTo(Dest: TPersistent);
begin
  if Dest is TIJpeg then
    Dest.Assign(Self)
  else if Dest is TGraphic then
  begin
    if not Decoded then
      Decode;
    if Empty then
      Dest.Assign(nil)
    else
      (Dest as TGraphic).Assign(FBitmap);
  end
  else
    inherited AssignTo(Dest);
end;
 
constructor TIJpeg.Create;
begin
  inherited Create;
 
  FBitmap := TBitmap.Create;
  with FBitmap do
  begin
    Width := 0;
    Height := 0;
    Palette := 0;
    PixelFormat := pf24bit;
  end;
 
  FCompressionQuality := 100;
  FComment := '';
  BFromFile := False;
  BFromStream := False;
  JpgFileName := '';
  FDecodeBeforePaint := True;
  //FDecodeBeforePaint := False;
  Decoded := False;
end;
 
procedure TIJpeg.Decode;
var
  iWidth, iHeight: Integer;
  iStatus: integer;
  jcprops: TJPEG_CORE_PROPERTIES;
  DIB: TDIBSection;
  Buff: AnsiString;
begin
  if not Decoded then
  begin
    // Initialise the JPEG library
    FillChar (jcprops, SizeOf (jcprops), 0);  // Just to be sure...
    iStatus := ijlInit (@jcprops);
 
    if iStatus = IJL_OK then
    try
      SetLength(FComment, 1024);
      jcprops.jprops.jpeg_comment := PChar(FComment);
      jcprops.jprops.jpeg_comment_size := 1024;
 
      //***** Parametres pour décodage ******************
      if BFromFile then
        jcprops.JPGFile := PAnsiChar (JpgFileName);
 
      if BFromStream then
      begin
        SetLength(Buff, JpgStream.Size);
        JpgStream.Read(Buff[1], JpgStream.Size);
 
        with jcprops do
        begin
          JPGFile := nil;
          JPGBytes := PByte(Buff);
          JPGSizeBytes := JpgStream.Size;
        end;
      end;
      //*************************************************
 
      iStatus := ijlRead (@jcprops, IJL_JFILE_READPARAMS);
      if iStatus = IJL_OK then
        begin
        iWidth := jcprops.JPGWidth;
        iHeight := jcprops.JPGHeight;
        GetScaleSize(iWidth, iHeight, FScale);
 
        case jcprops.JPGChannels of
          1:
            begin
              jcprops.JPGColor    := IJL_G;
              jcprops.DIBChannels := 3;
              jcprops.DIBColor    := IJL_BGR;
            end;
 
          3:
            begin
              jcprops.JPGColor    := IJL_YCBCR;
              jcprops.DIBChannels := 3;
              jcprops.DIBColor    := IJL_BGR;
            end;
 
          4:
            begin
              jcprops.JPGColor    := IJL_YCBCRA_FPX;
              jcprops.DIBChannels := 4;
              jcprops.DIBColor    := IJL_RGBA_FPX;
            end;
          else
            begin
              jcprops.DIBColor := TIJL_COLOR(IJL_OTHER);
              jcprops.JPGColor := TIJL_COLOR(IJL_OTHER);
              jcprops.DIBChannels := jcprops.JPGChannels;
            end;
        end;
 
        with FBitmap do
        begin
          if jcprops.DIBChannels = 1 then
            PixelFormat := pf8Bit
          else
            PixelFormat := pf24Bit;
 
          Width := iWidth;
          Height := iHeight;
        end;
 
        Width := iWidth;
        Height := iHeight;
 
        FillChar (DIB, SizeOf (DIB), 0);
        iStatus := GetObject (FBitmap.Handle, SizeOf (DIB), @DIB);
        if iStatus <> 0 then
        begin
          with jcprops do
          begin
            DIBWidth := iWidth;
            DIBHeight := -iHeight;
            DIBPadBytes := IJL_DIB_PAD_BYTES(jcprops.DIBWidth, jcprops.DIBChannels);
            DIBBytes := PByte (DIB.dsBm.bmBits);
          end;
 
          if BFromFile then
          begin
            case FScale of
              jsHalf: iStatus := ijlRead (@jcprops, IJL_JFILE_READONEHALF);
              jsQuarter: iStatus := ijlRead (@jcprops, IJL_JFILE_READONEQUARTER);
              jsEighth: iStatus := ijlRead (@jcprops, IJL_JFILE_READONEEIGHTH);
            else
              iStatus := ijlRead (@jcprops, IJL_JFILE_READWHOLEIMAGE);
            end;
          end;
 
          if BFromStream then
          begin
            case FScale of
              jsHalf: iStatus := ijlRead (@jcprops, IJL_JBUFF_READONEHALF);
              jsQuarter: iStatus := ijlRead (@jcprops, IJL_JBUFF_READONEQUARTER);
              jsEighth: iStatus := ijlRead (@jcprops, IJL_JBUFF_READONEEIGHTH);
            else
              iStatus := ijlRead (@jcprops, IJL_JBUFF_READWHOLEIMAGE);
            end;
          end;
 
          if iStatus >= 0 then
            FBitmap.Modified := True;
 
          SetLength(FComment, Length(FComment));
        end;
      end;
 
      if iStatus <> IJL_OK then
      begin
        if BFromFile then
          raise (EReadError.Create ('Error reading JPEG from file'));
 
        if BFromStream then
          raise (EReadError.Create ('Error reading JPEG from stream'));
      end;
 
    finally
      ijlFree (@jcprops);
    end;
  end;
 
  Decoded := True;
  BFromFile := False;
  BFromStream := False;
  JpgFileName := '';
  if BFromStream then
    JpgStream.Free;
end;
 
destructor TIJpeg.Destroy;
begin
  if FBitmap <> nil then
  begin
 
    if FBitmap.Palette <> 0 then
      DeleteObject(FBitmap.Palette);
    FBitmap.Free;
  end;
 
  inherited Destroy;
end;
 
procedure TIJpeg.Draw(ACanvas: TCanvas; const ARect: TRect);
begin
  if not Decoded and FDecodeBeforePaint then
    Decode;
 
  if FBitmap <> nil then
    ACanvas.StretchDraw(ARect, FBitmap);
end;
 
function TIJpeg.Equals(Graphic: TGraphic): Boolean;
begin
  if FBitmap = nil then
    Result := Graphic = nil
  else
    Result := (Graphic is TIJpeg) and (FBitmap = TIJpeg(TIJpeg).FBitmap);
end;
 
function TIJpeg.GetEmpty: Boolean;
begin
  Result := FBitmap = nil;
end;
 
function TIJpeg.GetHeight: Integer;
begin
  if FBitmap <> nil then
    Result := FBitmap.Height
  else
    Result := -1;
end;
 
function TIJpeg.GetPalette: HPALETTE;
begin
  if FBitmap <> nil then
    Result := FBitmap.Palette
  else
    Result := 0;
end;
 
function TIJpeg.GetTransparent: Boolean;
begin
  if FBitmap <> nil then
    Result := FBitmap.Transparent
  else
    Result := False;
end;
 
function TIJpeg.GetWidth: Integer;
begin
  if FBitmap <> nil then
    Result := FBitmap.Width
  else
    Result := -1;
end;
 
procedure TIJpeg.LoadFromClipboardFormat(AFormat: Word; AData: THandle;
  APalette: HPALETTE);
begin
  if FBitmap <> nil then
    FBitmap.LoadFromClipboardFormat(AFormat, AData, APalette);
end;
 
procedure TIJpeg.LoadFromFile(const FileName: string);
var
  iWidth, iHeight: Integer;
  iStatus: integer;
  jcprops: TJPEG_CORE_PROPERTIES;
begin
  JpgFileName := FileName;
  BFromFile := True;
  BFromStream := False;
 
  if FDecodeBeforePaint then
  begin
    // Initialise the JPEG library
    FillChar (jcprops, SizeOf (jcprops), 0);  // Just to be sure...
    iStatus := ijlInit (@jcprops);
 
    if iStatus = IJL_OK then
    try
      SetLength(FComment, 1024);
      jcprops.jprops.jpeg_comment := PChar(FComment);
      jcprops.jprops.jpeg_comment_size := 1024;
 
      jcprops.JPGFile := PAnsiChar(JpgFileName);
      iStatus := ijlRead (@jcprops, IJL_JFILE_READPARAMS);
      if iStatus = IJL_OK then
      begin
        iWidth := jcprops.JPGWidth;
        iHeight := jcprops.JPGHeight;
        GetScaleSize(iWidth, iHeight, FScale);
 
        Width := iWidth;
        Height := iHeight;
 
        SetLength(FComment, Length(FComment));
      end;
 
    finally
      ijlFree (@jcprops);
    end;
  end
  else
    Decode;
end;
 
procedure TIJpeg.LoadFromResourceID(Instance: THandle; ResID: Integer;
  ResType: PChar);
var
  Stream: TStream;
begin
  Stream := TResourceStream.CreateFromID(Instance, ResId, ResType);
  Self.LoadFromStream(Stream);
  Stream.Free;
end;
 
procedure TIJpeg.LoadFromResourceName(Instance: THandle;
  const ResName: AnsiString; ResType: PChar);
var
  Stream: TStream;
begin
  Stream := TResourceStream.Create(Instance, ResName, ResType);
  Self.LoadFromStream(Stream);
  Stream.Free;
end;
 
procedure TIJpeg.LoadFromStream(Stream: TStream);
var
  iWidth, iHeight: Integer;
  iStatus: integer;
  jcprops: TJPEG_CORE_PROPERTIES;
  Buff: AnsiString;
begin
  BFromStream := True;
  BFromFile := False;
  JpgStream := TStream.Create;
 
  if FDecodeBeforePaint then
    begin
    // Initialise the JPEG library
    FillChar (jcprops, SizeOf (jcprops), 0);  // Just to be sure...
    iStatus := ijlInit (@jcprops);
 
    if iStatus = IJL_OK then
    try
      SetLength(Buff, Stream.Size);
      Stream.Read(Buff[1], Stream.Size);
 
      with jcprops do
      begin
        JPGFile := nil;
        JPGBytes := PByte(Buff);
        JPGSizeBytes := Stream.Size;
      end;
 
      jcprops.jprops.jpeg_comment := PChar(FComment);
      jcprops.jprops.jpeg_comment_size := 1024;
 
      iStatus := ijlRead(@jcprops, IJL_JBUFF_READPARAMS);
      if iStatus = IJL_OK then
      begin
        iWidth := jcprops.JPGWidth;
        iHeight := jcprops.JPGHeight;
        GetScaleSize(iWidth, iHeight, FScale);
 
        Width := iWidth;
        Height := iHeight;
 
        SetLength(FComment, Length(FComment));
      end;
    finally
      ijlFree (@jcprops);
    end;
  end
  else
    Decode;
end;
 
procedure TIJpeg.SaveToClipboardFormat(var AFormat: Word;
  var AData: THandle; var APalette: HPALETTE);
begin
  if FBitmap <> nil then
    FBitmap.SaveToClipboardFormat(AFormat, AData, APalette);
end;
 
procedure TIJpeg.SaveToFile(const FileName: string);
var
  jcprops : TJPEG_CORE_PROPERTIES;
  iWidth, iHeight, iNChannels : Integer;
  iStatus, err: integer;
  DIB: TDIBSection;
  B: Boolean;
begin
  if not Decoded then
    Decode;
 
  B := True;
  FBitmap.PixelFormat := pf24bit;
  // Initialise the JPEG library
  FillChar (jcprops, SizeOf (jcprops), 0);  // Just to be sure...
  iStatus := ijlInit (@jcprops);
 
  if iStatus = IJL_OK then
  try
    FillChar (DIB, SizeOf(DIB), 0);
    GetObject (FBitmap.Handle, SizeOf (DIB), @DIB);
    iWidth  := DIB.dsBm.bmWidth;
    iHeight := DIB.dsBm.bmHeight;
    case FPixelFormat of
      jf8bit: iNChannels := 1;
      jf24bit: iNChannels := 3;
    else
      Raise EInvalidOperation.Create ('Cannot save bitmap as JPEG with specified PixelFormat');
    end;
 
    with jcprops do
    begin
      DIBWidth := iWidth;
      DIBHeight := -iHeight;
      DIBChannels := iNChannels;
      case FPixelFormat of
        jf8bit: DIBColor := IJL_G;
        jf24bit: DIBColor := IJL_BGR;
      end;
      DIBPadBytes := IJL_DIB_PAD_BYTES(jcprops.DIBWidth,jcprops.DIBChannels);
      DIBBytes := PByte (DIB.dsBm.bmBits);
 
      JPGFile := PAnsiChar(AnsiString(FileName));
 
      JPGWidth := iWidth;
      JPGHeight := iHeight;
      JPGChannels := 3;
      JPGColor := IJL_YCBCR;
      jquality := CompressionQuality;
 
      jprops.jpeg_comment_size := Length(FComment) + 1;
      jprops.jpeg_comment := PChar(FComment);
 
      if FProgressiveEncoding then
        jprops.progressive_found := 1;
    end;
 
    err := ijlWrite (@jcprops, IJL_JFILE_WRITEWHOLEIMAGE);
    B := IJL_OK = err;
 
    ijlFree (@jcprops);
  except
  end;
 
  if not B then
    raise (EWriteError.Create ('Error writing JPEG to file. ' + ijlErrorStr(Err)));
end;
 
procedure TIJpeg.SaveToStream(Stream: TStream);
var
  jcprops : TJPEG_CORE_PROPERTIES;
  iWidth, iHeight, iNChannels : Integer;
  iStatus: Integer;
  B: Boolean;
  Buff: AnsiString;
  BufSize: Integer;
  Err: Integer;
  DIB: TDIBSection;
begin
  if not Decoded then
    Decode;
 
  B := True;
 
  FBitmap.PixelFormat := pf24bit;
  // Initialise the JPEG library
  FillChar (jcprops, SizeOf (jcprops), 0);  // Just to be sure...
  iStatus := ijlInit (@jcprops);
 
  if iStatus = IJL_OK then
  try
    FillChar (DIB, SizeOf(DIB), 0);
    GetObject (FBitmap.Handle, SizeOf (DIB), @DIB);
    iWidth  := DIB.dsBm.bmWidth;
    iHeight := DIB.dsBm.bmHeight;
 
    BufSize := iWidth * iHeight * 3;
    SetLength(Buff, BufSize);
 
    case FPixelFormat of
      jf8bit: iNChannels := 1;
      jf24bit: iNChannels := 3;
    else
      Raise EInvalidOperation.Create ('Cannot save bitmap as JPEG with specified PixelFormat');
    end;
 
    with jcprops do
    begin
      DIBWidth := iWidth;
      DIBHeight := -iHeight;
      DIBBytes := PByte (DIB.dsBm.bmBits);;
      DIBChannels := iNChannels;
      case FPixelFormat of
        jf8bit: DIBColor := IJL_G;
        jf24bit: DIBColor := IJL_BGR;
      end;
      DIBPadBytes := IJL_DIB_PAD_BYTES(jcprops.DIBWidth, jcprops.DIBChannels);
 
      JPGWidth := iWidth;
      JPGHeight := iHeight;
      JPGFile := nil;
      JPGBytes := PByte(Buff);
      JPGSizeBytes := BufSize;
      JPGChannels := 3;
      JPGColor := IJL_YCBCR;
      //JPGSubsampling := IJL_411;
      jquality := CompressionQuality;
 
      jprops.jpeg_comment_size := Length(FComment) + 1;
      jprops.jpeg_comment := PChar(FComment);
 
      if FProgressiveEncoding then
        jprops.progressive_found := 1;
    end;
 
    Err := ijlWrite (@jcprops, IJL_JBUFF_WRITEWHOLEIMAGE);
    B := IJL_OK = Err;
 
    if B then
      Stream.Write(Buff[1], BufSize);
 
    ijlFree (@jcprops);
  except
  end;
 
  if not B then
    raise (EWriteError.Create ('Error writing JPEG to stream. ' + ijlErrorStr(Err)));
end;
 
procedure TIJpeg.SetHeight(Value: Integer);
begin
  if FBitmap <> nil then
  begin
    FBitmap.Height := Value;
    Changed(Self);
  end;
end;
 
procedure TIJpeg.SetScale(const Value: TJPEGScale);
var
  tmpWidth, tmpHeight: Integer;
begin
  FScale := Value;
  if FDecodeBeforePaint then
  begin
    tmpWidth := Width;
    tmpHeight := Height;
    GetScaleSize(tmpWidth, tmpHeight, FScale);
    Width := tmpWidth;
    Height := tmpHeight;
  end;
end;
 
procedure TIJpeg.SetWidth(Value: Integer);
begin
  if FBitmap <> nil then
  begin
    FBitmap.Width := Value;
    Changed(Self);
  end;
end;
 
procedure TIJpeg.WriteData(Stream: TStream);
begin
  SaveToStream(Stream);
end;
 
procedure TIJpeg.GetScaleSize(var iWidth: Integer; var iHeight: Integer; S: TJPEGScale);
begin
  case S of
    jsHalf: begin
             iWidth := (iWidth + 1) shr 1;
             iHeight := (iHeight + 1) shr 1;
             end;
    jsQuarter: begin
             iWidth := (iWidth + 3) shr 2;
             iHeight := (iHeight + 3) shr 2;
             end;
    jsEighth: begin
             iWidth := (iWidth + 7) shr 3;
             iHeight := (iHeight + 7) shr 3;
             end;
  end;
end;
 
{**************************************************}
 
initialization
  RegisterClass(TIJpeg);
  TPicture.RegisterFileFormat('jpg', 'JPEG Image', TIJpeg);
 
finalization
  TPicture.UnRegisterGraphicClass(TIJpeg);
 
end.

**ALEX77** · 20/08/2012, 18h50

et enfin l'unité ijl.pas

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
unit IJL;
{$Z+,A+}
//Caution! It must be 8-byte alignment structures.
 
{
 Description: This file contains:  definitions for data types, data
              structures, error codes, and function prototypes used
              in the Intel(R) JPEG Library (IJLib).
 
 Version:     1.51
}
 
interface
 
uses
  Windows;
 
type
  PShort = ^Short;
  IJL_INT64  = TLargeInteger;
  IJL_UINT64 = TULargeInteger;
 
{
 Macros/Constants
}
 
const
  IJL_NONE  = 0;
  IJL_OTHER = 255;
  JBUFSIZE  = 4096;    // Size of file I/O buffer (4K).
  IJL_DIB_ALIGN = SizeOf(Integer) - 1;
 
function IJL_DIB_UWIDTH(width: Integer; nchannels: Integer): Integer;
function IJL_DIB_AWIDTH(width: Integer; nchannels: Integer): Integer;
function IJL_DIB_PAD_BYTES(width: Integer; nchannels: Integer): Integer;
 
////////////////////////////////////////////////////////////////////////////
// Name:        IJLibVersion
//
// Purpose:     Stores library version info.
//
// Context:
//
// Fields:
//  major           -
//  minor           -
//  build           -
//  Name            -
//  Version         -
//  InternalVersion -
//  BuildDate       -
//  CallConv        -
//
////////////////////////////////////////////////////////////////////////////
 
type
  PIJLibVersion = ^TIJLibVersion;
  TIJLibVersion = record
    Major           : Integer;
    Minor           : Integer;
    Build           : Integer;
    Name            : PChar;
    Version         : PChar;
    InternalVersion : PChar;
    BuildDate       : PChar;
    CallConv        : PChar;
  end;
 
 
////////////////////////////////////////////////////////////////////////////
// Name:        IJL_RECT
//
// Purpose:     Keep coordinates for rectangle region of image
//
// Context:     Used to specify roi
//
// Fields:
//
////////////////////////////////////////////////////////////////////////////
 
  PIJL_RECT = ^TIJL_RECT;
  TIJL_RECT = record
    Left   : Longint;
    Top    : Longint;
    Right  : Longint;
    Bottom : Longint;
  end;
 
////////////////////////////////////////////////////////////////////////////
// Name:        IJL_HANDLE
//
// Purpose:     file handle
//
// Context:     used internally
//
// Fields:
//
////////////////////////////////////////////////////////////////////////////
 
  TIJL_HANDLE = Pointer;
 
{
 Name:        IJLIOTYPE
 
 Purpose:     Possible types of data read/write/other operations to be
              performed by the functions IJL_Read and IJL_Write.
 
              See the Developer's Guide for details on appropriate usage.
 
 Fields:
 
  IJL_JFILE_XXXXXXX   Indicates JPEG data in a stdio file.
 
  IJL_JBUFF_XXXXXXX   Indicates JPEG data in an addressable buffer.
}
 
const
  IJL_SETUP = -1;
type
  TIJLIOType = (
    // Read JPEG parameters (i.e., height, width, channels, sampling, etc.)
    // from a JPEG bit stream.
    IJL_JFILE_READPARAMS,      //    =  0
    IJL_JBUFF_READPARAMS,      //    =  1
 
    // Read a JPEG Interchange Format image.
    IJL_JFILE_READWHOLEIMAGE,  //    =  2
    IJL_JBUFF_READWHOLEIMAGE,  //    =  3
 
    // Read JPEG tables from a JPEG Abbreviated Format bit stream.
    IJL_JFILE_READHEADER,      //    =  4,
    IJL_JBUFF_READHEADER,      //    =  5,
 
    // Read image info from a JPEG Abbreviated Format bit stream.
    IJL_JFILE_READENTROPY,     //    =  6
    IJL_JBUFF_READENTROPY,     //    =  7
 
    // Write an entire JFIF bit stream.
    IJL_JFILE_WRITEWHOLEIMAGE, //    =  8
    IJL_JBUFF_WRITEWHOLEIMAGE, //    =  9
 
    // Write a JPEG Abbreviated Format bit stream.
    IJL_JFILE_WRITEHEADER,     //    = 10
    IJL_JBUFF_WRITEHEADER,     //    = 11
 
    // Write image info to a JPEG Abbreviated Format bit stream.
    IJL_JFILE_WRITEENTROPY,    //    = 12
    IJL_JBUFF_WRITEENTROPY,    //    = 13
 
 
    // Scaled Decoding Options:
 
    // Reads a JPEG image scaled to 1/2 size.
    IJL_JFILE_READONEHALF,     //    = 14
    IJL_JBUFF_READONEHALF,     //    = 15
 
    // Reads a JPEG image scaled to 1/4 size.
    IJL_JFILE_READONEQUARTER,  //    = 16
    IJL_JBUFF_READONEQUARTER,  //    = 17
 
    // Reads a JPEG image scaled to 1/8 size.
    IJL_JFILE_READONEEIGHTH,   //    = 18
    IJL_JBUFF_READONEEIGHTH,   //    = 19
 
    // Reads an embedded thumbnail from a JFIF bit stream.
    IJL_JFILE_READTHUMBNAIL,   //    = 20
    IJL_JBUFF_READTHUMBNAIL    //    = 21
    );
 
 
////////////////////////////////////////////////////////////////////////////
// Name:        IJL_COLOR
//
// Purpose:     Possible color space formats.
//
//              Note these formats do *not* necessarily denote
//              the number of channels in the color space.
//              There exists separate "channel" fields in the
//              JPEG_CORE_PROPERTIES data structure specifically
//              for indicating the number of channels in the
//              JPEG and/or DIB color spaces.
//
//              See the Developer's Guide for details on appropriate usage.
//
////////////////////////////////////////////////////////////////////////////
 
  TIJL_COLOR = (
    IJL_PAD1,      // = 0   // Stub for Delphi, enum type start with 0
    IJL_RGB,       // = 1   // Red-Green-Blue color space.
    IJL_BGR,       // = 2   // Reversed channel ordering from IJL_RGB.
    IJL_YCBCR,     // = 3   // Luminance-Chrominance color space as defined
                            // by CCIR Recommendation 601.
    IJL_G,         // = 4   // Grayscale color space.
    IJL_RGBA_FPX,  // = 5   // FlashPix RGB 4 channel color space that
                            // has pre-multiplied opacity.
    IJL_YCBCRA_FPX // = 6   // FlashPix YCbCr 4 channel color space that
                            // has pre-multiplied opacity.
    //IJL_OTHER  = 255      // Some other color space not defined by the IJL.
                            // (This means no color space conversion will
                            //  be done by the IJL.)
    );
 
 
////////////////////////////////////////////////////////////////////////////
// Name:        IJL_JPGSUBSAMPLING
//
// Purpose:     Possible subsampling formats used in the JPEG.
//
//              See the Developer's Guide for details on appropriate usage.
//
////////////////////////////////////////////////////////////////////////////
 
  TIJL_JPGSUBSAMPLING = (
    IJL_PAD2,      // = 0     // Stub for Delphi, enum type start with 0
    IJL_411,       // = 1,    // Valid on a JPEG w/ 3 channels.
    IJL_422,       // = 2,    // Valid on a JPEG w/ 3 channels.
    IJL_4114,      // = 3,    // Valid on a JPEG w/ 4 channels.
    IJL_4224       // = 4     // Valid on a JPEG w/ 4 channels.
    );
 
 
////////////////////////////////////////////////////////////////////////////
// Name:        IJL_DIBSUBSAMPLING
//
// Purpose:     Possible subsampling formats used in the DIB.
//
//              See the Developer's Guide for details on appropriate usage.
//
////////////////////////////////////////////////////////////////////////////
  TIJL_DIBSUBSAMPLING = TIJL_JPGSUBSAMPLING;
 
 
////////////////////////////////////////////////////////////////////////////
// Name:        HUFFMAN_TABLE
//
// Purpose:     Stores Huffman table information in a fast-to-use format.
//
// Context:     Used by Huffman encoder/decoder to access Huffman table
//              data.  Raw Huffman tables are formatted to fit this
//              structure prior to use.
//
// Fields:
//  huff_class  0 == DC Huffman or lossless table, 1 == AC table.
//  ident       Huffman table identifier, 0-3 valid (Extended Baseline).
//  huffelem    Huffman elements for codes <= 8 bits long;
//              contains both zero run-length and symbol length in bits.
//  huffval     Huffman values for codes 9-16 bits in length.
//  mincode     Smallest Huffman code of length n.
//  maxcode     Largest Huffman code of length n.
//  valptr      Starting index into huffval[] for symbols of length k.
//
////////////////////////////////////////////////////////////////////////////
 
  PHUFFMAN_TABLE = ^THUFFMAN_TABLE;
  THUFFMAN_TABLE = record
    huff_class : Integer;
    ident      : Integer;
    huffelem   : array [0..255] of UINT;
    huffval    : array [0..255] of SHORT;
    mincode    : array [0..16]  of SHORT;
    maxcode    : array [0..17]  of SHORT;
    valptr     : array [0..16]  of SHORT;
  end;
 
 
////////////////////////////////////////////////////////////////////////////
// Name:        JPEGHuffTable
//
// Purpose:     Stores pointers to JPEG-binary spec compliant
//              Huffman table information.
//
// Context:     Used by interface and table methods to specify encoder
//              tables to generate and store JPEG images.
//
// Fields:
//  bits        Points to number of codes of length i (<=16 supported).
//  vals        Value associated with each Huffman code.
//  hclass      0 == DC table, 1 == AC table.
//  ident       Specifies the identifier for this table.
//              0-3 for extended JPEG compliance.
//
////////////////////////////////////////////////////////////////////////////
 
  PJPEGHuffTable = ^TJPEGHuffTable;
  TJPEGHuffTable = record
    bits   : PUCHAR;
    vals   : PUCHAR;
    hclass : UCHAR;
    ident  : UCHAR;
  end;
 
 
////////////////////////////////////////////////////////////////////////////
// Name:        QUANT_TABLE
//
// Purpose:     Stores quantization table information in a
//              fast-to-use format.
//
// Context:     Used by quantizer/dequantizer to store formatted
//              quantization tables.
//
// Fields:
//  precision   0 => elements contains 8-bit elements,
//              1 => elements contains 16-bit elements.
//  ident       Table identifier (0-3).
//  elements    Pointer to 64 table elements + 16 extra elements to catch
//              input data errors that may cause malfunction of the
//              Huffman decoder.
//  elarray     Space for elements (see above) plus 8 bytes to align
//              to a quadword boundary.
//
////////////////////////////////////////////////////////////////////////////
 
  PQUANT_TABLE = ^TQUANT_TABLE;
  TQUANT_TABLE = record
    precision : Integer;
    ident     : Integer;
    elements  : PSHORT;
    elarray   : array [0..83] of Short;
  end;
 
 
////////////////////////////////////////////////////////////////////////////
// Name:        JPEGQuantTable
//
// Purpose:     Stores pointers to JPEG binary spec compliant
//              quantization table information.
//
// Context:     Used by interface and table methods to specify encoder
//              tables to generate and store JPEG images.
//
// Fields:
//  quantizer   Zig-zag order elements specifying quantization factors.
//  ident       Specifies identifier for this table.
//              0-3 valid for Extended Baseline JPEG compliance.
//
////////////////////////////////////////////////////////////////////////////
 
  PJPEGQuantTable = ^TJPEGQuantTable;
  TJPEGQuantTable = record
    quantizer : PUCHAR;
    ident     : UCHAR;
  end;
 
 
////////////////////////////////////////////////////////////////////////////
// Name:        FRAME_COMPONENT
//
// Purpose:     One frame-component structure is allocated per component
//              in a frame.
//
// Context:     Used by Huffman decoder to manage components.
//
// Fields:
//  ident       Component identifier.  The tables use this ident to
//              determine the correct table for each component.
//  hsampling   Horizontal subsampling factor for this component,
//              1-4 are legal.
//  vsampling   Vertical subsampling factor for this component,
//              1-4 are legal.
//  quant_sel   Quantization table selector.  The quantization table
//              used by this component is determined via this selector.
//
////////////////////////////////////////////////////////////////////////////
 
  PFRAME_COMPONENT = ^TFRAME_COMPONENT;
  TFRAME_COMPONENT = record
    ident     : Integer;
    hsampling : Integer;
    vsampling : Integer;
    quant_sel : Integer;
  end;
 
 
////////////////////////////////////////////////////////////////////////////
// Name:        FRAME
//
// Purpose:     Stores frame-specific data.
//
// Context:     One Frame structure per image.
//
// Fields:
//  precision       Sample precision in bits.
//  width           Width of the source image in pixels.
//  height          Height of the source image in pixels.
//  MCUheight       Height of a frame MCU.
//  MCUwidth        Width of a frame MCU.
//  max_hsampling   Max horiz sampling ratio of any component in the frame.
//  max_vsampling   Max vert sampling ratio of any component in the frame.
//  ncomps          Number of components/channels in the frame.
//  horMCU          Number of horizontal MCUs in the frame.
//  totalMCU        Total number of MCUs in the frame.
//  comps           Array of 'ncomps' component descriptors.
//  restart_interv  Indicates number of MCUs after which to restart the
//                  entropy parameters.
//  SeenAllDCScans  Used when decoding Multiscan images to determine if
//                  all channels of an image have been decoded.
//  SeenAllACScans  (See SeenAllDCScans)
//
////////////////////////////////////////////////////////////////////////////
 
  PFRAME = ^TFRAME;
  TFRAME = record
    precision      : Integer;
    width          : Integer;
    height         : Integer;
    MCUheight      : Integer;
    MCUwidth       : Integer;
    max_hsampling  : Integer;
    max_vsampling  : Integer;
    ncomps         : Integer;
    horMCU         : Integer;
    totalMCU       : Longint;
    comps          : PFRAME_COMPONENT;
    restart_interv : Integer;
    SeenAllDCScans : Integer;
    SeenAllACScans : Integer;
  end;
 
 
////////////////////////////////////////////////////////////////////////////
// Name:        SCAN_COMPONENT
//
// Purpose:     One scan-component structure is allocated per component
//              of each scan in a frame.
//
// Context:     Used by Huffman decoder to manage components within scans.
//
// Fields:
//  comp        Component number, index to the comps member of FRAME.
//  hsampling   Horizontal sampling factor.
//  vsampling   Vertical sampling factor.
//  dc_table    DC Huffman table pointer for this scan.
//  ac_table    AC Huffman table pointer for this scan.
//  quant_table Quantization table pointer for this scan.
//
////////////////////////////////////////////////////////////////////////////
 
  PSCAN_COMPONENT = ^TSCAN_COMPONENT;
  TSCAN_COMPONENT = record
    comp        : Integer;
    hsampling   : Integer;
    vsampling   : Integer;
    dc_table    : PHUFFMAN_TABLE;
    ac_table    : PHUFFMAN_TABLE;
    quant_table : PQUANT_TABLE;
  end;
 
 
////////////////////////////////////////////////////////////////////////////
// Name:        SCAN
//
// Purpose:     One SCAN structure is allocated per scan in a frame.
//
// Context:     Used by Huffman decoder to manage scans.
//
// Fields:
//  ncomps          Number of image components in a scan, 1-4 legal.
//  gray_scale      If TRUE, decode only the Y channel.
//  start_spec      Start coefficient of spectral or predictor selector.
//  end_spec        End coefficient of spectral selector.
//  approx_high     High bit position in successive approximation
//                  Progressive coding.
//  approx_low      Low bit position in successive approximation
//                  Progressive coding.
//  restart_interv  Restart interval, 0 if disabled.
//  curxMCU         Next horizontal MCU index to be processed after
//                  an interrupted SCAN.
//  curyMCU         Next vertical MCU index to be processed after
//                  an interrupted SCAN.
//  dc_diff         Array of DC predictor values for DPCM modes.
//  comps           Array of ncomps SCAN_COMPONENT component identifiers.
//
////////////////////////////////////////////////////////////////////////////
 
  PSCAN = ^TSCAN;
  TSCAN = record
    ncomps         : Integer;
    gray_scale     : Integer;
    start_spec     : Integer;
    end_spec       : Integer;
    approx_high    : Integer;
    approx_low     : Integer;
    restart_interv : UINT;
    curxMCU        : DWORD;
    curyMCU        : DWORD;
    dc_diff        : array [0..3] of Integer;
    comps          : PSCAN_COMPONENT;
  end;
 
 
////////////////////////////////////////////////////////////////////////////
// Name:        DCTTYPE
//
// Purpose:     Possible algorithms to be used to perform the discrete
//              cosine transform (DCT).
//
// Fields:
//  IJL_AAN     The AAN (Arai, Agui, and Nakajima) algorithm from
//              Trans. IEICE, vol. E 71(11), 1095-1097, Nov. 1988.
//  IJL_IPP     The modified K. R. Rao and P. Yip algorithm from
//              Intel Performance Primitives Library
//
////////////////////////////////////////////////////////////////////////////
 
  TDCTTYPE = (
    IJL_AAN,   // = 0
    IJL_IPP    // = 1
  );
 
 
////////////////////////////////////////////////////////////////////////////
// Name:        UPSAMPLING_TYPE
//
// Purpose:            -  Possible algorithms to be used to perform upsampling
//
// Fields:
//  IJL_BOX_FILTER      - the algorithm is simple replication of the input pixel
//                        onto the corresponding output pixels (box filter);
//  IJL_TRIANGLE_FILTER - 3/4 * nearer pixel + 1/4 * further pixel in each
//                        dimension
////////////////////////////////////////////////////////////////////////////
 
  TUPSAMPLING_TYPE = (
    IJL_BOX_FILTER,     // = 0
    IJL_TRIANGLE_FILTER // = 1
  );
 
 
////////////////////////////////////////////////////////////////////////////
// Name:        SAMPLING_STATE
//
// Purpose:     Stores current conditions of sampling. Only for upsampling
//              with triangle filter is used now.
//
// Fields:
//  top_row        - pointer to buffer with MCUs, that are located above than
//                   current row of MCUs;
//  cur_row        - pointer to buffer with current row of MCUs;
//  bottom_row     - pointer to buffer with MCUs, that are located below than
//                   current row of MCUs;
//  last_row       - pointer to bottom boundary of last row of MCUs
//  cur_row_number - number of row of MCUs, that is decoding;
//  user_interrupt - field to store jprops->interrupt, because of we prohibit
//                   interrupts while top row of MCUs is upsampling.
////////////////////////////////////////////////////////////////////////////
 
  PSAMPLING_STATE = ^TSAMPLING_STATE;
  TSAMPLING_STATE = record
    top_row        : PShort;
    cur_row        : PShort;
    bottom_row     : PShort;
    last_row       : PShort;
    cur_row_number : Integer;
  end;
 
 
////////////////////////////////////////////////////////////////////////////
// Name:        PROCESSOR_TYPE
//
// Purpose:     Possible types of processors.
//              Note that the enums are defined in ascending order
//              depending upon their various IA32 instruction support.
//
// Fields:
//
// IJL_OTHER_PROC
//      Does not support the CPUID instruction and
//      assumes no Pentium(R) processor instructions.
//
// IJL_PENTIUM_PROC
//      Corresponds to an Intel(R) Pentium processor
//      (or a 100% compatible) that supports the
//      Pentium processor instructions.
//
// IJL_PENTIUM_PRO_PROC
//      Corresponds to an Intel Pentium Pro processor
//      (or a 100% compatible) that supports the
//      Pentium Pro processor instructions.
//
// IJL_PENTIUM_PROC_MMX_TECH
//      Corresponds to an Intel Pentium processor
//      with MMX(TM) technology (or a 100% compatible)
//      that supports the MMX instructions.
//
// IJL_PENTIUM_II_PROC
//      Corresponds to an Intel Pentium II processor
//      (or a 100% compatible) that supports both the
//      Pentium Pro processor instructions and the
//      MMX instructions.
//
// IJL_PENTIUM_III_PROC
//      Corresponds to an Intel(R) Pentium(R) III processor
//
// IJL_PENTIUM_4_PROC
//      Corresponds to an Intel(R) Pentium(R) 4 processor
//
// IJL_NEW_PROCESSOR
//      Correponds to new processor
//
//  Any additional processor types that support a superset
//  of both the Pentium Pro processor instructions and the
//  MMX instructions should be given an enum value greater
//  than IJL_PENTIUM_4_PROC.
//
////////////////////////////////////////////////////////////////////////////
 
  TPROCESSOR_TYPE = (
    IJL_OTHER_PROC,            // = 0,
    IJL_PENTIUM_PROC,          // = 1,
    IJL_PENTIUM_PRO_PROC,      // = 2,
    IJL_PENTIUM_PROC_MMX_TECH, // = 3,
    IJL_PENTIUM_II_PROC,       // = 4
    IJL_PENTIUM_III_PROC,      // = 5
    IJL_PENTIUM_4_PROC,        // = 6
    IJL_NEW_PROCESSOR          // = 7
  );
 
 
////////////////////////////////////////////////////////////////////////////
// Name:        RAW_DATA_TYPES_STATE
//
// Purpose:     Stores data types: raw dct coefficients or raw sampled data.
//              Pointer to structure in JPEG_PROPERTIES is NULL, if any raw
//              data isn't request (DIBBytes!=NULL).
//
// Fields:
//  short* raw_ptrs[4] - pointers to buffers with raw data; one pointer
//                       corresponds one JPG component;
//  data_type          - 0 - raw dct coefficients, 1 - raw sampled data.
////////////////////////////////////////////////////////////////////////////
 
  PRAW_DATA_TYPES_STATE = ^TRAW_DATA_TYPES_STATE;
  TRAW_DATA_TYPES_STATE = record
    data_type      : Integer;
    raw_ptrs       : array [0..3] of PShort;
  end;
 
 
////////////////////////////////////////////////////////////////////////////
// Name:        ENTROPYSTRUCT
//
// Purpose:     Stores the decoder state information necessary to "jump"
//              to a particular MCU row in a compressed entropy stream.
//
// Context:     Used to persist the decoder state within Decode_Scan when
//              decoding using ROIs.
//
// Fields:
//      offset              Offset (in bytes) into the entropy stream
//                          from the beginning.
//      dcval1              DC val at the beginning of the MCU row
//                          for component 1.
//      dcval2              DC val at the beginning of the MCU row
//                          for component 2.
//      dcval3              DC val at the beginning of the MCU row
//                          for component 3.
//      dcval4              DC val at the beginning of the MCU row
//                          for component 4.
//      bit_buffer_64       64-bit Huffman bit buffer.  Stores current
//                          bit buffer at the start of a MCU row.
//                          Also used as a 32-bit buffer on 32-bit
//                          architectures.
//      bitbuf_bits_valid   Number of valid bits in the above bit buffer.
//      unread_marker       Have any markers been decoded but not
//                          processed at the beginning of a MCU row?
//                          This entry holds the unprocessed marker, or
//                          0 if none.
//
////////////////////////////////////////////////////////////////////////////
 
  PENTROPYSTRUCT = ^TENTROPYSTRUCT;
  TENTROPYSTRUCT = record
    offset            : DWORD;
    dcval1            : Integer;
    dcval2            : Integer;
    dcval3            : Integer;
    dcval4            : Integer;
    bit_buffer_64     : IJL_UINT64;
    bitbuf_bits_valid : Integer;
    unread_marker     : Byte;
  end;
 
 
////////////////////////////////////////////////////////////////////////////
// Name:        STATE
//
// Purpose:     Stores the active state of the IJL.
//
// Context:     Used by all low-level routines to store pseudo-global or
//              state variables.
//
// Fields:
//      bit_buffer_64           64-bit bitbuffer utilized by Huffman
//                              encoder/decoder algorithms utilizing routines
//                              designed for MMX(TM) technology.
//      bit_buffer_32           32-bit bitbuffer for all other Huffman
//                              encoder/decoder algorithms.
//      bitbuf_bits_valid       Number of bits in the above two fields that
//                              are valid.
//
//      cur_entropy_ptr         Current position (absolute address) in
//                              the entropy buffer.
//      start_entropy_ptr       Starting position (absolute address) of
//                              the entropy buffer.
//      end_entropy_ptr         Ending position (absolute address) of
//                              the entropy buffer.
//      entropy_bytes_processed Number of bytes actually processed
//                              (passed over) in the entropy buffer.
//      entropy_buf_maxsize     Max size of the entropy buffer.
//      entropy_bytes_left      Number of bytes left in the entropy buffer.
//      Prog_EndOfBlock_Run     Progressive block run counter.
//
//      DIB_ptr                 Temporary offset into the input/output DIB.
//
//      unread_marker           If a marker has been read but not processed,
//                              stick it in this field.
//      processor_type          (0, 1, or 2) == current processor does not
//                              support MMX(TM) instructions.
//                              (3 or 4) == current processor does
//                              support MMX(TM) instructions.
//      cur_scan_comp           On which component of the scan are we working?
//      file                    Process file handle, or
//                              0x00000000 if no file is defined.
//      JPGBuffer               Entropy buffer (~4K).
//
//
////////////////////////////////////////////////////////////////////////////
 
  PSTATE = ^TSTATE;
  TSTATE = record
    // Bit buffer.
    bit_buffer_64     : IJL_UINT64;
    bit_buffer_32     : DWORD;
    bitbuf_bits_valid : Integer;
 
    // Entropy.
    cur_entropy_ptr         : PByte;
    start_entropy_ptr       : PByte;
    end_entropy_ptr         : PByte;
    entropy_bytes_processed : Longint;
    entropy_buf_maxsize     : Longint;
    entropy_bytes_left      : Integer;
    Prog_EndOfBlock_Run     : Integer;
 
    // Input or output DIB.
    DIB_ptr        : PByte;
 
    unread_marker  : Byte;
    processor_type : TPROCESSOR_TYPE;
    cur_scan_comp  : Integer;
    hFile          : TIJL_HANDLE; //THandle;
    JPGBuffer      : array [0..JBUFSIZE-1] of Byte;
  end;
 
 
////////////////////////////////////////////////////////////////////////////
// Name:        FAST_MCU_PROCESSING_TYPE
//
// Purpose:     Advanced Control Option.  Do NOT modify.
//              WARNING:  Used for internal reference only.
//
// Fields:
//
//   IJL_(sampling)_(JPEG color space)_(sampling)_(DIB color space)
//      Decode is read left to right w/ upsampling.
//      Encode is read right to left w/ subsampling.
//
////////////////////////////////////////////////////////////////////////////
 
  TFAST_MCU_PROCESSING_TYPE = (
    IJL_NO_CC_OR_US,                   //  = 0,
 
    IJL_111_YCBCR_111_RGB,             //  = 1,
    IJL_111_YCBCR_111_BGR,             //  = 2,
 
    IJL_411_YCBCR_111_RGB,             //  = 3,
    IJL_411_YCBCR_111_BGR,             //  = 4,
 
    IJL_422_YCBCR_111_RGB,             //  = 5,
    IJL_422_YCBCR_111_BGR,             //  = 6,
 
    IJL_111_YCBCR_1111_RGBA_FPX,       //  = 7,
    IJL_411_YCBCR_1111_RGBA_FPX,       //  = 8,
    IJL_422_YCBCR_1111_RGBA_FPX,       //  = 9,
 
    IJL_1111_YCBCRA_FPX_1111_RGBA_FPX, //  = 10,
    IJL_4114_YCBCRA_FPX_1111_RGBA_FPX, //  = 11,
    IJL_4224_YCBCRA_FPX_1111_RGBA_FPX, //  = 12,
 
    IJL_111_RGB_1111_RGBA_FPX,         //  = 13,
 
    IJL_1111_RGBA_FPX_1111_RGBA_FPX,   //  = 14
 
    IJL_111_OTHER_111_OTHER,           //  = 15,
    IJL_411_OTHER_111_OTHER,           //  = 16,
    IJL_422_OTHER_111_OTHER,           //  = 17,
 
    IJL_YCBYCR_YCBCR,                  //  = 18, encoding from YCbCr 422 format
 
    IJL_YCBCR_YCBYCR                   //  = 19  decoding to YCbCr 422 format
 
  );
 
 
////////////////////////////////////////////////////////////////////////////
// Name:        JPEG_PROPERTIES
//
// Purpose:     Stores low-level and control information.  It is used by
//              both the encoder and decoder.  An advanced external user
//              may access this structure to expand the interface
//              capability.
//
//              See the Developer's Guide for an expanded description
//              of this structure and its use.
//
// Context:     Used by all interface methods and most IJL routines.
//
// Fields:
//
//  iotype              IN:     Specifies type of data operation
//                              (read/write/other) to be
//                              performed by IJL_Read or IJL_Write.
//  roi                 IN:     Rectangle-Of-Interest to read from, or
//                              write to, in pixels.
//  dcttype             IN:     DCT alogrithm to be used.
//  fast_processing     OUT:    Supported fast pre/post-processing path.
//                              This is set by the IJL.
//  interrupt           IN:     Signals an interrupt has been requested.
//
//  DIBBytes            IN:     Pointer to buffer of uncompressed data.
//  DIBWidth            IN:     Width of uncompressed data.
//  DIBHeight           IN:     Height of uncompressed data.
//  DIBPadBytes         IN:     Padding (in bytes) at end of each
//                              row in the uncompressed data.
//  DIBChannels         IN:     Number of components in the
//                              uncompressed data.
//  DIBColor            IN:     Color space of uncompressed data.
//  DIBSubsampling      IN:     Required to be IJL_NONE.
//  DIBLineBytes        OUT:    Number of bytes in an output DIB line
//                              including padding.
//
//  JPGFile             IN:     Pointer to file based JPEG.
//  JPGBytes            IN:     Pointer to buffer based JPEG.
//  JPGSizeBytes        IN:     Max buffer size. Used with JPGBytes.
//                      OUT:    Number of compressed bytes written.
//  JPGWidth            IN:     Width of JPEG image.
//                      OUT:    After reading (except READHEADER).
//  JPGHeight           IN:     Height of JPEG image.
//                      OUT:    After reading (except READHEADER).
//  JPGChannels         IN:     Number of components in JPEG image.
//                      OUT:    After reading (except READHEADER).
//  JPGColor            IN:     Color space of JPEG image.
//  JPGSubsampling      IN:     Subsampling of JPEG image.
//                      OUT:    After reading (except READHEADER).
//  JPGThumbWidth       OUT:    JFIF embedded thumbnail width [0-255].
//  JPGThumbHeight      OUT:    JFIF embedded thumbnail height [0-255].
//
//  cconversion_reqd    OUT:    If color conversion done on decode, TRUE.
//  upsampling_reqd     OUT:    If upsampling done on decode, TRUE.
//  jquality            IN:     [0-100] where highest quality is 100.
//  jinterleaveType     IN/OUT: 0 => MCU interleaved file, and
//                              1 => 1 scan per component.
//  numxMCUs            OUT:    Number of MCUs in the x direction.
//  numyMCUs            OUT:    Number of MCUs in the y direction.
//
//  nqtables            IN/OUT: Number of quantization tables.
//  maxquantindex       IN/OUT: Maximum index of quantization tables.
//  nhuffActables       IN/OUT: Number of AC Huffman tables.
//  nhuffDctables       IN/OUT: Number of DC Huffman tables.
//  maxhuffindex        IN/OUT: Maximum index of Huffman tables.
//  jFmtQuant           IN/OUT: Formatted quantization table info.
//  jFmtAcHuffman       IN/OUT: Formatted AC Huffman table info.
//  jFmtDcHuffman       IN/OUT: Formatted DC Huffman table info.
//
//  jEncFmtQuant        IN/OUT: Pointer to one of the above, or
//                              to externally persisted table.
//  jEncFmtAcHuffman    IN/OUT: Pointer to one of the above, or
//                              to externally persisted table.
//  jEncFmtDcHuffman    IN/OUT: Pointer to one of the above, or
//                              to externally persisted table.
//
//  use_external_qtables IN:    Set to default quantization tables.
//                              Clear to supply your own.
//  use_external_htables IN:    Set to default Huffman tables.
//                              Clear to supply your own.
//  rawquanttables      IN:     Up to 4 sets of quantization tables.
//  rawhufftables       IN:     Alternating pairs (DC/AC) of up to 4
//                              sets of raw Huffman tables.
//  HuffIdentifierAC    IN:     Indicates what channel the user-
//                              supplied Huffman AC tables apply to.
//  HuffIdentifierDC    IN:     Indicates what channel the user-
//                              supplied Huffman DC tables apply to.
//
//  jframe              OUT:    Structure with frame-specific info.
//  needframe           OUT:    TRUE when a frame has been detected.
//
//  jscan               Persistence for current scan pointer when
//                      interrupted.
//
//  state               OUT:    Contains info on the state of the IJL.
//  SawAdobeMarker      OUT:    Decoder saw an APP14 marker somewhere.
//  AdobeXform          OUT:    If SawAdobeMarker TRUE, this indicates
//                              the JPEG color space given by that marker.
//
//  rowoffsets          Persistence for the decoder MCU row origins
//                      when decoding by ROI.  Offsets (in bytes
//                      from the beginning of the entropy data)
//                      to the start of each of the decoded rows.
//                      Fill the offsets with -1 if they have not
//                      been initalized and NULL could be the
//                      offset to the first row.
//
//  MCUBuf              OUT:    Quadword aligned internal buffer.
//                              Big enough for the largest MCU
//                              (10 blocks) with extra room for
//                              additional operations.
//  tMCUBuf             OUT:    Version of above, without alignment.
//
//  processor_type      OUT:    Determines type of processor found
//                              during initialization.
//
//  raw_coefs           IN:     Place to hold pointers to raw data buffers or
//                              raw DCT coefficients buffers
//
//  progressive_found   OUT:    1 when progressive image detected.
//  coef_buffer         IN:     Pointer to a larger buffer containing
//                              frequency coefficients when they
//                              cannot be decoded dynamically
//                              (i.e., as in progressive decoding).
//
//  upsampling_type     IN:     Type of sampling:
//                              IJL_BOX_FILTER or IJL_TRIANGLE_FILTER.
//  SAMPLING_STATE*    OUT:     pointer to structure, describing current
//                              condition of upsampling
//
//  AdobeVersion       OUT      version field, if Adobe APP14 marker detected
//  AdobeFlags0        OUT      flags0 field, if Adobe APP14 marker detected
//  AdobeFlags1        OUT      flags1 field, if Adobe APP14 marker detected
//
//  jfif_app0_detected OUT:     1 - if JFIF APP0 marker detected,
//                              0 - if not
//  jfif_app0_version  IN/OUT   The JFIF file version
//  jfif_app0_units    IN/OUT   units for the X and Y densities
//                              0 - no units, X and Y specify
//                                  the pixel aspect ratio
//                              1 - X and Y are dots per inch
//                              2 - X and Y are dots per cm
//  jfif_app0_Xdensity IN/OUT   horizontal pixel density
//  jfif_app0_Ydensity IN/OUT   vertical pixel density
//
//  jpeg_comment       IN       pointer to JPEG comments
//  jpeg_comment_size  IN/OUT   size of JPEG comments, in bytes
//
////////////////////////////////////////////////////////////////////////////
 
  PJPEG_PROPERTIES = ^TJPEG_PROPERTIES;
  TJPEG_PROPERTIES = record
    // Compression/Decompression control.
    iotype          : TIJLIOTYPE;                // default = IJL_SETUP
    roi             : TIJL_RECT;                 // default = 0
    dcttype         : TDCTTYPE;                  // default = IJL_AAN
    fast_processing : TFAST_MCU_PROCESSING_TYPE; // default = IJL_NO_CC_OR_US
    intr            : DWORD;                     // default = FALSE
 
    // DIB specific I/O data specifiers.
    DIBBytes       : PByte;               // default = NULL
    DIBWidth       : DWORD;               // default = 0
    DIBHeight      : Integer;             // default = 0
    DIBPadBytes    : DWORD;               // default = 0
    DIBChannels    : DWORD;               // default = 3
    DIBColor       : TIJL_COLOR;          // default = IJL_BGR
    DIBSubsampling : TIJL_DIBSUBSAMPLING; // default = IJL_NONE
    DIBLineBytes   : Integer;             // default = 0
 
    // JPEG specific I/O data specifiers.
    JPGFile        : PChar;               // default = NULL
    JPGBytes       : PByte;               // default = NULL
    JPGSizeBytes   : DWORD;               // default = 0
    JPGWidth       : DWORD;               // default = 0
    JPGHeight      : DWORD;               // default = 0
    JPGChannels    : DWORD;               // default = 3
    JPGColor       : TIJL_COLOR;          // default = IJL_YCBCR
    JPGSubsampling : TIJL_JPGSUBSAMPLING; // default = IJL_411
    JPGThumbWidth  : DWORD;               // default = 0
    JPGThumbHeight : DWORD;               // default = 0
 
    // JPEG conversion properties.
    cconversion_reqd : DWORD;             // default = TRUE
    upsampling_reqd  : DWORD;             // default = TRUE
    jquality         : DWORD;             // default = 75
    jinterleaveType  : DWORD;             // default = 0
    numxMCUs         : DWORD;             // default = 0
    numyMCUs         : DWORD;             // default = 0
 
    // Tables.
    nqtables      : DWORD;
    maxquantindex : DWORD;
    nhuffActables : DWORD;
    nhuffDctables : DWORD;
    maxhuffindex  : DWORD;
 
    jFmtQuant     : array [0..3] of TQUANT_TABLE;
    jFmtAcHuffman : array [0..3] of THUFFMAN_TABLE;
    jFmtDcHuffman : array [0..3] of THUFFMAN_TABLE;
 
    jEncFmtQuant     : array [0..3] of PSHORT;
    jEncFmtAcHuffman : array [0..3] of PHUFFMAN_TABLE;
    jEncFmtDcHuffman : array [0..3] of PHUFFMAN_TABLE;
 
    // Allow user-defined tables.
    use_external_qtables : DWORD;
    use_external_htables : DWORD;
 
    rawquanttables   : array [0..3] of TJPEGQuantTable;
    rawhufftables    : array [0..7] of TJPEGHuffTable;
    HuffIdentifierAC : array [0..3] of Byte;
    HuffIdentifierDC : array [0..3] of Byte;
 
    // Frame specific members.
    jframe    : TFRAME;
    needframe : Integer;
 
    // SCAN persistent members.
    jscan : PSCAN;
 
    Pad   : DWORD;  // 8-byte alignment!!!
 
    // State members.
    state          : TSTATE;
    SawAdobeMarker : DWORD;
    AdobeXform     : DWORD;
 
    // ROI decoder members.
    rowoffsets : PENTROPYSTRUCT;
 
    // Intermediate buffers.
    MCUBuf  : PByte;
    tMCUBuf : array [0..720*2-1] of Byte; // ???
 
    // Processor detected.
    processor_type : TPROCESSOR_TYPE;
 
    raw_coefs : PRAW_DATA_TYPES_STATE;
 
    // Progressive mode members.
    progressive_found : Integer;
    coef_buffer       : PShort;
 
    // Upsampling mode members.
    upsampling_type    : TUPSAMPLING_TYPE;
    sampling_state_ptr : PSAMPLING_STATE;
 
    // Adobe APP14 segment variables
    AdobeVersion : Short;         // default = 100
    AdobeFlags0  : Short;         // default = 0
    AdobeFlags1  : Short;         // default = 0
 
    // JFIF APP0 segment variables
    jfif_app0_detected : Integer;
    jfif_app0_version  : Short;    // default = 0x0101
    jfif_app0_units    : UCHAR;    // default = 0 - pixel
    jfif_app0_Xdensity : Short;    // default = 1
    jfif_app0_Ydensity : Short;    // default = 1
 
    // comments related fields
    jpeg_comment      : PChar;     // default = NULL
    jpeg_comment_size : Short;     // default = 0
 
  end;
 
 
////////////////////////////////////////////////////////////////////////////
// Name:        JPEG_CORE_PROPERTIES
//
// Purpose:     This is the primary data structure between the IJL and
//              the external user.  It stores JPEG state information
//              and controls the IJL.  It is user-modifiable.
//
//              See the Developer's Guide for details on appropriate usage.
//
// Context:     Used by all low-level IJL routines to store
//              pseudo-global information.
//
// Fields:
//
//  UseJPEGPROPERTIES   Set this flag != 0 if you wish to override
//                      the JPEG_CORE_PROPERTIES "IN" parameters with
//                      the JPEG_PROPERTIES parameters.
//
//  DIBBytes            IN:     Pointer to buffer of uncompressed data.
//  DIBWidth            IN:     Width of uncompressed data.
//  DIBHeight           IN:     Height of uncompressed data.
//  DIBPadBytes         IN:     Padding (in bytes) at end of each
//                              row in the uncompressed data.
//  DIBChannels         IN:     Number of components in the
//                              uncompressed data.
//  DIBColor            IN:     Color space of uncompressed data.
//  DIBSubsampling      IN:     Required to be IJL_NONE.
//
//  JPGFile             IN:     Pointer to file based JPEG.
//  JPGBytes            IN:     Pointer to buffer based JPEG.
//  JPGSizeBytes        IN:     Max buffer size. Used with JPGBytes.
//                      OUT:    Number of compressed bytes written.
//  JPGWidth            IN:     Width of JPEG image.
//                      OUT:    After reading (except READHEADER).
//  JPGHeight           IN:     Height of JPEG image.
//                      OUT:    After reading (except READHEADER).
//  JPGChannels         IN:     Number of components in JPEG image.
//                      OUT:    After reading (except READHEADER).
//  JPGColor            IN:     Color space of JPEG image.
//  JPGSubsampling      IN:     Subsampling of JPEG image.
//                      OUT:    After reading (except READHEADER).
//  JPGThumbWidth       OUT:    JFIF embedded thumbnail width [0-255].
//  JPGThumbHeight      OUT:    JFIF embedded thumbnail height [0-255].
//
//  cconversion_reqd    OUT:    If color conversion done on decode, TRUE.
//  upsampling_reqd     OUT:    If upsampling done on decode, TRUE.
//  jquality            IN:     [0-100] where highest quality is 100.
//
//  jprops              "Low-Level" IJL data structure.
//
////////////////////////////////////////////////////////////////////////////
 
type
  PJPEG_CORE_PROPERTIES = ^TJPEG_CORE_PROPERTIES;
  TJPEG_CORE_PROPERTIES = record
    UseJPEGPROPERTIES : DWORD;               // default = 0
 
    // DIB specific I/O data specifiers.
    DIBBytes          : PByte;               // default = NULL
    DIBWidth          : DWORD;               // default = 0
    DIBHeight         : Integer;             // default = 0
    DIBPadBytes       : DWORD;               // default = 0
    DIBChannels       : DWORD;               // default = 3
    DIBColor          : TIJL_COLOR;          // default = IJL_BGR
    DIBSubsampling    : TIJL_DIBSUBSAMPLING; // default = IJL_NONE
 
    // JPEG specific I/O data specifiers.
    JPGFile           : PAnsiChar;               // default = NULL
    JPGBytes          : PByte;               // default = NULL
    JPGSizeBytes      : DWORD;               // default = 0
    JPGWidth          : DWORD;               // default = 0
    JPGHeight         : DWORD;               // default = 0
    JPGChannels       : DWORD;               // default = 3
    JPGColor          : TIJL_COLOR;          // default = IJL_YCBCR
    JPGSubsampling    : TIJL_JPGSUBSAMPLING; // default = IJL_411
    JPGThumbWidth     : DWORD;               // default = 0
    JPGThumbHeight    : DWORD;               // default = 0
 
    // JPEG conversion properties.
    cconversion_reqd  : DWORD;               // default = TRUE
    upsampling_reqd   : DWORD;               // default = TRUE
    jquality          : DWORD;               // default = 75
 
    Pad               : DWORD;               // 8-byte alignment!!!
    // Low-level properties.
    jprops            : TJPEG_PROPERTIES;
  end;
 
 
////////////////////////////////////////////////////////////////////////////
// Name:        IJLERR
//
// Purpose:     Listing of possible "error" codes returned by the IJL.
//
//              See the Developer's Guide for details on appropriate usage.
//
// Context:     Used for error checking.
//
////////////////////////////////////////////////////////////////////////////
 
const
  // The following "error" values indicate an "OK" condition.
  IJL_OK                              =   0;
  IJL_INTERRUPT_OK                    =   1;
  IJL_ROI_OK                          =   2;
 
  // The following "error" values indicate an error has occurred.
  IJL_EXCEPTION_DETECTED              =  -1;
  IJL_INVALID_ENCODER                 =  -2;
  IJL_UNSUPPORTED_SUBSAMPLING         =  -3;
  IJL_UNSUPPORTED_BYTES_PER_PIXEL     =  -4;
  IJL_MEMORY_ERROR                    =  -5;
  IJL_BAD_HUFFMAN_TABLE               =  -6;
  IJL_BAD_QUANT_TABLE                 =  -7;
  IJL_INVALID_JPEG_PROPERTIES         =  -8;
  IJL_ERR_FILECLOSE                   =  -9;
  IJL_INVALID_FILENAME                = -10;
  IJL_ERROR_EOF                       = -11;
  IJL_PROG_NOT_SUPPORTED              = -12;
  IJL_ERR_NOT_JPEG                    = -13;
  IJL_ERR_COMP                        = -14;
  IJL_ERR_SOF                         = -15;
  IJL_ERR_DNL                         = -16;
  IJL_ERR_NO_HUF                      = -17;
  IJL_ERR_NO_QUAN                     = -18;
  IJL_ERR_NO_FRAME                    = -19;
  IJL_ERR_MULT_FRAME                  = -20;
  IJL_ERR_DATA                        = -21;
  IJL_ERR_NO_IMAGE                    = -22;
  IJL_FILE_ERROR                      = -23;
  IJL_INTERNAL_ERROR                  = -24;
  IJL_BAD_RST_MARKER                  = -25;
  IJL_THUMBNAIL_DIB_TOO_SMALL         = -26;
  IJL_THUMBNAIL_DIB_WRONG_COLOR       = -27;
  IJL_BUFFER_TOO_SMALL                = -28;
  IJL_UNSUPPORTED_FRAME               = -29;
  IJL_ERR_COM_BUFFER                  = -30;
  IJL_RESERVED                        = -99;
 
 
/////////////////////////////////////////////////////////////////////////
//                     Function Prototypes (API Calls)                 //
/////////////////////////////////////////////////////////////////////////
 
 
////////////////////////////////////////////////////////////////////////////
// Name:        ijlInit
//
// Purpose:     Used to initalize the IJL.
//
//              See the Developer's Guide for details on appropriate usage.
//
// Context:     Always call this before anything else.
//              Also, only call this with a new jcprops structure, or
//              after calling IJL_Free.  Otherwise, dynamically
//              allocated memory may be leaked.
//
// Returns:     Any IJLERR value.  IJL_OK indicates success.
//
// Parameters:
//  jcprops     Pointer to an externally allocated
//              JPEG_CORE_PROPERTIES structure.
//
////////////////////////////////////////////////////////////////////////////
 
function ijlInit(jcprops : PJPEG_CORE_PROPERTIES) : Integer; stdcall;
 
 
////////////////////////////////////////////////////////////////////////////
// Name:        ijlFree
//
// Purpose:     Used to properly close down the IJL.
//
//              See the Developer's Guide for details on appropriate usage.
//
// Context:     Always call this when done using the IJL to perform
//              clean-up of dynamically allocated memory.
//              Note, IJL_Init will have to be called to use the
//              IJL again.
//
// Returns:     Any IJLERR value.  IJL_OK indicates success.
//
// Parameters:
//  jcprops     Pointer to an externally allocated
//              JPEG_CORE_PROPERTIES structure.
//
////////////////////////////////////////////////////////////////////////////
 
function ijlFree(jcprops : PJPEG_CORE_PROPERTIES) : Integer; stdcall;
 
 
////////////////////////////////////////////////////////////////////////////
// Name:        IJL_Read
//
// Purpose:     Used to read JPEG data (entropy, or header, or both) into
//              a user-supplied buffer (to hold the image data) and/or
//              into the JPEG_CORE_PROPERTIES structure (to hold the
//              header info).
//
// Context:     See the Developer's Guide for a detailed description
//              on the use of this function.  The jcprops main data
//              members are checked for consistency.
//
// Returns:     Any IJLERR value.  IJL_OK indicates success.
//
// Parameters:
//  jcprops     Pointer to an externally allocated
//              JPEG_CORE_PROPERTIES structure.
//  iotype      Specifies what type of read operation to perform.
//
////////////////////////////////////////////////////////////////////////////
 
function ijlRead(jcprops : PJPEG_CORE_PROPERTIES;
                 IoType  : TIJLIOTYPE) : Integer; stdcall;
 
 
////////////////////////////////////////////////////////////////////////////
// Name:        ijlWrite
//
// Purpose:     Used to write JPEG data (entropy, or header, or both) into
//              a user-supplied buffer (to hold the image data) and/or
//              into the JPEG_CORE_PROPERTIES structure (to hold the
//              header info).
//
// Context:     See the Developer's Guide for a detailed description
//              on the use of this function.  The jcprops main data
//              members are checked for consistency.
//
// Returns:     Any IJLERR value.  IJL_OK indicates success.
//
// Parameters:
//  jcprops     Pointer to an externally allocated
//              JPEG_CORE_PROPERTIES structure.
//  iotype      Specifies what type of write operation to perform.
//
////////////////////////////////////////////////////////////////////////////
 
function ijlWrite(jcprops : PJPEG_CORE_PROPERTIES;
                  IoType  : TIJLIOTYPE) : Integer; stdcall;
 
 
////////////////////////////////////////////////////////////////////////////
// Name:        ijlGetLibVersion
//
//
// Purpose:     To identify the version number of the IJL.
//
// Context:     Call to get the IJL version number.
//
// Returns:     pointer to IJLibVersion struct
//
// Parameters:  none
//
////////////////////////////////////////////////////////////////////////////
 
function ijlGetLibVersion : PIJLibVersion; stdcall;
 
 
////////////////////////////////////////////////////////////////////////////
// Name:        ijlErrorStr
//
// Purpose:     Gets the string to describe error code.
//
// Context:     Is called to get descriptive string on arbitrary IJLERR code.
//
// Returns:     pointer to string
//
// Parameters:  IJLERR - IJL error code
//
////////////////////////////////////////////////////////////////////////////
 
function ijlErrorStr(Code : Integer) : PChar; stdcall;
 
 
implementation
 
const
  ijlDLL = 'IJL15.DLL';
 
function ijlInit;          external ijlDLL;
function ijlFree;          external ijlDLL;
function ijlRead;          external ijlDLL;
function ijlWrite;         external ijlDLL;
function ijlGetLibVersion; external ijlDLL;
function ijlErrorStr;      external ijlDLL;
 
function IJL_DIB_UWIDTH(width: Integer; nchannels: Integer): Integer;
begin
  result := width * nchannels;
end;
 
function IJL_DIB_AWIDTH(width: Integer; nchannels: Integer): Integer;
begin
  result := (IJL_DIB_UWIDTH(width, nchannels) + IJL_DIB_ALIGN) and (IJL_DIB_ALIGN xor (not 0));
end;
 
function IJL_DIB_PAD_BYTES(width: Integer; nchannels: Integer): Integer;
begin
  result := IJL_DIB_AWIDTH(width, nchannels) - IJL_DIB_UWIDTH(width, nchannels);
end;
 
{
  -------------------------------------------
  $Log:: /Delphi Projects/Intel JPEG Librar $
 *
 * 3     20.04.99 18:50 Lee_step
 * IJL10 -> IJL20
 *
 * 2     26.10.98 9:13 Lee_step
 * Added ijlGetErrorStr
 *
 * 1     20.10.98 8:35 Lee_step
 * Renamed from IJLib.pas
 *
 * 4     17.10.98 16:25 Lee_step
 * Completed IJL interface.
 * Added 'Flush Cache' feature.
 *
 * 3     17.10.98 14:31 Lee_step
 * Fix IJL_JBUFF_WRITE
 *
 * 2     16.10.98 8:50 Lee_step
 *
 * 1     15.10.98 9:10 Lee_step
 *
 }
end.

Je coche donc Résolu.

XE2 erreur avec les images JPEG

Langage Delphi

Discussions similaires

Partager

Partager