home *** CD-ROM | disk | FTP | other *** search
/ PC-X 1998 July / pcx23_9807.iso / PC-XUSER / PC-XUSER.17 / OOP / PCX_APP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-02-08  |  9.7 KB  |  314 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {   PC-X User Application for Turbo Vision              }
  4. {   Copyright (c) 1997 By PC-X User and Bérczi László   }
  5. {                                                       }
  6. {   Portions Copyright (c) 1990 by Borland Int.         }
  7. {*******************************************************}
  8. {Last Edit: 1997 II 15. 21:00}
  9. {$X+,V-,F+,O-,S+,Q-}
  10.  
  11. {Lásd a file végét a szerzô megállapodás véget ! - Licens agreements.}
  12.  
  13. unit PCX_App;
  14.  
  15. INTERFACE
  16. uses App, Views, Dialogs, PCX_Dlg, Objects;
  17.  
  18. const
  19.  
  20.   CPCXColor =
  21.       #$8F#$70#$78#$74#$20#$28#$24#$17#$1F#$1A#$31#$31#$1E#$71#$1F + {  1- 15}
  22.   #$37#$3F#$3A#$13#$13#$3E#$21#$3F#$70#$7F#$7A#$13#$13#$70#$7F#$7E + { 16- 31}
  23.   #$70#$7F#$7A#$13#$13#$70#$70#$7F#$7E#$20#$2B#$2F#$78#$2E#$70#$30 + { 32- 47}
  24.   #$3F#$3E#$1F#$2F#$1A#$20#$72#$31#$31#$30#$2F#$3E#$31#$13#$38#$00 + { 48- 63}
  25.   {CPCXBlueDialog}
  26.   #$97#$9F#$F0#$70#$F0#$90#$90#$9F#$9E#$20#$2B#$2F#$78#$2E#$90#$30 + { 64- 79}
  27.   #$3F#$3E#$1F#$2F#$7A#$20#$92#$39#$39#$9F#$0F#$9E#$90#$93#$38#$00 + { 80- 95}
  28.   #$F7#$F0#$F2#$F0#$9E+ {PTitle+ATitle+DTitle+Icon+Drag}             { 96-100}
  29.   {CPCXRedDialog}
  30.   #$47#$4F#$F0#$70#$F0#$4E#$47#$4F#$4E#$20#$2B#$2F#$78#$2E#$40#$30 + {101-116}
  31.   #$3F#$3E#$70#$2F#$7A#$20#$42#$34#$34#$30#$2F#$3E#$34#$43#$38#$00 + {117-132}
  32.   #$F7#$F0#$F2#$F0#$4E+ {PTitle+ATitle+DTitle+Icon+Drag}             {133-137}
  33.   {CPCXGrayDialog}
  34.   #$70#$7F#$7A#$70#$F0#$70#$70#$7F#$7E#$20#$2B#$2F#$78#$2E#$70#$30 + {138-153}
  35.   #$3F#$3E#$1F#$2F#$1A#$20#$72#$31#$31#$30#$2F#$3E#$31#$13#$38#$00 + {154-169}
  36.   #$F7#$F0#$F2#$F0#$7E+ {PTitle+ATitle+DTitle+Icon+Drag}             {180-174}
  37.   { TPCXTitleBar }
  38.   #$1F;                                                              {175}
  39.  
  40.   CPCXBlackWhite =
  41.       #$8F#$70#$78#$74#$20#$28#$24#$17#$1F#$1A#$31#$31#$1E#$71#$1F + {  1- 15}
  42.   #$37#$3F#$3A#$13#$13#$3E#$21#$3F#$70#$7F#$7A#$13#$13#$70#$7F#$7E + { 16- 31}
  43.   #$70#$7F#$7A#$13#$13#$70#$70#$7F#$7E#$20#$2B#$2F#$78#$2E#$70#$30 + { 32- 47}
  44.   #$3F#$3E#$1F#$2F#$1A#$20#$72#$31#$31#$30#$2F#$3E#$31#$13#$38#$00 + { 48- 63}
  45.   {CPCXBlueDialog}
  46.   #$97#$9F#$F0#$70#$F0#$90#$90#$9F#$9E#$20#$2B#$2F#$78#$2E#$90#$30 + { 64- 79}
  47.   #$3F#$3E#$1F#$2F#$7A#$20#$92#$39#$39#$9F#$0F#$9E#$90#$93#$38#$00 + { 80- 95}
  48.   #$F7#$F0#$F2#$F0#$9E+ {PTitle+ATitle+DTitle+Icon+Drag}             { 96-100}
  49.   {CPCXRedDialog}
  50.   #$47#$4F#$F0#$70#$F0#$4E#$47#$4F#$4E#$20#$2B#$2F#$78#$2E#$40#$30 + {101-116}
  51.   #$3F#$3E#$70#$2F#$7A#$20#$42#$34#$34#$30#$2F#$3E#$34#$43#$38#$00 + {117-132}
  52.   #$F7#$F0#$F2#$F0#$4E+ {PTitle+ATitle+DTitle+Icon+Drag}             {133-137}
  53.   {CPCXGrayDialog}
  54.   #$70#$7F#$7A#$70#$F0#$70#$70#$7F#$7E#$20#$2B#$2F#$78#$2E#$70#$30 + {138-153}
  55.   #$3F#$3E#$1F#$2F#$1A#$20#$72#$31#$31#$30#$2F#$3E#$31#$13#$38#$00 + {154-169}
  56.   #$F7#$F0#$F2#$F0#$7E+ {PTitle+ATitle+DTitle+Icon+Drag}             {180-174}
  57.   { TPCXTitleBar }
  58.   #$1F;                                                              {175}
  59.  
  60.   CPCXMonochrome =
  61.       #$8F#$70#$78#$74#$20#$28#$24#$17#$1F#$1A#$31#$31#$1E#$71#$1F + {  1- 15}
  62.   #$37#$3F#$3A#$13#$13#$3E#$21#$3F#$70#$7F#$7A#$13#$13#$70#$7F#$7E + { 16- 31}
  63.   #$70#$7F#$7A#$13#$13#$70#$70#$7F#$7E#$20#$2B#$2F#$78#$2E#$70#$30 + { 32- 47}
  64.   #$3F#$3E#$1F#$2F#$1A#$20#$72#$31#$31#$30#$2F#$3E#$31#$13#$38#$00 + { 48- 63}
  65.   {CPCXBlueDialog}
  66.   #$97#$9F#$F0#$70#$F0#$90#$90#$9F#$9E#$20#$2B#$2F#$78#$2E#$90#$30 + { 64- 79}
  67.   #$3F#$3E#$1F#$2F#$7A#$20#$92#$39#$39#$9F#$0F#$9E#$90#$93#$38#$00 + { 80- 95}
  68.   #$F7#$F0#$F2#$F0#$9E+ {PTitle+ATitle+DTitle+Icon+Drag}             { 96-100}
  69.   {CPCXRedDialog}
  70.   #$47#$4F#$F0#$70#$F0#$4E#$47#$4F#$4E#$20#$2B#$2F#$78#$2E#$40#$30 + {101-116}
  71.   #$3F#$3E#$70#$2F#$7A#$20#$42#$34#$34#$30#$2F#$3E#$34#$43#$38#$00 + {117-132}
  72.   #$F7#$F0#$F2#$F0#$4E+ {PTitle+ATitle+DTitle+Icon+Drag}             {133-137}
  73.   {CPCXGrayDialog}
  74.   #$70#$7F#$7A#$70#$F0#$70#$70#$7F#$7E#$20#$2B#$2F#$78#$2E#$70#$30 + {138-153}
  75.   #$3F#$3E#$1F#$2F#$1A#$20#$72#$31#$31#$30#$2F#$3E#$31#$13#$38#$00 + {154-169}
  76.   #$F7#$F0#$F2#$F0#$7E+ {PTitle+ATitle+DTitle+Icon+Drag}             {180-174}
  77.   { TPCXTitleBar }
  78.   #$1F;                                                              {175}
  79.  
  80.  
  81. type
  82.  
  83.   PPCXApplication = ^TPCXApplication;
  84.   TPCXApplication = Object(TApplication)
  85.   public
  86.     ApplicationName,
  87.     ApplicationVersion,
  88.     UserName,
  89.     UserCorporation   : String[100];
  90.     constructor Init(AppName, AppVer, UName, UCorp: String);
  91.     destructor  Done; virtual;
  92.     procedure DosShell; virtual;
  93.     procedure Draw; virtual;
  94.     procedure InitDeskTop; virtual;
  95.     function  GetPalette: PPalette; virtual;
  96.     procedure GetMenuBarExtent(var R: TRect);
  97.   private
  98. {    IntroBox     : PPCXRedStatusBox;}
  99.     ControlBoxApp: PPCXControlBoxApp;
  100. {    Clock        : PPCXClockView;
  101.     Heap         : PPCXHeapView;}
  102.     HaveWeMouse{,
  103.     TempBoolean}  : Boolean;
  104. {    procedure Sysinfo;}
  105.   end;
  106.  
  107.   PPCXBackGround = ^TPCXBackGround;
  108.   TPCXBackGround = Object(TBackGround)
  109.     function  GetPalette: PPalette; virtual;
  110.   end;
  111.  
  112.   PPCXDeskTop = ^TPCXDeskTop;
  113.   TPCXDeskTop = Object(TDeskTop)
  114.     procedure InitBackGround; virtual;
  115.   end;
  116.  
  117.   PPCXTitleBar = ^TPCXTitleBar;
  118.   TPCXTitleBar = Object(TStaticText)
  119.     constructor Init(AText: String);
  120.     function  GetPalette: PPalette; virtual;
  121.     procedure SetTitleText(AText: String);
  122.   end;
  123.  
  124. const
  125.  
  126.   {PCX_App unit consts}
  127.   IsMonoPalette: Boolean = False;
  128.   NeedClockView: Boolean = True;
  129.   NeedHeapView : Boolean = False;
  130.   PCXTitlebar  : PPCXTitleBar = nil;
  131.  
  132. IMPLEMENTATION
  133. uses PCX_Util, Drivers, Memory, DOS;
  134.  
  135. var
  136.   TempScreen: TScreen; {To save screen's text    }
  137.   X, Y      : Byte;    {To keep cursor's position}
  138.  
  139. {TPCXApplication}
  140. constructor TPCXApplication.Init(AppName, AppVer, UName, UCorp: String);
  141. var
  142.   P: TPCXPoint;
  143.   R: TRect;
  144. begin
  145.   GetScreen(TempScreen);
  146.  
  147.   Inherited Init;
  148.   IsMonoPalette:=(GetPrimaryAdapterType in[$05, $07, $0B, $FF, $22, $E8]) or SearchForParameter('/MONO');
  149.  
  150.   if Not IsMonoPalette then SetBackGroundIntensity(True);
  151.  
  152.   HaveWeMouse:=MouseEvents;
  153.   ApplicationName   :=AppName;
  154.   ApplicationVersion:=AppVer;
  155.   UserName          :=UName;
  156.   UserCorporation   :=UCorp;
  157.  
  158.   New(PCXTitlebar, Init(#3+ApplicationName));
  159.   Insert(PCXTitlebar);
  160.   P.Assign(0,0);
  161.   New(ControlBoxApp, Init(P));
  162.   Insert(ControlBoxApp);
  163. {  if NeedClockView then
  164.   begin
  165.     GetExtent(R);
  166.     R.A.X := R.B.X - 9; R.B.Y := R.A.Y + 1;
  167.     New(Clock, Init(R));
  168.     Insert(Clock);
  169.   end;
  170.   if NeedHeapView then
  171.   begin
  172.     GetExtent(R);
  173.     Dec(R.B.X);
  174.     R.A.X := R.B.X - 9; R.A.Y := R.B.Y - 1;
  175.     New(Heap, Init(R));
  176.     Insert(Heap);
  177.   end;}
  178.  
  179. end;
  180.  
  181. destructor  TPCXApplication.Done;
  182. begin
  183.   Inherited Done;
  184.   if Not IsMonoPalette then SetBackGroundIntensity(False);
  185.   PutScreen(TempScreen);
  186. end;
  187.  
  188. procedure TPCXApplication.DosShell;
  189. begin
  190.   DoneSysError;
  191.   DoneEvents;
  192.   DoneVideo;
  193.   DoneDosMem;
  194.     PutScreen(TempScreen);
  195.     SetXY(X, Y);
  196.     if IsPCXGraphCharsOn then PutSavedChars;
  197.   WriteShellMsg;
  198.   SwapVectors;
  199.   Exec(GetEnv('COMSPEC'), '');
  200.   SwapVectors;
  201.   InitDosMem;
  202.     GetScreen(TempScreen);
  203.     GetXY(X, Y);
  204.     if IsPCXGraphCharsOn then
  205.     begin
  206.       GetSaveableChars;
  207.       SetPCXGraphChars(True);
  208.     end;
  209.   InitVideo;
  210.   InitEvents;
  211.   InitSysError;
  212.   Redraw;
  213. end;
  214.  
  215. procedure TPCXApplication.InitDeskTop;
  216. var R: TRect;
  217. begin
  218.   GetExtent(R);
  219.   Inc(R.A.Y); Dec(R.B.Y);
  220.   DeskTop:=New(PPCXDeskTop, Init(R));
  221. end;
  222.  
  223. procedure TPCXApplication.Draw;
  224. begin
  225.   Inherited Draw;
  226.   Message(@Self, evCommand, cmMouseChanged, @Self);
  227. end;
  228.  
  229. function  TPCXApplication.GetPalette: PPalette;
  230. const
  231.   PA: Array[apColor..apMonochrome] of String[Length(CPCXColor)] =
  232.         (CPCXColor, CPCXBlackWhite, CPCXMonochrome);
  233. begin
  234.   if IsMonoPalette then GetPalette := @PA[apBlackWhite]
  235.                    else GetPalette := @PA[AppPalette];
  236. end;
  237.  
  238. procedure TPCXApplication.GetMenuBarExtent(var R: TRect);
  239. begin
  240.   GetExtent(R);
  241.   Inc(R.A.Y);
  242.   R.B.Y := R.A.Y + 1;
  243. end;
  244.  
  245.  
  246. {TPCXBackGround}
  247. function  TPCXBackGround.GetPalette;
  248. const P: String[Length(CBackground)] = CBackground;
  249. begin
  250.   GetPalette := @P;
  251. end;
  252.  
  253. {TPCXDeskTop}
  254. procedure TPCXDeskTop.InitBackGround;
  255. var R: TRect;
  256. begin
  257.   GetExtent(R);
  258.   BackGround:=New(PBackground, Init(R, #32));
  259. end;
  260.  
  261. {TPCXTitleBar}
  262. constructor TPCXTitleBar.Init(AText: String);
  263. var R: TRect;
  264. begin
  265.   R.A.Y:= 0;
  266.   R.B.Y:= R.A.Y + 1;
  267.   R.A.X:= 0;
  268.   R.B.X:= Application^.Size.X;
  269.   Inherited Init(R, AText);
  270. end;
  271.  
  272. function  TPCXTitleBar.GetPalette: PPalette;
  273. const
  274.   P: String[Length(CPCXTitleBar)] = CPCXTitleBar;
  275. begin
  276.   GetPalette := @P;
  277. end;
  278.  
  279. procedure TPCXTitleBar.SetTitleText(AText: String);
  280. begin
  281.   if Text <> nil then Dispose(Text);
  282.   if AText = ''  then Text:=nil
  283.                  else Text:=NewStr(^C+AText);
  284.   DrawView;
  285.  
  286. end;
  287.  
  288. var
  289.   OldExitProc: Pointer;
  290.  
  291. procedure PCXExitProc; far;
  292. begin
  293.   if IsPCXGraphCharsOn then PutSavedChars;
  294.   if IsBackGroundIntensityOn then SetBackGroundIntensity(False);
  295.   SetXY(X, Y);
  296.   ExitProc:=OldExitProc;
  297. end;
  298.  
  299.  
  300. BEGIN
  301.   GetXY(X, Y);
  302.   GetSaveableChars;
  303.   OldExitProc:=ExitProc;
  304.   ExitProc:=@PCXExitProc;
  305. END.
  306. {*********************************************************}
  307. {                                                         }
  308. {   A unit forráskódja az IDG - PC-X szerkesztôségének,   }
  309. {   és Bérczi László-nak a tulajdona.                     }
  310. {   A forráskód a kereskedelmi célokat kivéve szabadon    }
  311. {                    terjeszthetô !                       }
  312. {                                                         }
  313. {   PC-X User (c) 1997, április                           }
  314. {*********************************************************}