home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / windows / om / bitmap.pas next >
Encoding:
Pascal/Delphi Source File  |  1992-04-08  |  6.8 KB  |  236 lines
  1. {BitMap - Extensions to ObjectWindows by BI - unit structure by D.Overmyer}
  2. unit BitMap;
  3. {************************  Interface    ***********************}
  4. interface
  5. uses WinTypes, WinProcs, WinDos, Strings, WObjects;
  6. type
  7. PTBMP = ^TBMP;
  8. TBMP = object
  9.     FileName: array[0..fsPathName] of Char;
  10.   BitmapHandle: HBitmap;
  11.   PixelHeight, PixelWidth: Word;
  12.   hPal:HPalette;
  13.   constructor Init(ATitle: PChar);
  14.   destructor Done; virtual;
  15.   function LoadBitmapFile(Name: PChar): Boolean;
  16.   procedure CopyDIBPalette(var bmi:TBitmapInfo);
  17.   function OpenDIB(var TheFile: File): Boolean;
  18.   procedure GetBitmapData(var TheFile: File;
  19.               BitsHandle: THandle; BitsByteSize: Longint);
  20.   procedure Draw(PaintDC:hDC;PictRect:TRect;Scale:Boolean);
  21. end;
  22.  
  23.  
  24. {************************  Implementation      **********************}
  25. Implementation
  26. { __ahIncr, ordinal 114, is a 'magic' function. Defining this
  27.   function causes Windows to patch the value into the passed
  28.   reference.  This makes it a type of global variable. To use
  29.   the value of AHIncr, use Ofs(AHIncr). }
  30.  
  31. procedure AHIncr; far; external 'KERNEL' index 114;
  32.  
  33. constructor TBMP.Init(ATitle: PChar);
  34. var
  35.   DCHandle: HDC;
  36. begin
  37.   BitmapHandle := 0;
  38.   hPal := GetStockObject(Default_Palette);
  39. end;
  40.  
  41.  
  42. {Done}
  43. destructor TBMP.Done;
  44. begin
  45.   if BitmapHandle <> 0 then DeleteObject(BitmapHandle);
  46.   if hPal <> 0 then DeleteObject(hPal);
  47.   hPal := 0;
  48. end;
  49.  
  50.  
  51. { Test if the passed file is a Windows 3.0 DI bitmap and if so read it.
  52.   Report errors if unable to do so. Adjust the Scroller to the new
  53.   bitmap dimensions. }
  54. {LoadBitmapFile}
  55. function TBMP.LoadBitmapFile(Name: PChar): Boolean;
  56. var
  57.   TheFile: File;
  58.   TestWin30Bitmap: Longint;
  59.   ErrorMsg: PChar;
  60.   OldCursor: HCursor;
  61. begin
  62.   ErrorMsg := nil;
  63.   OldCursor := SetCursor(LoadCursor(0, idc_Wait));
  64.   Assign(TheFile, Name);
  65.   {$I-}
  66.   Reset(TheFile, 1);
  67.   {$I+}
  68.   if IOResult = 0 then
  69.   begin
  70.     Seek(TheFile, 14);
  71.     BlockRead(TheFile, TestWin30Bitmap, SizeOf(TestWin30Bitmap));
  72.     if TestWin30Bitmap = 40 then
  73.       if OpenDIB(TheFile) then
  74.       else ErrorMsg := 'Unable to create Windows 3.0 bitmap from file'
  75.     else
  76.       ErrorMsg := 'Not a Windows 3.0 bitmap file';
  77.     Close(TheFile);
  78.   end
  79.   else
  80.     ErrorMsg := 'Cannot open bitmap file';
  81.   SetCursor(OldCursor);
  82.   if ErrorMsg = nil then
  83.       LoadBitmapFile := True ;
  84. end;
  85.  
  86.  
  87. { Copys the bitmap bit data from the file into memory. Since
  88.   copying cannot cross a segment (64K) boundary, we are forced
  89.   to do segment arithmetic to compute the next segment.  Created
  90.   a LongType type to simplify the process. }
  91. {GetBitmapData}
  92. procedure TBMP.GetBitmapData(var TheFile: File;
  93.   BitsHandle: THandle; BitsByteSize: Longint);
  94. type
  95.   LongType = record
  96.     case Word of
  97.       0: (Ptr: Pointer);
  98.       1: (Long: Longint);
  99.       2: (Lo: Word;
  100.       Hi: Word);
  101.   end;
  102. var
  103.   Count: Longint;
  104.   Start, ToAddr, Bits: LongType;
  105. begin
  106.   Start.Long := 0;
  107.   Bits.Ptr := GlobalLock(BitsHandle);
  108.   Count := BitsByteSize - Start.Long;
  109.   while Count > 0 do
  110.   begin
  111.     ToAddr.Hi := Bits.Hi + (Start.Hi * Ofs(AHIncr));
  112.     ToAddr.Lo := Start.Lo;
  113.     if Count > $4000 then Count := $4000;
  114.     BlockRead(TheFile, ToAddr.Ptr^, Count);
  115.     Start.Long := Start.Long + Count;
  116.     Count := BitsByteSize - Start.Long;
  117.   end;
  118.   GlobalUnlock(BitsHandle);
  119. end;
  120.  
  121. {CopyDIBPalette}
  122. procedure TBMP.CopyDibPalette(var bmi:TBitMapInfo);
  123. var
  124.     LogPal :PLogPalette;
  125.    i : Integer;
  126.    PalSize:Integer;
  127.    sz : Word;
  128. begin
  129. if hPal <> 0 then
  130.     begin
  131.    DeleteObject(hPal);
  132.    hPal := 0;
  133.    end;
  134. PalSize := 1 shl bmi.bmiHeader.biBitCount;
  135. sz := sizeof(TLogPalette)+Pred(Palsize)*sizeof(TPaletteEntry);
  136. LogPal := MemAlloc(sz);
  137. {$R-}
  138. for i := 0 to Pred(PalSize) do
  139.     With LogPal^ do
  140.        begin
  141.       palNumEntries := PalSize;
  142.       palVersion := $0300;
  143.       With palPalEntry[i],bmi.bmicolors[i] do
  144.           begin
  145.          peRed := rgbRed;
  146.          peBlue := rgbBlue;
  147.          peGreen := rgbGreen;
  148.          peFlags := 0;
  149.          end;
  150.       end;
  151. hPal := CreatePalette(LogPal^);
  152. FreeMem(LogPal,sz);
  153. end;
  154.  
  155. { Attempt to open a Windows 3.0 device independent bitmap. }
  156. {OpenDIB}
  157. function TBMP.OpenDIB(var TheFile: File): Boolean;
  158. var
  159.   bitCount: Word;
  160.   size: Word;
  161.   longWidth: Longint;
  162.   DCHandle: HDC;
  163.   BitsPtr: Pointer;
  164.   BitmapInfo: PBitmapInfo;
  165.   BitsHandle, NewBitmapHandle,OldPal: THandle;
  166.   NewPixelWidth, NewPixelHeight: Word;
  167. begin
  168.   OpenDIB := True;
  169.   Seek(TheFile, 28);
  170.   BlockRead(TheFile, bitCount, SizeOf(bitCount));
  171.   if bitCount <= 8 then
  172.   begin
  173.     size := SizeOf(TBitmapInfoHeader) + ((1 shl bitCount) * SizeOf(TRGBQuad));
  174.     BitmapInfo := MemAlloc(size);
  175.     Seek(TheFile, SizeOf(TBitmapFileHeader));
  176.     BlockRead(TheFile, BitmapInfo^, size);
  177.     NewPixelWidth := BitmapInfo^.bmiHeader.biWidth;
  178.     NewPixelHeight := BitmapInfo^.bmiHeader.biHeight;
  179.     CopyDIBPalette(BitMapInfo^);
  180.     longWidth := (((NewPixelWidth * bitCount) + 31) div 32) * 4;
  181.     BitmapInfo^.bmiHeader.biSizeImage := longWidth * NewPixelHeight;
  182.     GlobalCompact(-1);
  183.     BitsHandle := GlobalAlloc(gmem_Moveable or gmem_Zeroinit,
  184.       BitmapInfo^.bmiHeader.biSizeImage);
  185.     GetBitmapData(TheFile, BitsHandle, BitmapInfo^.bmiHeader.biSizeImage);
  186.     DCHandle := CreateDC('Display', nil, nil, nil);
  187.     BitsPtr := GlobalLock(BitsHandle);
  188.     OldPal := Selectpalette(DCHandle,hPal,false);
  189.     UnRealizeObject(hPal);
  190.     RealizePalette(DCHandle);
  191.     NewBitmapHandle :=
  192.       CreateDIBitmap(DCHandle, BitmapInfo^.bmiHeader, cbm_Init, BitsPtr,
  193.       BitmapInfo^, 0);
  194.       SelectPalette(DCHandle,OldPal,false);
  195.     DeleteDC(DCHandle);
  196.     GlobalUnlock(BitsHandle);
  197.     GlobalFree(BitsHandle);
  198.     FreeMem(BitmapInfo, size);
  199.     if NewBitmapHandle <> 0 then
  200.     begin
  201.       if BitmapHandle <> 0 then DeleteObject(BitmapHandle);
  202.       BitmapHandle := NewBitmapHandle;
  203.       PixelWidth := NewPixelWidth;
  204.       PixelHeight := NewPixelHeight;
  205.     end
  206.     else
  207.       OpenDIB := False;
  208.   end
  209.   else
  210.     OpenDIB := False;
  211. end;
  212.  
  213. procedure TBMP.Draw(PaintDC:hDC;PictRect:TRect;Scale:Boolean);
  214. var
  215.     MemDC:hDC;
  216.   OldBitmap:hBitmap;
  217.   OldPal:HPalette;
  218. begin
  219.     MemDC := CreateCompatibleDC(PaintDC);
  220.   OldBitmap := SelectObject(MemDC,BitmapHandle);
  221.   OldPal := SelectPalette(PaintDC,hPal,false);
  222.   RealizePalette(hPal);
  223.   If Scale = True then
  224.       StretchBlt(PaintDC,PictRect.Left,PictRect.Top,
  225.         PictRect.Right-PictRect.Left,PictRect.Bottom-PictRect.Top,
  226.       MemDC,0,0,PixelWidth,PixelHeight,SrcCopy)
  227.   else
  228.       BitBlt(PaintDC,PictRect.Left,PictRect.Top,
  229.         PictRect.Right-PictRect.Left,PictRect.Bottom-PictRect.Top,
  230.       MemDC,0,0,SrcCopy);
  231.    SelectObject(MemDC,OldBitmap);
  232.    SelectPalette(PaintDC,OldPal,false);
  233.    DeleteDC(MemDC);
  234. end;
  235. {************************       End              **********************}
  236. end.