home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / windows / phello / bitmaps.pas next >
Encoding:
Pascal/Delphi Source File  |  1991-04-25  |  1.8 KB  |  72 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal for Windows                     }
  4. {   Bitmaps unit                                 }
  5. {   Copyright (c) 1991 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. unit BitMaps;
  10.  
  11. {$S-}
  12.  
  13. interface
  14.  
  15. uses WinTypes, WinProcs;
  16.  
  17. function LoadBitMapFile(FileName: PChar): HBitMap;
  18.  
  19. implementation
  20.  
  21. procedure AHIncr; far; external 'KERNEL' index 114;
  22.  
  23. function LoadBitMapFile(FileName: PChar): HBitMap;
  24. label
  25.   Exit1, Exit2, Exit3;
  26. type
  27.   PtrRec = record Lo, Hi: Word end;
  28. var
  29.   F: Integer;
  30.   N: Word;
  31.   H: THandle;
  32.   DC: HDC;
  33.   Size, L: Longint;
  34.   P: PBitMapInfo;
  35.   Header: TBitMapFileHeader;
  36. begin
  37.   LoadBitMapFile := 0;
  38.   F := _LOpen(FileName, of_Read);
  39.   if F = -1 then goto Exit1;
  40.   if (_LRead(F, @Header, SizeOf(Header)) <> SizeOf(Header)) or
  41.     (Header.bfType <> $4D42) then goto Exit2;
  42.   Size := Header.bfSize - SizeOf(TBitMapFileHeader);
  43.   H := GlobalAlloc(gmem_Moveable, Size);
  44.   if H = 0 then goto Exit2;
  45.   P := GlobalLock(H);
  46.   L := 0;
  47.   while L < Size do
  48.   begin
  49.     N := Size - L;
  50.     if N > $8000 then N := $8000;
  51.     if _LRead(F, Ptr(PtrRec(P).Hi + PtrRec(L).Hi * Ofs(AHIncr),
  52.       PtrRec(L).Lo), N) <> N then goto Exit3;
  53.     Inc(L, N);
  54.   end;
  55.   if P^.bmiHeader.biSize <> SizeOf(TBitMapInfoHeader) then goto Exit3;
  56.   N := P^.bmiHeader.biBitCount;
  57.   if N = 24 then N := 0 else N := (1 shl N) * SizeOf(TRGBQuad);
  58.   DC := GetDC(0);
  59.   LoadBitMapFile := CreateDIBitMap(DC, P^.bmiHeader,
  60.     cbm_Init, Ptr(PtrRec(P).Hi, SizeOf(TBitMapInfoHeader) + N),
  61.     P^, dib_RGB_Colors);
  62.   ReleaseDC(0, DC);
  63.   Exit3:
  64.   GlobalUnlock(H);
  65.   GlobalFree(H);
  66.   Exit2:
  67.   _LClose(F);
  68.   Exit1:
  69. end;
  70.  
  71. end.
  72.