Crawly Crypt Collection 2/crawlyvol2.bin/program/pascal/sgem122p/demo/demo.pas

Pascal/Delphi Source File | 1994-05-30 | 22.2 KB | 563 lines

(* ------------------------------------------------------------------- *)
(* Module Type          : *) PROGRAM
(* Module Name          : *) Demo;
(* Module Param         : *) {$X+}
(* Module Version       : 1.22                                         *
 * Module Date          : 30-05-94                                     *
 * Last Change          : 30-05-94                                     *
 * Author               : Andrea Pietsch                               *
 * Programming Language : Pure-Pascal                                  *
 * Copyright            : (c) 1994, Andrea Pietsch, 56727 Mayen        *
 * ------------------------------------------------------------------- *)

USES    SYS_GEM, GEM;

(* ------------------------------------------------------------------- *)

{$I DEMO.I }

(* ------------------------------------------------------------------- *)

CONST   USR_KEY         = 0;

(* ------------------------------------------------------------------- *)

        ASK_TERM        = '[2][ Wollen Sie das Demo | wirklich verlassen? ][ [Nein | [Ja ]';
        NO_DRAG         = '[1][ Auf dieses Fenster können | Sie keine Objekte ziehen! ][ [Abbruch ]';

(* ------------------------------------------------------------------- *)

VAR     par             : PARAMETER;
        win_id          : LONGINT;
        pop             : INTEGER;
        slid_txt        : ARRAY [1..20] OF STRING [35];
        zeit            : LONGINT;
        s               : STRING;
        i               : INTEGER;

(* ------------------------------------------------------------------- *)

        rsc_main        : AESTreePtr;
        rsc_menu        : AESTreePtr;
        rsc_info        : AESTreePtr;
        rsc_bits        : AESTreePtr;
        rsc_tool        : AESTreePtr;
        rsc_pop         : AESTreePtr;
        rsc_edit        : AESTreePtr;

(* ------------------------------------------------------------------- *)

PROCEDURE LoadText ( CONST fname : STRING ); FORWARD;

(* -------------------------------------------------------------------
 * Zeichnet die "Uhr" im Fenster jede Sekunde
 * ------------------------------------------------------------------- *)

PROCEDURE draw_bits;

VAR     s : STRING [10];

BEGIN
  zeit := zeit + 1;
  str ( zeit : 5, s );
  SetText ( rsc_bits, BI_SEC, s );
  RedrawObj ( rsc_bits, BI_SEC, 0, NONE, UPD_STATE );
END;

(* -------------------------------------------------------------------
 * Behandelt die Aktivitäten des "Uhren"-Fensters. Wenn das Fenster
 * ausgeblendet oder Iconifiziert wird, müssen die Timer-Funktion
 * ausgeschaltet werden.
 * ------------------------------------------------------------------- *)

FUNCTION handle_bits ( msg, button : INTEGER; inf : DIALOG_INFO_PTR ) : INTEGER;

BEGIN
  CASE msg OF
    SG_START     : BEGIN
                     SetText ( rsc_bits, BI_SEC, '' );
                     SetProcTimer ( draw_bits );
                     SetTimer ( 1000, 0 );
                   END;
    SG_INVISIBLE : SetTimer ( 0, 0 );
    SG_VISIBLE   : SetTimer ( 1000, 0 );
    SG_QUIT,
    SG_END       : BEGIN
                     SetTimer ( 0, 0 );
                     handle_bits := SG_CLOSE;
                     exit;
                   END;
  END;
  handle_bits := SG_CONT;
END;

(* -------------------------------------------------------------------
 * Soll ein Fensterdialog geöffnet werden und steht kein Fenster mehr
 * zur Verfügung, so kann der Dialog entweder abgebrochen (DIAL_ABORT)
 * werden, oder als "normale" Dialogbox weitergeführt werden.
 * ------------------------------------------------------------------- *)

FUNCTION no_window_left : INTEGER;

