home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / tvision / gravis / gv / gvapp.int < prev    next >
Encoding:
Text File  |  1994-05-23  |  6.0 KB  |  214 lines
  1. unit GVApp;
  2.  
  3. { Unit GVApp enthält die Typen TProgram und TApplication }
  4.  
  5.  
  6. interface
  7.  
  8. uses Dos, Objects, Drivers, Memory, Views, GVViews, GVDialog, GVMenus;
  9.  
  10. const
  11.  
  12. { TApplication palette }
  13.  
  14.   CColor = #03#00#07#12#15#07#12#15#00#15#07#15#01#00#15#01#00#15#07#00#15#08+
  15.            #15#00#07#08#07#07#15#00#07#07#07#15#01#00#15#01#00#15#07#00#15#08+
  16.            #15#00#07#08#07#07#15#00#07#11#07#15#01#00#15#01#00#15#07#00#15#08+
  17.            #15#00#07#08#07#07#15#00#07#15#07#15#01#00#15#01#00#15#07#00#15#08+
  18.            #15#00#07#08#07#00#00#15#04#04#07#07#00#09#07#00#14#15#06#12#12#12+
  19.            #08#00#09#00#07#15#00#15#14#14#07#07#07#08#15#15#07#02#00#00#15#07+
  20.            #00#15#00#00#15#15#00#15#07;
  21.  
  22. { Standard application commands }
  23.  
  24.   cmNew       = 30;
  25.   cmOpen      = 31;
  26.   cmSave      = 32;
  27.   cmSaveAs    = 33;
  28.   cmSaveAll   = 34;
  29.   cmChangeDir = 35;
  30.   cmDosShell  = 36;
  31.   cmCloseAll  = 37;
  32.  
  33. { Standard application help contexts }
  34.  
  35. { Note: range $FF00 - $FFFF of help contexts are reserved }
  36.  
  37.   hcNew          = $FF01;
  38.   hcOpen         = $FF02;
  39.   hcSave         = $FF03;
  40.   hcSaveAs       = $FF04;
  41.   hcSaveAll      = $FF05;
  42.   hcChangeDir    = $FF06;
  43.   hcDosShell     = $FF07;
  44.   hcExit         = $FF08;
  45.  
  46.   hcUndo         = $FF10;
  47.   hcCut          = $FF11;
  48.   hcCopy         = $FF12;
  49.   hcPaste        = $FF13;
  50.   hcClear        = $FF14;
  51.  
  52.   hcTile         = $FF20;
  53.   hcCascade      = $FF21;
  54.   hcCloseAll     = $FF22;
  55.   hcResize       = $FF23;
  56.   hcZoom         = $FF24;
  57.   hcNext         = $FF25;
  58.   hcPrev         = $FF26;
  59.   hcClose        = $FF27;
  60.  
  61. type
  62.  
  63. { TDeskTop object }
  64.  
  65.   PDeskTop = ^TDeskTop;
  66.   TDeskTop = object(TGGroup)
  67.     Background: PBackground;
  68.     constructor Init(var Bounds: TRect);
  69.     constructor Load(var S: TStream);
  70.     procedure Store(var S: TStream);
  71.     procedure Cascade(var R: TRect);
  72.     procedure Draw; virtual;
  73.     procedure HandleEvent(var Event: TEvent); virtual;
  74.     procedure InitBackground; virtual;
  75.     procedure Tile(var R: TRect);
  76.     procedure TileError; virtual;
  77.   end;
  78.  
  79. { TProgram object }
  80.  
  81.   { Palette layout }
  82.   {      1 = TBackground }
  83.   {  2-  9 = TMenuView/TStatusLine }
  84.   { 10- 31 = TWindow (White) }
  85.   { 32- 53 = TWindow (Gray) }
  86.   { 54- 75 = TWindow (Cyan) }
  87.   { 76-138 = TDialog }
  88.  
  89.     {  94 = StaticText and StaticSign }
  90.     {  95 = Label normal text }
  91.     {  96 = Label selected text }
  92.     {  97 = Label normal shortcut }
  93.     {  98 = Label selected shortcut }
  94.     {  99 = Label normal background }
  95.     { 100 = Label selected background }
  96.     { 101 = Icon normal background }
  97.     { 102 = Icon selected background }
  98.     { 103 = Button background }
  99.     { 104 = Button normal text }
  100.     { 105 = Button default text }
  101.     { 106 = Button selected text }
  102.     { 107 = Button disabled text }
  103.     { 108 = Button normal shortcut }
  104.     { 109 = Button default shortcut }
  105.     { 110 = Button selected shortcut }
  106.     { 111 = Button border }
  107.     { 112 = Button lines }
  108.     { 113 = Regler frame selected }
  109.     { 114 = Regler frame normal }
  110.     { 115 = Regler frame disabled }
  111.     { 116 = Regler background }
  112.     { 117 = Cluster normal text }
  113.     { 118 = Cluster selected text }
  114.     { 119 = Cluster normal shortcut }
  115.     { 120 = Cluster selected shortcut }
  116.     { 121 = Cluster normal background }
  117.     { 122 = Cluster selected background }
  118.     { 123 = Cluster disabled background
  119.     { 124 = Cluster disabled text }
  120.     { 125 = InputLine passive }
  121.     { 126 = InputLine active }
  122.     { 127 = InputLine selected }
  123.     { 128 = InputLine arrows }
  124.     { 129 = InputLine frame }
  125.     { 130 = InputLine text }
  126.     { 131 = InputLine cursor }
  127.     { 132 = Arrowfield background }
  128.     { 133 = Arrowfield icon }
  129.     { 134 = ListViewer background }
  130.     { 135 = ListViewer frame }
  131.     { 136 = ListViewer normal text }
  132.     { 137 = ListViewer selected text }
  133.     { 138 = ListViewer normal background }
  134.     { 139 = ListViewer selected background }
  135.     { 140 = InfoPane text }
  136.     { 141 = InfoPane background }
  137.  
  138.   PProgram = ^TProgram;
  139.   TProgram = object(TGGroup)
  140.     constructor Init;
  141.     destructor Done; virtual;
  142.     function CanMoveFocus: Boolean;
  143.     procedure DoneEvents; virtual;
  144.     function ExecuteDialog (P: PDialog; Data: Pointer): Word;
  145.     procedure GetEvent(var Event: TEvent); virtual;
  146.     function GetPalette: PPalette; virtual;
  147.     procedure HandleEvent(var Event: TEvent); virtual;
  148.     procedure Idle; virtual;
  149.     procedure InitDesktop; virtual;
  150.     procedure InitEvents; virtual;
  151.     procedure InitMenuBar; virtual;
  152.     procedure InitScreen; virtual;
  153.     procedure InitStatusLine; virtual;
  154.     function InsertWindow(P: PWindow): PWindow;
  155.     procedure OutOfMemory; virtual;
  156.     procedure PutEvent(var Event: TEvent); virtual;
  157.     procedure Run; virtual;
  158.     function ValidView(P: PGView): PGView;
  159.   end;
  160.  
  161. { TApplication object }
  162.  
  163.   PApplication = ^TApplication;
  164.   TApplication = object(TProgram)
  165.     constructor Init;
  166.     destructor Done; virtual;
  167.     procedure Cascade;
  168.     procedure DosShell;
  169.     procedure GetTileRect(var R: TRect); virtual;
  170.     procedure HandleEvent(var Event: TEvent); virtual;
  171.     procedure Tile;
  172.     procedure WriteShellMsg; virtual;
  173.   end;
  174.  
  175. { Standard menus and status lines }
  176.  
  177. function StdStatusKeys(Next: PStatusItem): PStatusItem;
  178.  
  179. function StdFileMenuItems(Next: PMenuItem): PMenuItem;
  180. function StdEditMenuItems(Next: PMenuItem): PMenuItem;
  181. function StdWindowMenuItems(Next: PMenuItem): PMenuItem;
  182.  
  183. { GVApp registration procedure }
  184.  
  185.   procedure RegisterGVApp;
  186.  
  187. const
  188.  
  189. { language constants }
  190.  
  191.   lfEnglish = 1;
  192.   lfGerman  = 2;
  193.  
  194. { Public variables }
  195.  
  196.   Application: PProgram = nil;
  197.   Desktop: PDesktop = nil;
  198.   MenuBar: PMenuView = nil;
  199.   StatusLine: PStatusLine = nil;
  200.  
  201.   Language: Byte = lfGerman;
  202.   Language = lfEnglish;
  203.   Language = lfGerman;
  204.  
  205. { Stream registration records }
  206.  
  207.   RDeskTop: TStreamRec = (
  208.     ObjType: 46;
  209.     VmtLink: Ofs(TypeOf(TDeskTop)^);
  210.     Load: @TDeskTop.Load;
  211.     Store: @TDeskTop.Store);
  212.  
  213. implementation
  214.