Autor Beitrag
K.S.M.
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 82

Windows 7 Professional
Delphi 2010, HTML, JavaScript, CSS, PHP, ein wenig C, Flash ActionScript 2.0/3.0, SQL, Assembler
BeitragVerfasst: Di 19.01.10 20:49 
Hallo! :)

Ein Problem, welches mich seit längerem beschäftigt ist folgendes: Ich möchte gerne mit meinem Programm Icons erstellen, die 32bit-Grafiken mit 16x16, 24x24, 32x32, 64x64 und 256x256 Pixel Auflösung beinhalten. Diese sollen aus mehreren TPNGImage erstellt werden, die jeweils diese Auflösung besitzen. Ich habe leider bisher nur Möglichkeiten gefunden Icons zu laden, allerdings nicht die einzelnen Pixelgrößen und Farbtiefen zu ändern und dies dann nachher abzuspeichern.

Könnt ihr mir helfen?
Vielen Dank!


Moderiert von user profile iconNarses: Topic aus Neue Einträge / Hinweise / etc. verschoben am Di 19.01.2010 um 19:51

_________________
"Programmieren ist keine Kunst. Programmieren ist eine Fähigkeit!"
jaenicke
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 19326
Erhaltene Danke: 1749

W11 x64 (Chrome, Edge)
Delphi 12 Pro, C# (VS 2022), JS/HTML, Java (NB), PHP, Lazarus
BeitragVerfasst: Di 19.01.10 21:09 
Du findest hier die Definition des Dateiformats. Das musst du dann nur entsprechend umsetzen, was nicht besonders schwer ist. Das Format ist sehr einfach gehalten:
en.wikipedia.org/wiki/ICO_(file_format)
K.S.M. Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 82

Windows 7 Professional
Delphi 2010, HTML, JavaScript, CSS, PHP, ein wenig C, Flash ActionScript 2.0/3.0, SQL, Assembler
BeitragVerfasst: Mi 20.01.10 20:35 
So, ich habe dann für alle, die gerne ihre eigenen Icons laden und speichern möchten, eine Klasse geschrieben die das kann :)
Leider kann Sie nur 32-Bit-TPNGImages laden und speichern.

Vielen Dank für den Wiki-Link, jaenicke!

Ich habe den Quelltext außerdem noch in den Dateianhang gepackt.

Ich freue mich, wenn ihr noch Anmerkungen habt, Verbesserungsvorschläge usw.!

ausblenden volle Höhe Delphi-Quelltext
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:
unit IconClass;
(*
*
*   this is a
*   XEONLAB DEVELOPMENT FILE
*
*   Language:   Pascal/Delphi
*   Title:      "Unit IconClass"
*   Developer:  Konstantin S. M. Möllers
*   Contact:    http://xeonlab.com
*   Published:  20-01-2010
*
*   Copyright © 2010 xeonlab.
*
*   This file was published under GNU General Public License (GPL).
*
*)

interface

uses
  Classes, PNGImage;

type
  { TIco }
  TIconHeader = record
    BitsPerPix: Word;
    Width, Height: Byte;
    Position: Int64;
  end;
  TIconHeaders = array of TIconHeader;
  TIcoBody = Array of TPNGImage;
  TIco = class
  private
    { Fields }
    FImageCount: Word;
    FImages: TIcoBody;
    FIconHeaders: TIconHeaders;
    { Functions }
    procedure DestroyImages;
    procedure WriteHeader( Str: TStream );
    procedure WriteImageHeader( Id: Integer; Str: TStream );
    procedure WriteImage( Id: Integer; Str: TStream; var Size, Offset: Integer );
    procedure ReadHeaderAndImage( Id: Integer; Str: TStream );
    procedure ReadImage( Id: Integer; Str: TStream; Start: Integer );
    function GetHeader( Index: Integer ): TIconHeader;
    function GetImage( Index: Integer ): TPNGImage;
    procedure SaveImages(Stream: TStream);
  public
    { Constructors / Destructors }
    constructor Create; virtual;
    destructor Destroy; override;
    { Add-Procedures }
    function AddImage( aImage: TPNGImage ): Integer;
    function AddImageRes( const aResName, aResType: String ): Integer;
    { Savers / Loaders }
    procedure SaveToStream( Stream: TStream );
    procedure LoadFromStream( Stream: TStream );
    procedure SaveToFile( const FileN: String );
    procedure LoadFromFile( const FileN: String );
    { Properties }
    property ImgCount: Word read FImageCount;
    property Header[ Index: Integer ]: TIconHeader read GetHeader;
    property Images[ Index: Integer ]: TPNGImage read GetImage;
  end;