BEGIN
  IF ( Alert ( ALERT_NORM, 1, '[4][ Kein Fenster mehr frei! | Möchten Sie mit einer | Dialogbox weiterarbeiten? ][ [Ja | [Nein ]' ) = 1 ) THEN
    BEGIN
      no_window_left := SG_CONT;
      exit;
    END;
  no_window_left := SG_ABORT;
END;

(* -------------------------------------------------------------------
 * Mit Hilfe von einer solchen Funktion, können ohne Probleme bestimmte
 * Werte oder Zustände in einem Dialog geprüft werden.
 *
 * ed ist dabei die positive Nummer des Editfeldes, wenn der Cursor das
 * Feld verlassen soll, negativ, wenn der Cursor das Feld betritt.
 *
 * Id ist die Id, die bei WindowDialog angegeben wurde. So kann man eine
 * Routine zum Testen mehrerer Dialoge verwenden.
 *
 *
 * Rückgabe:  -1   Der Cursor soll im Feld bleiben
 *             0   Cursor wurde mittels SetEditField schon gesetzt
 *             1   ok. Weitermachen!
 * ------------------------------------------------------------------- *)

FUNCTION check_range ( tree : AESTreePtr; ed : INTEGER; id : LONGINT ) : INTEGER;

VAR     s   : STRING [80];
        i   : INTEGER;
        res : INTEGER;

BEGIN
  IF ( tree = rsc_edit ) THEN
    BEGIN
      IF ( ed > 0 ) THEN
        BEGIN
          GetText ( rsc_edit, ed, s );
          val ( s, i, res );
          CASE ed OF
            SE_Z50_100 : BEGIN
                           IF (( i < 50 ) or ( i > 100 )) THEN
                             BEGIN
                               Alert ( ALERT_NORM, 1, '[1][ Die Zahl soll zwischen | 50..100 liegen! ][ [Nochmal ]' );
                               check_range := -1;
                               exit;
                             END;
                         END;
            SE_Z90_200 : BEGIN
                           IF (( i < 90 ) or ( i > 200 )) THEN
                             BEGIN
                               Alert ( ALERT_NORM, 1, '[1][ Die Zahl soll zwischen | 90..200 liegen! ][ [Nochmal ]' );
                               check_range := -1;
                               exit;
                             END;
                         END;
            SE_Z99_101 : BEGIN
                           IF (( i < 99 ) or ( i > 101 )) THEN
                             BEGIN
                               Alert ( ALERT_NORM, 1, '[1][ Die Zahl soll zwischen | 99..101 liegen! ][ [Nochmal ]' );
                               check_range := -1;
                               exit;
                             END;
                         END;
            END;
        END;
    END;
  check_range := 1;
END;

(* -------------------------------------------------------------------
 * Behandelt alle Aktionen wärend einem Dialog.
 *
 * SG_NOWIN     Kein Fenster mehr da. SG_CONT bedeutet, als Dialog
 *              darstellen --> ist wichtig!
 *
 * SG_START     Der Dialog wird gleich gezeichnet. Hier ist Zeit für
 *              eine eventuelle Initialisierung des Dialogs, Buttons,
 *              Editfelder etc...
 *
 * SG_END       Dialog soll geschlossen werden. button enthält das
 *              Objekt, den der Benutzer gewählt hat.
 *
 * SG_QUIT      wird nach dem Schliessen aufgerufen. Evtl. Speicher
 *              sollte hier freigegeben werden.
 *
 * SG_DRAGDROP  Der User hat Objekte auf das Fenster gezogen. Ob Sie die
 *              Nachricht auswerten oder nicht, liegt allein bei Ihnen.
 * ------------------------------------------------------------------- *)

FUNCTION handle_edit ( msg, button : INTEGER; inf : DIALOG_INFO_PTR ) : INTEGER;

