home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / vp11demo.zip / rtlsrc.rar / tv / APP.PAS next >
Pascal/Delphi Source File  |  1996-10-08  |  8KB  |  241 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Turbo Pascal Version 7.0                        }
  5. {       Turbo Vision Unit                               }
  6. {                                                       }
  7. {       Copyright (c) 1992 Borland International        }
  8. {                                                       }
  9. {*******************************************************}
  10. {$PureInt+}
  11. unit App;
  12.  
  13. {$X+,I-,S-,Cdecl-}
  14.  
  15. interface
  16.  
  17. uses Objects, Drivers, Memory, HistList, Views, Menus, Dialogs, Use32;
  18.  
  19. const
  20.  
  21. { TApplication palette entries }
  22.  
  23.   apColor      = 0;
  24.   apBlackWhite = 1;
  25.   apMonochrome = 2;
  26.  
  27. { TApplication palettes }
  28.  
  29.   { Turbo Vision 1.0 Color Palettes }
  30.  
  31.   CColor =
  32.         #$71#$70#$78#$74#$20#$28#$24#$17#$1F#$1A#$31#$31#$1E#$71#$1F +
  33.     #$37#$3F#$3A#$13#$13#$3E#$21#$3F#$70#$7F#$7A#$13#$13#$70#$7F#$7E +
  34.     #$70#$7F#$7A#$13#$13#$70#$70#$7F#$7E#$20#$2B#$2F#$78#$2E#$70#$30 +
  35.     #$3F#$3E#$1F#$2F#$1A#$20#$72#$31#$31#$30#$2F#$3E#$31#$13#$38#$00;
  36.  
  37.   CBlackWhite =
  38.         #$70#$70#$78#$7F#$07#$07#$0F#$07#$0F#$07#$70#$70#$07#$70#$0F +
  39.     #$07#$0F#$07#$70#$70#$07#$70#$0F#$70#$7F#$7F#$70#$07#$70#$07#$0F +
  40.     #$70#$7F#$7F#$70#$07#$70#$70#$7F#$7F#$07#$0F#$0F#$78#$0F#$78#$07 +
  41.     #$0F#$0F#$0F#$70#$0F#$07#$70#$70#$70#$07#$70#$0F#$07#$07#$78#$00;
  42.  
  43.   CMonochrome =
  44.         #$70#$07#$07#$0F#$70#$70#$70#$07#$0F#$07#$70#$70#$07#$70#$00 +
  45.     #$07#$0F#$07#$70#$70#$07#$70#$00#$70#$70#$70#$07#$07#$70#$07#$00 +
  46.     #$70#$70#$70#$07#$07#$70#$70#$70#$0F#$07#$07#$0F#$70#$0F#$70#$07 +
  47.     #$0F#$0F#$07#$70#$07#$07#$70#$07#$07#$07#$70#$0F#$07#$07#$70#$00;
  48.  
  49.   { Turbo Vision 2.0 Color Palettes }
  50.  
  51.   CAppColor =
  52.         #$71#$70#$78#$74#$20#$28#$24#$17#$1F#$1A#$31#$31#$1E#$71#$1F +
  53.     #$37#$3F#$3A#$13#$13#$3E#$21#$3F#$70#$7F#$7A#$13#$13#$70#$7F#$7E +
  54.     #$70#$7F#$7A#$13#$13#$70#$70#$7F#$7E#$20#$2B#$2F#$78#$2E#$70#$30 +
  55.     #$3F#$3E#$1F#$2F#$1A#$20#$72#$31#$31#$30#$2F#$3E#$31#$13#$38#$00 +
  56.     #$17#$1F#$1A#$71#$71#$1E#$17#$1F#$1E#$20#$2B#$2F#$78#$2E#$10#$30 +
  57.     #$3F#$3E#$70#$2F#$7A#$20#$12#$31#$31#$30#$2F#$3E#$31#$13#$38#$00 +
  58.     #$37#$3F#$3A#$13#$13#$3E#$30#$3F#$3E#$20#$2B#$2F#$78#$2E#$30#$70 +
  59.     #$7F#$7E#$1F#$2F#$1A#$20#$32#$31#$71#$70#$2F#$7E#$71#$13#$38#$00;
  60.  
  61.   CAppBlackWhite =
  62.         #$70#$70#$78#$7F#$07#$07#$0F#$07#$0F#$07#$70#$70#$07#$70#$0F +
  63.     #$07#$0F#$07#$70#$70#$07#$70#$0F#$70#$7F#$7F#$70#$07#$70#$07#$0F +
  64.     #$70#$7F#$7F#$70#$07#$70#$70#$7F#$7F#$07#$0F#$0F#$78#$0F#$78#$07 +
  65.     #$0F#$0F#$0F#$70#$0F#$07#$70#$70#$70#$07#$70#$0F#$07#$07#$78#$00 +
  66.     #$07#$0F#$0F#$07#$70#$07#$07#$0F#$0F#$70#$78#$7F#$08#$7F#$08#$70 +
  67.     #$7F#$7F#$7F#$0F#$70#$70#$07#$70#$70#$70#$07#$7F#$70#$07#$78#$00 +
  68.     #$70#$7F#$7F#$70#$07#$70#$70#$7F#$7F#$07#$0F#$0F#$78#$0F#$78#$07 +
  69.     #$0F#$0F#$0F#$70#$0F#$07#$70#$70#$70#$07#$70#$0F#$07#$07#$78#$00;
  70.  
  71.   CAppMonochrome =
  72.         #$70#$07#$07#$0F#$70#$70#$70#$07#$0F#$07#$70#$70#$07#$70#$00 +
  73.     #$07#$0F#$07#$70#$70#$07#$70#$00#$70#$70#$70#$07#$07#$70#$07#$00 +
  74.     #$70#$70#$70#$07#$07#$70#$70#$70#$0F#$07#$07#$0F#$70#$0F#$70#$07 +
  75.     #$0F#$0F#$07#$70#$07#$07#$70#$07#$07#$07#$70#$0F#$07#$07#$70#$00 +
  76.     #$70#$70#$70#$07#$07#$70#$70#$70#$0F#$07#$07#$0F#$70#$0F#$70#$07 +
  77.     #$0F#$0F#$07#$70#$07#$07#$70#$07#$07#$07#$70#$0F#$07#$07#$70#$00 +
  78.     #$70#$70#$70#$07#$07#$70#$70#$70#$0F#$07#$07#$0F#$70#$0F#$70#$07 +
  79.     #$0F#$0F#$07#$70#$07#$07#$70#$07#$07#$07#$70#$0F#$07#$07#$70#$00;
  80.  
  81. { TBackground palette }
  82.  
  83.   CBackground = #1;
  84.  
  85. { Standard application commands }
  86.  
  87.   cmNew       = 30;
  88.   cmOpen      = 31;
  89.   cmSave      = 32;
  90.   cmSaveAs    = 33;
  91.   cmSaveAll   = 34;
  92.   cmChangeDir = 35;
  93.   cmDosShell  = 36;
  94.   cmCloseAll  = 37;
  95.  
  96. { Standard application help contexts }
  97.  
  98. { Note: range $FF00 - $FFFF of help contexts are reserved by Borland }
  99.  
  100.   hcNew          = $FF01;
  101.   hcOpen         = $FF02;
  102.   hcSave         = $FF03;
  103.   hcSaveAs       = $FF04;
  104.   hcSaveAll      = $FF05;
  105.   hcChangeDir    = $FF06;
  106.   hcDosShell     = $FF07;
  107.   hcExit         = $FF08;
  108.  
  109.   hcUndo         = $FF10;
  110.   hcCut          = $FF11;
  111.   hcCopy         = $FF12;
  112.   hcPaste        = $FF13;
  113.   hcClear        = $FF14;
  114.  
  115.   hcTile         = $FF20;
  116.   hcCascade      = $FF21;
  117.   hcCloseAll     = $FF22;
  118.   hcResize       = $FF23;
  119.   hcZoom         = $FF24;
  120.   hcNext         = $FF25;
  121.   hcPrev         = $FF26;
  122.   hcClose        = $FF27;
  123.  
  124. type
  125.  
  126. { TBackground object }
  127.  
  128.   PBackground = ^TBackground;
  129.   TBackground = object(TView)
  130.     Pattern: Char;
  131.     constructor Init(var Bounds: TRect; APattern: Char);
  132.     constructor Load(var S: TStream);
  133.     procedure Draw; virtual;
  134.     function GetPalette: PPalette; virtual;
  135.     procedure Store(var S: TStream);
  136.   end;
  137.  
  138. { TDesktop object }
  139.  
  140.   PDesktop = ^TDesktop;
  141.   TDesktop = object(TGroup)
  142.     Background: PBackground;
  143.     TileColumnsFirst: Boolean;
  144.     constructor Init(var Bounds: TRect);
  145.     constructor Load(var S: TStream);
  146.     procedure Cascade(var R: TRect);
  147.     procedure HandleEvent(var Event: TEvent); virtual;
  148.     procedure InitBackground; virtual;
  149.     procedure Store(var S: TStream);
  150.     procedure Tile(var R: TRect);
  151.     procedure TileError; virtual;
  152.   end;
  153.  
  154. { TProgram object }
  155.  
  156.   { Palette layout }
  157.   {     1 = TBackground }
  158.   {  2- 7 = TMenuView and TStatusLine }
  159.   {  8-15 = TWindow(Blue) }
  160.   { 16-23 = TWindow(Cyan) }
  161.   { 24-31 = TWindow(Gray) }
  162.   { 32-63 = TDialog }
  163.  
  164.   PProgram = ^TProgram;
  165.   TProgram = object(TGroup)
  166.     constructor Init;
  167.     destructor Done; virtual;
  168.     function CanMoveFocus: Boolean;
  169.     function ExecuteDialog(P: PDialog; Data: Pointer): Word;
  170.     procedure GetEvent(var Event: TEvent); virtual;
  171.     function GetPalette: PPalette; virtual;
  172.     procedure HandleEvent(var Event: TEvent); virtual;
  173.     procedure Idle; virtual;
  174.     procedure InitDesktop; virtual;
  175.     procedure InitMenuBar; virtual;
  176.     procedure InitScreen; virtual;
  177.     procedure InitStatusLine; virtual;
  178.     function InsertWindow(P: PWindow): PWindow;
  179.     procedure OutOfMemory; virtual;
  180.     procedure PutEvent(var Event: TEvent); virtual;
  181.     procedure Run; virtual;
  182.     procedure SetScreenMode(Mode: Word);
  183.     function ValidView(P: PView): PView;
  184.   end;
  185.  
  186. { TApplication object }
  187.  
  188.   PApplication = ^TApplication;
  189.   TApplication = object(TProgram)
  190.     constructor Init;
  191.     destructor Done; virtual;
  192.     procedure Cascade;
  193.     procedure DosShell;
  194.     procedure GetTileRect(var R: TRect); virtual;
  195.     procedure HandleEvent(var Event: TEvent); virtual;
  196.     procedure Tile;
  197.     procedure WriteShellMsg; virtual;
  198.   end;
  199.  
  200. { Standard menus and status lines }
  201.  
  202. function StdStatusKeys(Next: PStatusItem): PStatusItem;
  203.  
  204. function StdFileMenuItems(Next: PMenuItem): PMenuItem;
  205. function StdEditMenuItems(Next: PMenuItem): PMenuItem;
  206. function StdWindowMenuItems(Next: PMenuItem): PMenuItem;
  207.  
  208. { App registration procedure }
  209.  
  210. procedure RegisterApp;
  211.  
  212. const
  213.  
  214. { Public variables }
  215.  
  216.   Application: PProgram = nil;
  217.   Desktop: PDesktop = nil;
  218.   StatusLine: PStatusLine = nil;
  219.   MenuBar: PMenuView = nil;
  220.   AppPalette: Integer = apColor;
  221.  
  222. { Stream registration records }
  223.  
  224. const
  225.   RBackground: TStreamRec = (
  226.     ObjType: 30;
  227.     VmtLink: Ofs(TypeOf(TBackground)^);
  228.     Load: @TBackground.Load;
  229.     Store: @TBackground.Store);
  230.  
  231. const
  232.   RDesktop: TStreamRec = (
  233.     ObjType: 31;
  234.     VmtLink: Ofs(TypeOf(TDesktop)^);
  235.     Load: @TDesktop.Load;
  236.     Store: @TDesktop.Store);
  237.  
  238. implementation
  239.  
  240. end.
  241.