ShowBit.mod: Translation to Stony Brook Modula-2

Last updated: 11. 1.1998, 17:45

<*/NOWARN:F*>
MODULE ShowBit;
(*-----------------------------------------------------------
   SHOWBIT.C       --- Shows bitmaps in BITLIB dynamic link library
                   (c) Charles Petzold, 1996
   ShowBit.mod     --- Translation to Stony Brook Modula-2
                   (c) Peter Stadler,   1998
  -----------------------------------------------------------*)

IMPORT SYSTEM;
IMPORT WINUSER;
IMPORT WIN32;
IMPORT WINGDI;
IMPORT Strings;
IMPORT WINX;

CONST szAppName = "ShowBit";
VAR
  hwnd        :  WIN32.HWND;
  msg         :  WINUSER.MSG;
  wc          :  WINUSER.WNDCLASSEX;
VAR   (* static in WndProc *)
   hLibrary   :  WIN32.HINSTANCE;
   iCurrent   :  INTEGER = 1;



(*********************************************************************)
PROCEDURE DrawBitmap (hdc           :  WIN32.HDC;
(*********************************************************************)
                      xStart        :  INTEGER;
                      yStart        :  INTEGER;
                      hBitmap       :  WIN32.HBITMAP);
VAR
  bm       :  WINGDI.BITMAP;
  hMemDC   :  WIN32.HDC;
  pt       :  WIN32.POINT;
BEGIN
     hMemDC := WINGDI.CreateCompatibleDC (hdc);
     WINGDI.SelectObject (hMemDC, SYSTEM.CAST(WIN32.HGDIOBJ,hBitmap));
     WINGDI.GetObject (SYSTEM.CAST(WIN32.HGDIOBJ,hBitmap), SIZE (WINGDI.BITMAP), SYSTEM.CAST(WIN32.PSTR,SYSTEM.ADR(bm)));
     pt.x := bm.bmWidth;
     pt.y := bm.bmHeight;

     WINGDI.BitBlt (hdc, xStart, yStart, pt.x, pt.y, hMemDC, 0, 0, WINGDI.SRCCOPY);

     WINGDI.DeleteDC (hMemDC);
END DrawBitmap;

<*/PUSH*>
%IF WIN32 %THEN
    <*/CALLS:WIN32SYSTEM*>
%ELSE
    <*/CALLS:WINSYSTEM*>
%END

(*++++*****************************************************************)
PROCEDURE  WndProc (hwnd        : WIN32.HWND;
                    iMsg        : WIN32.UINT;
                    wParam      : WIN32.WPARAM;
                    lParam      : WIN32.LPARAM) : WIN32.LRESULT [EXPORT];
(**********************************************************************)
VAR
  hdc         :  WIN32.HDC;
  ps          :  WINUSER.PAINTSTRUCT;
  hBitmap     :  WIN32.HBITMAP;
  lpstr       :  WIN32.LPSTR;
BEGIN

  CASE (iMsg) OF

          | WINUSER.WM_CREATE :
               hLibrary := WIN32.LoadLibrary ("BitLib.DLL");
               IF (hLibrary = NIL) THEN
                    WINUSER.DestroyWindow (hwnd);
               END;
               RETURN 0;

          | WINUSER.WM_CHAR :
               IF (hLibrary # NIL) THEN
                    INC(iCurrent);
                    WINUSER.InvalidateRect (hwnd, WINX.NIL_RECT, TRUE);
               END;
               RETURN 0;

          | WINUSER.WM_PAINT :
               hdc := WINUSER.BeginPaint (hwnd, ps);

               IF (hLibrary # NIL) THEN
                    lpstr :=  WINUSER.MAKEINTRESOURCE (iCurrent);
                    hBitmap := WINUSER.LoadBitmap (hLibrary,lpstr^);
                    IF (hBitmap = NIL) THEN
                         iCurrent := 1;
                         hBitmap := WINUSER.LoadBitmap (hLibrary,lpstr^);
                    END;

                    IF (hBitmap # NIL) THEN
                         DrawBitmap (hdc, 0, 0, hBitmap);
                         WINGDI.DeleteObject (SYSTEM.CAST(WIN32.HGDIOBJ,hBitmap));
                    END;

               END;
               WINUSER.EndPaint (hwnd, ps);
               RETURN 0;

          | WINUSER.WM_DESTROY :
               IF (hLibrary # NIL) THEN
                    WIN32.FreeLibrary (hLibrary);
               END;
               WINUSER.PostQuitMessage (0);
               RETURN 0;
     ELSE
               RETURN WINUSER.DefWindowProc (hwnd, iMsg, wParam, lParam);
     END;
END WndProc;
<*/POP*>
(*++++*****************************************************************)
PROCEDURE InitApplication () : BOOLEAN;
(**********************************************************************)
VAR
  rc  :  CARDINAL;
BEGIN
  wc.cbSize        := SIZE(WINUSER.WNDCLASSEX);
  wc.style         := WINUSER.CS_HREDRAW BOR WINUSER.CS_VREDRAW;
  wc.lpfnWndProc   := WndProc;
  wc.cbClsExtra    := 0;
  wc.cbWndExtra    := 0;
  wc.hInstance     := WINX.Instance;
  wc.hIcon         := WINUSER.LoadIcon (NIL, WINUSER.IDI_APPLICATION^);
  wc.hCursor       := WINUSER.LoadCursor (NIL, WINUSER.IDC_ARROW^);
  wc.hbrBackground := SYSTEM.CAST(WIN32.HBRUSH, WINGDI.GetStockObject (WINGDI.WHITE_BRUSH));
  wc.lpszMenuName  := NIL;
  wc.lpszClassName := SYSTEM.ADR(szAppName);
  wc.hIconSm       := WINUSER.LoadIcon (NIL, WINUSER.IDI_APPLICATION^);

  rc := WINUSER.RegisterClassEx (wc);
  RETURN rc #0;
END InitApplication;
(*++++*****************************************************************)
PROCEDURE InitMainWindow () : BOOLEAN;
(**********************************************************************)
BEGIN
  hwnd := WINUSER.CreateWindow
           (szAppName,                           (* window class name            *)
           "Show Bitmaps from BITLIB (Press Key), Translation to Stony Brook Modula-2",
                                                 (* window caption               *)
           WINUSER.WS_OVERLAPPEDWINDOW,          (* window style                 *)
           WINUSER.CW_USEDEFAULT,                (* initial x position           *)
           WINUSER.CW_USEDEFAULT,                (* initial y position           *)
           WINUSER.CW_USEDEFAULT,                (* initial x size               *)
           WINUSER.CW_USEDEFAULT,                (* initial y size               *)
           NIL,                                  (* parent window handle         *)
           NIL,                                  (* window menu handle           *)
           WINX.Instance,                        (* program instance handle      *)
           NIL);                                 (* creation parameters          *)

  IF hwnd = NIL THEN
    RETURN FALSE;
  END;
  WINUSER.ShowWindow (hwnd, WINUSER.SW_SHOWDEFAULT);
  WINUSER.UpdateWindow (hwnd);
  RETURN TRUE;
END InitMainWindow;
(*++++*****************************************************************)
BEGIN
  IF InitApplication()  AND  InitMainWindow() THEN
    WHILE (WINUSER.GetMessage(msg,NIL,0,0)) DO
      WINUSER.TranslateMessage(msg);
      WINUSER.DispatchMessage(msg);
    END;
  END;
END ShowBit.