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

{************************************************}
{                                                }
{   Turbo Pascal for Windows                     }
{   Demo unit                                    }
{   Copyright (c) 1991 by Borland International  }
{                                                }
{************************************************}

{$R-}

unit LoadBMPs;

interface

uses WinProcs, WinTypes, Strings, WinDos;
  { ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ I do not have these units!!! }

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]