高分请教，关于图标转换问题，只要解决，保证送分，急急急！！！

只要是BMP文件，就会有失真，不过可以放大后用POTOSHOP模糊一下
//文件名：Icons.Pas
unit Icons;interfaceuses windows, sysutils;type
  PByte = ^Byte;
  PBitmapInfo = ^BitmapInfo;/// 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 = ^TMEMICONDIRENTRY;
  TMEMICONDIRENTRY = 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 = ^TMEMICONDIR;
  TMEMICONDIR = packed record
    idReserved: WORD; /// Reserved
    idType: WORD; /// resource type (1 for icons)
    idCount: WORD; /// how many images?
    idEntries: array[0..10] of TMEMICONDIRENTRY; /// the entries for each image
    ///查看msdn，这个数组长度应该是1，但是为什么图标猎手定义的是0..10？
  end;/// These next two structs represent how the icon information is stored
/// in an ICO file.type
  PICONDIRENTRY = ^TICONDIRENTRY;
  TICONDIRENTRY = 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 = ^TICONDIR;
  TICONDIR = packed record
    idReserved: WORD; /// Reserved
    idType: WORD; /// resource type (1 for icons)
    idCount: WORD; /// how many images?
    idEntries: array[0..0] of TICONDIRENTRY; /// 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 = ^TICONIMAGE;
  TICONIMAGE = packed record
    Width, Height, Colors: UINT; /// Width, Height and bpp
    lpBits: pointer; /// ptr to DIB bits
    dwNumBytes: DWORD; /// how many bytes?
    pBmpInfo: PBitmapInfo;
  end;
{   ///这是原来的，上面的是对照IconHunt的
  TICONIMAGE = packed record
    Width, Height, Colors: UINT; /// Width, Height and bpp
    lpBits: pointer; /// 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 = ^TICONRESOURCE;
  TICONRESOURCE = packed record
    nNumImages: UINT; /// How many images?
    IconImages: array[0..10] of TICONIMAGE; /// Image entries
  end;
{///下面是原来的，上面是对照IconHunt的
  TICONRESOURCE = 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 WriteIconToFile(Bitmap: hBitmap; Icon: hIcon; szFileName: string): Boolean; overload;
function ExtractIconFromFile(ResFileName: string; IcoFileName: string; nIndex: string): Boolean;
function WriteIconResourceToFile(hFile: hwnd; lpIR: PICONRESOURCE): Boolean;
implementationfunction WriteICOHeader(hFile: HWND; nNumEntries: UINT): Boolean;
type
  TFIcoHeader = record
    wReserved: WORD;
    wType: WORD;
    wNumEntries: WORD;
  end;
var
  IcoHeader: TFIcoHeader;
///  Output: WORD;
  dwBytesWritten: DWORD;
begin
  Result := False;
  IcoHeader.wReserved := 0;
  IcoHeader.wType := 1;
  IcoHeader.wNumEntries := WORD(nNumEntries);
  if not WriteFile(hFile, IcoHeader, SizeOf(IcoHeader), dwBytesWritten, nil) then
  begin
    MessageBox(0, pchar(SysErrorMessage(GetLastError)), 'info', MB_OK);
    exit;
  end;
  if dwBytesWritten <> SizeOf(IcoHeader) then
    exit;
{
  Output := 0;
  /// 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(TICONDIRENTRY));
    /// 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 WriteIconResourceToFile(hFile: hwnd; lpIR: PICONRESOURCE): Boolean;
var
  i: UINT;
  dwBytesWritten: DWORD;
  ide: TICONDIRENTRY;
  dwTemp: DWORD;
begin
    /// open the file
  Result := False;
    /// 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].pBmpInfo.bmiHeader.biPlanes;
    ide.wBitCount := lpIR^.IconImages[i].pBmpInfo.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(TICONDIRENTRY), dwBytesWritten, nil) then
      exit;
        /// Did we write a full ICONDIRENTRY ?
    if dwBytesWritten <> sizeof(TICONDIRENTRY) then
      exit;
  end;
    /// Write the image bits for each image
  for i := 0 to lpIR^.nNumImages - 1 do
  begin
    dwTemp := lpIR^.IconImages[i].pBmpInfo^.bmiHeader.biSizeImage;
        /// Set the sizeimage member to zero
    lpIR^.IconImages[i].pBmpInfo^.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].pBmpInfo^.bmiHeader.biSizeImage := dwTemp;
  end;
  Result := True;
end;function AWriteIconToFile(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;function AdjustIconImagePointers(lpImage: PICONIMAGE): Bool;
begin
  if lpImage = nil then
  begin
    Result := False;
    exit;
  end;
  lpImage.pBmpInfo := PBitMapInfo(lpImage^.lpBits);
  lpImage.Width := lpImage^.pBmpInfo^.bmiHeader.biWidth;
  lpImage.Height := (lpImage^.pBmpInfo^.bmiHeader.biHeight) div 2;
  lpImage.Colors := lpImage^.pBmpInfo^.bmiHeader.biPlanes * lpImage^.pBmpInfo^.bmiHeader.biBitCount;
  Result := true;
end;function ExtractIconFromFile(ResFileName: string; IcoFileName: string; nIndex: string): Boolean;
var
  h: HMODULE;
  lpMemIcon: PMEMICONDIR;
  lpIR: TICONRESOURCE;
  src: HRSRC;
  Global: HGLOBAL;
  i: integer;
  hFile: hwnd;
begin
  Result := False;
  hFile := CreateFile(pchar(IcoFileName), GENERIC_WRITE, 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
  if hFile = INVALID_HANDLE_VALUE then exit; ///Error Create File
  h := LoadLibraryEx(pchar(ResFileName), 0, LOAD_LIBRARY_AS_DATAFILE);
  if h = 0 then exit;
  try
    src := FindResource(h, pchar(nIndex), RT_GROUP_ICON);
    if src = 0 then
      Src := FindResource(h, Pointer(StrToInt(nIndex)), RT_GROUP_ICON);
    if src <> 0 then
    begin
      Global := LoadResource(h, src);
      if Global <> 0 then
      begin
        lpMemIcon := LockResource(Global);
        if Global <> 0 then
        begin
///          lpIR := @IR;
          try
            lpIR.nNumImages := lpMemIcon.idCount;
              /// Write the header
            for i := 0 to lpMemIcon^.idCount - 1 do
            begin
              src := FindResource(h, MakeIntResource(lpMemIcon^.idEntries[i].nID), RT_ICON);
              if src <> 0 then
              begin
                Global := LoadResource(h, src);
                if Global <> 0 then
                begin
                  lpIR.IconImages[i].dwNumBytes := SizeofResource(h, src);
                  GetMem(lpIR.IconImages[i].lpBits, lpIR.IconImages[i].dwNumBytes);
                  CopyMemory(lpIR.IconImages[i].lpBits, LockResource(Global), lpIR.IconImages[i].dwNumBytes);
                  if not AdjustIconImagePointers(@(lpIR.IconImages[i])) then exit;
                end;
              end;
            end;
            if WriteICOHeader(hFile, lpIR.nNumImages) then ///No Error Write File
              if WriteIconResourceToFile(hFile, @lpIR) then
                Result := True;
          finally
            for i := 0 to lpIR.nNumImages - 1 do
              if assigned(lpIR.IconImages[i].lpBits) then
                FreeMem(lpIR.IconImages[i].lpBits);
          end;
        end;
      end;
    end;
  finally
    FreeLibrary(h);
  end;
  CloseHandle(hFile);
end;end.

调试易

高分请教，关于图标转换问题，只要解决，保证送分，急急急！！！

解决方案 »