Форум: "Основная";
Текущий архив: 2007.02.18;
Скачать: [xml.tar.bz2];

Вниз

Как сохранить иконку в 32 цветах ?   Найти похожие ветки 

← →
Action   (2006-12-21 12:49) [0]

Извлекаю иконку :


  ic := TIcon.Create;
 begin
   ic.Handle := ExtractIcon(Application.Handle,    PChar("c:\prog.exe"), 0);
   Form1.Canvas.Draw(32 * (0 mod w), 32 * (0 div w), ic);
   ic.SaveToFile("c:\ico.ico");
 end;
 ic.Destroy;


Рисуеться на форме нормально в хорошей цветовой гамме.
При сохранении на диск c:\ico.ico становиться с расцветкой в 8 цветов :(

Вопрос : Как сохранить полученную иконку в нормальной цветовой гаме ?

---

← →
Rouse_ ©   (2006-12-21 14:04) [1]

Руками придется, или попробуй вот через этот компонент: http://rouse.drkb.ru/components.php#fwiconex

---

← →
Action   (2006-12-21 15:25) [2]

> Rouse_ ©   (21.12.06 14:04) [1]

Руками это как ?

---

← →
Gero ©   (2006-12-23 23:50) [3]

> [2] Action   (21.12.06 15:25)

С написанием кода кроме вызова стандартных функций и методов.

---

← →
Vovan #2   (2006-12-24 13:42) [4]

Типа такого:


type
 TIconHeader = packed record // 6 byte
   idReserved: Word;
   idType: Word;
   idCount: Word;
 end;

 TIconDirEntry = packed record // 16 byte
   bWidth: Byte;
   bHeight: Byte;
   bColorCount: Byte;
   bReserved: Byte;
   wPlanes: Word;
   wBitCount: Word;
   dwBytesInRes: Longint;
   dwImageOffset: Longint;
 end;

type TIconImage = packed record
   icHeader: TBitmapInfoHeader;
   icColors: array[Byte] of TRGBQuad;
   icXorBits: Pointer;
   icAndBits: Pointer;
 end;

type
 TIconClassHigh = class
   Loaded: Boolean;
   IconHeader: TIconHeader;
   IconDirEntries: array of TIconDirEntry;
   IconXorBitmaps: array of TBitmap;
   IconAndBitmaps: array of TBitmap;
   procedure SaveToIconFile(Filename: string);
 end;

procedure TIconClassHigh.SaveToIconFile(Filename: string);
var
 FS: TFileStream;
 BitmapInfo: TBitmapInfo;
 ColorTable: array[Byte] of TRGBQuad;
 ColorCount: Integer;
 MaxColorCount: Integer;
 i, j: Integer;
begin

 if FileExists(Filename) then Exit;
 FS := TFileStream.Create(Filename, fmCreate);

 try
   // Writing IconHeader here
   FS.Write(IconHeader, SizeOf(TIconHeader));

   // Writing IconDirEntries one by one
   for i := 0 to IconHeader.idCount - 1 do
     begin

       // Collecting info for IconDirIntries

       with IconDirEntries[i] do
         begin

           case IconXorBitmaps[i].PixelFormat of
             pf1bit: wBitCount := 1;
             pf4bit: wBitCount := 4;
             pf8bit: wBitCount := 8;
             pf15bit: wBitCount := 15;
             pf16bit: wBitCount := 16;
             pf24bit: wBitCount := 24;
             pf32bit: wBitCount := 32;
             else wBitCount := 32;
           end;

           if (wBitCount <= 8) then
             begin
               MaxColorCount := 1 shl wBitCount;
               ColorCount := GetDibColorTable(IconXorBitmaps[i].Canvas.Handle,
                 0, MaxColorCount, ColorTable);

               if MaxColorCount = ColorCount then
                 bColorCount := 0
               else bColorCount := ColorCount;
             end
           else
             begin
               ColorCount := 0;
               bColorCount := 0;
             end;

           if IconXorBitmaps[i].Width < 256 then
             bWidth := IconXorBitmaps[i].Width
           else bWidth := 0;

           if IconXorBitmaps[i].Height < 256 then
             bHeight := IconXorBitmaps[i].Height
           else bHeight := 0;

           bReserved := 0;
           wPlanes := 1;

           IconDirEntries[i].dwBytesInRes :=
             SizeOf(TBitmapInfoHeader) +
             ColorCount * SizeOf(TRGBQuad) +
             IconXorBitmaps[i].Height *
             BytesPerScanline(IconXorBitmaps[i].Width, wBitCount, 32) +
             IconAndBitmaps[i].Height *
             BytesPerScanline(IconAndBitmaps[i].Width, 1, 32);

           if i = 0 then
             dwImageOffset := SizeOf(TIconHeader) + SizeOf(TIconDirEntry) *
               IconHeader.idCount
           else
             dwImageOffset := IconDirEntries[i - 1].dwImageOffset +
               IconDirEntries[i - 1].dwBytesInRes;

         end;

       FS.Write(IconDirEntries[i], SizeOf(TIconDirEntry));
     end;

   // Writing image data one by one
   for i := 0 to IconHeader.idCount - 1 do
     begin

       // Collecting BitmapInfo of bitmaps

       with BitmapInfo.bmiHeader do begin
           biSize := SizeOf(TBitmapInfoHeader);
           biWidth := IconXorBitmaps[i].Width;
          // up-down bitmap saving is not supported at the time
           biHeight := Abs(IconXorBitmaps[i].Height) * 2;
           biPlanes := 1;
           biBitCount := IconDirEntries[i].wBitCount;
           biCompression := BI_RGB;
           BitmapInfo.bmiHeader.biSizeImage :=
             BytesPerScanline(biWidth, biBitCount, 32) * (biHeight div 2) + // XOR
             BytesPerScanline(biWidth, 1, 32) * (biHeight div 2); // AND
           biXPelsPerMeter := 0;
           biYPelsPerMeter := 0;
         end;

       if (BitmapInfo.bmiHeader.biBitCount <= 8) then
         begin
           MaxColorCount := (1 shl BitmapInfo.bmiHeader.biBitCount);
           ColorCount := GetDibColorTable(IconXorBitmaps[i].Canvas.Handle,
             0, MaxColorCount, ColorTable);

           if MaxColorCount = ColorCount then
             BitmapInfo.bmiHeader.biClrUsed := 0
           else BitmapInfo.bmiHeader.biClrUsed := ColorCount;

           BitmapInfo.bmiHeader.biClrImportant := BitmapInfo.bmiHeader.biClrUsed;

           FS.Write(BitmapInfo.bmiHeader, SizeOf(TBitmapInfoHeader));
           FS.Write(ColorTable, SizeOf(TRGBQuad) * ColorCount);
         end
       else
         begin
           BitmapInfo.bmiHeader.biClrUsed := 0;
           BitmapInfo.bmiHeader.biClrImportant := 0;
           FS.Write(BitmapInfo.bmiHeader, SizeOf(TBitmapInfoHeader));
         end;

       for j := IconXorBitmaps[i].Height - 1 downto 0 do
         begin
           FS.Write(IconXorBitmaps[i].Scanline[j]^, BytesPerScanline(BitmapInfo.bmiHeader.biWidth,
             BitmapInfo.bmiHeader.biBitCount, 32));
         end;

       for j := IconAndBitmaps[i].Height - 1 downto 0 do
         begin
           FS.Write(IconAndBitmaps[i].Scanline[j]^,
             BytesPerScanline(BitmapInfo.bmiHeader.biWidth, 1, 32));
         end;
     end;

 finally
   FS.Free;
 end;
end;


---

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

Форум: "Основная";
Текущий архив: 2007.02.18;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.48 MB
Время: 0.032 c