home *** CD-ROM | disk | FTP | other *** search
/ Vectronix 2 / VECTRONIX2.iso / FILES_01 / HISPEED2.LZH / GEMDEMO / ACCDEMO.PAS next >
Pascal/Delphi Source File  |  1991-07-02  |  5KB  |  139 lines
  1. {A skeleton program for a Desk  ACCessory}
  2. {You may change it into whatever you like, by rewriting RedrawWindow}
  3.  
  4. Program ACCDemo;
  5. {$R-,S-,D-}
  6. {$M 4,1,1,20} {4KByte stack, 1KByte heap, unused, unused}
  7.  
  8. Uses GemDecl,GemAes,GemVdi,Dos;
  9.  
  10. Var
  11.   ACCtitle,Title: String[15];
  12.   DeskTop: GRect;
  13.   MyWindow, VdiHandle, appl_id, deskId, LastTime: Integer;
  14.   QuitFlag: Boolean;
  15.  
  16. Procedure OpenWork;
  17. var
  18.   i, WSysChar,HSysChar,WSysCharBox,HSysCharBox: Integer;
  19.   work_in:  intin_ARRAY;
  20.   work_out: workout_ARRAY;
  21. begin
  22.   for i:=0 to 9 do work_in[i]:=1;
  23.   work_in[10]:=2;
  24.   VdiHandle:=graf_handle(WSysChar, HSysChar, WSysCharBox, HSysCharBox);
  25.   v_opnvwk(work_in, VdiHandle, work_out);
  26.   with DeskTop do begin
  27.     x:=0; y:=0; w:=work_out[0]; h:=work_out[1];
  28.   end;
  29. end;
  30.  
  31. Procedure OpenWindow;
  32. begin
  33.   if MyWindow = 0 then begin
  34.     with DeskTop do
  35.       MyWindow:=wind_create(NAME+CLOSER+MOVER, 0, 0, w, h);
  36.     if MyWindow <= 0 then Exit;
  37.     wind_set(MyWindow, WF_NAME, HiPtr(Title[1]), LoPtr(Title[1]), 0, 0);
  38.     wind_open(MyWindow, 30, 30, 150, 80);
  39.   end else
  40.     wind_set(MyWindow, WF_TOP,0,0,0,0);
  41. end;
  42.  
  43. Procedure RedrawWindow(DrawAll: Boolean);
  44. var
  45.   WindowRect,MyArea: GRect;   {Using x,y,w,h system}
  46.   Clip: ARRAY_4;              {Using x1,y1,x2,y2 system}
  47.   S: String[9];
  48.   Year, Month, Day, Hour, Minute, Sec, S100, DayOfWeek: integer;
  49. begin
  50.   if MyWindow = 0 then exit;
  51.   GetDate(Year, Month, Day, DayOfWeek); GetTime(Hour, Minute, Sec, s100);
  52.   if (Sec <> LastTime)  or DrawAll  then
  53.   begin
  54.     LastTime:=Sec;
  55.     Str(Sec:3,S);                      {Make something to write}
  56.     graf_mouse(M_OFF, NIL);            {Hide the cursor while drawing}
  57.     vsf_color(VdiHandle, White);
  58.     vswr_mode(VdiHandle, MD_REPLACE);
  59.  
  60.     with MyArea do wind_get(MyWindow, WF_WORKXYWH, x, y, w, h);
  61.     with WindowRect do wind_get(MyWindow, WF_FIRSTXYWH, x, y, w, h);
  62.  
  63.     if intersect(DeskTop, MyArea) then {Stay inside the screen. Updates MyArea!}
  64.       while not EmptyRect(WindowRect) do begin
  65.         if intersect(MyArea, WindowRect) then begin
  66.           MakeXYXY(WindowRect, Clip);
  67.           vs_clip(VdiHandle, 1, Clip);    {Unused, but better safe than sorry!}
  68.           if DrawAll then vr_recfl(VdiHandle, Clip); {Clear whole area}
  69.           with MyArea do
  70.             v_gtext(VdiHandle, x+(w div 2)-20, y+(h div 2), s);
  71.         end;
  72.         with WindowRect do wind_get(MyWindow, WF_NEXTXYWH, x, y, w, h);
  73.       end;
  74.     graf_mouse(M_ON, NIL);
  75.   end
  76. end;
  77.  
  78. Procedure HandleMsg(Var MsgBuf: array_8);
  79. begin
  80.   case MsgBuf[0] of
  81.   AC_OPEN:    if MsgBuf[4] = deskId then OpenWindow;
  82.   AC_CLOSE:   if MsgBuf[3] = deskId then MyWindow:=0;
  83.   WM_REDRAW:  RedrawWindow(True);
  84.   WM_TOPPED:  wind_set(MyWindow, WF_TOP,0,0,0,0 );
  85.   WM_CLOSED:  begin
  86.                 if MsgBuf[3] = MyWindow then begin
  87.                   wind_close(MyWindow); wind_delete(MyWindow); MyWindow:=0;
  88.                 end;
  89.                 if AppFlag then QuitFlag:=True; { Stop }
  90.               end;
  91.   WM_MOVED,
  92.   WM_SIZED:   if MsgBuf[3] = MyWindow then
  93.                 wind_set(MyWindow, WF_CURRXYWH,
  94.                          MsgBuf[4], MsgBuf[5], MsgBuf[6], MsgBuf[7]);
  95.   end;
  96. end;
  97.  
  98. Procedure EventLoop;
  99. var
  100.   event, mx, my, mbutton, kstate, key, clicks: Integer;
  101.   MsgBuf: array_8;
  102. begin
  103.   event:=evnt_multi(MU_MESAG  or  MU_TIMER or MU_KEYBD,
  104.                     1, $0001, $0001, {clicks, mask, state}
  105.                     0, 0, 0, 0, 0,   {M1 data}
  106.                     0, 0, 0, 0, 0,   {M2 data}
  107.                     MsgBuf,
  108.                     250, 0,     {Timer. HiWord first. LoWord almost always 0}
  109.                     mx, my, mbutton, kstate, key, clicks);
  110.   wind_update(BEG_UPDATE);
  111.   if (event and MU_MESAG) <> 0 then HandleMsg(MsgBuf);
  112.   if (event and MU_TIMER) <> 0 then RedrawWindow(False);
  113.   if AppFlag and ((event and MU_KEYBD) <>0 ) and (key = Ctrl_Q) then
  114.     QuitFlag:=True;
  115.   wind_update(END_UPDATE);
  116. end;
  117.  
  118. { Main part of program}
  119. begin
  120.   QuitFlag:=false;
  121.   Title    := ' My first ACC '#0;        { Window title. (C string)}
  122.   ACCtitle := '  My own ACC'#0;          { Menu title.   (C string)}
  123.   appl_id:=appl_init;
  124.   if appl_id <> -1 then begin
  125.     OpenWork;
  126.     if VdiHandle <> 0 then begin
  127.       if AppFlag then begin
  128.         OpenWindow;
  129.         repeat EventLoop until QuitFlag;
  130.       end else begin
  131.         deskId:=menu_register(appl_id,ACCtitle[1]);
  132.         repeat EventLoop until FALSE; {Stay here forever}
  133.       end;
  134.       v_clsvwk(VdiHandle);
  135.     end;
  136.     appl_exit;
  137.   end
  138. end.
  139.