home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9203 / tvision / tool.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-03-24  |  33.0 KB  |  889 lines
  1. (* **************************************************************** *)
  2. (*                             TOOL.PAS                             *)
  3. (*                                                                  *)
  4. (* TOOL ist das Hauptprogramm für die Unit DlgBuild; seine Hauptauf-*)
  5. (* gabe besteht darin, das Systemmenü, das Desktop- und das Items-  *)
  6. (* Menü auszuführen und sich um das Speichern von Dialogen als      *)
  7. (* Quelltext oder auf Ressource plus Quelltext zu kümmern.          *)
  8. (*                                                                  *)
  9. (*               (c) 1992 by R.Reichert & DMV-Verlag                *)
  10. (* **************************************************************** *)
  11. PROGRAM a_CaseTool_For_TurboVision;
  12.  
  13. USES Dos, Drivers, Memory, Objects, Views, Dialogs, Menus, Gadgets,
  14.      MsgBox, StdDlg, ColorSel, ToolCmds, DlgBuild, App;
  15.  
  16. CONST                      { Befehle des Systemmenüs:                }
  17.   cmSaveGroup     = 3000;  { Gruppe speichern                        }
  18.   cmSysMenu       = 3003;  { Systemmenü ausführen, wird von der
  19.                              tSignView (≡█≡) abgesetzt               }
  20.   cmSaveDesktop   = 3005;  { Desktop speichern. Wird bei Programmende
  21.                              automatisch abgesetzt.                  }
  22.   cmLoadDesktop   = 3006;  { Desktop laden. Wird bei Programmbeginn
  23.                              von tCaseToolApp.Init abgesetzt         }
  24.   cmNewDesktop    = 3007;  { Neuen Desktop einrichten                }
  25.   cmChangeDir     = 3008;  { Verzeichnis wechseln                    }
  26.   cmDosShell      = 3009;  { DOS-Shell ausführen                     }
  27.   cmColorSel      = 3010;  { ColorDialog ausführen                   }
  28.   cmVideoMode     = 3020;  { Bildschirmmodus wechseln                }
  29.                            { Befehle des Desktopmenüs, das über die
  30.                              rechte Maustaste oder über das System-
  31.                              menü ausgeführt werden kann             }
  32.   cmNewDialog     = 3011;  { Neue Dialogbox einrichten               }
  33.   cmAbout         = 3013;  { Kurzinfo über TOOL                      }
  34.  
  35.   hcNext          = 2000;
  36.   hcNewGroup      = 2001;
  37.   hcResize        = 2002;
  38.   hcClose         = 2003;
  39.   hcSaveGroup     = 3000;
  40.   hcSaveDesktop   = 3005;
  41.   hcLoadDesktop   = 3006;
  42.   hcNewDesktop    = 3007;
  43.   hcChangeDir     = 3008;
  44.   hcDosShell      = 3009;
  45.   hcColorSel      = 3010;
  46.   hcVideoMode     = 3020;
  47.   hcNewDialog     = 3011;
  48.   hcAbout         = 3013;
  49.  
  50. TYPE
  51.   pSignView    = ^tSignView;
  52.   tSignView    = OBJECT (tStaticText)
  53.     KeyCode:  WORD;              { Tastenkombination für Aktivierung }
  54.     Command:  WORD;              { bei Anwahl abzusetzender Befehl   }
  55.     PalEntry: BYTE;              { zu verwendender Paletteneintrag   }
  56.  
  57.     CONSTRUCTOR Init (VAR Bounds: tRect;
  58.                       aSign:      STRING;
  59.                       aKeyCode:   WORD;
  60.                       aCommand:   WORD;
  61.                       aPalEntry:  BYTE);
  62.     FUNCTION GetPalette: PPalette;                            VIRTUAL;
  63.     PROCEDURE HandleEvent (VAR Event: tEvent);                VIRTUAL;
  64.   END;
  65.  
  66.   tCaseToolApp = OBJECT (tApplication)
  67.      SysMenu     : pMenu;         { das Systemmenü                   }
  68.      SysMenuOpen : BOOLEAN;       { und sein Zustand                 }
  69.      DesktopMenu : pMenu;         { das Desktopmenü                  }
  70.      DeskMenuOpen: BOOLEAN;       { und sein Zustand                 }
  71.      Heap        : pHeapView;     { Anzeige des freien Speichers     }
  72.      DesktopFile : STRING;        { vollständiger Pfad für .DSK-File }
  73.      SaveDir     : STRING;        { Verzeichnis, in dem die Dateien
  74.                                     gespeichert werden = aktuelles
  75.                                     Verzeichnis                      }
  76.      OriginDir   : STRING;        { das Start-Verzeichnis,
  77.                                     wird am Ende wieder gesetzt.     }
  78.  
  79.      CONSTRUCTOR Init;
  80.      FUNCTION GetDesktopMenu: pMenu;
  81.      FUNCTION GetItemsMenu: pMenu;
  82.      FUNCTION GetSysMenu: pMenu;
  83.      PROCEDURE Idle;                                          VIRTUAL;
  84.      PROCEDURE InitStatusLine;                                VIRTUAL;
  85.      PROCEDURE InitMenuBar;                                   VIRTUAL;
  86.      PROCEDURE OutOfMemory;                                   VIRTUAL;
  87.      PROCEDURE HandleEvent (VAR Event : tEvent);              VIRTUAL;
  88.      DESTRUCTOR Done;                                         VIRTUAL;
  89.   END;
  90.  
  91. VAR
  92.   CaseToolApp : tCaseToolApp;
  93.  
  94. (* ================================================================ *)
  95. (*                            tSignView                             *)
  96. (* ================================================================ *)
  97. (* tSignView, dargestellt durch den in aSign übergebenen String,    *)
  98. (* setzt bei der Anwahl über die Maus oder über aKeyCode den Befehl *)
  99. (* aCommand ab. aPalEntry wird von Draw verwendet und bezieht sich  *)
  100. (* auf die Palette von Application. In Options muss ofPreProcess    *)
  101. (* gesetzt werden, da das Objekt die Tastatureingaben sonst nicht   *)
  102. (* erhält. Für diesen Zweck wird auch evKeyboard in EventMask       *)
  103. (* gesetzt.                                                         *)
  104. (* ---------------------------------------------------------------- *)
  105. CONSTRUCTOR tSignView.Init (VAR Bounds: tRect;
  106.                             aSign:      STRING;
  107.                             aKeyCode:   WORD;
  108.                             aCommand:   WORD;
  109.                             aPalEntry:  BYTE);
  110. BEGIN
  111.   tStaticText.Init (Bounds, aSign);
  112.   EventMask:= EventMask OR evKeyboard;
  113.   Options  := Options OR ofPreProcess;
  114.   KeyCode  := aKeyCode;
  115.   Command  := aCommand;
  116.   PalEntry := aPalEntry;
  117. END;
  118.  
  119. (* ---------------------------------------------------------------- *)
  120. (* HandleEvent reagiert auf die Selektierung per Maus oder über die *)
  121. (* Tastatur mit dem Absetzen des an Init übergebenen Befehls        *)
  122. (* Command.                                                         *)
  123. (* ---------------------------------------------------------------- *)
  124. PROCEDURE tSignView.HandleEvent (VAR Event: tEvent);
  125.   VAR NewEvent: tEvent;
  126. BEGIN
  127.   tView.HandleEvent (Event);
  128.   IF (Event.What = evMouseDown) OR
  129.      ((Event.What = evKeyDown) AND
  130.       (Event.KeyCode = KeyCode)) THEN BEGIN
  131.     NewEvent.What := evCommand;
  132.     NewEvent.Command := Command;
  133.     PutEvent (NewEvent);
  134.     ClearEvent (Event);
  135.   END;
  136. END;
  137.  
  138. (* ---------------------------------------------------------------- *)
  139. (* GetPalette verwendet den Eintrag PalEntry der Palette des Owners,*)
  140. (* so dass ein tSignView in verschiedene Gruppen eingefügt werden   *)
  141. (* könnte.                                                          *)
  142. (* ---------------------------------------------------------------- *)
  143. FUNCTION tSignView.GetPalette: pPalette;
  144.   CONST Pal : STRING = '';
  145. BEGIN
  146.   Pal := CHAR (PalEntry);
  147.   GetPalette := @Pal;
  148. END;
  149.  
  150. (* ================================================================ *)
  151. (*                         tCaseToolApp                             *)
  152. (* ================================================================ *)
  153. (* tCaseToolApp ist der Koordinator, dessen Hauptaufgabe es ist,    *)
  154. (* die Arbeit zu delegieren und sich um das Speichern der Dateien   *)
  155. (* zu kümmern. Init versucht, die DSK-Datei zu öffnen. Die SignView *)
  156. (* für das Systemmenü wird rechts oben auf dem Bildschirm eingefügt.*)
  157. (* Auch muss Init die RegisterUnit-Prozeduren aufrufen, damit der   *)
  158. (* Desktop geladen bzw gespeichert werden kann.                     *)
  159. (* ---------------------------------------------------------------- *)
  160. CONSTRUCTOR tCaseToolApp.Init;
  161.   VAR
  162.     R: tRect;
  163.     f: FILE;
  164.     NewEvent: tEvent;
  165. BEGIN
  166.   LowMemSize := 8192 DIV 16;
  167.   tApplication.Init;
  168.  
  169.   RegisterObjects;
  170.   RegisterViews;
  171.   RegisterMenus;
  172.   RegisterDialogs;
  173.   RegisterDlgBuild;
  174.  
  175.   GetExtent (R);
  176.   Dec (R.B.X);
  177.   R.A.X := R.B.X - 9; R.A.Y := R.B.Y - 1;
  178.   Heap := New (pHeapView, Init (R));
  179.   Insert (Heap);
  180.  
  181.   GetExtent (R);
  182.   R.A.X := R.B.X - 5;
  183.   R.B.Y := R.A.Y + 1;
  184.   Insert (New (pSignView, Init (R, ' ≡█≡ ',
  185.                                 kbAltSpace, cmSysMenu, 10)));
  186.  
  187.   SysMenuOpen := FALSE;
  188.   DeskMenuOpen:= FALSE;
  189.  
  190.   DesktopFile := ParamStr (0);
  191.   System.Delete (DesktopFile, Length (DesktopFile)-2, 3);
  192.   DesktopFile := DesktopFile+'DSK';
  193.   {$I-}
  194.     Assign (f, DesktopFile);  ReSet (f);
  195.   {$I+}
  196.   IF IoResult = 0 THEN
  197.     Message (@Self, evCommand, cmLoadDesktop, NIL);
  198.   GetDir (0, SaveDir);
  199.   OriginDir := SaveDir;
  200.  
  201.   IF ButtonCount = 0 THEN BEGIN
  202.     MessageBox (^C'Das Systemmenü (≡█≡) wird über '#13+
  203.                 ^C'"Alt-Leertaste"'#13+
  204.                 ^C'aktiviert',
  205.                 NIL, mfInformation + mfOkButton);
  206.     NewEvent.What := evCommand;
  207.     NewEvent.Command := cmSysmenu;
  208.     PutEvent (NewEvent);
  209.   END;
  210. END;
  211.  
  212. (* ---------------------------------------------------------------- *)
  213. (* GetDesktopMenu legt das Menu mit den Gruppen an, die in die      *)
  214. (* Arbeitsfläche eingefügt werden können.                           *)
  215. (* ---------------------------------------------------------------- *)
  216. FUNCTION tCaseToolApp.GetDesktopMenu: pMenu;
  217. BEGIN
  218.   GetDesktopMenu := NewMenu (
  219.     NewItem ('Neue ~D~ialogbox', 'Alt-D',
  220.              kbAltD, cmNewDialog, hcNewDialog,
  221.   NIL));
  222. END;
  223.  
  224. (* ---------------------------------------------------------------- *)
  225. (* GetItemsMenu legt das Menü mit den Elementen an, die in die      *)
  226. (* aktuell selektierte Gruppe eingefügt werden können. Dazu wird    *)
  227. (* ermittelt, ob überhaupt eine Gruppe (und nicht der Hintergrund;  *)
  228. (* andere Objekte dürfen sich sowieso nicht auf dem Desktop         *)
  229. (* befinden) selektiert ist. Ist das der Fall, so wird ihr der Be-  *)
  230. (* fehl cmGetItemsMenu übermittelt, woraufhin ihre HandleEvent-     *)
  231. (* Methode ein Menu anlegen und mit einem Befehl der Art            *)
  232. (*   pMenu (Event.InfoPtr^) := GetItemsMenu;                        *)
  233. (* den Zeiger darauf zurückliefern muss. GetItemsMenu ist so        *)
  234. (* gehalten, dass TOOL jederzeit weitere Gruppen "beigebracht"      *)
  235. (* werden können, ohne dass ein grosser Aufwand dazu nötig wäre.    *)
  236. (* Es braucht nur GetDesktopMenu angepasst zu werden.               *)
  237. (* ---------------------------------------------------------------- *)
  238. FUNCTION tCaseToolApp.GetItemsMenu: pMenu;
  239.   VAR Menu: pMenu;
  240. BEGIN
  241.   IF Desktop^.Current <> Desktop^.Last THEN BEGIN
  242.     Message (Desktop^.Current,
  243.              evCommand, cmGetItemsMenu, @Menu);
  244.     GetItemsMenu := Menu;
  245.   END ELSE
  246.     GetItemsMenu := NIL;
  247. END;
  248.  
  249. (* ---------------------------------------------------------------- *)
  250. (* GetSysMenu legt das Systemmenü an, wobei die beiden obigen       *)
  251. (* Methoden helfen. Ist auf dem Desktop noch keine Gruppe, so gibt  *)
  252. (* GetItemsMenu einen NIL-Zeiger zurück, und der entsprechende      *)
  253. (* NewSubMenu-Aufruf ebenfalls, dh, der Menüpunkt "Neues Element"   *)
  254. (* erscheint nicht im Systemmenü.                                   *)
  255. (* ---------------------------------------------------------------- *)
  256. FUNCTION tCaseToolApp.GetSysMenu: pMenu;
  257.   VAR Menu: pMenu;
  258. BEGIN
  259.   EnableCommands ([cmNext, cmResize, cmClose]);
  260.   Menu := GetItemsMenu;
  261.   GetSysMenu := NewMenu (
  262.     NewItem ('~Ü~ber TOOL', '', 0, cmAbout, hcAbout,
  263.     NewLine (
  264.     NewSubMenu ('Neue ~G~ruppe', hcNewGroup,
  265.       GetDesktopMenu,
  266.     NewSubMenu ('Neues ~E~lement', hcNewItem,
  267.       Menu,
  268.     NewItem ('Gruppe ~b~earbeiten', 'Alt-G',
  269.              kbAltG, cmEditGroup, hcEditGroup,
  270.     NewItem ('~N~ächste Gruppe', 'F6', kbF6, cmNext, hcNext,
  271.     NewItem ('Gruppe ~v~erschieben', 'Ctrl-F5',
  272.              kbCtrlF5, cmResize, hcResize,
  273.     NewItem ('Gruppe s~c~hliessen', 'Alt-F3', kbAltF3, cmClose, hcClose,
  274.     NewItem ('Gruppe ~s~peichern', '', 0, cmSaveGroup, hcSaveGroup,
  275.     NewLine (
  276.     NewItem ('Desktop neu', '', 0, cmNewDesktop, hcNewDesktop,
  277.     NewItem ('Bildschirm~m~odus', '', 0, cmVideoMode, hcVideoMode,
  278.     NewItem ('~F~arben einstellen', '', 0, cmColorSel, hcColorSel,
  279.     NewItem ('Verzeichnis ~w~echseln', '',
  280.              0, cmChangeDir, hcChangeDir,
  281.     NewItem ('DOS S~h~ell', '', 0, cmDosShell, hcDosShell,
  282.     NewLine (
  283.     NewItem ('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
  284.   NIL))))))))))))))))));
  285. END;
  286.  
  287. PROCEDURE tCaseToolApp.Idle;
  288. BEGIN
  289.   Heap^.Update;
  290. END;
  291.  
  292. PROCEDURE tCaseToolApp.InitStatusLine;
  293.   VAR R: tRect;
  294. BEGIN
  295.   GetExtent (R);
  296.   R.A.Y := R.B.Y-1;
  297.   StatusLine := New (pStatusLine, Init (R, NIL));
  298. END;
  299.  
  300. PROCEDURE tCaseToolApp.OutOfMemory;
  301. BEGIN
  302.   MessageBox ('Nicht genügend Speicher, um den Befehl auszuführen!',
  303.               NIL, mfError + mfOkButton);
  304. END;
  305.  
  306. PROCEDURE tCaseToolApp.InitMenuBar;
  307.   VAR R: tRect;
  308. BEGIN
  309.   GetExtent (R);
  310.   R.B.Y := R.A.Y + 1;
  311.   MenuBar := New (pMenuBar, Init (R, NIL));
  312. END;
  313.  
  314. (* ---------------------------------------------------------------- *)
  315. (* HandleEvent fällt es zu, zu koordinieren und zu delegieren.      *)
  316. (* ---------------------------------------------------------------- *)
  317. PROCEDURE tCaseToolApp.HandleEvent (VAR Event : tEvent);
  318.  
  319.   (* -------------------------------------------------------------- *)
  320.   (* Das Desktopmenü wird an der Position Event.Where ausgeführt,   *)
  321.   (* dort, wo die rechte Maustaste gedrückt wurde.                  *)
  322.   (* -------------------------------------------------------------- *)
  323.   PROCEDURE ExecuteDeskMenu (Event: tEvent);
  324.     VAR
  325.       NewEvent: tEvent;
  326.       MousePos: tPoint;
  327.       Code:     WORD;
  328.       Box:      pMenuBox;
  329.       R:        tRect;
  330.   BEGIN
  331.     IF NOT DeskMenuOpen THEN BEGIN
  332.       DeskMenuOpen := TRUE;
  333.       MousePos := Event.Where;
  334.       IF (MousePos.X > 58) THEN MousePos.X := 58;
  335.       IF (MousePos.X < 8) THEN MousePos.X := 8;
  336.       IF (MousePos.Y > ScreenHeight-6) THEN
  337.         MousePos.Y := Screenheight-6;
  338.       R.Assign (MousePos.X,    MousePos.Y,
  339.                 MousePos.X+20, MousePos.Y+6);
  340.  
  341.       DesktopMenu := GetDesktopMenu;
  342.       Box := New (pMenuBox, Init (R, DesktopMenu, NIL));
  343.       Code:= ExecView (Box);
  344.       Dispose (Box);
  345.       DisposeMenu (DesktopMenu);
  346.  
  347.       NewEvent.What := evCommand;
  348.       NewEvent.Command := Code;
  349.       PutEvent (NewEvent);
  350.       DeskMenuOpen := FALSE;
  351.     END;
  352.   END;
  353.  
  354.   (* -------------------------------------------------------------- *)
  355.   (* Das Systemmenü wird im rechten oberen Teil des Bildschirmes    *)
  356.   (* ausgeführt. Das über PutEvent abgesetzte Ereignis wird dann    *)
  357.   (* von der HandleEvent-Methode abgefangen.                        *)
  358.   (* -------------------------------------------------------------- *)
  359.   PROCEDURE ExecuteSysMenu;
  360.     VAR
  361.       NewEvent: tEvent;
  362.       MousePos: tPoint;
  363.       Code:     WORD;
  364.       Box:      pMenuBox;
  365.       R:        tRect;
  366.   BEGIN
  367.     IF NOT SysMenuOpen THEN BEGIN
  368.       SysMenuOpen := TRUE;
  369.       R.Assign (60, 1, 78, 22);
  370.  
  371.       SysMenu := GetSysMenu;
  372.       Box := New (pMenuBox, Init (R, SysMenu, NIL));
  373.       Code := ExecView (Box);
  374.       Dispose (Box);
  375.       DisposeMenu (SysMenu);
  376.  
  377.       NewEvent.What := evCommand;
  378.       NewEvent.Command := Code;
  379.       PutEvent (NewEvent);
  380.       SysMenuOpen := FALSE;
  381.     END;
  382.   END;
  383.  
  384.   (* -------------------------------------------------------------- *)
  385.   (* SaveGroupDialog fragt in einem Dialog, welche Gruppe in welche *)
  386.   (* Datei und als was (als Ressource oder als Quelltext: Prozedur  *)
  387.   (* oder Objekt) gespeichert werden soll.                          *)
  388.   (* -------------------------------------------------------------- *)
  389.   FUNCTION SaveGroupDialog (VAR Name: STRING;
  390.                             VAR GroupName: STRING;
  391.                             VAR AsWhat: WORD): INTEGER;
  392.     TYPE
  393.       DialogData = RECORD
  394.          ListPtr:  pCollection;
  395.          Focused:  INTEGER;
  396.          FileName: STRING [80];
  397.          AsWhat:   WORD;
  398.       END;
  399.  
  400.     VAR
  401.       ScrollBar: pScrollBar;
  402.       ListBox:   pListBox;
  403.       StrList:   pStringCollection;
  404.       Code :     INTEGER;
  405.       View:      pView;
  406.       Box:       pDialog;
  407.       DD:        DialogData;
  408.       R:         tRect;
  409.  
  410.     PROCEDURE AddToList (Win: pWindow); FAR;
  411.     BEGIN
  412.       IF TypeOf (Win^) <> TypeOf (tBackGround) THEN
  413.         StrList^.Insert (NewStr (Win^.Title^));
  414.     END;
  415.  
  416.   BEGIN
  417.     R.Assign (10, 5, 70, 18);
  418.     Box := New (pDialog, Init (R, ' Gruppe speichern '));
  419.  
  420.     WITH Box^ DO BEGIN
  421.       R.Assign (22, 3, 23, 10);
  422.       ScrollBar := New (pScrollBar, Init (R));
  423.       Insert (ScrollBar);
  424.       R.Assign (2, 3, 22, 10);
  425.       ListBox := New (pListBox, Init (R, 1, ScrollBar));
  426.       Insert (ListBox);
  427.       R.Assign (1, 2, 22, 3);
  428.       Insert (New (pLabel, Init (R, 'Gruppen auf Desktop:', ListBox)));
  429.       StrList := New (pStringCollection, Init (20, 10));
  430.       Desktop^.ForEach (@AddToList);
  431.  
  432.       R.Assign (24, 2, 58, 4);
  433.       Insert (New (pStaticText, Init (R, 'Verzeichnis:'#13+'  '+SaveDir)));
  434.       R.Assign (45, 4, 58, 5);
  435.       View := New (pInputLine, Init (R, 80));
  436.       Insert (View);
  437.       R.Assign (23, 4, 45, 5);
  438.       Insert (New (pLabel, Init (R, 'Datei (OHNE Ext):', View)));
  439.  
  440.       R.Assign (24, 7, 58, 10);
  441.       View := New (pRadioButtons, Init (R, NewSItem ('... als Resource',
  442.                                            NewSItem ('... als Prozedur im Quelltext',
  443.                                            NewSItem ('... als Objekt im Quelltext',
  444.                                            NIL)))));
  445.       Insert (View);
  446.       R.Assign (23, 6, 58, 7);
  447.       Insert (New (pLabel, Init (R, 'Gruppe speichern als ...', View)));
  448.  
  449.       R.Assign (15, Size.Y-3, 25, Size.Y-1);
  450.       Insert (New (pButton, Init (R, '~S~ave', cmOk, bfDefault)));
  451.       R.Assign (35, Size.Y-3, 45, Size.Y-1);
  452.       Insert (New (pButton, Init (R, '~C~ancel', cmCancel, bfNormal)));
  453.       SelectNext (FALSE);
  454.     END;
  455.  
  456.     DD.ListPtr := StrList;
  457.     DD.Focused := 0;
  458.     DD.FileName:= '';
  459.     DD.AsWhat  := 0;
  460.  
  461.     Box^.SetData (DD);
  462.  
  463.     IF ListBox^.Range = 0 THEN BEGIN
  464.       MessageBox (^C'Keine Gruppen auf dem Desktop!',
  465.                   NIL, mfError+mfOkButton);
  466.       Dispose (Box, Done);
  467.       Dispose (StrList, Done);
  468.       Exit;
  469.     END;
  470.  
  471.     Code := Desktop^.ExecView (Application^.ValidView (Box));
  472.     IF Code <> cmCancel THEN BEGIN
  473.       Box^.GetData (DD);
  474.       Name := DD.FileName;
  475.       AsWhat := DD.AsWhat;
  476.       GroupName := STRING (DD.ListPtr^.At (DD.Focused)^);
  477.     END;
  478.     IF Box <> NIL THEN Dispose (Box, Done);
  479.     Dispose (StrList, Done);
  480.     SaveGroupDialog := Code;
  481.   END;
  482.  
  483.   (* -------------------------------------------------------------- *)
  484.   (* SaveGroup übernimmt die Speicherung der über SaveGroupDialog   *)
  485.   (* ausgewählten Gruppe. Dabei muss unterschieden werden, als was  *)
  486.   (* gespeichert werden soll. Am aufwendigsten ist als Ressource,   *)
  487.   (* da dabei in zwei verschiedene Dateien geschrieben werden muss, *)
  488.   (* in eine .PAS-Datei und auf einen Stream, der zu einem          *)
  489.   (* tResourceFile gehört.                                          *)
  490.   (* -------------------------------------------------------------- *)
  491.   PROCEDURE SaveGroup;
  492.     CONST
  493.       GroupName: STRING = '';
  494.     VAR
  495.       RezStream: pBufStream;
  496.       RezFile:   tResourceFile;
  497.       FileName:  STRING;
  498.       AsWhat:    WORD;
  499.       Code:      INTEGER;
  500.       t:         TEXT;
  501.       Group:     pGroup;
  502.   BEGIN
  503.     Code := SaveGroupDialog (FileName, GroupName, AsWhat);
  504.     IF Code <> cmCancel THEN BEGIN
  505.       IF SaveDir [Length (SaveDir)] = '\' THEN
  506.         FileName := SaveDir+FileName
  507.       ELSE
  508.         FileName := SaveDir+'\'+FileName;
  509.       (* ----------------------------------------------------------
  510.          Die .PAS-Datei erstellen und im Fehlerfall beschweren.
  511.          ---------------------------------------------------------- *)
  512.       Assign (t, FileName+'.PAS');
  513.       {$I-} ReWrite (t); {$I+}
  514.       IF IoResult <> 0 THEN BEGIN
  515.         MessageBox (^C'Datei '+FileName+'.PAS'+
  516.                     #13^C' konnte nicht erstellt werden!',
  517.                     NIL, mfError + mfOkButton);
  518.         Exit;
  519.       END;
  520.       (* ----------------------------------------------------------
  521.          Falls die Gruppe als Dialog gespeichert werden soll, muss
  522.          zusätzlich noch ein Ressourcenstream und eine Ressourcen-
  523.          datei angelegt werden.
  524.          ---------------------------------------------------------- *)
  525.       IF AsWhat = 0 THEN BEGIN
  526.         RezStream := New (pBufStream,
  527.                           Init (FileName+'.REZ', stCreate, 4096));
  528.         IF RezStream^.Status <> 0 THEN BEGIN
  529.           MessageBox ('Datei konnte nicht erstellt/geöffnet werden !',
  530.                       NIL, mfError+mfOkButton);
  531.           Dispose (RezStream, Done);
  532.           Exit;
  533.         END;
  534.         RezFile.Init (RezStream);
  535.       END;
  536.       (* ----------------------------------------------------------
  537.          Über cmWhoIs wird die Gruppe ermittelt, die gespeichert
  538.          werden soll und anschliessend in Abhängigkeit von AsWhat
  539.          dieser Gruppe die verschiedenen Befehle übermittelt.
  540.          ---------------------------------------------------------- *)
  541.       Group := Message (@Self, evBroadCast, cmWhoIsDlg,
  542.                         @GroupName);
  543.       CASE AsWhat OF
  544.         0 : BEGIN
  545.               Message (Group, evCommand,
  546.                        cmSaveDlgAsR+cmSaveInc, @t);
  547.               Message (Group, evCommand,
  548.                        cmSaveDlgAsR+cmSaveRez, @RezFile);
  549.               RezFile.Done;
  550.             END;
  551.         1 : Message (Group, evCommand, cmSaveDlgAsP, @t);
  552.         2 : Message (Group, evCommand, cmSaveDlgAsO+cmSaveAll, @t);
  553.       END;
  554.       Close (t);
  555.     END;
  556.   END;
  557.  
  558.   (* -------------------------------------------------------------- *)
  559.   (* VideoMode wechselt zwischen 25- und 43/50-Zeilenmodus.         *)
  560.   (* -------------------------------------------------------------- *)
  561.   PROCEDURE VideoMode;
  562.     VAR
  563.       NewMode: WORD;
  564.       R:       tRect;
  565.   BEGIN
  566.     NewMode := ScreenMode XOR smFont8x8;
  567.     IF NewMode AND smFont8x8 <> 0 THEN
  568.       ShadowSize.X := 1
  569.     ELSE
  570.       ShadowSize.X := 2;
  571.     Desktop^.Lock;
  572.     SetScreenMode (NewMode);
  573.     R.Assign (71, ScreenHeight-1, 80, ScreenHeight);
  574.     Heap^.ChangeBounds (R);
  575.     Desktop^.ReDraw;
  576.     Desktop^.UnLock;
  577.   END;
  578.  
  579.   (* -------------------------------------------------------------- *)
  580.   (* Speichert den Desktop im Verzeichnis, in dem sich die .EXE-    *)
  581.   (* Datei befindet, unter dem Namen DesktopFile, der vom Init-     *)
  582.   (* konstruktor gesetzt wird.                                      *)
  583.   (* -------------------------------------------------------------- *)
  584.   PROCEDURE SaveDesktop;
  585.     VAR
  586.       S: pStream;
  587.       f: File;
  588.       Pal: String;
  589.  
  590.     PROCEDURE WriteView (P: PView); FAR;
  591.     BEGIN
  592.       IF P <> Desktop^.Last THEN S^.Put (P);
  593.     END;
  594.  
  595.   BEGIN
  596.     S := New (pBufStream, Init (DesktopFile, stCreate, 1024));
  597.     IF NOT LowMemory AND (S^.Status = stOk) THEN BEGIN
  598.       Pal := Application^.GetPalette^;
  599.       S^.WriteStr (@Pal);
  600.       S^.Write (ScreenMode, SizeOf (ScreenMode));
  601.       Desktop^.ForEach (@WriteView);
  602.       S^.Put (NIL);
  603.       IF S^.Status <> stOk THEN BEGIN
  604.         MessageBox ('TOOL.DSK konnte nicht erstellt werden.',
  605.                     NIL, mfOkButton + mfError);
  606.         Dispose (S, Done);
  607.         {$I-}  Assign (F, DesktopFile);  Erase (F);  {$I+}
  608.         Exit;
  609.       END;
  610.       S^.Truncate;
  611.     END;
  612.     Dispose (S, Done);
  613.   END;
  614.  
  615.   (* -------------------------------------------------------------- *)
  616.   (* Räumt den Desktop auf. Falls einzelne Gruppen noch nicht       *)
  617.   (* gespeichert sind, so fragen sie selbst nach, ob das noch nach- *)
  618.   (* geholt werden soll.                                            *)
  619.   (* -------------------------------------------------------------- *)
  620.   PROCEDURE ClearDesktop;
  621.  
  622.     PROCEDURE CloseView (P: pView); FAR;
  623.     BEGIN
  624.       Message (P, evCommand, cmClose, NIL);
  625.     END;
  626.  
  627.   BEGIN
  628.     Desktop^.ForEach (@CloseView);
  629.   END;
  630.  
  631.   (* -------------------------------------------------------------- *)
  632.   (* LoadDesktop lädt den Desktop Gruppe für Gruppe, damit bei      *)
  633.   (* eventuellem Speichermangel die Sicherheitszone nicht überbe-   *)
  634.   (* ansprucht wird.                                                *)
  635.   (* -------------------------------------------------------------- *)
  636.   PROCEDURE LoadDesktop;
  637.     VAR
  638.       S:    pStream;
  639.       View: pView;
  640.       Pal:  pSTRING;
  641.       L:    BYTE;
  642.       Video:WORD;
  643.   BEGIN
  644.     S := New (pBufStream, Init (DesktopFile, stOpenRead, 1024));
  645.     IF LowMemory THEN OutOfMemory
  646.     ELSE IF S^.Status <> stOk THEN
  647.       MessageBox ('Konnte TOOL.DSK nicht laden!',
  648.                   NIL, mfOkButton + mfError)
  649.     ELSE BEGIN
  650.       IF Desktop^.Valid (cmClose) THEN BEGIN
  651.         ClearDesktop;
  652.         Pal := S^.ReadStr;
  653.         IF S^.Status <> stOk THEN BEGIN
  654.           MessageBox ('Konnte TOOL.DSK nicht laden!',
  655.                       NIL, mfOkButton + mfError);
  656.           Dispose (S, Done);
  657.           Exit;
  658.         END;
  659.         Application^.GetPalette^ := Pal^;
  660.         S^.Read (Video, SizeOf (Video));
  661.         IF Video <> ScreenMode THEN
  662.           VideoMode;
  663.         Desktop^.ReDraw;
  664.         REPEAT
  665.           View := pView (S^.Get);
  666.           Desktop^.InsertBefore (ValidView (View), Desktop^.Last);
  667.         UNTIL View = NIL;
  668.       END;
  669.       IF S^.Status <> stOk THEN
  670.         MessageBox ('Fehler beim Lesen von TOOL.DSK.',
  671.                     NIL, mfOkButton + mfError);
  672.     END;
  673.     Dispose (S, Done);
  674.   END;
  675.  
  676.   (* -------------------------------------------------------------- *)
  677.   (* Standardmässiges Verzeichniswechseln - der neue Pfad wird in   *)
  678.   (* SaveDir festgehalten, damit die Dateien auch dort landen.      *)
  679.   (* -------------------------------------------------------------- *)
  680.   PROCEDURE ChangeDirectory;
  681.     VAR D: pChDirDialog;
  682.   BEGIN
  683.     D := New (pChDirDialog, Init (cdNormal + cdHelpButton, 101));
  684.     IF ValidView (D) <> NIL THEN BEGIN
  685.       DeskTop^.ExecView (D);
  686.       Dispose (D, Done);
  687.       GetDir (0, SaveDir);
  688.     END;
  689.   END;
  690.  
  691.   (* -------------------------------------------------------------- *)
  692.   (* "Normale" DosShell ausführen - siehe auch TVDEMO.PAS.          *)
  693.   (* -------------------------------------------------------------- *)
  694.   PROCEDURE DosShell;
  695.   BEGIN
  696.     DoneSysError;
  697.     DoneEvents;
  698.     DoneVideo;
  699.     DoneMemory;
  700.     SetMemTop (HeapPtr);
  701.     PrintStr ('EXIT um DOS zu beenden ...');
  702.     SwapVectors;
  703.     Exec (GetEnv ('COMSPEC'), '');
  704.     SwapVectors;
  705.     SetMemTop (HeapEnd);
  706.     InitMemory;
  707.     InitVideo;
  708.     InitEvents;
  709.     InitSysError;
  710.     Redraw;
  711.   END;
  712.  
  713.   (* -------------------------------------------------------------- *)
  714.   (* Einstellen der Farben; kopiert aus tvdemo.pas; hier            *)
  715.   (* entsprechend gekürzt, da TOOL z.B. keinen Calender enthält.    *)
  716.   (* -------------------------------------------------------------- *)
  717.   PROCEDURE Colors;
  718.     VAR D: pColorDialog;
  719.   BEGIN
  720.     D := New (pColorDialog, Init ('',
  721.       ColorGroup ('Desktop',
  722.         ColorItem ('Color',             1,
  723.         NIL),
  724.       ColorGroup ('Menus',
  725.         ColorItem ('Normal',            2,
  726.         ColorItem ('Disabled',          3,
  727.         ColorItem ('Shortcut',          4,
  728.         ColorItem ('Selected',          5,
  729.         ColorItem ('Selected disabled', 6,
  730.         ColorItem ('Shortcut selected', 7,
  731.         NIL)))))),
  732.       ColorGroup ('Dialogs/Calc',
  733.         ColorItem ('Frame/background',  33,
  734.         ColorItem ('Frame icons',       34,
  735.         ColorItem ('Scroll bar page',   35,
  736.         ColorItem ('Scroll bar icons',  36,
  737.         ColorItem ('Static text',       37,
  738.  
  739.         ColorItem ('Label normal',      38,
  740.         ColorItem ('Label selected',    39,
  741.         ColorItem ('Label shortcut',    40,
  742.  
  743.         ColorItem ('Button normal',     41,
  744.         ColorItem ('Button default',    42,
  745.         ColorItem ('Button selected',   43,
  746.         ColorItem ('Button disabled',   44,
  747.         ColorItem ('Button shortcut',   45,
  748.         ColorItem ('Button shadow',     46,
  749.  
  750.         ColorItem ('Cluster normal',    47,
  751.         ColorItem ('Cluster selected',  48,
  752.         ColorItem ('Cluster shortcut',  49,
  753.  
  754.         ColorItem ('Input normal',      50,
  755.         ColorItem ('Input selected',    51,
  756.         ColorItem ('Input arrow',       52,
  757.  
  758.         ColorItem ('History button',    53,
  759.         ColorItem ('History sides',     54,
  760.         ColorItem ('History bar page',  55,
  761.         ColorItem ('History bar icons', 56,
  762.  
  763.         ColorItem ('List normal',       57,
  764.         ColorItem ('List focused',      58,
  765.         ColorItem ('List selected',     59,
  766.         ColorItem ('List divider',      60,
  767.  
  768.         ColorItem ('Information pane',  61,
  769.         NIL))))))))))))))))))))))))))))),
  770.       NIL)))));
  771.  
  772.     IF ValidView (D) <> NIL THEN BEGIN
  773.       D^.SetData (Application^.GetPalette^);
  774.       IF Desktop^.ExecView (D) <> cmCancel THEN BEGIN
  775.         Application^.GetPalette^ := D^.Pal;
  776.         DoneMemory;
  777.         ReDraw;
  778.       END;
  779.       Dispose (D, Done);
  780.     END;
  781.   END;
  782.  
  783.   (* -------------------------------------------------------------- *)
  784.   (* AboutDialog gibt nur eine kurze Kurzinfo zu TOOL.              *)
  785.   (* -------------------------------------------------------------- *)
  786.   PROCEDURE AboutDialog;
  787.     VAR
  788.       R: tRect;
  789.       Dialog: pDialog;
  790.   BEGIN
  791.     R.Assign (13, 4, 62, 16);
  792.     Dialog := New (pDialog, Init (R, 'Über TOOL'));
  793.  
  794.     R.Assign (22, 2, 29, 3);
  795.     Dialog^.Insert (New (pStaticText, Init (R, 'TOOL - ')));
  796.     R.Assign (5, 4, 45, 5);
  797.     Dialog^.Insert (New (pStaticText, Init (R, 'ein Casetool für Turbo Vision Programme,')));
  798.     R.Assign (8, 5, 43, 6);
  799.     Dialog^.Insert (New (pStaticText, Init (R, 'für die Erstellung von Dialogboxen.')));
  800.     R.Assign (5, 7, 45, 8);
  801.     Dialog^.Insert (New (pStaticText, Init (R, 'v1.0 (c) 1992 by R.Reichert & DMV-Verlag')));
  802.     R.Assign (15, 9, 33, 11);
  803.     Dialog^.Insert (New (pButton, Init (R, '~OK~', 10, 1)));
  804.     Dialog^.SelectNext (FALSE);
  805.  
  806.     Desktop^.ExecView (Application^.ValidView (Dialog));
  807.     IF Dialog <> NIL THEN
  808.       Dispose (Dialog, Done);
  809.   END;
  810.  
  811. BEGIN
  812.   tApplication.HandleEvent (Event);
  813.   (* --------------------------------------------------------------
  814.      Short-Cuts wie Alt-X müssen "von Hand" abgefangen werden, da
  815.      sie nicht vom Menü "gehört" werden, denn das Systememnü wird
  816.      nur bei Bedarf in das Programm eingefügt.
  817.      -------------------------------------------------------------- *)
  818.   IF (Event.What = evKeyboard) THEN BEGIN
  819.     CASE Event.KeyCode OF
  820.       kbAltX  : Message (@Self, evCommand, cmQuit, NIL);
  821.       kbAltD  : Message (@Self, evCommand, cmNewDialog, NIL);
  822.       kbAltG  : Message (@Self, evCommand, cmEditGroup, NIL);
  823.       kbF6    : Message (@Self, evCommand, cmNext, NIL);
  824.       kbCtrlF5: Message (@Self, evCommand, cmResize, NIL);
  825.       kbAltF3 : Message (@Self, evCommand, cmClose, NIL);
  826.       ELSE Exit;
  827.     END;
  828.     ClearEvent (Event);
  829.   END;
  830.   (* --------------------------------------------------------------
  831.      Das Programm muss mit Hilfe der obigen Prozeduren auf einige
  832.      Rundrufe und Befehle reagieren:
  833.      -------------------------------------------------------------- *)
  834.   IF (Event.What = evCommand) OR
  835.      (Event.What = evBroadcast) THEN BEGIN
  836.     CASE Event.Command OF
  837.       cmSysMenu    : ExecuteSysMenu;
  838.  
  839.       cmNewDialog  : NewOrEditDialog (NIL);
  840.       cmEditGroup  : Message (Desktop^.Current, evCommand, cmEditGroup, NIL);
  841.       cmSaveGroup  : SaveGroup;
  842.  
  843.       cmSaveDesktop: SaveDesktop;
  844.       cmLoadDesktop: LoadDesktop;
  845.       cmNewDesktop : ClearDesktop;
  846.  
  847.       cmVideoMode  : VideoMode;
  848.       cmChangeDir  : ChangeDirectory;
  849.       cmDosShell   : DosShell;
  850.       cmColorSel   : Colors;
  851.       cmAbout      : AboutDialog;
  852.       ELSE Exit;
  853.     END;
  854.     ClearEvent (Event);
  855.   END;
  856.   (* --------------------------------------------------------------
  857.      Das Desktopmenü kann auch aktiviert werden, indem im Desktop-
  858.      Bereich die rechte Maustaste gedrückt wird.
  859.      -------------------------------------------------------------- *)
  860.   IF (Event.What = evMouseDown) AND
  861.      (Event.Buttons = mbRightButton) AND
  862.      (Event.Where.Y >= 1) AND
  863.      (Event.Where.Y < ScreenHeight-1) THEN BEGIN
  864.     ExecuteDeskMenu (Event);
  865.     ClearEvent (Event);
  866.   END;
  867. END;
  868.  
  869. (* ---------------------------------------------------------------- *)
  870. (* Done veranlasst das eigene Objekt, also tCaseToolApp, den        *)
  871. (* Desktop zu sichern und setzt das Startverzeichnis wieder.        *)
  872. (* ---------------------------------------------------------------- *)
  873. DESTRUCTOR tCaseToolApp.Done;
  874. BEGIN
  875.   Message (@Self, evCommand, cmSaveDesktop, NIL);
  876.   tApplication.Done;
  877.   ChDir (OriginDir);
  878. END;
  879.  
  880. BEGIN
  881.   CaseToolApp.Init;
  882.   CaseToolApp.Run;
  883.   CaseToolApp.Done;
  884. END.
  885.  
  886. (* ---------------------------------------------------------------- *)
  887. (*                          Ende von TOOL.PAS                       *)
  888. (* ---------------------------------------------------------------- *)
  889.