home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / win-os2.swg / 0016_Load Bitmaps.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-11-21  |  3.1 KB  |  121 lines
  1. {
  2. From: ELM MORROW
  3. Subj: LOADBMPS.PAS
  4. }
  5.  
  6. {$R-}
  7.  
  8. unit LoadBMPs;
  9.  
  10. interface
  11.  
  12. uses WinProcs, WinTypes, Strings, WinDos;
  13.  
  14. function LoadBMP(Name: PChar; Window: hWnd; var DibPal: Word;
  15.   var Width, Height: LongInt): hBitMap;
  16.  
  17. implementation
  18.  
  19. function CreateBIPalette(BI: PBitMapInfoHeader): HPalette;
  20. type
  21.   ARGBQuad = Array[1..5000] of TRGBQuad;
  22. var
  23.   RGB: ^ARGBQuad;
  24.   NumColors: Word;
  25.   Pal: PLogPalette;
  26.   hPal: hPalette;
  27.   I: Integer;
  28. begin
  29.   CreateBiPalette := 0;
  30.   RGB := Ptr(Seg(BI^), Ofs(BI^)+BI^.biSize);
  31.   if BI^.biBitCount<24 then
  32.   begin
  33.     NumColors:= 1 shl BI^.biBitCount;
  34.     if NumColors<>0 then
  35.     begin
  36.       GetMem(Pal, SizeOf(PLogPalette)+NumColors*SizeOf(TPaletteEntry));
  37.       Pal^.palNumEntries := NumColors;
  38.       Pal^.palVersion := $300;
  39.       for I := 0 to NumColors-1 do
  40.       begin
  41.         Pal^.palPalEntry[I].peRed := RGB^[I].rgbRed;
  42.         Pal^.palPalEntry[I].peGreen := RGB^[I].rgbGreen;
  43.         Pal^.palPalEntry[I].peBlue := RGB^[I].rgbBlue;
  44.         Pal^.palPalEntry[I].peFlags := 0;
  45.       end;
  46.       hPal := CreatePalette(Pal^);
  47.       FreeMem(Pal, SizeOf(PLogPalette) + NumColors * SizeOf(TPaletteEntry));
  48.       CreateBiPalette := hPal;
  49.     end;
  50.   end;
  51. end;
  52.  
  53. function LoadBMP(Name: PChar; Window: hWnd; var DibPal: Word;
  54.   var Width, Height: LongInt): hBitMap;
  55. var
  56.   BitMapFileHeader: TBitMapFileHeader;
  57.   DibSize, ReadSize, ColorTableSize, TempReadSize: LongInt;
  58.   DIB: PBitMapInfoHeader;
  59.   TempDib: Pointer;
  60.   Bits: Pointer;
  61.   F: File;
  62.   BitMap: hBitMap;
  63.   Handle: Word;
  64.   DC: hDC;
  65.   OldCursor: HCursor;
  66. begin
  67.   Assign(F, Name);
  68.   {$I-}Reset(F, 1);{$I+}
  69.   if IOResult<>0 then
  70.   begin
  71.     LoadBMP := 0;
  72.     Exit;
  73.   end;
  74.   OldCursor := SetCursor(LoadCursor(0, IDC_Wait));
  75.   BlockRead(F, BitMapFileHeader, SizeOf(BitMapFileHeader));
  76.   DibSize := BitMapFileHeader.bfSize - BitMapFileHeader.bfOffBits;
  77.   ReadSize := LongInt(BitMapFileHeader.bfSize) - SizeOf(BitMapFileHeader);
  78.   Handle := GlobalAlloc(GMem_Moveable, ReadSize);
  79.   DIB := GlobalLock(Handle);
  80.   TempReadSize := ReadSize;
  81.   TempDib := Dib;
  82.   while TempReadSize > 0 do
  83.   begin
  84.     if TempReadSize > $8000 then
  85.     begin
  86.       BlockRead(F, TempDIB^, $8000);
  87.       if Ofs(TempDib^) = $8000 then
  88.          TempDib := Ptr(Seg(TempDib^) + 8, 0)
  89.       else
  90.          TempDib := Ptr(Seg(TempDib^), $8000);
  91.     end
  92.     else
  93.       BlockRead(F, TempDIB^, TempReadSize);
  94.     Dec(TempReadSize, $8000);
  95.   end;
  96.   if DIB^.biBitCount = 24 then
  97.     ColorTableSize := 0
  98.   else
  99.     ColorTableSize := LongInt(1) shl DIB^.biBitCount * SizeOf(TRGBQuad);
  100.   Bits := Ptr(Seg(DIB^), Ofs(DIB^) + DIB^.biSize + ColorTableSize);
  101.   Close(F);
  102.   DC := GetDC(Window);
  103.   DibPal := CreateBIPalette(DIB);
  104.   if DibPal = 0 then
  105.   begin
  106.     SelectPalette(DC, DibPal, false);
  107.     RealizePalette(DC);
  108.   end;
  109.   BitMap := CreateDIBitMap(DC, DIB^, cbm_Init, Bits, PBitMapInfo(Dib)^,
  110.     dib_RGB_Colors);
  111.   Height := DIB^.biHeight;
  112.   Width := DIB^.biWidth;
  113.   ReleaseDC(Window, DC);
  114.   GlobalUnLock(Handle);
  115.   GlobalFree(Handle);
  116.   LoadBMP := BitMap;
  117.   SetCursor(OldCursor);
  118. end;
  119.  
  120. end.
  121.