BEGIN
  CASE msg OF
    SG_NOWIN    : BEGIN
                    handle_edit := no_window_left;
                    exit;
                  END;
    SG_START    : BEGIN
                    ClearEditFields ( rsc_edit );
                    SetReturn ( 1 );
                    SetFieldProc ( check_range );
                    SetText ( rsc_edit, SE_Z50_100, '20'  );
                    SetText ( rsc_edit, SE_Z90_200, '100' );
                    SetText ( rsc_edit, SE_Z99_101, '100' );
                  END;
    SG_END      : BEGIN
                    IF ( button = SE_CLR ) THEN
                      BEGIN
                        ClearEditFields ( rsc_edit );
                        SetEditField ( rsc_edit, SE_Z50_100 );
                        SetText ( rsc_edit, SE_Z50_100, '20'  );
                        SetText ( rsc_edit, SE_Z90_200, '100' );
                        SetText ( rsc_edit, SE_Z99_101, '100' );
                        handle_edit := SG_REDRAW;
                        exit;
                      END
                    ELSE
                      BEGIN
                        handle_edit := SG_CLOSE;
                        exit;
                      END;
                  END;
    SG_DRAGDROP : Alert ( ALERT_NORM, 1, '[1][ Drag & Drop Aktionen | in dieses Fenster | sind nicht möglich! ][ [Abbruch ]' );
  END;
  handle_edit := SG_CONT;
END;

(* -------------------------------------------------------------------
 * Verwaltet die Textfenster. Beim Klick ins Fenster können die Stati
 * der Zeile eingestellt werden (SG_.CLICK), oder beim Klick in die
 * Toolbar wird sortiert (SG_BUTTON).
 * ------------------------------------------------------------------- *)

FUNCTION handle_text ( msg : INTEGER; inf : WINDOW_INFO_PTR ) : INTEGER;

VAR     s : STRING [200];
        i : INTEGER;

BEGIN
  CASE msg OF
    SG_END     : BEGIN
                   handle_text := SG_CLOSE;
                   exit;
                 END;
    SG_BUTTON  : BEGIN
                   IF ( inf^.obj_id = MakeId ( 'TOOL' )) THEN
                     BEGIN
                       IF ( inf^.item = TO_SORT ) THEN
                         BEGIN
                           i := Alert ( ALERT_NORM, 3, '[2][ Wie soll sortiert werden? ][ [Auf | A[b | [Nix ]' );
                           IF ( i = 1 ) THEN do_qsort ( inf^.id, cmp_strings_up );
                           IF ( i = 2 ) THEN do_qsort ( inf^.id, cmp_strings_dn );
                         END;
                     END;
                 END;
    SG_KEY     : BEGIN
                   CASE inf^.key OF
                     $4800 : ScrollWindow ( inf^.handle, SCROLL_UP );
                     $4b00 : ScrollWindow ( inf^.handle, SCROLL_LEFT );
                     $5000 : ScrollWindow ( inf^.handle, SCROLL_DOWN );
                     $4d00 : ScrollWindow ( inf^.handle, SCROLL_RIGHT );
                     $4838 : ScrollWindow ( inf^.handle, SCROLL_PG_UP );
                     $4b34 : ScrollWindow ( inf^.handle, SCROLL_PG_LEFT );
                     $5032 : ScrollWindow ( inf^.handle, SCROLL_PG_DOWN );
                     $4d36 : ScrollWindow ( inf^.handle, SCROLL_PG_RIGHT );
                   END;
                 END;
    SG_LCLICK1,
    SG_LCLICK2,
    SG_RCLICK1,
    SG_RCLICK2 : BEGIN
                   IF ( inf^.line_ptr <> NIL ) THEN
                     BEGIN
                       str ( inf^.line, s );
                       s := concat ( '[2][ Sie haben Zeile ', s, ' angeklickt. | Darstellung ändern: ][ [Fett | [Kursiv | [Unterst. | [Nix ]' );
                       CASE Alert ( ALERT_NORM, 4, s ) OF
                         1 : BEGIN
                               inf^.line_ptr^ := #1;
                               RedrawArea ( inf^.handle, inf^.draw_area );
                             END;
                         2 : BEGIN
                               inf^.line_ptr^ := #4;
                               RedrawArea ( inf^.handle, inf^.draw_area );
                             END;
                         3 : BEGIN
                               inf^.line_ptr^ := #8;
                               RedrawArea ( inf^.handle, inf^.draw_area );
                             END;
                         END;
                       END;
                 END;
    SG_DRAGDROP: BEGIN
                   ctopascalstring ( s, inf^.dd^.data );
                   LoadText ( s );
                 END;
  END;
  handle_text := SG_CONT;
