home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / os2bnd01.zip / wintest.adb < prev   
Text File  |  1995-10-15  |  5KB  |  141 lines
  1. -- quick-and-dirty test program for the OS/2 bindings package
  2. -- 
  3. -- build (GNAT 2.06): 
  4. --     gcc -c wintest.adb
  5. --     gnatbl wintest.ali -o wintest
  6. --     emxbind -p wintest
  7.  
  8.  
  9. with OS2; use OS2;
  10. with Interfaces.C.Strings; use Interfaces.C.Strings;
  11.  
  12. procedure WinTest is 
  13.    hand_ab:    HAB;
  14.    hand_mq:    HMQ;
  15.    hand_frame:    HWND;
  16.    q_mess:    PQMSG := new QMSG;
  17.    flFlags:    PULONG;   
  18.    boolrc:    BOOL; 
  19.    class:    PCSZ := New_String("MyClass");
  20.    title:    PCSZ := New_String("A Window of MyClass");
  21.    ulongrc:    ULONG;
  22.    
  23.    p_space:    HPS;
  24.  
  25.    -- the message handler
  26.    function window_func(handle : HWND; mess: ULONG; 
  27.                         parm1: MPARAM; parm2: MPARAM) return MRESULT is
  28.    coords:    PPOINTL := new POINTL;
  29.    longrc:    LONG;
  30.    helptext:    PCSZ := New_String("click-move-release mouse button 1 or 2 to draw lines or boxes");
  31.    
  32.    begin
  33.       case mess is
  34.  
  35.          when WM_PAINT =>
  36.              p_space := WinBeginPaint(handle, NULLHANDLE, NULL);
  37.              boolrc :=  GpiSetBackMix(p_space, BM_OVERPAINT);
  38.  
  39.              coords.x := 10;
  40.              coords.y := 10;
  41.              boolrc   := GpiSetColor(p_space, CLR_BLACK);
  42.              longrc   := GpiCharStringAt(p_space,
  43.                                          coords,
  44.                                          LONG(Strlen(helptext)),
  45.                                          helptext);
  46.                                     
  47.              return OS2.FALSE;
  48.  
  49.          when WM_BUTTON1DOWN | WM_BUTTON2DOWN =>
  50.              coords.x := LONG(SHORT1FROMMP(parm1));
  51.              coords.y := LONG(SHORT2FROMMP(parm1));
  52.              boolrc   := GpiSetCurrentPosition(p_space, coords);
  53.              return OS2.FALSE;
  54.  
  55.          when WM_BUTTON1UP =>
  56.              coords.x := LONG(SHORT1FROMMP(parm1));
  57.              coords.y := LONG(SHORT2FROMMP(parm1));
  58.              boolrc   := GpiSetColor(p_space, CLR_BLUE);
  59.              longrc   := GpiLine(p_space, coords);
  60.              return OS2.FALSE;
  61.  
  62.          when WM_BUTTON2UP =>
  63.              coords.x := LONG(SHORT1FROMMP(parm1));
  64.              coords.y := LONG(SHORT2FROMMP(parm1));
  65.              boolrc   := GpiSetColor(p_space, CLR_RED);
  66.              longrc   := GpiBox(p_space, DRO_FILL, coords, 0, 0);
  67.              return OS2.FALSE;             
  68.  
  69.          when WM_ERASEBACKGROUND =>
  70.              return OS2.TRUE;
  71.  
  72.          when WM_CLOSE =>
  73.              boolrc := WinEndPaint(p_space);
  74.  
  75.              ulongrc := WinMessageBox(HWND_DESKTOP, 
  76.                                       handle,
  77.                                       New_String("Thanks for making a " &
  78.                                                  "simple program very happy."),
  79.                                       New_String("Goodbye"),
  80.                                       0,
  81.                                       MB_OK+MB_MOVEABLE+MB_ICONEXCLAMATION);
  82.  
  83.              return WinDefWindowProc(handle, mess, parm1, parm2);
  84.          when others =>
  85.              return WinDefWindowProc(handle, mess, parm1, parm2);
  86.       end case;
  87.    end window_func;
  88.  
  89.  
  90. begin
  91.  
  92.    flFlags := new ULONG'(FCF_TITLEBAR+
  93.                          FCF_SIZEBORDER+
  94.                          FCF_MINMAX+
  95.                          FCF_SYSMENU+
  96.                          FCF_VERTSCROLL+
  97.                          FCF_HORZSCROLL+
  98.                          FCF_TASKLIST+
  99.                          FCF_SHELLPOSITION);
  100.    
  101.    hand_ab := WinInitialize(0);
  102.    hand_mq := WinCreateMsgQueue(hand_ab, 0);
  103.  
  104.    
  105.    boolrc := WinRegisterClass(hand_ab, 
  106.                               class,             
  107.                               window_func'access,    -- caution
  108.                               CS_SIZEREDRAW,
  109.                               0);
  110.  
  111.    hand_frame := WinCreateStdWindow(HWND_DESKTOP,
  112.                                     WS_VISIBLE,
  113.                                     flFlags,     
  114.                                     class,    
  115.                      title,     
  116.                     WS_VISIBLE,
  117.                     0,
  118.                     0,
  119.                     NULL);
  120.  
  121.  
  122.    boolrc := BOOL(WinSendMsg(hand_frame, 
  123.                              WM_SETICON, 
  124.                              MPARAM(WinQuerySysPointer(HWND_DESKTOP, 
  125.                                                        SPTR_ICONINFORMATION, 
  126.                                                        0)),
  127.                              0));
  128.  
  129.    while WinGetMsg(hand_ab, q_mess, HWND(0), 0, 0) = OS2.TRUE
  130.       loop
  131.          boolrc:= BOOL(WinDispatchMsg(hand_ab, q_mess));
  132.       end loop;
  133.  
  134.    boolrc := WinDestroyWindow(hand_frame);
  135.    boolrc := WinDestroyMsgQueue(hand_mq);
  136.    boolrc := WinTerminate(hand_ab);
  137.  
  138. end WinTest;
  139.  
  140. -- eof
  141.