这个是Delphi的限制，我也正在研究这个。有一个没有完成的单元Icons.pas，你自己看看吧：
//Icons.pas
//the Data Struct For Icon
unit Icons;interfaceuses windows, sysutils;type
LPByte = pointer;// These first two structs represent how the icon information is stored
// when it is bound into a EXE or DLL file. Structure members are WORD
// aligned and the last member of the structure is the ID instead of
// the imageoffset.type
PMEMICONDIRENTRY = ^MEMICONDIRENTRY;
MEMICONDIRENTRY = packed record
bWidth: BYTE; // Width of the image
bHeight: BYTE; // Height of the image (times 2)
bColorCount: BYTE; // Number of colors in image (0 if >=8bpp)
bReserved: BYTE; // Reserved
wPlanes: WORD; // Color Planes
wBitCount: WORD; // Bits per pixel
dwBytesInRes: DWORD; // how many bytes in this resource?
nID: WORD; // the ID
end;type
PMEMICONDIR = ^MEMICONDIR;
MEMICONDIR = packed record
idReserved: WORD; // Reserved
idType: WORD; // resource type (1 for icons)
idCount: WORD; // how many images?
idEntries: array[0..0] of MEMICONDIRENTRY; // the entries for each image
end;// These next two structs represent how the icon information is stored
// in an ICO file.type
PICONDIRENTRY = ^ICONDIRENTRY;
ICONDIRENTRY = packed record
bWidth: BYTE; // Width of the image
bHeight: BYTE; // Height of the image (times 2)
bColorCount: BYTE; // Number of colors in image (0 if >=8bpp)
bReserved: BYTE; // Reserved
wPlanes: WORD; // Color Planes
wBitCount: WORD; // Bits per pixel
dwBytesInRes: DWORD; // how many bytes in this resource?
dwImageOffset: DWORD; // where in the file is this image
end;type
PICONDIR = ^ICONDIR;
ICONDIR = packed record
idReserved: WORD; // Reserved
idType: WORD; // resource type (1 for icons)
idCount: WORD; // how many images?
idEntries: array[0..0] of ICONDIRENTRY; // the entries for each image
end;// The following two structs are for the use of this program in
// manipulating icons. They are more closely tied to the operation
// of this program than the structures listed above. One of the
// main differences is that they provide a pointer to the DIB
// information of the masks.
type
PICONIMAGE = ^ICONIMAGE;
ICONIMAGE = packed record
Width, Height, Colors: UINT; // Width, Height and bpp
lpBits: LPBYTE; // ptr to DIB bits
dwNumBytes: DWORD; // how many bytes?
lpbi: PBITMAPINFO; // ptr to header
lpXOR: LPBYTE; // ptr to XOR image bits
lpAND: LPBYTE; // ptr to AND image bits
end;type
PICONRESOURCE = ^ICONRESOURCE;
ICONRESOURCE = packed record
bHasChanged: BOOL; // Has image changed?
szOriginalICOFileName: array[0..MAX_PATH] of char; // Original name
szOriginalDLLFileName: array[0..MAX_PATH] of char; // Original name
nNumImages: UINT; // How many images?
IconImages: array[0..0] of ICONIMAGE; // Image entries
end;type
TPageInfo = packed record
Width: byte;
Height: byte;
ColorQuantity: integer;
Reserved: DWORD;
PageSize: DWORD;
PageOffSet: DWORD;
end;type
TPageDataHeader = packed record
PageHeadSize: DWORD;
XSize: DWORD;
YSize: DWORD;
SpeDataPerPixSize: integer;
ColorDataPerPixSize: integer;
Reserved: DWORD;
DataAreaSize: DWORD;
ReservedArray: array[0..15] of char;
end;type
TIcoFileHeader = packed record
FileFlag: array[0..3] of byte;
PageQuartity: integer;
PageInfo: TPageInfo;
end;function WriteIconToICOFile(Bitmap:hBitmap;Icon: hIcon; szFileName: string): Boolean; overload;
function WriteIconToICOFile(lpIR: PICONRESOURCE; szFileName: pchar): Boolean; overload;implementationfunction WriteICOHeader(hFile: HWND; nNumEntries: UINT): Boolean;
var
Output: WORD;
dwBytesWritten: DWORD;
begin
Output := 0;
Result := False;
// Write 'reserved' WORD
if not WriteFile(hFile, Output, SizeOf(WORD), dwBytesWritten, nil) then
exit;
// Did we write a WORD?
if dwBytesWritten <> SizeOf(WORD) then exit;
// Write 'type' WORD (1)
Output := 1;
if not WriteFile(hFile, Output, SizeOf(WORD), dwBytesWritten, nil) then
exit;
if dwBytesWritten <> SizeOf(WORD) then exit;
// Write Number of Entries
Output := WORD(nNumEntries);
if not WriteFile(hFile, Output, SizeOf(WORD), dwBytesWritten, nil) then
exit;
if dwBytesWritten <> SizeOf(WORD) then exit;
Result := True;
end;function CalculateImageOffset(lpIR: PICONRESOURCE; nIndex: UINT): DWORD;
var
dwSize: DWORD;
i: integer;
begin
// Calculate the ICO header size
dwSize := 3 * sizeof(WORD);
// Add the ICONDIRENTRY's
inc(dwSize, lpIR.nNumImages * sizeof(ICONDIRENTRY));
// Add the sizes of the previous images
for i := 0 to nIndex - 1 do
inc(dwSize, lpIR.IconImages[i].dwNumBytes);
// we're there - return the number
Result := dwSize;
end;function WriteIconToICOFile(lpIR: PICONRESOURCE; szFileName: LPCTSTR): Boolean;
var
hFile: THANDLE;
i: UINT;
dwBytesWritten: DWORD;
ide: ICONDIRENTRY;
dwTemp: DWORD;
begin
// open the file
Result := False;
hFile := CreateFile(szFileName, GENERIC_WRITE, 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
if hFile = INVALID_HANDLE_VALUE then exit; //Error Create File
// Write the header
if not WriteICOHeader(hFile, lpIR.nNumImages) then //Error Write File
begin
CloseHandle(hFile);
exit;
end;
// Write the ICONDIRENTRY's
for i := 0 to lpIR.nNumImages - 1 do
begin
// Convert internal format to ICONDIRENTRY
ide.bWidth := lpIR.IconImages[i].Width;
ide.bHeight := lpIR.IconImages[i].Height;
ide.bReserved := 0;
ide.wPlanes := lpIR.IconImages[i].lpbi.bmiHeader.biPlanes;
ide.wBitCount := lpIR.IconImages[i].lpbi.bmiHeader.biBitCount;
if ide.wPlanes * ide.wBitCount >= 8 then
ide.bColorCount := 0
else
ide.bColorCount := 1 shl (ide.wPlanes * ide.wBitCount);
ide.dwBytesInRes := lpIR.IconImages[i].dwNumBytes;
ide.dwImageOffset := CalculateImageOffset(lpIR, i);
// Write the ICONDIRENTRY out to disk
if not WriteFile(hFile, ide, sizeof(ICONDIRENTRY), dwBytesWritten, nil) then
exit;
// Did we write a full ICONDIRENTRY ?
if dwBytesWritten <> sizeof(ICONDIRENTRY) then
exit;
end;
// Write the image bits for each image
for i := 0 to lpIR.nNumImages - 1 do
begin
dwTemp := lpIR.IconImages[i].lpbi.bmiHeader.biSizeImage;
// Set the sizeimage member to zero
lpIR.IconImages[i].lpbi.bmiHeader.biSizeImage := 0;
// Write the image bits to file
if not WriteFile(hFile, lpIR.IconImages[i].lpBits, lpIR.IconImages[i].dwNumBytes, dwBytesWritten, nil) then
exit;
if dwBytesWritten <> lpIR.IconImages[i].dwNumBytes then
exit;
// set it back
lpIR.IconImages[i].lpbi.bmiHeader.biSizeImage := dwTemp;
end;
CloseHandle(hFile);
Result := True;
end;function WriteIconToICOFile(bitmap:hBitmap;Icon: hIcon; szFileName: string): Boolean;
var
fh: file of byte;
IconInfo: _ICONINFO;
PageInfo: TPageInfo;
PageDataHeader: TPageDataHeader;
IcoFileHeader: TIcoFileHeader;
BitsInfo: tagBITMAPINFO;
p: pointer;
PageDataSize:integer;
begin
Result := False;
GetIconInfo(Icon, IconInfo);
AssignFile(fh, szFileName);
FileMode := 1;
Reset(fh); GetDIBits(0, Icon, 0, 32, nil, BitsInfo, DIB_PAL_COLORS);
GetDIBits(0, Icon, 0, 32, p, BitsInfo, DIB_PAL_COLORS);
PageDataSize:=SizeOf(PageDataHeader)+BitsInfo.bmiHeader.biBitCount; PageInfo.Width := 32;
PageInfo.Height := 32;
PageInfo.ColorQuantity := 65535;
Pageinfo.Reserved:=0;
PageInfo.PageSize:=PageDataSize;
PageInfo.PageOffSet:=SizeOf(IcoFileHeader); IcoFileHeader.FileFlag[0] := 0;
IcoFileHeader.FileFlag[1] := 0;
IcoFileHeader.FileFlag[2] := 1;
IcoFileHeader.FileFlag[3] := 0;
IcoFileHeader.PageQuartity := 1;
IcoFileHeader.PageInfo := PageInfo; FillChar(PageDataHeader,SizeOf(PageDataHeader),0);
PageDataHeader.XSize:=32;
PageDataHeader.YSize:=32;
PageDataHeader.SpeDataPerPixSize:=0;
PageDataHeader.ColorDataPerPixSize:=32;
PageDataHeader.PageHeadSize:=SizeOf(PageDataHeader);
PageDataHeader.Reserved:=0;
PageDataHeader.DataAreaSize:=BitsInfo.bmiHeader.biBitCount; BlockWrite(fh, IcoFileHeader, SizeOf(IcoFileHeader));
BlockWrite(fh,PageDataHeader,SizeOf(PageDataHeader));
BlockWrite(fh,p,BitsInfo.bmiHeader.biBitCount);
CloseFile(fh);
end;end.
//Icons.pas
//the Data Struct For Icon
unit Icons;interfaceuses windows, sysutils;type
LPByte = pointer;// These first two structs represent how the icon information is stored
// when it is bound into a EXE or DLL file. Structure members are WORD
// aligned and the last member of the structure is the ID instead of
// the imageoffset.type
PMEMICONDIRENTRY = ^MEMICONDIRENTRY;
MEMICONDIRENTRY = packed record
bWidth: BYTE; // Width of the image
bHeight: BYTE; // Height of the image (times 2)
bColorCount: BYTE; // Number of colors in image (0 if >=8bpp)
bReserved: BYTE; // Reserved
wPlanes: WORD; // Color Planes
wBitCount: WORD; // Bits per pixel
dwBytesInRes: DWORD; // how many bytes in this resource?
nID: WORD; // the ID
end;type
PMEMICONDIR = ^MEMICONDIR;
MEMICONDIR = packed record
idReserved: WORD; // Reserved
idType: WORD; // resource type (1 for icons)
idCount: WORD; // how many images?
idEntries: array[0..0] of MEMICONDIRENTRY; // the entries for each image
end;// These next two structs represent how the icon information is stored
// in an ICO file.type
PICONDIRENTRY = ^ICONDIRENTRY;
ICONDIRENTRY = packed record
bWidth: BYTE; // Width of the image
bHeight: BYTE; // Height of the image (times 2)
bColorCount: BYTE; // Number of colors in image (0 if >=8bpp)
bReserved: BYTE; // Reserved
wPlanes: WORD; // Color Planes
wBitCount: WORD; // Bits per pixel
dwBytesInRes: DWORD; // how many bytes in this resource?
dwImageOffset: DWORD; // where in the file is this image
end;type
PICONDIR = ^ICONDIR;
ICONDIR = packed record
idReserved: WORD; // Reserved
idType: WORD; // resource type (1 for icons)
idCount: WORD; // how many images?
idEntries: array[0..0] of ICONDIRENTRY; // the entries for each image
end;// The following two structs are for the use of this program in
// manipulating icons. They are more closely tied to the operation
// of this program than the structures listed above. One of the
// main differences is that they provide a pointer to the DIB
// information of the masks.
type
PICONIMAGE = ^ICONIMAGE;
ICONIMAGE = packed record
Width, Height, Colors: UINT; // Width, Height and bpp
lpBits: LPBYTE; // ptr to DIB bits
dwNumBytes: DWORD; // how many bytes?
lpbi: PBITMAPINFO; // ptr to header
lpXOR: LPBYTE; // ptr to XOR image bits
lpAND: LPBYTE; // ptr to AND image bits
end;type
PICONRESOURCE = ^ICONRESOURCE;
ICONRESOURCE = packed record
bHasChanged: BOOL; // Has image changed?
szOriginalICOFileName: array[0..MAX_PATH] of char; // Original name
szOriginalDLLFileName: array[0..MAX_PATH] of char; // Original name
nNumImages: UINT; // How many images?
IconImages: array[0..0] of ICONIMAGE; // Image entries
end;type
TPageInfo = packed record
Width: byte;
Height: byte;
ColorQuantity: integer;
Reserved: DWORD;
PageSize: DWORD;
PageOffSet: DWORD;
end;type
TPageDataHeader = packed record
PageHeadSize: DWORD;
XSize: DWORD;
YSize: DWORD;
SpeDataPerPixSize: integer;
ColorDataPerPixSize: integer;
Reserved: DWORD;
DataAreaSize: DWORD;
ReservedArray: array[0..15] of char;
end;type
TIcoFileHeader = packed record
FileFlag: array[0..3] of byte;
PageQuartity: integer;
PageInfo: TPageInfo;
end;function WriteIconToICOFile(Bitmap:hBitmap;Icon: hIcon; szFileName: string): Boolean; overload;
function WriteIconToICOFile(lpIR: PICONRESOURCE; szFileName: pchar): Boolean; overload;implementationfunction WriteICOHeader(hFile: HWND; nNumEntries: UINT): Boolean;
var
Output: WORD;
dwBytesWritten: DWORD;
begin
Output := 0;
Result := False;
// Write 'reserved' WORD
if not WriteFile(hFile, Output, SizeOf(WORD), dwBytesWritten, nil) then
exit;
// Did we write a WORD?
if dwBytesWritten <> SizeOf(WORD) then exit;
// Write 'type' WORD (1)
Output := 1;
if not WriteFile(hFile, Output, SizeOf(WORD), dwBytesWritten, nil) then
exit;
if dwBytesWritten <> SizeOf(WORD) then exit;
// Write Number of Entries
Output := WORD(nNumEntries);
if not WriteFile(hFile, Output, SizeOf(WORD), dwBytesWritten, nil) then
exit;
if dwBytesWritten <> SizeOf(WORD) then exit;
Result := True;
end;function CalculateImageOffset(lpIR: PICONRESOURCE; nIndex: UINT): DWORD;
var
dwSize: DWORD;
i: integer;
begin
// Calculate the ICO header size
dwSize := 3 * sizeof(WORD);
// Add the ICONDIRENTRY's
inc(dwSize, lpIR.nNumImages * sizeof(ICONDIRENTRY));
// Add the sizes of the previous images
for i := 0 to nIndex - 1 do
inc(dwSize, lpIR.IconImages[i].dwNumBytes);
// we're there - return the number
Result := dwSize;
end;function WriteIconToICOFile(lpIR: PICONRESOURCE; szFileName: LPCTSTR): Boolean;
var
hFile: THANDLE;
i: UINT;
dwBytesWritten: DWORD;
ide: ICONDIRENTRY;
dwTemp: DWORD;
begin
// open the file
Result := False;
hFile := CreateFile(szFileName, GENERIC_WRITE, 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
if hFile = INVALID_HANDLE_VALUE then exit; //Error Create File
// Write the header
if not WriteICOHeader(hFile, lpIR.nNumImages) then //Error Write File
begin
CloseHandle(hFile);
exit;
end;
// Write the ICONDIRENTRY's
for i := 0 to lpIR.nNumImages - 1 do
begin
// Convert internal format to ICONDIRENTRY
ide.bWidth := lpIR.IconImages[i].Width;
ide.bHeight := lpIR.IconImages[i].Height;
ide.bReserved := 0;
ide.wPlanes := lpIR.IconImages[i].lpbi.bmiHeader.biPlanes;
ide.wBitCount := lpIR.IconImages[i].lpbi.bmiHeader.biBitCount;
if ide.wPlanes * ide.wBitCount >= 8 then
ide.bColorCount := 0
else
ide.bColorCount := 1 shl (ide.wPlanes * ide.wBitCount);
ide.dwBytesInRes := lpIR.IconImages[i].dwNumBytes;
ide.dwImageOffset := CalculateImageOffset(lpIR, i);
// Write the ICONDIRENTRY out to disk
if not WriteFile(hFile, ide, sizeof(ICONDIRENTRY), dwBytesWritten, nil) then
exit;
// Did we write a full ICONDIRENTRY ?
if dwBytesWritten <> sizeof(ICONDIRENTRY) then
exit;
end;
// Write the image bits for each image
for i := 0 to lpIR.nNumImages - 1 do
begin
dwTemp := lpIR.IconImages[i].lpbi.bmiHeader.biSizeImage;
// Set the sizeimage member to zero
lpIR.IconImages[i].lpbi.bmiHeader.biSizeImage := 0;
// Write the image bits to file
if not WriteFile(hFile, lpIR.IconImages[i].lpBits, lpIR.IconImages[i].dwNumBytes, dwBytesWritten, nil) then
exit;
if dwBytesWritten <> lpIR.IconImages[i].dwNumBytes then
exit;
// set it back
lpIR.IconImages[i].lpbi.bmiHeader.biSizeImage := dwTemp;
end;
CloseHandle(hFile);
Result := True;
end;function WriteIconToICOFile(bitmap:hBitmap;Icon: hIcon; szFileName: string): Boolean;
var
fh: file of byte;
IconInfo: _ICONINFO;
PageInfo: TPageInfo;
PageDataHeader: TPageDataHeader;
IcoFileHeader: TIcoFileHeader;
BitsInfo: tagBITMAPINFO;
p: pointer;
PageDataSize:integer;
begin
Result := False;
GetIconInfo(Icon, IconInfo);
AssignFile(fh, szFileName);
FileMode := 1;
Reset(fh); GetDIBits(0, Icon, 0, 32, nil, BitsInfo, DIB_PAL_COLORS);
GetDIBits(0, Icon, 0, 32, p, BitsInfo, DIB_PAL_COLORS);
PageDataSize:=SizeOf(PageDataHeader)+BitsInfo.bmiHeader.biBitCount; PageInfo.Width := 32;
PageInfo.Height := 32;
PageInfo.ColorQuantity := 65535;
Pageinfo.Reserved:=0;
PageInfo.PageSize:=PageDataSize;
PageInfo.PageOffSet:=SizeOf(IcoFileHeader); IcoFileHeader.FileFlag[0] := 0;
IcoFileHeader.FileFlag[1] := 0;
IcoFileHeader.FileFlag[2] := 1;
IcoFileHeader.FileFlag[3] := 0;
IcoFileHeader.PageQuartity := 1;
IcoFileHeader.PageInfo := PageInfo; FillChar(PageDataHeader,SizeOf(PageDataHeader),0);
PageDataHeader.XSize:=32;
PageDataHeader.YSize:=32;
PageDataHeader.SpeDataPerPixSize:=0;
PageDataHeader.ColorDataPerPixSize:=32;
PageDataHeader.PageHeadSize:=SizeOf(PageDataHeader);
PageDataHeader.Reserved:=0;
PageDataHeader.DataAreaSize:=BitsInfo.bmiHeader.biBitCount; BlockWrite(fh, IcoFileHeader, SizeOf(IcoFileHeader));
BlockWrite(fh,PageDataHeader,SizeOf(PageDataHeader));
BlockWrite(fh,p,BitsInfo.bmiHeader.biBitCount);
CloseFile(fh);
end;end.
解决方案 »
- 菜鸟求助（代码改错）
- 初次接触com, 客户端在Result := CreateRemoteComObject(MachineName, CLASS_aaa) as Iaaa时，提示： rpc服务器不可用
- 请问如何用Rave打印报表
- delphi里有没有反悔功能？
- 字符串的小问题！！！在线等！！！
- 各位帮忙看看，我的那句话说错了，我的信誉分怎么突然为0的？
- delphi操作excel2003，如何获得当前sheet中已用的行和列数？
- “袖珍文档管理系统”之RIA版——将文档管理移植到Web上。
- 怎样通过程序判断出来数据库中的字段的必填属性？
- 请问在delphi里如何对实现计算机文件系统的访问。在VB中用Scripting.FileSystemObject？
- 如何实现cd播放器的上一曲（用mediaplayer)
- delphi中开发分布web应用时，web server 选择isapi时生成DLL文件，在浏览时出现xmlrowset未定义，请问如何处理。(delphi5 ,win2000 server)
另外,Kingron能告诉我你的email吗?