END;

(* -------------------------------------------------------------------
 * Lädt eine Textdatei und stellt sie im Fenster dar. Die Fenster
 * werden von SysGem verwaltet. Würde statt 'handle_text' NULL über-
 * geben, würde auf keine Nachricht reagiert, außer auf das Schließen
 * des Fensters.
 * ------------------------------------------------------------------- *)

PROCEDURE LoadText ( CONST fname : STRING );

VAR     i : WORD;

BEGIN
  IF ( length ( fname ) > 4 ) THEN
    BEGIN
      ShowBee;
      i := Display ( fname, fname, '', 255, win_id, 8, 90, 300, 200, handle_text );
      ShowArrow;
      IF ( i = 0 ) THEN
        BEGIN
          Alert ( ALERT_NORM, 1, '[1][ Die Datei konnte nicht | geladen werden! ][ [Abbruch ]' );
        END
      else
        BEGIN
          i := WORD ( SetWindowParm ( GetHandle ( win_id ), SET_W, -1 ));
          SetWinMaxSize ( win_id, i, -1 );
          LinkTree ( win_id, rsc_tool, MakeId ( 'TOOL' ), LINK_TOP );
          inc ( win_id );
        END;
    END;
END;

(* ------------------------------------------------------------------- *)

FUNCTION handle_main ( msg, button : INTEGER; inf : DIALOG_INFO_PTR ) : INTEGER;

VAR     s : STRING [255];

BEGIN
  CASE msg OF
    SG_START    : LinkSlider ( rsc_main, MA_UP, MA_DN, MA_SHOW, MA_HIDE, 20, MA_BOX, @slid_txt, sizeof ( slid_txt [1] ), 0 );
    SG_END      : BEGIN
                    CASE button OF
                      -1       : BEGIN
                                   IF ( Alert ( ALERT_NORM, 1, ASK_TERM ) = 2 ) THEN
                                     BEGIN
                                       handle_main := SG_TERM;
                                       exit;
                                     END;
                                 END;
                      MA_POP1  : BEGIN
                                   xPopUp ( rsc_main, MA_POP1, rsc_pop, 0, pop );
                                   RedrawObj ( rsc_main, MA_POP2, 0, NONE, UPD_STATE );
                                 END;
                      MA_POP2  : BEGIN
                                   Cycle ( rsc_main, MA_POP1, rsc_pop, SP_1, SP_16, pop );
                                   RedrawObj ( rsc_main, MA_POP2, 0, NONE, UPD_STATE );
                                 END;
                      MA_LIST1,
                      MA_LIST2 : BEGIN
                                   s := '';
                                   s := s + ' Weiß      ' + #0;
                                   s := s + ' Schwarz   ' + #0;
                                   s := s + ' Rot       ' + #0;
                                   s := s + ' Grün      ' + #0;
                                   s := s + ' Blau      ' + #0;
                                   s := s + ' Cyan      ' + #0;
                                   s := s + ' Gelb      ' + #0;
                                   s := s + ' Magenta   ' + #0;
                                   s := s + ' Hellgrau  ' + #0;
                                   s := s + ' Dunkelgrau' + #0;
                                   s := s + ' Hellrot   ' + #0;
                                   s := s + ' Hellgrün  ' + #0;
                                   Listbox ( @s [1], 11, 12, rsc_main, MA_LIST1 );
                                 END;
                    ELSE BEGIN
                           Alert ( ALERT_NORM, 1, '[1][ Dieser Button könnte | eine Funktion haben. ][ [Aha ]' );
                         END;
                    END;
                  END;
    SG_MENU     : BEGIN
                    CASE button OF
                      M2_INFO : DoDialog ( rsc_info, 0, ' Information ' );
                      M2_QUIT : BEGIN
                                  IF ( Alert ( ALERT_NORM, 1, ASK_TERM ) = 2 ) THEN
                                    BEGIN
                                      handle_main := SG_TERM;
                                      exit;
                                    END;
                                END;
                    END;
                  END;
    SG_KEY      : BEGIN
                    CASE button OF
                      $4800 : ScrollSlider ( rsc_main, MA_BOX, SCROLL_UP );
                      $5000 : ScrollSlider ( rsc_main, MA_BOX, SCROLL_DOWN );
                    END;
                  END;
    SG_DRAGDROP : BEGIN
                   ctopascalstring ( s, inf^.dd^.data );
                   LoadText ( s );
                 END;
    END;
  handle_main := SG_CONT;
