home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Pascal / HISOFTPASCAL2,0-1.DMS / in.adf / HSPascal / AmigaDemos / WindowDemo.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1992-05-20  |  6.5 KB  |  153 lines
  1. {--------------------------------------------------------------------------
  2.  
  3.                      HighSpeed Pascal for the Amiga
  4.  
  5.                               WINDOW DEMO
  6.  
  7.                   Programmed by Martin Eskildsen 1991
  8.  
  9.                   Copyright (c) 1991 by D-House I ApS
  10.                          All rights reserved
  11.  
  12.  
  13.   Version : Date (dd.mm.yy) : Comment
  14.   -----------------------------------
  15.     1.00 : 20.07.91 : First version
  16.     1.01 : 17.09.91 : Modified for new libraries
  17.     1.02 : 06.11.91 : Final for first release
  18.     1.10 : 20.05.92 : Modified for new units
  19.  
  20. --------------------------------------------------------------------------}
  21.  
  22. program WindowDemo;
  23.  
  24. uses Init, Intuition, Graphics;
  25.  
  26. label
  27.   1;                                      { Disaster branch-out }
  28.  
  29. const
  30.   MaxWindows = 7;                         { Can't do more because of screen size }
  31.  
  32. var
  33.   w1def     : tNewWindow;                 { Defs for window 1 }
  34.   wdef      : tNewWindow;                 { Defs for other windows }
  35.   w         : array [1..MaxWindows] of pWindow;   { Window records }
  36.   i, j      : integer;                    { Index }
  37.   s            : string;                      { For text string }
  38.  
  39. begin
  40.   if PrepareEnvironment('Window') then begin     { Init Demo environment }
  41.  
  42.     Message('First, a simple window with borders only');
  43.     with w1def do begin                   { Set up window: }
  44.       LeftEdge       := 20;
  45.       TopEdge        := Init.TopOffset;   { Start below info window }
  46.       Width          := 210;
  47.       Height         := 75;
  48.       DetailPen      := 0;                { Color to use for details }
  49.       BlockPen       := 1;                { and blocks }
  50.       Title          := NIL;              { Window has no title bar, so NIL }
  51.       Flags          := SMART_REFRESH or  { Save parts in RAM }
  52.                         NOCAREREFRESH;    { Don't want no refresh messages }
  53.       IDCMPflags     := 0;                { Don't want any messages at all! }
  54.       Type_          := CUSTOMSCREEN;     { Put it on the CUSTOMSCREEN }
  55.       FirstGadget    := NIL;              { No gadgets attached }
  56.       CheckMark      := NIL;              { Usual check mark }
  57.       Screen         := Init.BaseScreen;  { The custom screen to use }
  58.       BitMap         := NIL;              { No special bitmap for window }
  59.       MinWidth       := Width;            { Values for user's resizing of }
  60.       MinHeight      := Height;           { window. Aren't used here as the }
  61.       MaxWidth       := MinWidth;         { window can't be resized }
  62.       MaxHeight      := MaxHeight
  63.     end;
  64.     w[1] := OpenWindow(@w1def);           { Open the window }
  65.     if Panic(w[1] = NIL, 'Could not open window 1!')  { Couldn't! }
  66.       then goto 1;                                    { Let's get out of here! }
  67.  
  68.     s := 'Window with borders only';
  69.     with w[1]^ do begin                   { Put some text in the window: }
  70.       Move_(RPort, 10,20);                { (x,y) for lower left corner }
  71.       Text_(RPort, @s[1], Ord(s[0]))      { The string and length to write }
  72.     end;
  73.  
  74.     Message('Then with the usual gadgets');
  75.     wdef := w1def;                        { Use same def as w[1] }
  76.     with wdef do begin                    { but change it a bit: }
  77.       inc(TopEdge,   15);                 { Move a bit down and }
  78.       inc(LeftEdge,  15);                 { to the right }
  79.       MinWidth   :=  40;                  { Make it resizable }
  80.       MinHeight  :=  20;
  81.       MaxWidth   := Init.ScrWidth;
  82.       MaxHeight  := Init.ScrHeight;
  83.       flags := flags or WINDOWCLOSE or    { Want the Close gadget, }
  84.                WINDOWDRAG or              { drag gadget, }
  85.                WINDOWDEPTH or             { depth arrangement gadgets, }
  86.                WINDOWSIZING;              { size gadget, too }
  87.       IDCMPflags := CLOSEWINDOW_;         { Want to know if user }
  88.                                           { clicked the Close gadget. }
  89.                                           { Note the underscore '_' }
  90.       Title := CStrConstPtr('Window 2'#0)
  91.     end;
  92.     w[2] := OpenWindow(@wdef);            { Open window 2 }
  93.     if Panic(w[2] = NIL, 'Could not open window 2!') then goto 1;
  94.  
  95.     DisableClose(w[2]);
  96. { This is funny! Now, if I want to be able to sense the Close gadget I have
  97.   to have the IDCMPflags set when opening the window. But I don't want to
  98.   sense this message right now, so I clear the CLOSEWINDOW_ flag immediately
  99.   upon creating the window.
  100.   This makes the program behave properly if the user clicks the "wrong"
  101.   Close gadget (i.e. in the wrong window) when there are two windows on the
  102.   screen. Try to remove DisableClose and play around with the Close clicks }
  103.  
  104.     Message('Nice name, right? Let''s call it something else');
  105.     SetWindowTitles(w[2],
  106.                     CStrConstPtr('Forty-two!'),
  107.                     ptr(-1));             { Don't change screen title }
  108.  
  109.     Inform('Say good-bye to window 2 by clicking its Close gadget');
  110.     WaitClose(w[2]);                      { Wait for user to click Close gadget }
  111.     CloseWindow(w[2]);                    { Close window 2 }
  112.  
  113.     Message('The application can resize the window (now six times)');
  114.     for i := 1 to 6 do SizeWindow(w[1], 20, 10);   { Delta x and y }
  115.  
  116.     Message('And change its position ten times 20 pixels');
  117.     for i := 1 to 10 do MoveWindow(w[1], 20, 0);   { Delta x and y }
  118.     
  119.     Message('Seen enough of that window, right? Let''s throw it away!');
  120.     CloseWindow(w[1]);
  121.     
  122.     Message('We shall now create a "stack" of windows');
  123.     wdef := w1def;
  124.     wdef.flags := wdef.flags or WINDOWDRAG or WINDOWDEPTH;
  125.     for i := 1 to MaxWindows do begin
  126.       with wdef do begin
  127.         inc(TopEdge,  10);
  128.         inc(LeftEdge, 20);
  129.         Title := CStrConstPtr('Window ' + chr(i + ord('@')) + #0)
  130.       end;
  131.       w[i] := OpenWindow(@wdef);
  132.       if Panic(w[i] = NIL, 'Error while opening a window!') then goto 1;
  133.       with w[i]^ do begin              { Put text in window }
  134.         Move_(RPort, 3, 20);           { at (3,20) }
  135.         for j := 1 to 24 do begin      { 24 letters: Window 1 = AAAAA... }
  136.           s[1] := chr(i + ord('@'));   {        Window 2 = BBBBB... etc. }
  137.           Text_(RPort, @s[1], 1)
  138.         end
  139.       end
  140.     end;
  141.  
  142.     Message('Now the application will "cycle" the stack');
  143.     for i := MaxWindows downto 1 do WindowToFront(w[i]);
  144.     
  145.     Message('Phew! Let''s close those windows again');
  146.     for i := MaxWindows downto 1 do CloseWindow(w[i]);
  147.  
  148.     1:                            { Where to go if the world gets "funny" }
  149.     CloseDown                     { Deinit Demo environment }
  150.   
  151.   end
  152. end.
  153.