[Back to WIN-OS2 SWAG index]  [Back to Main SWAG index]  [Original]

{
From: ELM MORROW
Subj: LOADBMPS.PAS
}

{$R-}

unit LoadBMPs;

interface

uses WinProcs, WinTypes, Strings, WinDos;

function LoadBMP(Name: PChar; Window: hWnd; var DibPal: Word;
  var Width, Height: LongInt): hBitMap;

implementation

function CreateBIPalette(BI: PBitMapInfoHeader): HPalette;
type
  ARGBQuad = Array[1..5000] of TRGBQuad;
var
  RGB: ^ARGBQuad;
  NumColors: Word;
  Pal: PLogPalette;
  hPal: hPalette;
  I: Integer;
begin
  CreateBiPalette := 0;
  RGB := Ptr(Seg(BI^), Ofs(BI^)+BI^.biSize);
  if BI^.biBitCount<24 then
  begin
    NumColors:= 1 shl BI^.biBitCount;
    if NumColors<>0 then
    begin
      GetMem(Pal, SizeOf(PLogPalette)+NumColors*SizeOf(TPaletteEntry));
      Pal^.palNumEntries := NumColors;
      Pal^.palVersion := $300;
      for I := 0 to NumColors-1 do
      begin
        Pal^.palPalEntry[I].peRed := RGB^[I].rgbRed;
        Pal^.palPalEntry[I].peGreen := RGB^[I].rgbGreen;
        Pal^.palPalEntry[I].peBlue := RGB^[I].rgbBlue;
        Pal^.palPalEntry[I].peFlags := 0;
      end;
      hPal := CreatePalette(Pal^);
      FreeMem(Pal, SizeOf(PLogPalette) + NumColors * SizeOf(TPaletteEntry));
      CreateBiPalette := hPal;
    end;
  end;
end;

function LoadBMP(Name: PChar; Window: hWnd; var DibPal: Word;
  var Width, Height: LongInt): hBitMap;
var
  BitMapFileHeader: TBitMapFileHeader;
  DibSize, ReadSize, ColorTableSize, TempReadSize: LongInt;
  DIB: PBitMapInfoHeader;
  TempDib: Pointer;
  Bits: Pointer;
  F: File;
  BitMap: hBitMap;
  Handle: Word;
  DC: hDC;
  OldCursor: HCursor;
begin
  Assign(F, Name);
  {$I-}Reset(F, 1);{$I+}
  if IOResult<>0 then
  begin
    LoadBMP := 0;
    Exit;
  end;
  OldCursor := SetCursor(LoadCursor(0, IDC_Wait));
  BlockRead(F, BitMapFileHeader, SizeOf(BitMapFileHeader));
  DibSize := BitMapFileHeader.bfSize - BitMapFileHeader.bfOffBits;
  ReadSize := LongInt(BitMapFileHeader.bfSize) - SizeOf(BitMapFileHeader);
  Handle := GlobalAlloc(GMem_Moveable, ReadSize);
  DIB := GlobalLock(Handle);
  TempReadSize := ReadSize;
  TempDib := Dib;
  while TempReadSize > 0 do
  begin
    if TempReadSize > $8000 then
    begin
      BlockRead(F, TempDIB^, $8000);
      if Ofs(TempDib^) = $8000 then
         TempDib := Ptr(Seg(TempDib^) + 8, 0)
      else
         TempDib := Ptr(Seg(TempDib^), $8000);
    end
    else
      BlockRead(F, TempDIB^, TempReadSize);
    Dec(TempReadSize, $8000);
  end;
  if DIB^.biBitCount = 24 then
    ColorTableSize := 0
  else
    ColorTableSize := LongInt(1) shl DIB^.biBitCount * SizeOf(TRGBQuad);
  Bits := Ptr(Seg(DIB^), Ofs(DIB^) + DIB^.biSize + ColorTableSize);
  Close(F);
  DC := GetDC(Window);
  DibPal := CreateBIPalette(DIB);
  if DibPal = 0 then
  begin
    SelectPalette(DC, DibPal, false);
    RealizePalette(DC);
  end;
  BitMap := CreateDIBitMap(DC, DIB^, cbm_Init, Bits, PBitMapInfo(Dib)^,
    dib_RGB_Colors);
  Height := DIB^.biHeight;
  Width := DIB^.biWidth;
  ReleaseDC(Window, DC);
  GlobalUnLock(Handle);
  GlobalFree(Handle);
  LoadBMP := BitMap;
  SetCursor(OldCursor);
end;

end.

[Back to WIN-OS2 SWAG index]  [Back to Main SWAG index]  [Original]