implementation

{ TIco }

  { Creates the Class. }
  constructor TIco.Create;
  begin
    // Reset FImages
    SetLength( FImages, 0 );
    // Reset Headers
    SetLength( FIconHeaders, 0 );
    FImageCount := 0;
  end;

  { Detroys the Class. }
  destructor TIco.Destroy;
  begin
    // Detroys all images which are owned by SELF
    DestroyImages;
    inherited Destroy;
  end;

  { Destroys all owned PNGs. }
  procedure TIco.DestroyImages;
  var
    I: Integer;
  begin
    if Length( FImages ) > 0 then
      begin
        for I := 0 to FImageCount - 1 do
          FImages[ I ].Free;
        SetLength( FImages, 0 );
        // Destroy Headers
        SetLength( FIconHeaders, 0 );
      end;
  end;

  { Adds a PNG to SELF. }
  function TIco.AddImage(aImage: TPngImage): Integer;
  var
    L: Integer;
  begin
    // Get new ID, stretch FImages
    L := ImgCount;
    // Set Lengths of Image- and IconHeader-Lists
    SetLength( FImages, L+1 );
    Setlength( FIconHeaders, L+1 );
    Inc( FImageCount );
    // Create new Image
    FImages[L] := TPNGImage.Create;
    FImages[L].Assign( aImage );
    // Set Header
    with FIconHeaders[L] do
      begin
        BitsPerPix := 32;
        Width := 0;
        if FImages[L].Width < 256 then
          Width := FImages[L].Width;
        Height := 0;
        if FImages[L].Height < 256 then
          Height := FImages[L].Height;
      end;
    // Return new ID
    Result := L;
  end;

  { Gets a PNG from FImages. }
  function TIco.GetImage(Index: Integer): TPNGImage;
  begin
    Result := nil;

    // Control parameters
    if Index < 0 then Exit;
    if Index >= FImageCount then Exit;

    // Create new PNGImage
    Result := TPngImage.Create;
    try
      Result.Assign( FImages[ Index ] );
    except
      // Delete if fails
      Result.Free;
    end;
  end;

  { Writes a Header for a PNG on a Stream. }
  procedure TIco.WriteImageHeader( Id: Integer; Str: TStream );
  var
    // Height / Width of PNG
    Buffer: Word;
  begin
    with FIconHeaders[ Id ] do
      begin
        // Write Size on Stream
        Str.Write( Width, 1 );
        Str.Write( Height, 1 );

        // Zeros
        Buffer := 0;
        Str.Write( Buffer, 2 );
        Buffer := 1;
        Str.Write( Buffer, 2 );
        {Str.Write( BitsPerPix, 2 );}
        Buffer := 32;
        Str.Write( Buffer, 2 );

        // Save position
        Position := Str.Position;

        // Writes a free space for information about the image
        Str.Write( Buffer, 8 );
      end;

  end;

  { Writes the image content on a Stream. }
  procedure TIco.WriteImage(Id: Integer; Str: TStream; var Size: Integer; var Offset: Integer);
  begin
    // Return current position
    Offset := Str.Position;
    // Saves the PNG
    FImages[ Id ].SaveToStream( Str );
    // Return used PNG-Size
    Size := Str.Position - Offset;
  end;

  { Writes the header of an ICO-File. }
  procedure TIco.WriteHeader(Str: TStream);
  var
    Buffer: Word;
  begin
    // Reserved
    Buffer := 0;
    Str.Write( Buffer, 2 );
    // ImageType (1 = Icon)
    Buffer := 1;
    Str.Write( Buffer, 2 );
    // Number of Images
    Str.Write( FImageCount, 2 );
  end;

  { Writes Icon on Stream. }
  procedure TIco.SaveToStream(Stream: TStream);
  var
    I: Integer;
  begin
    // Check if Stream exists
    if not assigned( Stream ) then
      Exit;

    // Write the header
    WriteHeader( Stream );

    // Write Image-headers
    for I := 0 to FImageCount - 1 do
      WriteImageHeader( I, Stream );

    // Save PNG-Images on the Stream
    SaveImages( Stream );
  end;

  { Saves the Icon in a File. }
  procedure TIco.SaveToFile(const FileN: string);
  var
    Fs: TFileStream;
  begin
    // Create a FileStream
    Fs := TFileStream.Create( FileN, fmCreate );
    try
      // Save
      SaveToStream( Fs );
    finally
      Fs.Free;
    end;
  end;

  { Returns the HeaderTag for an icon. }
  function TIco.GetHeader(Index: Integer): TIconHeader;
  begin
    // Control parameters
    if Index < 0 then Exit;
    if Index >= FImageCount then Exit;
    // Get Header
    Result := FIconHeaders[ Index ];
  end;

  { Loads an Icon from a Stream. }
  procedure TIco.LoadFromStream(Stream: TStream);
  var
    I: Integer;
  begin
    // Read Image count
    Stream.Position := 4;
    Stream.Read( FImageCount, 2 );
    // Set lengths
    DestroyImages;
    SetLength( FImages, FImageCount );
    SetLength( FIconheaders, FImageCount );
    // Read information
    for I := 0 to FImageCount - 1 do
      ReadHeaderAndImage( I, Stream );
  end;

  { Loads an Icon from a File. }
  procedure TIco.LoadFromFile(const FileN: string);
  var
    Fs: TFileStream;
  begin
    // Create a FileStream
    Fs := TFileStream.Create( FileN, $0000 );
    try
      // Load
      LoadFromStream( Fs );
    finally
      Fs.Free;
    end;
  end;

  { Saves the PNGs on a Stream. }
  procedure TIco.SaveImages(Stream: TStream);
  var
    CurPos: Int64;
    Size,
    I,
    Offset: Integer;
  begin
    for I := 0 to FImageCount - 1 do
      begin
        // Write the Image
        WriteImage(I, Stream, Size, Offset);
        // Save Position
        CurPos := Stream.Position;
        // Update ImageHeader
        Stream.Position := FIconHeaders[I].Position;
        Stream.Write(Size, 4);
        Stream.Write(Offset, 4);
        // Load old Position
        Stream.Position := CurPos;
      end;
  end;

  { Reads Header and Image from Stream. }
  procedure TIco.ReadHeaderAndImage(Id: Integer; Str: TStream);
  var
    Start: Integer;
  begin
    with FIconHeaders[Id] do
      begin
        // Read Header information
        Str.Read( Width, 1 );
        Str.Read( Height, 1 );
        Str.Position := Str.Position + 4;
        Str.Read( BitsPerPix, 2 );
        Str.Position := Str.Position + 4;
        Str.Read( Start, 4 );
        // Load the image
        ReadImage( Id, Str, Start );
      end;
  end;

  { Read the PNG Image from a Stream. }
  procedure TIco.ReadImage(Id: Integer; Str: TStream; Start: Integer);
  var
    CurPos: Int64;
  begin
    // Save Position
    CurPos := Str.Position;
    Str.Position := Start;
    // Create the PNG
    FImages[ Id ] := TPNGImage.Create;
    FImages[ Id ].LoadFromStream( Str );
    // Load old Position
    Str.Position := CurPos;
  end;

  { Adds an image from the Resource. }
  function TIco.AddImageRes(const aResName: stringconst aResType: string): Integer;
  var
    RC: TResourceStream;
    PNG: TPNGImage;
  begin
    // Create a Resource Stream
    RC := TResourceStream.Create( HInstance, aResName, PChar( aResType ) );
    try
      // Create a PNG
      PNG := TPngImage.Create;
      try
        // Load from Stream
        PNG.LoadFromStream( RC );
        Result := AddImage( PNG );
      finally
        PNG.Free;
      end;
    finally
      RC.Free;
    end;
  end;

{ End Of TIco }

end.
Einloggen, um Attachments anzusehen!
_________________
"Programmieren ist keine Kunst. Programmieren ist eine Fähigkeit!"