Как подгрузить 256 цветный битмап из ресурса и отобразить его в нормальной

Как подгрузить 256 цветный битмап из ресурса и отобразить его в нормальной палитре?

Обычно это делается таким образом:
  Image1.BitMap.Handle:=LoadBitMap(hInstance,'BMP_NAME');

LoadBitmap загружает только картинку, без палитры. Если палитра BitMap'а отличается от системной, то ее надо устанавливать "вручную". Могут возникнуть проблемы, если на одной форме расположены две картинки с
разными палитрами.

procedure XLoadBitmap(Instance: THandle; BitmapName: PChar;
                      var HB: HBitmap; var HP: HPalette);
var
  DC: HDC;
  BI: PBitMapInfo;
  Pal: PLogPalette;
  I: Integer;
  ResIdHandle: THandle;
  ResDataHandle: THandle;
  Bitmap: HBitmap;
  C: HWnd;
  OldPalette, Palette: HPalette;

begin
  Bitmap:= 0; Palette:=0;
  HB:=0; HP:=0;
  {Получить ресурс из модуля}
  ResIDHandle := FindResource(Instance, BitmapName, rt_BitMap);
  if ResIDHandle<>0 then begin
    ResDataHandle := LoadResource(Instance, ResIDHandle);
    if ResDataHandle<>0 then begin
      BI:= LockResource(ResDataHandle);
      if BI <> nil then begin
        {256-цветный битмап?}
        if BI^.bmiHeader.biBitCount = 8 then begin
          {Создать палитру}
          GetMem(Pal, SizeOf(TLogPalette) + 256 * SizeOf(TPaletteEntry));
          for I:= 0 to 255 do
            with Pal^.palPalEntry[I] do begin
              peRed  := BI^.bmiColors[I].rgbRed;
              peGreen:= BI^.bmiColors[I].rgbGreen;
              peBlue := BI^.bmiColors[I].rgbBlue;
              peFlags:= 0;
            end;
          Pal^.palNumEntries:= 256;
          Pal^.palVersion   := $300;
          Palette:= CreatePalette(Pal^);
          FreeMem(Pal, SizeOf(TLogPalette) + 256 * SizeOf(TPaletteEntry));

          {Привести цвета палитры в системные}
          DC:= CreateDC('Display', nil, nil, nil);
          OldPalette:= SelectPalette(DC, Palette, False);
          UnrealizeObject(Palette);
          RealizePalette(DC);

          {Создать битмап}
          BitMap:= CreateDIBitmap(DC, BI^.bmiHeader, CBM_INIT,
            @PByteArray(BI)^[SizeOf(TBitMapInfo) + SizeOf(TRGBQuad) * 256 - 4],
            BI^, DIB_RGB_COLORS);

          {Освободить ресурсы}
          UnlockResource(ResDataHandle);
          FreeResource(ResDataHandle);
          SelectPalette(DC, OldPalette, False);
          DeleteDC(DC);
        end else begin
          {Не 256-цветный битмап}
          UnlockResource(ResDataHandle);
          FreeResource(ResDataHandle);
          BitMap:= LoadBitmap(Instance, BitmapName);
        end;
        HB := Bitmap;
        HP := Palette;
      end;  {BI <> nil         }
    end;    {ResDataHandle <> 0}
  end;      {ResIDHandle <> 0  }
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  HB: HBitmap;
  HP: HPalette;
begin
  xLoadBitmap(hInstance, 'PHOTO', HB, HP);
  Image1.Picture.Bitmap.Handle :=HB;
  Image1.Picture.Bitmap.Palette:=HP;
end;

Код Вадима Пузанова /Красноярск/

Эта запись была добавлена в Вторник, 6 мая, 2008 - 18:16 В разделы Delphi, Ресурсы. Вы можете подписаться на получение новых комментариев RSS 2.0 feed. Both comments and pings are currently closed.