home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / drawbmp / drawbits.pas next >
Encoding:
Pascal/Delphi Source File  |  1993-04-11  |  3.0 KB  |  128 lines
  1. library DrawBits;
  2.  
  3. {$X+,W+}
  4.  
  5. uses WinProcs, WinTypes, LoadBmps;
  6.  
  7. const
  8.   HWindow: HWnd   = 0;
  9.   Bitmap: HBitmap = 0;
  10.  
  11. { DrawBitmap ------------------------------------------------------- }
  12.  
  13. procedure DrawBitmap(DC: HDC; X, Y: Integer; Bitmap: HBitmap);
  14. var
  15.   MemDC: HDC;
  16.   BitmapRec: TBitmap;
  17. begin
  18.   MemDC := CreateCompatibleDC(DC);
  19.   SelectObject(MemDC, Bitmap);
  20.   GetObject(Bitmap, SizeOf(BitmapRec), @BitmapRec);
  21.   BitBlt(DC, X, Y, BitmapRec.bmWidth, BitmapRec.bmHeight, MemDC,
  22.     0, 0, srcCopy);
  23.   DeleteDC(MemDC);
  24. end;
  25.  
  26. { WndProc ---------------------------------------------------------- }
  27.  
  28. function WndProc(HWindow: HWnd; Message: Word; wParam: Word;
  29.   lParam: LongInt): LongInt; export;
  30. var
  31.   DC: HDC;
  32.   Rect: TRect;
  33.   PS: TPaintStruct;
  34.   I: Integer;
  35. begin
  36.   WndProc := 0;
  37.   case Message of
  38.     wm_Destroy:
  39.       begin
  40.         HWindow := 0;
  41.         if Bitmap <> 0 then DeleteObject(Bitmap);
  42.         Bitmap := 0;
  43.       end;
  44.     wm_Paint:
  45.       if Bitmap <> 0 then begin
  46.         DC := BeginPaint(HWindow, PS);
  47.         DrawBitmap(DC, 0, 0, Bitmap);
  48.         EndPaint(HWindow, PS);
  49.         Exit;
  50.       end;
  51.   end;
  52.   WndProc := DefWindowProc(HWindow, Message, wParam, lParam);
  53. end;
  54.  
  55. { RegisterClass ---------------------------------------------------- }
  56.  
  57. procedure RegisterClasses;
  58. var
  59.   Class: TWndClass;
  60. begin
  61.   with Class do
  62.   begin
  63.     lpszClassName := 'DrawBits';
  64.     hCursor       := LoadCursor(0, IDC_ARROW);
  65.     lpszMenuName  := nil;
  66.     style         := cs_HRedraw or cs_VRedraw;
  67.     lpfnWndProc   := @WndProc;
  68.     hInstance     := System.hInstance;
  69.     hIcon         := 0;
  70.     cbWndExtra    := 0;
  71.     cbClsExtra    := 0;
  72.     hbrBackground := color_AppWorkSpace + 1;
  73.   end;
  74.   RegisterClass(Class);
  75. end;
  76.  
  77. { CreateWindow ----------------------------------------------------- }
  78.  
  79. procedure CreateWindows;
  80. begin
  81.   HWindow := CreateWindow('DrawBits', 'Bitmap Viewer', ws_OverlappedWindow,
  82.     0, 0, 250, 200, 0, 0,
  83.     hInstance, nil);
  84.   if HWindow <> 0 then begin
  85.     ShowWindow(hWindow, sw_Minimize);
  86.     UpdateWindow(hWindow);
  87.   end;
  88. end;
  89.  
  90. { ShowBitmap ------------------------------------------------------- }
  91.  
  92. procedure ShowBitmap(Filename: PChar); export;
  93. var
  94.   Pal: Word;
  95.   Height, Width: LongInt;
  96.   Pos: TRect;
  97.   Focus: HWnd;
  98. begin
  99.   if HWindow <> 0 then begin
  100.     if Bitmap <> 0 then DeleteObject(Bitmap);
  101.     Bitmap := LoadBMP(Filename, 0, Pal, Width, Height);
  102.     Focus := GetFocus;
  103.     ShowWindow(hWindow, sw_Normal);
  104.     SetFocus(Focus);
  105.     GetWindowRect(HWindow, Pos);
  106.     SetWindowPos(HWindow, 0, Pos.left, Pos.top, Width + 8, Height + 24,
  107.       swp_NoActivate or swp_DrawFrame);
  108.     InvalidateRect(HWindow, nil, False);
  109.   end;
  110. end;
  111.  
  112. { EndSession ------------------------------------------------------- }
  113.  
  114. procedure EndSession; export;
  115. begin
  116.   if IsWindow(HWindow) then DestroyWindow(HWindow);
  117. end;
  118.  
  119. exports
  120.   SHOWBITMAP,
  121.   ENDSESSION;
  122.  
  123. { ------------------------------------------------------------------ }
  124. begin
  125.   RegisterClasses;
  126.   CreateWindows;
  127. end.
  128.