OwnerDrw.mod: Translation to Stony Brook Modula-2

Last updated: 15. 1.1998, 21:42

<*/NOWARN:F*>
MODULE OwnerDrw;
(*----------------------------------------------
   OWNERDRW.C      --- Owner-Draw Button Demo Program
                   (c) Charles Petzold, 1996
   OwnerDrw.mod    --- Translation to Stony Brook Modula-2
                   (c) Peter Stadler,   1998
  ----------------------------------------------*)
IMPORT WIN32;
IMPORT WINX;
IMPORT WINGDI;
IMPORT WINUSER;
IMPORT SYSTEM;

CONST
  IDC_SMALLER =  1;
  IDC_LARGER  =  2;



VAR
  hInst      :  WIN32.HINSTANCE;

CONST
  szAppName    =  "OwnerDrw";

VAR
  hwnd         :  WIN32.HWND;
  msg          :  WINUSER.MSG;
  wc           :  WINUSER.WNDCLASSEX;
VAR
  hwndSmaller    : WIN32.HWND;
  hwndLarger     : WIN32.HWND;
  cxClient       : INTEGER;
  cyClient       : INTEGER;
  cxChar         : INTEGER;
  cyChar         : INTEGER;
  BTN_WIDTH      : INTEGER;
  BTN_HEIGHT     : INTEGER;
(**********************************************************************)
PROCEDURE Triangle (hdc : WIN32.HDC; pt : ARRAY OF WIN32.POINT);
(**********************************************************************)
BEGIN
     WINGDI.SelectObject (hdc, WINGDI.GetStockObject (WINGDI.BLACK_BRUSH));
     WINGDI.Polygon (hdc, pt, 3);
     WINGDI.SelectObject (hdc, WINGDI.GetStockObject (WINGDI.WHITE_BRUSH));
END Triangle;

<*/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
  cx      :  INTEGER;
  cy      :  INTEGER;
  rc      :  WIN32.RECT;
  pdis    :  WINUSER.LPDRAWITEMSTRUCT;
  pt      :  ARRAY[0..2] OF WIN32.POINT;
