{*******************************************************}
{ }
{ Turbo Pascal Version 7.0 }
{ Turbo Vision Unit }
{ }
{ Copyright (c) 1992 Borland International }
{ }
{*******************************************************}
{$PureInt+}
unit App;
{$X+,I-,S-,Cdecl-}
interface
uses Objects, Drivers, Memory, HistList, Views, Menus, Dialogs, Use32;
const
{ TApplication palette entries }
apColor = 0;
apBlackWhite = 1;
apMonochrome = 2;
{ TApplication palettes }
{ Turbo Vision 1.0 Color Palettes }
CColor =
#$71#$70#$78#$74#$20#$28#$24#$17#$1F#$1A#$31#$31#$1E#$71#$1F +
#$37#$3F#$3A#$13#$13#$3E#$21#$3F#$70#$7F#$7A#$13#$13#$70#$7F#$7E +
#$70#$7F#$7A#$13#$13#$70#$70#$7F#$7E#$20#$2B#$2F#$78#$2E#$70#$30 +
#$3F#$3E#$1F#$2F#$1A#$20#$72#$31#$31#$30#$2F#$3E#$31#$13#$38#$00;
CBlackWhite =
#$70#$70#$78#$7F#$07#$07#$0F#$07#$0F#$07#$70#$70#$07#$70#$0F +
#$07#$0F#$07#$70#$70#$07#$70#$0F#$70#$7F#$7F#$70#$07#$70#$07#$0F +
#$70#$7F#$7F#$70#$07#$70#$70#$7F#$7F#$07#$0F#$0F#$78#$0F#$78#$07 +
#$0F#$0F#$0F#$70#$0F#$07#$70#$70#$70#$07#$70#$0F#$07#$07#$78#$00;
CMonochrome =
#$70#$07#$07#$0F#$70#$70#$70#$07#$0F#$07#$70#$70#$07#$70#$00 +
#$07#$0F#$07#$70#$70#$07#$70#$00#$70#$70#$70#$07#$07#$70#$07#$00 +
#$70#$70#$70#$07#$07#$70#$70#$70#$0F#$07#$07#$0F#$70#$0F#$70#$07 +
#$0F#$0F#$07#$70#$07#$07#$70#$07#$07#$07#$70#$0F#$07#$07#$70#$00;
{ Turbo Vision 2.0 Color Palettes }
CAppColor =
#$71#$70#$78#$74#$20#$28#$24#$17#$1F#$1A#$31#$31#$1E#$71#$1F +
#$37#$3F#$3A#$13#$13#$3E#$21#$3F#$70#$7F#$7A#$13#$13#$70#$7F#$7E +
#$70#$7F#$7A#$13#$13#$70#$70#$7F#$7E#$20#$2B#$2F#$78#$2E#$70#$30 +
#$3F#$3E#$1F#$2F#$1A#$20#$72#$31#$31#$30#$2F#$3E#$31#$13#$38#$00 +
#$17#$1F#$1A#$71#$71#$1E#$17#$1F#$1E#$20#$2B#$2F#$78#$2E#$10#$30 +
#$3F#$3E#$70#$2F#$7A#$20#$12#$31#$31#$30#$2F#$3E#$31#$13#$38#$00 +
#$37#$3F#$3A#$13#$13#$3E#$30#$3F#$3E#$20#$2B#$2F#$78#$2E#$30#$70 +
#$7F#$7E#$1F#$2F#$1A#$20#$32#$31#$71#$70#$2F#$7E#$71#$13#$38#$00;
CAppBlackWhite =
#$70#$70#$78#$7F#$07#$07#$0F#$07#$0F#$07#$70#$70#$07#$70#$0F +
#$07#$0F#$07#$70#$70#$07#$70#$0F#$70#$7F#$7F#$70#$07#$70#$07#$0F +
#$70#$7F#$7F#$70#$07#$70#$70#$7F#$7F#$07#$0F#$0F#$78#$0F#$78#$07 +
#$0F#$0F#$0F#$70#$0F#$07#$70#$70#$70#$07#$70#$0F#$07#$07#$78#$00 +
#$07#$0F#$0F#$07#$70#$07#$07#$0F#$0F#$70#$78#$7F#$08#$7F#$08#$70 +
#$7F#$7F#$7F#$0F#$70#$70#$07#$70#$70#$70#$07#$7F#$70#$07#$78#$00 +
#$70#$7F#$7F#$70#$07#$70#$70#$7F#$7F#$07#$0F#$0F#$78#$0F#$78#$07 +
#$0F#$0F#$0F#$70#$0F#$07#$70#$70#$70#$07#$70#$0F#$07#$07#$78#$00;
CAppMonochrome =
#$70#$07#$07#$0F#$70#$70#$70#$07#$0F#$07#$70#$70#$07#$70#$00 +
#$07#$0F#$07#$70#$70#$07#$70#$00#$70#$70#$70#$07#$07#$70#$07#$00 +
#$70#$70#$70#$07#$07#$70#$70#$70#$0F#$07#$07#$0F#$70#$0F#$70#$07 +
#$0F#$0F#$07#$70#$07#$07#$70#$07#$07#$07#$70#$0F#$07#$07#$70#$00 +
#$70#$70#$70#$07#$07#$70#$70#$70#$0F#$07#$07#$0F#$70#$0F#$70#$07 +
#$0F#$0F#$07#$70#$07#$07#$70#$07#$07#$07#$70#$0F#$07#$07#$70#$00 +
#$70#$70#$70#$07#$07#$70#$70#$70#$0F#$07#$07#$0F#$70#$0F#$70#$07 +
#$0F#$0F#$07#$70#$07#$07#$70#$07#$07#$07#$70#$0F#$07#$07#$70#$00;
{ TBackground palette }
CBackground = #1;
{ Standard application commands }
cmNew = 30;
cmOpen = 31;
cmSave = 32;
cmSaveAs = 33;
cmSaveAll = 34;
cmChangeDir = 35;
cmDosShell = 36;
cmCloseAll = 37;
{ Standard application help contexts }
{ Note: range $FF00 - $FFFF of help contexts are reserved by Borland }
hcNew = $FF01;
hcOpen = $FF02;
hcSave = $FF03;
hcSaveAs = $FF04;
hcSaveAll = $FF05;
hcChangeDir = $FF06;
hcDosShell = $FF07;
hcExit = $FF08;
hcUndo = $FF10;
hcCut = $FF11;
hcCopy = $FF12;
hcPaste = $FF13;
hcClear = $FF14;
hcTile = $FF20;
hcCascade = $FF21;
hcCloseAll = $FF22;
hcResize = $FF23;
hcZoom = $FF24;
hcNext = $FF25;
hcPrev = $FF26;
hcClose = $FF27;
type
{ TBackground object }
PBackground = ^TBackground;
TBackground = object(TView)
Pattern: Char;
constructor Init(var Bounds: TRect; APattern: Char);
constructor Load(var S: TStream);
procedure Draw; virtual;
function GetPalette: PPalette; virtual;
procedure Store(var S: TStream);
end;
{ TDesktop object }
PDesktop = ^TDesktop;
TDesktop = object(TGroup)
Background: PBackground;
TileColumnsFirst: Boolean;
constructor Init(var Bounds: TRect);
constructor Load(var S: TStream);
procedure Cascade(var R: TRect);
procedure HandleEvent(var Event: TEvent); virtual;
procedure InitBackground; virtual;
procedure Store(var S: TStream);
procedure Tile(var R: TRect);
procedure TileError; virtual;
end;
{ TProgram object }
{ Palette layout }
{ 1 = TBackground }
{ 2- 7 = TMenuView and TStatusLine }
{ 8-15 = TWindow(Blue) }
{ 16-23 = TWindow(Cyan) }
{ 24-31 = TWindow(Gray) }
{ 32-63 = TDialog }
PProgram = ^TProgram;
TProgram = object(TGroup)
constructor Init;
destructor Done; virtual;
function CanMoveFocus: Boolean;
function ExecuteDialog(P: PDialog; Data: Pointer): Word;
procedure GetEvent(var Event: TEvent); virtual;
function GetPalette: PPalette; virtual;
procedure HandleEvent(var Event: TEvent); virtual;
procedure Idle; virtual;
procedure InitDesktop; virtual;
procedure InitMenuBar; virtual;
procedure InitScreen; virtual;
procedure InitStatusLine; virtual;
function InsertWindow(P: PWindow): PWindow;
procedure OutOfMemory; virtual;
procedure PutEvent(var Event: TEvent); virtual;
procedure Run; virtual;
procedure SetScreenMode(Mode: Word);
function ValidView(P: PView): PView;
end;
{ TApplication object }
PApplication = ^TApplication;
TApplication = object(TProgram)
constructor Init;
destructor Done; virtual;
procedure Cascade;
procedure DosShell;
procedure GetTileRect(var R: TRect); virtual;
procedure HandleEvent(var Event: TEvent); virtual;
procedure Tile;
procedure WriteShellMsg; virtual;
end;
{ Standard menus and status lines }
function StdStatusKeys(Next: PStatusItem): PStatusItem;
function StdFileMenuItems(Next: PMenuItem): PMenuItem;
function StdEditMenuItems(Next: PMenuItem): PMenuItem;
function StdWindowMenuItems(Next: PMenuItem): PMenuItem;
{ App registration procedure }
procedure RegisterApp;
const
{ Public variables }
Application: PProgram = nil;
Desktop: PDesktop = nil;
StatusLine: PStatusLine = nil;
MenuBar: PMenuView = nil;
AppPalette: Integer = apColor;
{ Stream registration records }
const
RBackground: TStreamRec = (
ObjType: 30;
VmtLink: Ofs(TypeOf(TBackground)^);
Load: @TBackground.Load;
Store: @TBackground.Store);
const
RDesktop: TStreamRec = (
ObjType: 31;
VmtLink: Ofs(TypeOf(TDesktop)^);
Load: @TDesktop.Load;
Store: @TDesktop.Store);
implementation
end.
