home *** CD-ROM | disk | FTP | other *** search
/ Vectronix 2 / VECTRONIX2.iso / FILES_01 / HSPASCAL.LZH / HSPASCAL / GEMDEMO / WINDOWS.PAS < prev   
Pascal/Delphi Source File  |  1992-05-01  |  7KB  |  174 lines
  1. {-------------------------------------------------------------------------
  2.                 HighSpeed Pascal GEM-interface demo program
  3.  
  4.                                 WINDOW DEMO
  5.  
  6.                       Copyright (c) 1990 by D-House I
  7.                             All rights reserved
  8.  
  9.                       Programmed by Martin Eskildsen
  10. -------------------------------------------------------------------------}
  11. {$R-,S-,D+}
  12. program Window_Demo;
  13.  
  14. uses GemInterface, GemDecl, GemAES, GemVDI;
  15.  
  16. const
  17.   LeftButton    = 0;            { left mouse button             }
  18.   RightButton   = 1;            { right mouse button            }
  19.  
  20. var
  21.   w1, w2, w3    : integer;      { window handles                }
  22.   x, y, w, h    : integer;      { used for various purposes     }
  23.   Title2        : string;       { window 2's title string       }
  24.   Title3        : string;       { window 3's title string       }
  25.   InfoLine      : string;       { window 3's info line string   }
  26.   AllElements   : integer;      { all window elements           }
  27.   i             : 0..1000;      { slider position index         }
  28.   j             : 0..2;         { FOR index                     }
  29.   mouseX        : integer;      { mouse x pos                   }
  30.   mouseY        : integer;      { mouse y pos                   }
  31.   mouseKeys     : integer;      { mouse button state            }
  32.   window        : integer;      { window handle from wind_find  }
  33.   s             : string;       { message string                }
  34.  
  35. { Clear the work rectangle of the given window }
  36. procedure ClearWindow(window : integer);
  37. var
  38.   p : Array_4;                  { rectangle to clear            }
  39. begin
  40.   wind_update(BEG_UPDATE);      { we're working !               }
  41.   wind_get(window, WF_WORKXYWH, x, y, w, h);    { get work area }
  42.   p[0] := x;                    { set up rectangle              }
  43.   p[1] := y;
  44.   p[2] := x + w - 1;
  45.   p[3] := y + h - 1;
  46.   vs_clip(VDI_handle, 1, p);            { set clip rectangle    }
  47.   vsf_color(VDI_handle, WHITE);         { white,                }
  48.   vsf_interior(VDI_handle, SOLID);      { solid                 }
  49.   vr_recfl(VDI_handle, p);              { fill                  }
  50.   v_gtext(VDI_handle, x, y + CharDefs.h_char,
  51.           ' HighSpeed Pascal window demonstration program '#00);
  52.   wind_update(END_UPDATE)               { we're through working }
  53. end;
  54.  
  55. begin  { main }
  56.   if Init_Gem then begin
  57.     Message('Welcome to the window library demonstration!');
  58.  
  59.     Message('We will now create and open a simple window...');
  60.     x := MinX + 5;                      { make border size      }
  61.     y := MinY;
  62.     w := MaxW div 2 - 5;
  63.     h := MaxH div 2 - 5;
  64.     w1 := wind_create(0, x, y, w, h);   { create the window     }
  65.     wind_open(w1, x, y, w, h);          { open (display) it     }
  66.     ClearWindow(w1);                    { clear work area       }
  67.  
  68.     Message('and a second, more complex, one...');
  69.     x := x + w + 5;                     { make x pos            }
  70.     Title2 := ' Window 2 '#00#00;       { create title          }
  71.     { create window #2 }
  72.     w2 := wind_create(NAME + CLOSER + SIZER, MinX + 5, MinY + 5, MaxW - 10, MaxH - 10);
  73.     { set title : }
  74.     wind_set(w2, WF_NAME, HiPtr(Title2[1]), LoPtr(Title2[1]), 0, 0);
  75.     wind_open(w2, x, y, w, h);          { display window        }
  76.     ClearWindow(w2);                    { clear work rectangle  }
  77.  
  78.     Message('and finally the most advanced available.');
  79.     AllElements := NAME + CLOSER + FULLER + INFO + SIZER + UPARROW +
  80.                    DNARROW + VSLIDE + LFARROW + RTARROW + HSLIDE;
  81.     x := MinX + 5;                      { make border pos, size }
  82.     y := MinY + MaxH div 2;
  83.     w := MaxW - 2*5;
  84.     h := MaxH div 2;
  85.     Title3   := ' Window 3 '#00#00;     { create title          }
  86.     InfoLine := 'This is the window''s'
  87.                  + ' info line'#00#00;  { create info line      }
  88.     w3 := wind_create(AllElements, x, y, w, h);
  89.     { set title : }
  90.     wind_set(w3, WF_NAME, HiPtr(Title3[1]), LoPtr(Title3[1]), 0, 0);
  91.     { set info line : }
  92.     wind_set(w3, WF_INFO, HiPtr(InfoLine[1]), LoPtr(InfoLine[1]), 0, 0);
  93.     wind_open(w3, x, y, w, h);          { display window #3     }
  94.     ClearWindow(w3);                    { clear work area       }
  95.  
  96.     Message('Now we''ll activate the second window...');
  97.     wind_set(w2, WF_TOP, 0, 0, 0, 0);   { top #2                }
  98.  
  99.     Message('and change the size of it...');
  100.     wind_get(w2, WF_CURRXYWH, x, y, w, h);     { get curr. size }
  101.     w := w div 2;                              { make half width}
  102.     wind_set(w2, WF_CURRXYWH, x, y, w, h);     { set new size   }
  103.     ClearWindow(w2);                           { clear work area}
  104.  
  105.     Message('full it...');
  106.     wind_get(w2, WF_FULLXYWH, x, y, w, h);     { get max size   }
  107.     wind_set(w2, WF_CURRXYWH, x, y, w, h);     { set it         }
  108.     ClearWindow(w2);                           { clear work area}
  109.  
  110.     Message('and restore to previous size.');
  111.     wind_get(w2, WF_PREVXYWH, x, y, w, h);     { get prev. size }
  112.     wind_set(w2, WF_CURRXYWH, x, y, w, h);     { set it         }
  113.     { As window #2 overlaid the other two windows, thereby
  114.       destroying their work areas, they have to be cleared again}
  115.     ClearWindow(w1);                           { clear work #1  }
  116.     ClearWindow(w2);                           {            #2  }
  117.     ClearWindow(w3);                           {            #3  }
  118.  
  119.     Message('A window can be closed...');
  120.     wind_get(w3, WF_CURRXYWH, x, y, w, h);     { save size      }
  121.     wind_close(w3);                            { remove from VDU}
  122.  
  123.     Message('and opened again later.');
  124.     wind_open(w3, x, y, w, h);                 { display        }
  125.     ClearWindow(w3);                           { clear work area}
  126.  
  127.     Message('Let''s change the horizontal slider''s size in #3');
  128.     wind_set(w3, WF_HSLSIZE, 333, 0, 0, 0);    { size = 1/3 of  }
  129.                                                { max. possible  }
  130.  
  131.     Message('Now we''ll move the vertical slider.');
  132.     i := 0;
  133.     for j := 0 to 2 do begin
  134.       while i < 1000 do begin
  135.         inc(i, 100);
  136.         wind_set(w3, WF_VSLIDE, i, 0, 0, 0)    { set size       }
  137.       end;
  138.       while i > 0 do begin
  139.         dec(i, 100);
  140.         wind_set(w3, WF_VSLIDE, i, 0, 0, 0)    { set size       }
  141.       end
  142.     end;
  143.  
  144.     Inform('Move and click left mouse button; right completes');
  145.     graf_mouse(M_ON, NIL);
  146.     repeat
  147.       vq_mouse(VDI_handle, mouseKeys, mouseX, mouseY);
  148.       if BitTest(LeftButton, mouseKeys) then begin
  149.         window := wind_find(mouseX, mouseY);
  150.         if window = 0 then s := '-No window-'
  151.         else begin
  152.           str(window, s);
  153.           s := 'Window handle = ' + s
  154.         end;
  155.         s := s + '   Right button completes';
  156.         Inform(s)
  157.       end
  158.     until BitTest(RightButton, mouseKeys);
  159.     graf_mouse(M_OFF, NIL);
  160.  
  161.     Message('Now all is shown, so let''s close all windows...');
  162.     wind_close(w1);
  163.     wind_close(w2);
  164.     wind_close(w3);
  165.  
  166.     Message('remove them from memory and terminate!');
  167.     wind_delete(w1);
  168.     wind_delete(w2);
  169.     wind_delete(w3);
  170.  
  171.     Exit_Gem
  172.   end
  173. end.
  174.