BEGIN
  CASE (iMsg) OF
          | WINUSER.WM_CREATE :
               cxChar := WINUSER.LOWORD (WINUSER.GetDialogBaseUnits ());
               cyChar := WINUSER.HIWORD (WINUSER.GetDialogBaseUnits ());
	       BTN_WIDTH   :=  8*cxChar;
               BTN_HEIGHT  :=  4*cyChar;

                         (* Create the owner-draw pushbuttons                  *)

               hwndSmaller := WINUSER.CreateWindow ("button", "",
                                  WINUSER.WS_CHILD BOR WINUSER.WS_VISIBLE BOR WINUSER.BS_OWNERDRAW,
                                  0, 0, BTN_WIDTH, BTN_HEIGHT,
                                  hwnd, SYSTEM.CAST(WIN32.HMENU,IDC_SMALLER), hInst, NIL);

               hwndLarger := WINUSER.CreateWindow ("button", "",
                                  WINUSER.WS_CHILD BOR WINUSER.WS_VISIBLE BOR WINUSER.BS_OWNERDRAW,
                                  0, 0, BTN_WIDTH, BTN_HEIGHT,
                                  hwnd, SYSTEM.CAST(WIN32.HMENU,IDC_LARGER), hInst, NIL);
               RETURN 0;

          | WINUSER.WM_SIZE :
               cxClient := WINUSER.LOWORD (lParam);
               cyClient := WINUSER.HIWORD (lParam);

                         (* Move the buttons to the new center                 *)

               WINUSER.MoveWindow (hwndSmaller, cxClient DIV 2 - 3 * BTN_WIDTH  DIV 2,
                                        cyClient DIV 2 -     BTN_HEIGHT DIV 2,
                                        BTN_WIDTH, BTN_HEIGHT, TRUE);

               WINUSER.MoveWindow (hwndLarger,  cxClient DIV 2 +     BTN_WIDTH  DIV 2,
                                        cyClient DIV 2 -     BTN_HEIGHT DIV 2,
                                        BTN_WIDTH, BTN_HEIGHT, TRUE);
               RETURN 0;

          | WINUSER.WM_COMMAND :
               WINUSER.GetWindowRect (hwnd, rc);

                         (* Make the window 10% smaller or larger              *)

               CASE (wParam) OF
                    | IDC_SMALLER :
                         rc.left   := rc.left   + cxClient DIV 20;
                         rc.right  := rc.right  - cxClient DIV 20;
                         rc.top    := rc.top    + cyClient DIV 20;
                         rc.bottom := rc.bottom - cyClient DIV 20;

                    | IDC_LARGER :
                         rc.left   := rc.left   - cxClient DIV 20;
                         rc.right  := rc.right  + cxClient DIV 20;
                         rc.top    := rc.top    - cyClient DIV 20;
                         rc.bottom := rc.bottom + cyClient DIV 20;

               ELSE
               END;
               WINUSER.MoveWindow (hwnd, rc.left, rc.top, rc.right  - rc.left,
                                                  rc.bottom - rc.top, TRUE);
               RETURN 0;

          | WINUSER.WM_DRAWITEM :
               pdis := SYSTEM.CAST(WINUSER.LPDRAWITEMSTRUCT,lParam);

                         (* Fill area with white and frame it black            *)

               WINUSER.FillRect (pdis^.hDC, pdis^.rcItem,
                         SYSTEM.CAST(WIN32.HBRUSH,WINGDI.GetStockObject (WINGDI.WHITE_BRUSH)));

               WINUSER.FrameRect (pdis^.hDC, pdis^.rcItem,
                          SYSTEM.CAST(WIN32.HBRUSH,WINGDI.GetStockObject (WINGDI.BLACK_BRUSH)));


                         (* Draw inward and outward black triangles            *)

               cx := pdis^.rcItem.right  - pdis^.rcItem.left;
               cy := pdis^.rcItem.bottom - pdis^.rcItem.top ;

               CASE (pdis^.CtlID) OF
                    | IDC_SMALLER :
                         pt[0].x := 3 * cx DIV 8;  pt[0].y := 1 * cy DIV 8;
                         pt[1].x := 5 * cx DIV 8;  pt[1].y := 1 * cy DIV 8;
                         pt[2].x := 4 * cx DIV 8;  pt[2].y := 3 * cy DIV 8;

                         Triangle (pdis^.hDC, pt);

                         pt[0].x := 7 * cx DIV 8;  pt[0].y := 3 * cy DIV 8;
                         pt[1].x := 7 * cx DIV 8;  pt[1].y := 5 * cy DIV 8;
                         pt[2].x := 5 * cx DIV 8;  pt[2].y := 4 * cy DIV 8;

                         Triangle (pdis^.hDC, pt);

                         pt[0].x := 5 * cx DIV 8;  pt[0].y := 7 * cy DIV 8;
                         pt[1].x := 3 * cx DIV 8;  pt[1].y := 7 * cy DIV 8;
                         pt[2].x := 4 * cx DIV 8;  pt[2].y := 5 * cy DIV 8;

                         Triangle (pdis^.hDC, pt);

                         pt[0].x := 1 * cx DIV 8;  pt[0].y := 5 * cy DIV 8;
                         pt[1].x := 1 * cx DIV 8;  pt[1].y := 3 * cy DIV 8;
                         pt[2].x := 3 * cx DIV 8;  pt[2].y := 4 * cy DIV 8;

                         Triangle (pdis^.hDC, pt);

                    | IDC_LARGER :

                         pt[0].x := 5 * cx DIV 8;  pt[0].y := 3 * cy DIV 8;
                         pt[1].x := 3 * cx DIV 8;  pt[1].y := 3 * cy DIV 8;
                         pt[2].x := 4 * cx DIV 8;  pt[2].y := 1 * cy DIV 8;

                         Triangle (pdis^.hDC, pt);

                         pt[0].x := 5 * cx DIV 8;  pt[0].y := 5 * cy DIV 8;
                         pt[1].x := 5 * cx DIV 8;  pt[1].y := 3 * cy DIV 8;
                         pt[2].x := 7 * cx DIV 8;  pt[2].y := 4 * cy DIV 8;

                         Triangle (pdis^.hDC, pt);

                         pt[0].x := 3 * cx DIV 8;  pt[0].y := 5 * cy DIV 8;
                         pt[1].x := 5 * cx DIV 8;  pt[1].y := 5 * cy DIV 8;
                         pt[2].x := 4 * cx DIV 8;  pt[2].y := 7 * cy DIV 8;

                         Triangle (pdis^.hDC, pt);

                         pt[0].x := 3 * cx DIV 8;  pt[0].y := 3 * cy DIV 8;
                         pt[1].x := 3 * cx DIV 8;  pt[1].y := 5 * cy DIV 8;
                         pt[2].x := 1 * cx DIV 8;  pt[2].y := 4 * cy DIV 8;

                         Triangle (pdis^.hDC, pt);
              ELSE
              END;
                         (* Invert the rectangle if the button is selected     *)

               IF (pdis^.itemState BAND WINUSER.ODS_SELECTED=1) THEN
                    WINUSER.InvertRect (pdis^.hDC, pdis^.rcItem);

               END;
                         (* Draw a focus rectangle if the button has the focus *)

               IF (pdis^.itemState BAND WINUSER.ODS_FOCUS=1) THEN
                    pdis^.rcItem.left   := pdis^.rcItem.left   + cx DIV 16;
                    pdis^.rcItem.top    := pdis^.rcItem.top    + cy DIV 16;
                    pdis^.rcItem.right  := pdis^.rcItem.right  - cx DIV 16;
                    pdis^.rcItem.bottom := pdis^.rcItem.bottom - cy DIV 16;

                    WINUSER.DrawFocusRect (pdis^.hDC, pdis^.rcItem);
               END;

               RETURN 0;

          | WINUSER.WM_DESTROY :
               WINUSER.PostQuitMessage (0);
               RETURN 0;
     ELSE
               RETURN WINUSER.DefWindowProc (hwnd, iMsg, wParam, lParam);
     END;
END WndProc;
<*/POP*>
(*++++*****************************************************************)
PROCEDURE InitApplication () : BOOLEAN;
(**********************************************************************)
VAR
  rc   :  CARDINAL;
BEGIN
  hInst := WINX.Instance;

  wc.cbSize        := SIZE(wc);
  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  := SYSTEM.ADR(szAppName);
  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            *)
                       "Owner-Draw Button Demo: 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           *)
                       wc.hInstance,                   (* 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 OwnerDrw.