END;

(* -------------------------------------------------------------------
 * Behandelt die Desktop-Menüzeile
 * ------------------------------------------------------------------- *)

FUNCTION handle_menu ( msg : INTEGER; inf : WINDOW_INFO_PTR ) : INTEGER;

BEGIN
  IF ( msg = SG_MENU ) THEN
    BEGIN
      CASE inf^.mItem OF
        ME_INFO : DoDialog ( rsc_info, 0, '| Information ' );
        ME_QUIT : BEGIN
                    IF ( Alert ( ALERT_NORM, 1, ASK_TERM ) = 2 ) THEN
                      BEGIN
                        handle_menu := SG_TERM;
                        exit;
                      END;
                  END;
        ME_EDIT : WindowDialog ( MakeId ( 'EDIT' ), -1, -1, ' Edit-Felder ', '', 1, 0, rsc_edit, NIL, SE_Z50_100, NIL, handle_edit );
      END;
    END;
  handle_menu := SG_CONT;
END;

(* ------------------------------------------------------------------- *)

PROCEDURE first_info;

VAR     id      : LONGINT;

BEGIN
  id := MakeId ( 'SGEM' );
  IF ( OpenLogWindow ( id, ' SysGem-Information ', '', 61, 15, 8, 20, APROC ( NIL )) <> 0 ) THEN
    BEGIN
      wwrite ( id, 'Willkommen bei ' + #27 + 'pSysGem' + #27 + 'q' + #13 + #13 );
      wwrite ( id, 'Mit ' + #27 + 'pSysGem' + #27 + 'q wird das Erstellen von GEM-Programmen zum Kinder-' + #13 );
      wwrite ( id, 'spiel! (Text-)Fenster und Fensterdialoge werden komplett' + #13 );
      wwrite ( id, 'von ' + #27 + 'pSysGem' + #27 + 'q verwaltet, so daß ' + #27 + '+Sie' + #27 + '- sich in Ruhe um' + #13 );
      wwrite ( id, 'die wichtigeren Dinge kümmern können.' + #13 );
      wwrite ( id, 'SysGem übernimmt z.B. auch die Verwaltung der ' + #27 + '+Iconifizierung' + #13 );
      wwrite ( id, '(ICFS/MTos) und des Drag & Drop (unter Gemini/MTos)' + #27 + '-. Pro-' + #13 );
      wwrite ( id, 'bieren Sie es doch einfach mal mit diesem Demo aus!' + #13 + #13 );
      wwrite ( id, 'Schauen Sie sich doch danach einfach mal die Quelle an,' + #13 );
      wwrite ( id, 'Sie werden überrascht sein, wie einfach und schnell es' + #13 );
      wwrite ( id, 'gehen kann...' + #13 + #13 );
      wwrite ( id, #27 + '(Schließ mich...' + #27 + ')' );
    END;
END;

(* ------------------------------------------------------------------- *)

BEGIN
  win_id := MakeId ( 'TX00' );
  pop    := 1;
  IF ( Init_GEM ( @par, '', MakeId ( 'DEMO' ), 'SysGem-Demo', MakeId ( 'ANPI' ), 'Andreas Pietsch', USR_KEY ) > 0 ) THEN
    BEGIN

      (* --------------------------------------------------------------
       * Initialisiert die Resource
       * -------------------------------------------------------------- *)

      IF ( LoadResource ( 'DEMO.RSC' ) = 0 ) THEN
        BEGIN
          exit;
        END;
      rsc_menu  := RscAdr ( R_TREE, MENUE1 );
      rsc_info  := RscAdr ( R_TREE, SGINFO );
      rsc_bits  := RscAdr ( R_TREE, BITS );
      rsc_main  := RscAdr ( R_TREE, MAIN );
      rsc_tool  := RscAdr ( R_TREE, TOOLS );
      rsc_pop   := RscAdr ( R_TREE, SPOPUP );
      rsc_edit  := RscAdr ( R_TREE, SEDIT );

      (* --------------------------------------------------------------
       * Überschrift für die Alertbox
       * -------------------------------------------------------------- *)

      SetAlertTitle ( '| SysGem-Demo ' );

      (* --------------------------------------------------------------
       * Die Texte für die Sliderbox in Buffer schreiben
       * -------------------------------------------------------------- *)

      FOR i := 0 TO 19 DO
        BEGIN
          str (( i + 1 ) : 2, s );
          s := concat ( ' Dieses ist die Textzeile Nr ', s, ' ' );
          pascaltocstring ( s, @slid_txt [i + 1] );
        END;

      (* --------------------------------------------------------------
       * Dialoge anmelden
       * -------------------------------------------------------------- *)

      NewDialog ( rsc_info );
      NewDialog ( rsc_bits );
      NewDialog ( rsc_tool );
      NewDialog ( rsc_main );
      NewDialog ( rsc_edit );

      (* --------------------------------------------------------------
       * Menüzeile anmelden
       * -------------------------------------------------------------- *)

      SetDeskTopMenu ( rsc_menu, handle_menu );

      (* --------------------------------------------------------------
       * Zeituhr starten
       * -------------------------------------------------------------- *)

      WindowDialog ( MakeId ( 'ZEIT' ), 8, 0, '| Zeit ', '', 1, 0, rsc_bits, NIL, 0, NIL, handle_bits );

      (* --------------------------------------------------------------
       * Hauptfenster öffnen
       * -------------------------------------------------------------- *)

      WindowDialog ( MakeId ( 'MAIN' ), -1, -1, ' SysGem-Demo ', '', 1, 0, rsc_main, NIL, 0, NIL, handle_main );

      (* --------------------------------------------------------------
       * Text laden und anzeigen
       * -------------------------------------------------------------- *)

      LoadText ( 'DEMO.I' );

      (* --------------------------------------------------------------
       * Tastendrücke an die Dialoge leiten...
       * -------------------------------------------------------------- *)

      TellKeyStrokes ( 1 );

      (* --------------------------------------------------------------
       * Info vom Demo anzeigen
       * -------------------------------------------------------------- *)

      first_info;

      (* --------------------------------------------------------------
       * Timer aktivieren
       * -------------------------------------------------------------- *)

      EnableTimer;

      (* --------------------------------------------------------------
       * Kontrolle an SysGem abgeben
       * -------------------------------------------------------------- *)

      HandleSysGem;

      (* --------------------------------------------------------------
       * Programm abmelden und Speicher freigeben
       * -------------------------------------------------------------- *)

      Exit_GEM;
    END;
END.

(* ------------------------------------------------------------------- *)