Discussion :

[Tardiff Jean-François]

Bonjour,

Je cheeche des exemple, simple si possible, pour sauvegarder un TBitmap dans un JPEG Via les outilles LeaTools (pBITMAPHANDLE, L_LoadBitmapMemory etc..).

Les exemples que j'ai à mas disposition sont quelque peux complexes, a mois d'être un shadock.

[sjrd]

Tu veux absolument utiliser LeadTools, ou bien TJpegImage suffit ?

[Tardiff Jean-François]

Bonjour,

A mon avis TJpegImage suffit, mais de l'avis de mon employeur cela est insufisant.

Il veut que l'on puisse changer les PixelByInch du jpeg résultant. Pourquoi ? mystère, mais il le désire plus que fortement.

[Tardiff Jean-François]

J'ai resolu mon problème.

Pas de la manière a laquelle j'avais pensé, mais cela fonctionne.

Pour ceux que cela interesse Voici un exmple pour charger un lead tool à partire d'un Tbitmap et pour sauvegarder une image TLeadTool.

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
 
 VAR
    BitmapHeader:  pBitmapInfo;
    BitmapImage :  Pointer;
    DelphiBitmap:  TBitmap;
    HeaderSize  :  DWORD;
    ImageSize   :  DWORD;
    LeadBitmap  :  BitmapHandle;
    StartTime   :  DWORD;
    BitmapInfo: TBitmapInfo;
begin
  StartTime := GetTickCount;
 
  DelphiBitmap := TBitmap.Create;
  TRY
    DelphiBitmap.LoadFromFile('D:\TEMP\TOTO.BMP');
    Image1.Picture.Graphic := DelphiBitmap;
 
    L_InitBitmap(@LeadBitmap, 0, 0, 24);
    TRY
      GetDIBSizes(DelphiBitmap.Handle, HeaderSize, ImageSize);
      GetMem(BitmapHeader, HeaderSize);
      GetMem(BitmapImage,  ImageSize);
      GetDIB(DelphiBitmap.Handle, DelphiBitmap.Palette, BitmapHeader^, BitmapImage^);
 
      BitmapInfo := TBitmapInfo(BitmapHeader^);
      TRY
        // Complete conversion to Lead Tool BitmapHandle
        L_ConvertFromDIB(
          @LeadBitmap,
          @BitmapInfo,
          BitmapImage);
      FINALLY
        FreeMem(BitmapHeader);
        FreeMem(BitmapImage)
      END;
 
      // QMS = quality more important than size
      L_SaveBitmap('D:\TEMP\TOTO.CMP', @LeadBitmap, FILE_CMP,  24,  QMS, nil);  // Lead Proprietary
 
      L_SaveBitmap('D:\TEMP\TOTO.EPS', @LeadBitmap, FILE_EPS,   8,  0, nil);  // Encapsulated Postscript
 
      // 20 here for Lead is like 80 for Delphi JPEGImage
      L_SaveBitmap('D:\TEMP\TOTO.JPG', @LeadBitmap, FILE_JFIF, 24,  MulDiv(255,20,100), nil);
 
      L_SaveBitmap('D:\TEMP\TOTO.PCT', @LeadBitmap, FILE_PCT,  24,  0, nil);  // Macintosh PCT
      L_SaveBitmap('D:\TEMP\TOTO.PCX', @LeadBitmap, FILE_PCX,  24,  0, nil);  // ZSoft PCX
      L_SaveBitmap('D:\TEMP\TOTO.PNG', @LeadBitmap, FILE_PNG,  24,  0, nil);  // Portable Network Graphics
      L_SaveBitmap('D:\TEMP\TOTO.RAS', @LeadBitmap, FILE_RAS,  24,  0, nil);  // Sun Raster
      L_SaveBitmap('D:\TEMP\TOTO.TGA', @LeadBitmap, FILE_TGA,  24,  0, nil);  // Truevision TARGA
      L_SaveBitmap('D:\TEMP\TOTO.TIF', @LeadBitmap, FILE_TIF,  24,  0, nil);  // TIFF
      L_SaveBitmap('D:\TEMP\TOTO.WMF', @LeadBitmap, FILE_WMF,  24,  0, nil);  // Windows Metafile
 
    FINALLY
      L_FreeBitmap(@LeadBitmap);
    END
 
  FINALLY
    DelphiBitmap.Free
  END;

Ceci dis cela n'a pas résolu mon problème qui était de changer la résolution en x et y ( n pixel par inch ou par cm) d'un jpeg.
J'ai cependant fini par trouver le code suivant.

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
 
procedure GetResJpg(JPGFile: string; out HorzRes, VertRes, DP: Word;
   out Measure: string);
const
   BufferSize = 50;
var
   Buffer: string;
   Index: integer;
   FileStream: TFileStream;
 
begin
   FileStream := TFileStream.Create(JPGFile,
       fmOpenReadWrite);
   try
       SetLength(Buffer, BufferSize);
       FileStream.Read(buffer[1], BufferSize);
       Index := Pos('JFIF' + #$00, buffer);
       if Index > 0 then
       begin
           FileStream.Seek(Index + 6, soFromBeginning);
           FileStream.Read(DP, 1);
           case DP of
               1: Measure := 'DPI'; //Dots Per Inch
               2: Measure := 'DPC'; //Dots Per Cm.
           end;
           FileStream.Read(HorzRes, 2); // x axis
           HorzRes := Swap(HorzRes);
           FileStream.Read(VertRes, 2); // y axis
           VertRes := Swap(VertRes);
       end
   finally
       FileStream.Free;
   end;
end;
 
procedure SetResJpg(name: string; dpix, dpiy: Integer; DP: Word {1 = inch, 2 = cm});
const
   BufferSize = 50;
   DPI = 1; //inch
   DPC = 2; //cm
var
   Buffer: string;
   index: INTEGER;
   FileStream: TFileStream;
   xResolution: WORD;
   yResolution: WORD;
   _type: Byte;
begin
  if not (Dp in [1, 2]) then dp := 1;
 
   FileStream := TFileStream.Create(name,
       fmOpenReadWrite);
   try
       SetLength(Buffer, BufferSize);
       FileStream.Read(buffer[1], BufferSize);
       index := POS('JFIF' + #$00, buffer);
       if index > 0
           then begin
           FileStream.Seek(index + 6, soFromBeginning);
           _type := DP;
           FileStream.write(_type, 1);
           xresolution := swap(dpix);
           FileStream.write(xresolution, 2);
           yresolution := swap(dpiy);
           FileStream.write(yresolution, 2);
       end
   finally
       FileStream.Free;
   end;
end;

Si cela peut éviter des recherches à certains, tant mieux.