Discussion :

[petitprince]

Voilà, je souhaite extraire toutes les icônes contenues dans un fichier icon, afin de les récupérer séparément....
J'ai trouvé récement un sujet sur le forum pascal, où un membre proposait un code d'une application console le faisant, mais écrit avec Lazarus....
Je l'ai donc modifié pour qu'il soit compilable sous Delphi 7...
J'arrive bien à extraire toutes les icônes, mais celles-ci sont vide !!
Voyez-vous d'où peut venir le problème ??
D'avance merci....

Si joint, le code de l'application:

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
program Project1;
 
{$APPTYPE CONSOLE}
 
uses
  classes,
  sysutils,
  Variants,
  Windows;
 
type
// les icones commencent par 3 WORDS définis ainsi
TlazIconHeader = packed record
IdReserved : WORD; // fixe, toujours 0
IdType : WORD; // type de ressource pour un icone = 1
IdCount : WORD; // Nombre d'images
end;
// Puis suivent les definitions des images
// ceci étant répété le nombre de fois defini au dessus par idCount
TlazImageHeader = packed record
bWidth : BYTE; // Largeur, en pixels, de l'image
bHeight : BYTE; // Hauteur, en pixels, de l'image
bColorCont : BYTE; // Nombre de couleurs: =0 si >=8bpp
bReserved : BYTE; // fixe, toujours 0
wPlanes : WORD; // Nombre de 'colors planes' << pas compris,
// semble toujours égal à 1
wBitCounts : WORD; // bits per pixels
dwBytesInRes : DWORD; // Taille de l'image dans le fichier
dwImageOffset : DWORD; // Offset de debut de l'image dans le fichier
end;
// Puis suivent, aux adresses indiquées par dwimageoffset
// sur une taille de dwimageOffset
// les données des images
  TMyMemoryStream = class(TMemoryStream)
  public
    procedure WriteByte(const Value: Byte);//: Byte;
    procedure WriteDWord(const Value: DWord);//: DWord;
  end;
 
procedure TMyMemoryStream.WriteByte(const Value: Byte);//: Byte;
begin
  WriteBuffer(Value, sizeof(Value));
  //Result:=Value;
end;
procedure TMyMemoryStream.WriteDWord(const Value: DWord);//: DWord;
begin
  WriteByte((Value shr 8) and $FF);
  WriteByte(Value and $FF);
  //Result:=Value;
end;
 
var
  ImageHeader : TlazImageHeader ;
  LIH : TlazIconHeader;
  tfs : Tfilestream;
  tms : TMymemoryStream;
  i:WORD;
 
begin
 
if paramcount >0 then begin
if fileexists(paramstr(1)) then begin
tfs:= tfilestream.Create(paramstr(1),fmopenread);
tms := tMymemorystream.Create;
// on lit l'entete de fichier
tfs.Read(LIH, sizeof(LIH));
// Si c'est un icone
if LIH.IdType = 1 then begin
// une boucle pour toutes les images
for i:= 1 to LIH.IdCount do begin
tms.clear;
// on se place au début de l'entete de l'image i
tfs.Seek ((i-1)*sizeof(ImageHeader)+sizeof(LIH),sofrombeginning);
// on charge l'entete de l'image i
tfs.Read(ImageHeader, sizeof(ImageHeader));
// on se replace au début dans les deux streams
tms.Seek(0,sofrombeginning);
tfs.seek(0,sofrombeginning);
// on copie l'entete de fichier dans le stream temp
tms.CopyFrom(tfs,sizeof(LIH));
// on se place au debut de l'entete de l'image i
tfs.Seek ((i-1)*sizeof(ImageHeader),sofromcurrent);
// on copie cette entète dans le stream temp
tms.copyfrom(tfs,sizeof(ImageHeader));
// on se place à l'adresse du debut du data de l'image i
tfs.Seek(ImageHeader.dwImageOffset, sofrombeginning);
// on copie le data dans le stream temp
tms.CopyFrom(tfs,ImageHeader.dwBytesInRes);
tms.Seek($04,Sofrombeginning); // adresse du WORD nombre d'images
tms.WriteByte($01);// Patch = 1 image
tms.Seek($12,Sofrombeginning); // adresse du dword offset debut Data
tms.WriteDWord($00000016); // Patch = bonne adresse
tms.Seek(0,Sofrombeginning);
 
// il ne reste plus qu'à copier le resultat dans un fichier
// sur le disque
tms.SaveToFile('c:\'+inttostr(I)+'.ico');
end;
end else writeln('Ce fichier n''est pas un fichier icone valide');
 
tms.Free;
tfs.Free;
end;
end;
writeln(inttostr(I)+' fichiers crees dans c:\');
readln;
End.
 
end.

[petitprince]

Bon et bien voilà, au détour d'une page Web, je viens de trouver une solution toute faite !
Voici le lien: http://www.tkweb.eu/en/delphicomp/kicon.html

C'est extraordinaire, mais ça ne fonctionne pas avec les nouvelles icones Vista, dommage.... Mais ça va venir je pense !

Ceci est donc résolu !