Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2006.12.24;
Скачать: CL | DM;

Вниз

ресурсы   Найти похожие ветки 

 
APiC ©   (2006-08-21 14:28) [0]

Привет мастерам! Значит нахожу я ресурс типа RC_ICON с помощью FindResource(), как мне потом этот ресурс сохранить в *.ico-файл?


 
Rouse_ ©   (2006-08-21 14:31) [1]

////////////////////////////////////////////////////////////////////////////////
//
//  ****************************************************************************
//  * Unit Name : Unit1
//  * Purpose   : Демо соранения иконки в файл
//  * Author    : Александр (Rouse_) Багель
//  * Version   : 1.00
//  ****************************************************************************
//

unit Unit1;

interface

uses
 Windows, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls;

type
 TForm1 = class(TForm)
   Button1: TButton;
   procedure Button1Click(Sender: TObject);
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

(*

Информация взята вот отсюда:
http://myfileformats.com/download.php?url=/files/bmp.zip&id=150&name=BMP

struct IconDirectoryEntry {
   BYTE  bWidth;
   BYTE  bHeight;
   BYTE  bColorCount;
   BYTE  bReserved;
   WORD  wPlanes;
   WORD  wBitCount;
   DWORD dwBytesInRes;
   DWORD dwImageOffset;
};

typedef struct ICONDIR {
   WORD          idReserved;
   WORD          idType;
   WORD          idCount;
   ICONDIRENTRY  idEntries[1];
} ICONHEADER;

*)

const
 RC3_ICON = 1;

type
 PIconDirectoryEntry = ^TIconDirectoryEntry;
 TIconDirectoryEntry = packed record
   bWidth: Byte;
   bHeight: Byte;
   bColorCount: Byte;
   bReserved: Byte;
   wPlanes: Word;
   wBitCount: Word;
   dwBytesInRes: DWORD;
   dwImageOffset: DWORD;
 end;

 PIconDir = ^TIconDir;
 TIconDir = packed record
   Reserved: Word;
   wType: Word;
   Count: Word;
   idEntries: TIconDirectoryEntry;
 end;

procedure TForm1.Button1Click(Sender: TObject);
const
 IconDirSize = SizeOf(TIconDir);
 IconDirectoryEntrySize = SizeOf(TIconDirectoryEntry);
var
 Icon: HICON;
 IconInfo: TIconInfo;
 IconDir: TIconDir;
 IconDirectoryEntry: TIconDirectoryEntry;
 IconBuff: array of Byte;
 IconFile: THandle;
 ColorInfoHeaderSize,
 ColorImageSize,
 MaskInfoHeaderSize,
 MaskImageSize,
 Position,
 WriteSize: DWORD;
 ColorInfoHeader,
 ColorImage,
 MaskInfoHeader,
 MaskImage: TByteArray;
begin
 // Загружаем иконку
 Icon := LoadIcon(HInstance, "MAINICON");
 if Icon <> 0 then
 begin
   // Получаем информацию о иконке
   if GetIconInfo(Icon, IconInfo) then
   try
     // GetDIBSizes, GetDIB из модуля Graphics
     // Получаем размер заголовка и изображения цветной картинки
     GetDIBSizes(IconInfo.hbmColor, ColorInfoHeaderSize, ColorImageSize);
     // Получаем размер заголовка и изображения картинки - маски
     GetDIBSizes(IconInfo.hbmMask, MaskInfoHeaderSize, MaskImageSize);
     // Получаем сам заголовок и цветную картинку
     GetDIB(IconInfo.hbmColor, 0, ColorInfoHeader[0], ColorImage[0]);
     // Получаем сам заголовок и картинку - маску
     GetDIB(IconInfo.hbmMask, 0, MaskInfoHeader[0], MaskImage[0]);

     // Подготавливаем заголовок иконки

     // Each icon-resource file starts with an icon directory. The icon directory,
     // defined as an ICONDIR structure, specifies the number of icons in the
     // resource and the dimensions and color format of each icon image.

     with IconDir do
     begin
       Reserved := 0;
       wType := RC3_ICON;
       Count := 1;
     end;

     // Подготавливаем служебную информацию по иконке

     // The ICONDIRENTRY structure specifies the dimensions and color format for an
     // icon. The structure has the following form:
     
     with IconDir.idEntries do
     begin
       bWidth := PBitmapInfoHeader(@ColorInfoHeader[0])^.biWidth;
       bHeight := PBitmapInfoHeader(@ColorInfoHeader[0])^.biHeight;
       bColorCount := PBitmapInfoHeader(@ColorInfoHeader[0])^.biBitCount *
         PBitmapInfoHeader(@ColorInfoHeader[0])^.biPlanes;
       dwBytesInRes := ColorInfoHeaderSize + ColorImageSize + MaskImageSize;
       dwImageOffset := IconDirSize + IconDirectoryEntrySize;
     end;

     // color height includes mono bits
     with PBitmapInfoHeader(@ColorInfoHeader[0])^ do
       Inc(biHeight, biHeight);

     // Имея на руках все необходимые данные, формируем из них иконку
     SetLength(IconBuff, IconDirSize + IconDirectoryEntrySize + ColorInfoHeaderSize +
       ColorImageSize + MaskImageSize);

     // Пишем полученные данные в буффер
     Position := 0;
     Move(IconDir, IconBuff[Position], IconDirSize);
     Inc(Position, IconDirSize);
     Move(IconDirectoryEntry, IconBuff[Position], IconDirectoryEntrySize);
     Inc(Position, IconDirectoryEntrySize);
     Move(ColorInfoHeader[0], IconBuff[Position], ColorInfoHeaderSize);
     Inc(Position, ColorInfoHeaderSize);
     Move(ColorImage[0], IconBuff[Position], ColorImageSize);
     Inc(Position, ColorImageSize);
     Move(MaskImage[0], IconBuff[Position], MaskImageSize);

     // Вот и все, осталось сохранить этот буффер в файл
     IconFile := CreateFile(PChar("c:\test.ico"), GENERIC_READ or GENERIC_WRITE,
       0, nil, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
     if IconFile <> INVALID_HANDLE_VALUE then
     try
       if not WriteFile(IconFile, IconBuff[0], Length(IconBuff), WriteSize, nil) then
         RaiseLastOSError;
       FlushFileBuffers(IconFile);
     finally
       CloseHandle(IconFile);
     end
     else
       RaiseLastOSError;
   finally
     // Освобождаем ресурсы ибо:
     // GetIconInfo creates bitmaps for the hbmMask and hbmColor members of ICONINFO.
     // The calling application must manage these bitmaps and delete them when they
     // are no longer necessary.
     DeleteObject(IconInfo.hbmColor);
     DeleteObject(IconInfo.hbmMask);
   end
   else
     RaiseLastOSError;
 end
 else
   RaiseLastOSError;
end;

end.



Страницы: 1 вся ветка

Текущий архив: 2006.12.24;
Скачать: CL | DM;

Наверх




Память: 0.49 MB
Время: 0.052 c
15-1164955082
psa247
2006-12-01 09:38
2006.12.24
Акт тех. состояния компа


9-1140717517
Очень Новичок
2006-02-23 20:58
2006.12.24
DXPlay или Client, Server Socket


2-1165586940
azl
2006-12-08 17:09
2006.12.24
TreeView


15-1164749715
Kerk
2006-11-29 00:35
2006.12.24
[usability] навигация сайта


15-1164798934
Суслик
2006-11-29 14:15
2006.12.24
Посоветуйте opensource систему project managment.