app.pas 54 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133
  1. { $Id$}
  2. {********[ SOURCE FILE OF GRAPHICAL FREE VISION ]**********}
  3. { }
  4. { System independent GRAPHICAL clone of APP.PAS }
  5. { }
  6. { Interface Copyright (c) 1992 Borland International }
  7. { }
  8. { Copyright (c) 1996, 1997, 1998, 1999 by Leon de Boer }
  9. { [email protected] - primary e-mail addr }
  10. { [email protected] - backup e-mail addr }
  11. { }
  12. {****************[ THIS CODE IS FREEWARE ]*****************}
  13. { }
  14. { This sourcecode is released for the purpose to }
  15. { promote the pascal language on all platforms. You may }
  16. { redistribute it and/or modify with the following }
  17. { DISCLAIMER. }
  18. { }
  19. { This SOURCE CODE is distributed "AS IS" WITHOUT }
  20. { WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR }
  21. { ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED. }
  22. { }
  23. {*****************[ SUPPORTED PLATFORMS ]******************}
  24. { }
  25. { Only Free Pascal Compiler supported }
  26. { }
  27. {**********************************************************}
  28. UNIT App;
  29. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  30. INTERFACE
  31. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  32. {====Include file to sort compiler platform out =====================}
  33. {$I Platform.inc}
  34. {====================================================================}
  35. {==== Compiler directives ===========================================}
  36. {$X+} { Extended syntax is ok }
  37. {$R-} { Disable range checking }
  38. {$S-} { Disable Stack Checking }
  39. {$I-} { Disable IO Checking }
  40. {$Q-} { Disable Overflow Checking }
  41. {$V-} { Turn off strict VAR strings }
  42. {====================================================================}
  43. USES
  44. {$IFDEF OS_WINDOWS} { WIN/NT CODE }
  45. Windows, { Standard units }
  46. {$ENDIF}
  47. {$IFDEF OS_OS2} { OS2 CODE }
  48. Os2Def, Os2Base, OS2PmApi, { Standard units }
  49. {$ENDIF}
  50. GFVGraph, { GFV standard unit }
  51. Common, Memory, { GFV standard units }
  52. Objects, Drivers, Views, Menus, HistList, Dialogs; { GFV standard units }
  53. {***************************************************************************}
  54. { PUBLIC CONSTANTS }
  55. {***************************************************************************}
  56. {---------------------------------------------------------------------------}
  57. { STANDARD APPLICATION COMMAND CONSTANTS }
  58. {---------------------------------------------------------------------------}
  59. CONST
  60. cmNew = 30; { Open new file }
  61. cmOpen = 31; { Open a file }
  62. cmSave = 32; { Save current }
  63. cmSaveAs = 33; { Save current as }
  64. cmSaveAll = 34; { Save all files }
  65. cmChangeDir = 35; { Change directories }
  66. cmDosShell = 36; { Dos shell }
  67. cmCloseAll = 37; { Close all windows }
  68. {---------------------------------------------------------------------------}
  69. { TApplication PALETTE ENTRIES }
  70. {---------------------------------------------------------------------------}
  71. CONST
  72. apColor = 0; { Coloured app }
  73. apBlackWhite = 1; { B&W application }
  74. apMonochrome = 2; { Monochrome app }
  75. {---------------------------------------------------------------------------}
  76. { TBackGround PALETTES }
  77. {---------------------------------------------------------------------------}
  78. CONST
  79. CBackground = #1; { Background colour }
  80. {---------------------------------------------------------------------------}
  81. { TApplication PALETTES }
  82. {---------------------------------------------------------------------------}
  83. CONST
  84. { Turbo Vision 1.0 Color Palettes }
  85. CColor =
  86. #$81#$70#$78#$74#$20#$28#$24#$17#$1F#$1A#$31#$31#$1E#$71#$1F +
  87. #$37#$3F#$3A#$13#$13#$3E#$21#$3F#$70#$7F#$7A#$13#$13#$70#$7F#$7E +
  88. #$70#$7F#$7A#$13#$13#$70#$70#$7F#$7E#$20#$2B#$2F#$78#$2E#$70#$30 +
  89. #$3F#$3E#$1F#$2F#$1A#$20#$72#$31#$31#$30#$2F#$3E#$31#$13#$38#$00;
  90. CBlackWhite =
  91. #$70#$70#$78#$7F#$07#$07#$0F#$07#$0F#$07#$70#$70#$07#$70#$0F +
  92. #$07#$0F#$07#$70#$70#$07#$70#$0F#$70#$7F#$7F#$70#$07#$70#$07#$0F +
  93. #$70#$7F#$7F#$70#$07#$70#$70#$7F#$7F#$07#$0F#$0F#$78#$0F#$78#$07 +
  94. #$0F#$0F#$0F#$70#$0F#$07#$70#$70#$70#$07#$70#$0F#$07#$07#$78#$00;
  95. CMonochrome =
  96. #$70#$07#$07#$0F#$70#$70#$70#$07#$0F#$07#$70#$70#$07#$70#$00 +
  97. #$07#$0F#$07#$70#$70#$07#$70#$00#$70#$70#$70#$07#$07#$70#$07#$00 +
  98. #$70#$70#$70#$07#$07#$70#$70#$70#$0F#$07#$07#$0F#$70#$0F#$70#$07 +
  99. #$0F#$0F#$07#$70#$07#$07#$70#$07#$07#$07#$70#$0F#$07#$07#$70#$00;
  100. { Turbo Vision 2.0 Color Palettes }
  101. CAppColor =
  102. #$71#$70#$78#$74#$20#$28#$24#$17#$1F#$1A#$31#$31#$1E#$71#$1F +
  103. #$37#$3F#$3A#$13#$13#$3E#$21#$3F#$70#$7F#$7A#$13#$13#$70#$7F#$7E +
  104. #$70#$7F#$7A#$13#$13#$70#$70#$7F#$7E#$20#$2B#$2F#$78#$2E#$70#$30 +
  105. #$3F#$3E#$1F#$2F#$1A#$20#$72#$31#$31#$30#$2F#$3E#$31#$13#$38#$00 +
  106. #$17#$1F#$1A#$71#$71#$1E#$17#$1F#$1E#$20#$2B#$2F#$78#$2E#$10#$30 +
  107. #$3F#$3E#$70#$2F#$7A#$20#$12#$31#$31#$30#$2F#$3E#$31#$13#$38#$00 +
  108. #$37#$3F#$3A#$13#$13#$3E#$30#$3F#$3E#$20#$2B#$2F#$78#$2E#$30#$70 +
  109. #$7F#$7E#$1F#$2F#$1A#$20#$32#$31#$71#$70#$2F#$7E#$71#$13#$38#$00;
  110. CAppBlackWhite =
  111. #$70#$70#$78#$7F#$07#$07#$0F#$07#$0F#$07#$70#$70#$07#$70#$0F +
  112. #$07#$0F#$07#$70#$70#$07#$70#$0F#$70#$7F#$7F#$70#$07#$70#$07#$0F +
  113. #$70#$7F#$7F#$70#$07#$70#$70#$7F#$7F#$07#$0F#$0F#$78#$0F#$78#$07 +
  114. #$0F#$0F#$0F#$70#$0F#$07#$70#$70#$70#$07#$70#$0F#$07#$07#$78#$00 +
  115. #$07#$0F#$0F#$07#$70#$07#$07#$0F#$0F#$70#$78#$7F#$08#$7F#$08#$70 +
  116. #$7F#$7F#$7F#$0F#$70#$70#$07#$70#$70#$70#$07#$7F#$70#$07#$78#$00 +
  117. #$70#$7F#$7F#$70#$07#$70#$70#$7F#$7F#$07#$0F#$0F#$78#$0F#$78#$07 +
  118. #$0F#$0F#$0F#$70#$0F#$07#$70#$70#$70#$07#$70#$0F#$07#$07#$78#$00;
  119. CAppMonochrome =
  120. #$70#$07#$07#$0F#$70#$70#$70#$07#$0F#$07#$70#$70#$07#$70#$00 +
  121. #$07#$0F#$07#$70#$70#$07#$70#$00#$70#$70#$70#$07#$07#$70#$07#$00 +
  122. #$70#$70#$70#$07#$07#$70#$70#$70#$0F#$07#$07#$0F#$70#$0F#$70#$07 +
  123. #$0F#$0F#$07#$70#$07#$07#$70#$07#$07#$07#$70#$0F#$07#$07#$70#$00 +
  124. #$70#$70#$70#$07#$07#$70#$70#$70#$0F#$07#$07#$0F#$70#$0F#$70#$07 +
  125. #$0F#$0F#$07#$70#$07#$07#$70#$07#$07#$07#$70#$0F#$07#$07#$70#$00 +
  126. #$70#$70#$70#$07#$07#$70#$70#$70#$0F#$07#$07#$0F#$70#$0F#$70#$07 +
  127. #$0F#$0F#$07#$70#$07#$07#$70#$07#$07#$07#$70#$0F#$07#$07#$70#$00;
  128. {---------------------------------------------------------------------------}
  129. { STANDRARD HELP CONTEXT CONSTANTS }
  130. {---------------------------------------------------------------------------}
  131. CONST
  132. { Note: range $FF00 - $FFFF of help contexts are reserved by Borland }
  133. hcNew = $FF01; { New file help }
  134. hcOpen = $FF02; { Open file help }
  135. hcSave = $FF03; { Save file help }
  136. hcSaveAs = $FF04; { Save file as help }
  137. hcSaveAll = $FF05; { Save all files help }
  138. hcChangeDir = $FF06; { Change dir help }
  139. hcDosShell = $FF07; { Dos shell help }
  140. hcExit = $FF08; { Exit program help }
  141. hcUndo = $FF10; { Clipboard undo help }
  142. hcCut = $FF11; { Clipboard cut help }
  143. hcCopy = $FF12; { Clipboard copy help }
  144. hcPaste = $FF13; { Clipboard paste help }
  145. hcClear = $FF14; { Clipboard clear help }
  146. hcTile = $FF20; { Desktop tile help }
  147. hcCascade = $FF21; { Desktop cascade help }
  148. hcCloseAll = $FF22; { Desktop close all }
  149. hcResize = $FF23; { Window resize help }
  150. hcZoom = $FF24; { Window zoom help }
  151. hcNext = $FF25; { Window next help }
  152. hcPrev = $FF26; { Window previous help }
  153. hcClose = $FF27; { Window close help }
  154. {***************************************************************************}
  155. { PUBLIC OBJECT DEFINITIONS }
  156. {***************************************************************************}
  157. {---------------------------------------------------------------------------}
  158. { TBackGround OBJECT - BACKGROUND OBJECT }
  159. {---------------------------------------------------------------------------}
  160. TYPE
  161. TBackGround = OBJECT (TView)
  162. Pattern: Char; { Background pattern }
  163. CONSTRUCTOR Init (Var Bounds: TRect; APattern: Char);
  164. CONSTRUCTOR Load (Var S: TStream);
  165. FUNCTION GetPalette: PPalette; Virtual;
  166. PROCEDURE DrawBackGround; Virtual;
  167. PROCEDURE Store (Var S: TStream);
  168. END;
  169. PBackGround = ^TBackGround;
  170. {---------------------------------------------------------------------------}
  171. { TDeskTop OBJECT - DESKTOP OBJECT }
  172. {---------------------------------------------------------------------------}
  173. TYPE
  174. TDeskTop = OBJECT (TGroup)
  175. Background : PBackground; { Background view }
  176. TileColumnsFirst: Boolean; { Tile direction }
  177. CONSTRUCTOR Init (Var Bounds: TRect);
  178. CONSTRUCTOR Load (Var S: TStream);
  179. PROCEDURE TileError; Virtual;
  180. PROCEDURE InitBackGround; Virtual;
  181. PROCEDURE Tile (Var R: TRect);
  182. PROCEDURE Store (Var S: TStream);
  183. PROCEDURE Cascade (Var R: TRect);
  184. PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
  185. END;
  186. PDeskTop = ^TDeskTop;
  187. {---------------------------------------------------------------------------}
  188. { TProgram OBJECT - PROGRAM ANCESTOR OBJECT }
  189. {---------------------------------------------------------------------------}
  190. TYPE
  191. TProgram = OBJECT (TGroup)
  192. CONSTRUCTOR Init;
  193. DESTRUCTOR Done; Virtual;
  194. FUNCTION GetPalette: PPalette; Virtual;
  195. FUNCTION CanMoveFocus: Boolean;
  196. FUNCTION ValidView (P: PView): PView;
  197. FUNCTION InsertWindow (P: PWindow): PWindow;
  198. FUNCTION ExecuteDialog (P: PDialog; Data: Pointer): Word;
  199. PROCEDURE Run; Virtual;
  200. PROCEDURE Idle; Virtual;
  201. PROCEDURE InitScreen; Virtual;
  202. PROCEDURE InitDeskTop; Virtual;
  203. PROCEDURE OutOfMemory; Virtual;
  204. PROCEDURE InitMenuBar; Virtual;
  205. PROCEDURE InitStatusLine; Virtual;
  206. PROCEDURE SetScreenMode (Mode: Word);
  207. PROCEDURE PutEvent (Var Event: TEvent); Virtual;
  208. PROCEDURE GetEvent (Var Event: TEvent); Virtual;
  209. PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
  210. END;
  211. PProgram = ^TProgram;
  212. {---------------------------------------------------------------------------}
  213. { TApplication OBJECT - APPLICATION OBJECT }
  214. {---------------------------------------------------------------------------}
  215. TYPE
  216. TApplication = OBJECT (TProgram)
  217. CONSTRUCTOR Init;
  218. DESTRUCTOR Done; Virtual;
  219. PROCEDURE Tile;
  220. PROCEDURE Cascade;
  221. PROCEDURE DosShell;
  222. PROCEDURE GetTileRect (Var R: TRect); Virtual;
  223. PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
  224. END;
  225. PApplication = ^TApplication; { Application ptr }
  226. {***************************************************************************}
  227. { INTERFACE ROUTINES }
  228. {***************************************************************************}
  229. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  230. { STANDARD MENU AND STATUS LINES ROUTINES }
  231. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  232. {-StdStatusKeys------------------------------------------------------
  233. Returns a pointer to a linked list of commonly used status line keys.
  234. The default status line for TApplication uses StdStatusKeys as its
  235. complete list of status keys.
  236. 22Oct99 LdB
  237. ---------------------------------------------------------------------}
  238. FUNCTION StdStatusKeys (Next: PStatusItem): PStatusItem;
  239. {-StdFileMenuItems---------------------------------------------------
  240. Returns a pointer to a list of menu items for a standard File menu.
  241. The standard File menu items are New, Open, Save, Save As, Save All,
  242. Change Dir, OS Shell, and Exit.
  243. 22Oct99 LdB
  244. ---------------------------------------------------------------------}
  245. FUNCTION StdFileMenuItems (Next: PMenuItem): PMenuItem;
  246. {-StdEditMenuItems---------------------------------------------------
  247. Returns a pointer to a list of menu items for a standard Edit menu.
  248. The standard Edit menu items are Undo, Cut, Copy, Paste, and Clear.
  249. 22Oct99 LdB
  250. ---------------------------------------------------------------------}
  251. FUNCTION StdEditMenuItems (Next: PMenuItem): PMenuItem;
  252. {-StdWindowMenuItems-------------------------------------------------
  253. Returns a pointer to a list of menu items for a standard Window menu.
  254. The standard Window menu items are Tile, Cascade, Close All,
  255. Size/Move, Zoom, Next, Previous, and Close.
  256. 22Oct99 LdB
  257. ---------------------------------------------------------------------}
  258. FUNCTION StdWindowMenuItems (Next: PMenuItem): PMenuItem;
  259. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  260. { OBJECT REGISTER ROUTINES }
  261. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  262. {-RegisterApp--------------------------------------------------------
  263. Calls RegisterType for each of the object types defined in this unit.
  264. 22oct99 LdB
  265. ---------------------------------------------------------------------}
  266. PROCEDURE RegisterApp;
  267. {***************************************************************************}
  268. { OBJECT REGISTRATION }
  269. {***************************************************************************}
  270. {---------------------------------------------------------------------------}
  271. { TBackGround STREAM REGISTRATION }
  272. {---------------------------------------------------------------------------}
  273. CONST
  274. RBackGround: TStreamRec = (
  275. ObjType: 30; { Register id = 30 }
  276. VmtLink: TypeOf(TBackGround);
  277. Load: @TBackGround.Load; { Object load method }
  278. Store: @TBackGround.Store { Object store method }
  279. );
  280. {---------------------------------------------------------------------------}
  281. { TDeskTop STREAM REGISTRATION }
  282. {---------------------------------------------------------------------------}
  283. CONST
  284. RDeskTop: TStreamRec = (
  285. ObjType: 31; { Register id = 31 }
  286. VmtLink: TypeOf(TDeskTop);
  287. Load: @TDeskTop.Load; { Object load method }
  288. Store: @TDeskTop.Store { Object store method }
  289. );
  290. {***************************************************************************}
  291. { INITIALIZED PUBLIC VARIABLES }
  292. {***************************************************************************}
  293. {---------------------------------------------------------------------------}
  294. { INITIALIZED PUBLIC VARIABLES }
  295. {---------------------------------------------------------------------------}
  296. CONST
  297. AppPalette: Integer = apColor; { Application colour }
  298. Desktop: PDeskTop = Nil; { Desktop object }
  299. MenuBar: PMenuView = Nil; { Application menu }
  300. StatusLine: PStatusLine = Nil; { App status line }
  301. Application : PApplication = Nil; { Application object }
  302. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  303. IMPLEMENTATION
  304. {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
  305. uses
  306. Video,Mouse;
  307. {***************************************************************************}
  308. { PRIVATE DEFINED CONSTANTS }
  309. {***************************************************************************}
  310. {***************************************************************************}
  311. { PRIVATE INITIALIZED VARIABLES }
  312. {***************************************************************************}
  313. {---------------------------------------------------------------------------}
  314. { INITIALIZED PRIVATE VARIABLES }
  315. {---------------------------------------------------------------------------}
  316. CONST Pending: TEvent = (What: evNothing); { Pending event }
  317. {---------------------------------------------------------------------------}
  318. { Tileable -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct99 LdB }
  319. {---------------------------------------------------------------------------}
  320. FUNCTION Tileable (P: PView): Boolean;
  321. BEGIN
  322. Tileable := (P^.Options AND ofTileable <> 0) AND { View is tileable }
  323. (P^.State AND sfVisible <> 0); { View is visible }
  324. END;
  325. {---------------------------------------------------------------------------}
  326. { ISqr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct99 LdB }
  327. {---------------------------------------------------------------------------}
  328. FUNCTION ISqr (X: Sw_Integer): Sw_Integer;
  329. VAR I: Sw_Integer;
  330. BEGIN
  331. I := 0; { Set value to zero }
  332. Repeat
  333. Inc(I); { Inc value }
  334. Until (I * I > X); { Repeat till Sqr > X }
  335. ISqr := I - 1; { Return result }
  336. END;
  337. {---------------------------------------------------------------------------}
  338. { MostEqualDivisors -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct99 LdB }
  339. {---------------------------------------------------------------------------}
  340. PROCEDURE MostEqualDivisors (N: Integer; Var X, Y: Integer; FavorY: Boolean);
  341. VAR I: Integer;
  342. BEGIN
  343. I := ISqr(N); { Int square of N }
  344. If ((N MOD I) <> 0) Then { Initial guess }
  345. If ((N MOD (I+1)) = 0) Then Inc(I); { Add one row/column }
  346. If (I < (N DIV I)) Then I := N DIV I; { In first page }
  347. If FavorY Then Begin { Horz preferred }
  348. X := N DIV I; { Calc x position }
  349. Y := I; { Set y position }
  350. End Else Begin { Vert preferred }
  351. Y := N DIV I; { Calc y position }
  352. X := I; { Set x position }
  353. End;
  354. END;
  355. {***************************************************************************}
  356. { OBJECT METHODS }
  357. {***************************************************************************}
  358. {--TBackGround--------------------------------------------------------------}
  359. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  360. {---------------------------------------------------------------------------}
  361. CONSTRUCTOR TBackGround.Init (Var Bounds: TRect; APattern: Char);
  362. BEGIN
  363. Inherited Init(Bounds); { Call ancestor }
  364. GrowMode := gfGrowHiX + gfGrowHiY; { Set grow modes }
  365. Pattern := APattern; { Hold pattern }
  366. END;
  367. {--TBackGround--------------------------------------------------------------}
  368. { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  369. {---------------------------------------------------------------------------}
  370. CONSTRUCTOR TBackGround.Load (Var S: TStream);
  371. BEGIN
  372. Inherited Load(S); { Call ancestor }
  373. S.Read(Pattern, SizeOf(Pattern)); { Read pattern data }
  374. END;
  375. {--TBackGround--------------------------------------------------------------}
  376. { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  377. {---------------------------------------------------------------------------}
  378. FUNCTION TBackGround.GetPalette: PPalette;
  379. CONST P: String[Length(CBackGround)] = CbackGround; { Always normal string }
  380. BEGIN
  381. GetPalette := @P; { Return palette }
  382. END;
  383. {--TBackGround--------------------------------------------------------------}
  384. { DrawBackground -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  385. {---------------------------------------------------------------------------}
  386. PROCEDURE TBackground.DrawBackground;
  387. VAR B: TDrawBuffer;
  388. BEGIN
  389. MoveChar(B, Pattern, GetColor($01), Size.X); { Fill draw buffer }
  390. WriteLine(0, 0, Size.X, Size.Y, B); { Draw to area }
  391. END;
  392. {--TBackGround--------------------------------------------------------------}
  393. { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  394. {---------------------------------------------------------------------------}
  395. PROCEDURE TBackGround.Store (Var S: TStream);
  396. BEGIN
  397. TView.Store(S); { TView store called }
  398. S.Write(Pattern, SizeOf(Pattern)); { Write pattern data }
  399. END;
  400. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  401. { TDesktop OBJECT METHODS }
  402. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  403. {--TDesktop-----------------------------------------------------------------}
  404. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  405. {---------------------------------------------------------------------------}
  406. CONSTRUCTOR TDesktop.Init (Var Bounds: Objects.TRect);
  407. BEGIN
  408. Inherited Init(Bounds); { Call ancestor }
  409. GrowMode := gfGrowHiX + gfGrowHiY; { Set growmode }
  410. InitBackground; { Create background }
  411. If (Background <> Nil) Then Insert(Background); { Insert background }
  412. END;
  413. {--TDesktop-----------------------------------------------------------------}
  414. { Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  415. {---------------------------------------------------------------------------}
  416. CONSTRUCTOR TDesktop.Load (Var S: TStream);
  417. BEGIN
  418. Inherited Load(S); { Call ancestor }
  419. GetSubViewPtr(S, Background); { Load background }
  420. S.Read(TileColumnsFirst, SizeOf(TileColumnsFirst));{ Read data }
  421. END;
  422. {--TDesktop-----------------------------------------------------------------}
  423. { TileError -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  424. {---------------------------------------------------------------------------}
  425. PROCEDURE TDeskTop.TileError;
  426. BEGIN { Abstract method }
  427. END;
  428. {--TDesktop-----------------------------------------------------------------}
  429. { InitBackGround -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  430. {---------------------------------------------------------------------------}
  431. PROCEDURE TDesktop.InitBackground;
  432. CONST Ch: Char = #176;
  433. VAR R: TRect;
  434. BEGIN
  435. GetExtent(R); { Get desktop extents }
  436. BackGround := New(PBackground, Init(R, Ch)); { Insert a background }
  437. END;
  438. {--TDesktop-----------------------------------------------------------------}
  439. { Tile -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct99 LdB }
  440. {---------------------------------------------------------------------------}
  441. PROCEDURE TDeskTop.Tile (Var R: TRect);
  442. VAR NumCols, NumRows, NumTileable, LeftOver, TileNum: Integer;
  443. FUNCTION DividerLoc (Lo, Hi, Num, Pos: Integer): Integer;
  444. BEGIN
  445. DividerLoc := LongInt( LongInt(Hi - Lo) * Pos)
  446. DIV Num + Lo; { Calc position }
  447. END;
  448. PROCEDURE DoCountTileable (P: PView); FAR;
  449. BEGIN
  450. If Tileable(P) Then Inc(NumTileable); { Count tileable views }
  451. END;
  452. PROCEDURE CalcTileRect (Pos: Integer; Var NR: TRect);
  453. VAR X, Y, D: Integer;
  454. BEGIN
  455. D := (NumCols - LeftOver) * NumRows; { Calc d value }
  456. If (Pos<D) Then Begin
  457. X := Pos DIV NumRows; Y := Pos MOD NumRows; { Calc positions }
  458. End Else Begin
  459. X := (Pos - D) div (NumRows + 1) +
  460. (NumCols - LeftOver); { Calc x position }
  461. Y := (Pos - D) mod (NumRows + 1); { Calc y position }
  462. End;
  463. NR.A.X := DividerLoc(R.A.X, R.B.X, NumCols, X); { Top left x position }
  464. NR.B.X := DividerLoc(R.A.X, R.B.X, NumCols, X+1);{ Right x position }
  465. If (Pos >= D) Then Begin
  466. NR.A.Y := DividerLoc(R.A.Y, R.B.Y,NumRows+1,Y);{ Top y position }
  467. NR.B.Y := DividerLoc(R.A.Y, R.B.Y, NumRows+1,
  468. Y+1); { Bottom y position }
  469. End Else Begin
  470. NR.A.Y := DividerLoc(R.A.Y, R.B.Y,NumRows,Y); { Top y position }
  471. NR.B.Y := DividerLoc(R.A.Y, R.B.Y, NumRows,
  472. Y+1); { Bottom y position }
  473. End;
  474. END;
  475. PROCEDURE DoTile(P: PView); FAR;
  476. VAR PState: Word; R: TRect;
  477. BEGIN
  478. If Tileable(P) Then Begin
  479. CalcTileRect(TileNum, R); { Calc tileable area }
  480. PState := P^.State; { Hold view state }
  481. P^.State := P^.State AND NOT sfVisible; { Temp not visible }
  482. P^.Locate(R); { Locate view }
  483. P^.State := PState; { Restore view state }
  484. Dec(TileNum); { One less to tile }
  485. End;
  486. END;
  487. BEGIN
  488. NumTileable := 0; { Zero tileable count }
  489. ForEach(@DoCountTileable); { Count tileable views }
  490. If (NumTileable>0) Then Begin
  491. MostEqualDivisors(NumTileable, NumCols, NumRows,
  492. NOT TileColumnsFirst); { Do pre calcs }
  493. If ((R.B.X - R.A.X) DIV NumCols = 0) OR
  494. ((R.B.Y - R.A.Y) DIV NumRows = 0) Then TileError { Can't tile }
  495. Else Begin
  496. LeftOver := NumTileable MOD NumCols; { Left over count }
  497. TileNum := NumTileable-1; { Tileable views }
  498. ForEach(@DoTile); { Tile each view }
  499. DrawView; { Now redraw }
  500. End;
  501. End;
  502. END;
  503. {--TDesktop-----------------------------------------------------------------}
  504. { Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  505. {---------------------------------------------------------------------------}
  506. PROCEDURE TDesktop.Store (Var S: TStream);
  507. BEGIN
  508. TGroup.Store(S); { Call group store }
  509. PutSubViewPtr(S, Background); { Store background }
  510. S.Write(TileColumnsFirst,SizeOf(TileColumnsFirst));{ Write data }
  511. END;
  512. {--TDesktop-----------------------------------------------------------------}
  513. { Cascade -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct99 LdB }
  514. {---------------------------------------------------------------------------}
  515. PROCEDURE TDeskTop.Cascade (Var R: TRect);
  516. VAR CascadeNum: Integer; LastView: PView; Min, Max: TPoint;
  517. PROCEDURE DoCount (P: PView); FAR;
  518. BEGIN
  519. If Tileable(P) Then Begin
  520. Inc(CascadeNum); LastView := P; { Count cascadable }
  521. End;
  522. END;
  523. PROCEDURE DoCascade (P: PView); FAR;
  524. VAR PState: Word; NR: TRect;
  525. BEGIN
  526. If Tileable(P) AND (CascadeNum >= 0) Then Begin { View cascadable }
  527. NR.Copy(R); { Copy rect area }
  528. Inc(NR.A.X, CascadeNum); { Inc x position }
  529. Inc(NR.A.Y, CascadeNum); { Inc y position }
  530. PState := P^.State; { Hold view state }
  531. P^.State := P^.State AND NOT sfVisible; { Temp stop draw }
  532. P^.Locate(NR); { Locate the view }
  533. P^.State := PState; { Now allow draws }
  534. Dec(CascadeNum); { Dec count }
  535. End;
  536. END;
  537. BEGIN
  538. CascadeNum := 0; { Zero cascade count }
  539. ForEach(@DoCount); { Count cascadable }
  540. If (CascadeNum>0) Then Begin
  541. LastView^.SizeLimits(Min, Max); { Check size limits }
  542. If (Min.X > R.B.X - R.A.X - CascadeNum) OR
  543. (Min.Y > R.B.Y - R.A.Y - CascadeNum) Then
  544. TileError Else Begin { Check for error }
  545. Dec(CascadeNum); { One less view }
  546. ForEach(@DoCascade); { Cascade view }
  547. DrawView; { Redraw now }
  548. End;
  549. End;
  550. END;
  551. {--TDesktop-----------------------------------------------------------------}
  552. { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 11May98 LdB }
  553. {---------------------------------------------------------------------------}
  554. PROCEDURE TDesktop.HandleEvent (Var Event: TEvent);
  555. BEGIN
  556. Inherited HandleEvent(Event); { Call ancestor }
  557. If (Event.What = evCommand) Then Begin
  558. Case Event.Command of { Command event }
  559. cmNext: FocusNext(False); { Focus next view }
  560. cmPrev: If (BackGround <> Nil) Then Begin
  561. If Valid(cmReleasedFocus) Then
  562. Current^.PutInFrontOf(Background); { Focus last view }
  563. End Else FocusNext(True); { Focus prior view }
  564. Else Exit;
  565. End;
  566. ClearEvent(Event); { Clear the event }
  567. End;
  568. END;
  569. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  570. { TProgram OBJECT METHODS }
  571. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  572. {--TProgram-----------------------------------------------------------------}
  573. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct99 LdB }
  574. {---------------------------------------------------------------------------}
  575. CONSTRUCTOR TProgram.Init;
  576. VAR I: Integer; R: TRect;
  577. BEGIN
  578. R.Assign(0, 0, -(GetMaxX(TextModeGFV)+1),
  579. -(GetMaxY(TextModeGFV)+1)); { Full screen area }
  580. Inherited Init(R); { Call ancestor }
  581. Application := @Self; { Set application ptr }
  582. InitScreen; { Initialize screen }
  583. State := sfVisible + sfSelected + sfFocused +
  584. sfModal + sfExposed; { Deafult states }
  585. Options := 0; { No options set }
  586. Size.X := ScreenWidth; { Set x size value }
  587. Size.Y := ScreenHeight; { Set y size value }
  588. RawSize.X := ScreenWidth * SysFontWidth - 1; { Set rawsize x }
  589. RawSize.Y := ScreenHeight * SysFontHeight - 1; { Set rawsize y }
  590. InitStatusLine; { Init status line }
  591. If (StatusLine <> Nil) Then Insert(StatusLine); { Insert status line }
  592. InitMenuBar; { Create a bar menu }
  593. If (MenuBar <> Nil) Then Insert(MenuBar); { Insert menu bar }
  594. InitDesktop; { Create desktop }
  595. If (Desktop <> Nil) Then Insert(Desktop); { Insert desktop }
  596. END;
  597. {--TProgram-----------------------------------------------------------------}
  598. { Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct99 LdB }
  599. {---------------------------------------------------------------------------}
  600. DESTRUCTOR TProgram.Done;
  601. VAR I: Integer;
  602. BEGIN
  603. { Do not free the Buffer of Video Unit }
  604. If Buffer = Views.PVideoBuf(VideoBuf) then
  605. Buffer:=nil;
  606. If (Desktop <> Nil) Then Dispose(Desktop, Done); { Destroy desktop }
  607. If (MenuBar <> Nil) Then Dispose(MenuBar, Done); { Destroy menu bar }
  608. If (StatusLine <> Nil) Then
  609. Dispose(StatusLine, Done); { Destroy status line }
  610. Application := Nil; { Clear application }
  611. Inherited Done; { Call ancestor }
  612. END;
  613. {--TProgram-----------------------------------------------------------------}
  614. { GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  615. {---------------------------------------------------------------------------}
  616. FUNCTION TProgram.GetPalette: PPalette;
  617. CONST P: Array[apColor..apMonochrome] Of String = (CAppColor, CAppBlackWhite,
  618. CAppMonochrome);
  619. BEGIN
  620. GetPalette := @P[AppPalette]; { Return palette }
  621. END;
  622. {--TProgram-----------------------------------------------------------------}
  623. { CanMoveFocus -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 23Sep97 LdB }
  624. {---------------------------------------------------------------------------}
  625. FUNCTION TProgram.CanMoveFocus: Boolean;
  626. BEGIN
  627. If (Desktop <> Nil) Then { Valid desktop view }
  628. CanMovefocus := DeskTop^.Valid(cmReleasedFocus) { Check focus move }
  629. Else CanMoveFocus := True; { No desktop who cares! }
  630. END;
  631. {--TProgram-----------------------------------------------------------------}
  632. { ValidView -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct99 LdB }
  633. {---------------------------------------------------------------------------}
  634. FUNCTION TProgram.ValidView (P: PView): PView;
  635. BEGIN
  636. ValidView := Nil; { Preset failure }
  637. If (P <> Nil) Then Begin
  638. If LowMemory Then Begin { Check memroy }
  639. Dispose(P, Done); { Dispose view }
  640. OutOfMemory; { Call out of memory }
  641. Exit; { Now exit }
  642. End;
  643. If NOT P^.Valid(cmValid) Then Begin { Check view valid }
  644. Dispose(P, Done); { Dipose view }
  645. Exit; { Now exit }
  646. End;
  647. ValidView := P; { Return view }
  648. End;
  649. END;
  650. {--TProgram-----------------------------------------------------------------}
  651. { InsertWindow -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct99 LdB }
  652. {---------------------------------------------------------------------------}
  653. FUNCTION TProgram.InsertWindow (P: PWindow): PWindow;
  654. BEGIN
  655. InsertWindow := Nil; { Preset failure }
  656. If (ValidView(P) <> Nil) Then { Check view valid }
  657. If (CanMoveFocus) AND (Desktop <> Nil) { Can we move focus }
  658. Then Begin
  659. Desktop^.Insert(P); { Insert window }
  660. InsertWindow := P; { Return view ptr }
  661. End Else Dispose(P, Done); { Dispose view }
  662. END;
  663. {--TProgram-----------------------------------------------------------------}
  664. { ExecuteDialog -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct99 LdB }
  665. {---------------------------------------------------------------------------}
  666. FUNCTION TProgram.ExecuteDialog (P: PDialog; Data: Pointer): Word;
  667. VAR ExecResult: Word;
  668. BEGIN
  669. ExecuteDialog := cmCancel; { Preset cancel }
  670. If (ValidView(P) <> Nil) Then Begin { Check view valid }
  671. If (Data <> Nil) Then P^.SetData(Data^); { Set data }
  672. If (P <> Nil) Then P^.SelectDefaultView; { Select default }
  673. ExecResult := Desktop^.ExecView(P); { Execute view }
  674. If (ExecResult <> cmCancel) AND (Data <> Nil)
  675. Then P^.GetData(Data^); { Get data back }
  676. Dispose(P, Done); { Dispose of dialog }
  677. ExecuteDialog := ExecResult; { Return result }
  678. End;
  679. END;
  680. {--TProgram-----------------------------------------------------------------}
  681. { Run -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  682. {---------------------------------------------------------------------------}
  683. PROCEDURE TProgram.Run;
  684. BEGIN
  685. Execute; { Call execute }
  686. END;
  687. {--TProgram-----------------------------------------------------------------}
  688. { Idle -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Oct99 LdB }
  689. {---------------------------------------------------------------------------}
  690. PROCEDURE TProgram.Idle;
  691. BEGIN
  692. If (StatusLine <> Nil) Then StatusLine^.Update; { Update statusline }
  693. If CommandSetChanged Then Begin { Check command change }
  694. Message(@Self, evBroadcast, cmCommandSetChanged,
  695. Nil); { Send message }
  696. CommandSetChanged := False; { Clear flag }
  697. End;
  698. END;
  699. {--TProgram-----------------------------------------------------------------}
  700. { InitScreen -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  701. {---------------------------------------------------------------------------}
  702. PROCEDURE TProgram.InitScreen;
  703. BEGIN
  704. { the orginal code can't be used here because of the limited
  705. video unit capabilities, the mono modus can't be handled
  706. }
  707. if (ScreenMode.Col div ScreenMode.Row<2) then
  708. ShadowSize.X := 1
  709. else
  710. ShadowSize.X := 2;
  711. ShadowSize.Y := 1;
  712. ShowMarkers := False;
  713. if ScreenMode.color then
  714. AppPalette := apColor
  715. else
  716. AppPalette := apBlackWhite;
  717. Buffer := Views.PVideoBuf(VideoBuf);
  718. END;
  719. {--TProgram-----------------------------------------------------------------}
  720. { InitDeskTop -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  721. {---------------------------------------------------------------------------}
  722. PROCEDURE TProgram.InitDesktop;
  723. VAR R: TRect;
  724. BEGIN
  725. GetExtent(R); { Get view extent }
  726. If (MenuBar <> Nil) Then Inc(R.A.Y); { Adjust top down }
  727. If (StatusLine <> Nil) Then Dec(R.B.Y); { Adjust bottom up }
  728. DeskTop := New(PDesktop, Init(R)); { Create desktop }
  729. END;
  730. {--TProgram-----------------------------------------------------------------}
  731. { OutOfMemory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 08May98 LdB }
  732. {---------------------------------------------------------------------------}
  733. PROCEDURE TProgram.OutOfMemory;
  734. BEGIN { Abstract method }
  735. END;
  736. {--TProgram-----------------------------------------------------------------}
  737. { InitMenuBar -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  738. {---------------------------------------------------------------------------}
  739. PROCEDURE TProgram.InitMenuBar;
  740. VAR R: TRect;
  741. BEGIN
  742. GetExtent(R); { Get view extents }
  743. R.B.Y := R.A.Y + 1; { One line high }
  744. MenuBar := New(PMenuBar, Init(R, Nil)); { Create menu bar }
  745. END;
  746. {--TProgram-----------------------------------------------------------------}
  747. { InitStatusLine -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  748. {---------------------------------------------------------------------------}
  749. PROCEDURE TProgram.InitStatusLine;
  750. VAR R: TRect;
  751. BEGIN
  752. GetExtent(R); { Get view extents }
  753. R.A.Y := R.B.Y - 1; { One line high }
  754. New(StatusLine, Init(R,
  755. NewStatusDef(0, $FFFF,
  756. NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
  757. StdStatusKeys(Nil)), Nil))); { Default status line }
  758. END;
  759. {--TProgram-----------------------------------------------------------------}
  760. { SetScreenMode -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Oct99 LdB }
  761. {---------------------------------------------------------------------------}
  762. PROCEDURE TProgram.SetScreenMode (Mode: Word);
  763. BEGIN { Compatability only }
  764. END;
  765. {--TProgram-----------------------------------------------------------------}
  766. { PutEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  767. {---------------------------------------------------------------------------}
  768. PROCEDURE TProgram.PutEvent (Var Event: TEvent);
  769. BEGIN
  770. Pending := Event; { Set pending event }
  771. END;
  772. {--TProgram-----------------------------------------------------------------}
  773. { GetEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 10May98 LdB }
  774. {---------------------------------------------------------------------------}
  775. PROCEDURE TProgram.GetEvent (Var Event: TEvent);
  776. BEGIN
  777. Event.What := evNothing;
  778. If (Event.What = evNothing) Then Begin
  779. If (Pending.What <> evNothing) Then Begin { Pending event }
  780. Event := Pending; { Load pending event }
  781. Pending.What := evNothing; { Clear pending event }
  782. End Else Begin
  783. NextQueuedEvent(Event); { Next queued event }
  784. If (Event.What = evNothing) Then Begin
  785. GetKeyEvent(Event); { Fetch key event }
  786. {$ifdef DEBUG}
  787. If (Event.What = evKeyDown) then
  788. Begin
  789. if Event.keyCode = kbAltF11 then
  790. WriteDebugInfo := not WriteDebugInfo;
  791. if Event.keyCode = kbAltF12 then
  792. ReDraw;
  793. End;
  794. {$endif DEBUG}
  795. If (Event.What = evNothing) Then Begin { No mouse event }
  796. Drivers.GetMouseEvent(Event); { Load mouse event }
  797. If (Event.What = evNothing) Then Idle; { Idle if no event }
  798. End;
  799. End;
  800. End;
  801. End;
  802. END;
  803. {--TProgram-----------------------------------------------------------------}
  804. { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Sep97 LdB }
  805. {---------------------------------------------------------------------------}
  806. PROCEDURE TProgram.HandleEvent (Var Event: TEvent);
  807. VAR C: Char;
  808. BEGIN
  809. If (Event.What = evKeyDown) Then Begin { Key press event }
  810. C := GetAltChar(Event.KeyCode); { Get alt char code }
  811. If (C >= '1') AND (C <= '9') Then
  812. If (Message(Desktop, evBroadCast, cmSelectWindowNum,
  813. Pointer(Byte(C) - $30)) <> Nil) { Select window }
  814. Then ClearEvent(Event); { Clear event }
  815. End;
  816. Inherited HandleEvent(Event); { Call ancestor }
  817. If (Event.What = evCommand) AND { Command event }
  818. (Event.Command = cmQuit) Then Begin { Quit command }
  819. EndModal(cmQuit); { Endmodal operation }
  820. ClearEvent(Event); { Clear event }
  821. End;
  822. END;
  823. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  824. { TApplication OBJECT METHODS }
  825. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  826. {--TApplication-------------------------------------------------------------}
  827. { Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct99 LdB }
  828. {---------------------------------------------------------------------------}
  829. CONSTRUCTOR TApplication.Init;
  830. BEGIN
  831. InitMemory; { Start memory up }
  832. Drivers.InitVideo; { Start video up }
  833. Drivers.InitEvents; { Start event drive }
  834. Drivers.InitSysError; { Start system error }
  835. InitHistory; { Start history up }
  836. Inherited Init; { Call ancestor }
  837. END;
  838. {--TApplication-------------------------------------------------------------}
  839. { Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct99 LdB }
  840. {---------------------------------------------------------------------------}
  841. DESTRUCTOR TApplication.Done;
  842. BEGIN
  843. Inherited Done; { Call ancestor }
  844. DoneHistory; { Close history }
  845. Drivers.DoneSysError; { Close system error }
  846. Drivers.DoneEvents; { Close event drive }
  847. Drivers.DoneVideo; { Close video }
  848. DoneMemory; { Close memory }
  849. END;
  850. {--TApplication-------------------------------------------------------------}
  851. { Tile -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct99 LdB }
  852. {---------------------------------------------------------------------------}
  853. PROCEDURE TApplication.Tile;
  854. VAR R: TRect;
  855. BEGIN
  856. GetTileRect(R); { Tileable area }
  857. If (Desktop <> Nil) Then Desktop^.Tile(R); { Tile desktop }
  858. END;
  859. {--TApplication-------------------------------------------------------------}
  860. { Cascade -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct99 LdB }
  861. {---------------------------------------------------------------------------}
  862. PROCEDURE TApplication.Cascade;
  863. VAR R: TRect;
  864. BEGIN
  865. GetTileRect(R); { Cascade area }
  866. If (Desktop <> Nil) Then Desktop^.Cascade(R); { Cascade desktop }
  867. END;
  868. {--TApplication-------------------------------------------------------------}
  869. { DosShell -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Oct99 LdB }
  870. {---------------------------------------------------------------------------}
  871. PROCEDURE TApplication.DosShell;
  872. BEGIN { Compatability only }
  873. END;
  874. {--TApplication-------------------------------------------------------------}
  875. { GetTileRect -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct99 LdB }
  876. {---------------------------------------------------------------------------}
  877. PROCEDURE TApplication.GetTileRect (Var R: TRect);
  878. BEGIN
  879. If (DeskTop <> Nil) Then Desktop^.GetExtent(R) { Desktop extents }
  880. Else GetExtent(R); { Our extents }
  881. END;
  882. {--TApplication-------------------------------------------------------------}
  883. { HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct99 LdB }
  884. {---------------------------------------------------------------------------}
  885. PROCEDURE TApplication.HandleEvent (Var Event: TEvent);
  886. BEGIN
  887. Inherited HandleEvent(Event); { Call ancestor }
  888. If (Event.What = evCommand) Then Begin
  889. Case Event.Command Of
  890. cmTile: Tile; { Tile request }
  891. cmCascade: Cascade; { Cascade request }
  892. cmDosShell: DosShell; { DOS shell request }
  893. Else Exit; { Unhandled exit }
  894. End;
  895. ClearEvent(Event); { Clear the event }
  896. End;
  897. END;
  898. {***************************************************************************}
  899. { INTERFACE ROUTINES }
  900. {***************************************************************************}
  901. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  902. { STANDARD MENU AND STATUS LINES ROUTINES }
  903. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  904. {---------------------------------------------------------------------------}
  905. { StdStatusKeys -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct99 LdB }
  906. {---------------------------------------------------------------------------}
  907. FUNCTION StdStatusKeys (Next: PStatusItem): PStatusItem;
  908. BEGIN
  909. StdStatusKeys :=
  910. NewStatusKey('', kbAltX, cmQuit,
  911. NewStatusKey('', kbF10, cmMenu,
  912. NewStatusKey('', kbAltF3, cmClose,
  913. NewStatusKey('', kbF5, cmZoom,
  914. NewStatusKey('', kbCtrlF5, cmResize,
  915. NewStatusKey('', kbF6, cmNext,
  916. NewStatusKey('', kbShiftF6, cmPrev,
  917. Next)))))));
  918. END;
  919. {---------------------------------------------------------------------------}
  920. { StdFileMenuItems -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct99 LdB }
  921. {---------------------------------------------------------------------------}
  922. FUNCTION StdFileMenuItems (Next: PMenuItem): PMenuItem;
  923. BEGIN
  924. StdFileMenuItems :=
  925. NewItem('~N~ew', '', kbNoKey, cmNew, hcNew,
  926. NewItem('~O~pen...', 'F3', kbF3, cmOpen, hcOpen,
  927. NewItem('~S~ave', 'F2', kbF2, cmSave, hcSave,
  928. NewItem('S~a~ve as...', '', kbNoKey, cmSaveAs, hcSaveAs,
  929. NewItem('Save a~l~l', '', kbNoKey, cmSaveAll, hcSaveAll,
  930. NewLine(
  931. NewItem('~C~hange dir...', '', kbNoKey, cmChangeDir, hcChangeDir,
  932. NewItem('OS shell', '', kbNoKey, cmDosShell, hcDosShell,
  933. NewItem('E~x~it', 'Alt+X', kbAltX, cmQuit, hcExit,
  934. Next)))))))));
  935. END;
  936. {---------------------------------------------------------------------------}
  937. { StdEditMenuItems -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct99 LdB }
  938. {---------------------------------------------------------------------------}
  939. FUNCTION StdEditMenuItems (Next: PMenuItem): PMenuItem;
  940. BEGIN
  941. StdEditMenuItems :=
  942. NewItem('~U~ndo', '', kbAltBack, cmUndo, hcUndo,
  943. NewLine(
  944. NewItem('Cu~t~', 'Shift+Del', kbShiftDel, cmCut, hcCut,
  945. NewItem('~C~opy', 'Ctrl+Ins', kbCtrlIns, cmCopy, hcCopy,
  946. NewItem('~P~aste', 'Shift+Ins', kbShiftIns, cmPaste, hcPaste,
  947. NewItem('C~l~ear', 'Ctrl+Del', kbCtrlDel, cmClear, hcClear,
  948. Next))))));
  949. END;
  950. {---------------------------------------------------------------------------}
  951. { StdWindowMenuItems -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct99 LdB }
  952. {---------------------------------------------------------------------------}
  953. FUNCTION StdWindowMenuItems (Next: PMenuItem): PMenuItem;
  954. BEGIN
  955. StdWindowMenuItems :=
  956. NewItem('~T~ile', '', kbNoKey, cmTile, hcTile,
  957. NewItem('C~a~scade', '', kbNoKey, cmCascade, hcCascade,
  958. NewItem('Cl~o~se all', '', kbNoKey, cmCloseAll, hcCloseAll,
  959. NewLine(
  960. NewItem('~S~ize/Move','Ctrl+F5', kbCtrlF5, cmResize, hcResize,
  961. NewItem('~Z~oom', 'F5', kbF5, cmZoom, hcZoom,
  962. NewItem('~N~ext', 'F6', kbF6, cmNext, hcNext,
  963. NewItem('~P~revious', 'Shift+F6', kbShiftF6, cmPrev, hcPrev,
  964. NewItem('~C~lose', 'Alt+F3', kbAltF3, cmClose, hcClose,
  965. Next)))))))));
  966. END;
  967. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  968. { OBJECT REGISTER ROUTINES }
  969. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  970. {---------------------------------------------------------------------------}
  971. { RegisterApp -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 22Oct99 LdB }
  972. {---------------------------------------------------------------------------}
  973. PROCEDURE RegisterApp;
  974. BEGIN
  975. RegisterType(RBackground); { Register background }
  976. RegisterType(RDesktop); { Register desktop }
  977. END;
  978. END.
  979. {
  980. $Log$
  981. Revision 1.11 2001-05-31 21:39:11 pierre
  982. + AltF12 to force Redraw of Application
  983. Revision 1.10 2001/05/31 12:15:24 pierre
  984. + some debug stuff added
  985. Revision 1.9 2001/05/10 16:46:26 pierre
  986. + some improovements made
  987. Revision 1.8 2001/05/07 22:22:03 pierre
  988. * removed NO_WINDOW cond, added GRAPH_API
  989. Revision 1.7 2001/05/04 15:43:45 pierre
  990. * several more fixes
  991. Revision 1.6 2001/05/04 08:42:54 pierre
  992. * some corrections for linux
  993. Revision 1.5 2001/05/03 22:32:52 pierre
  994. new bunch of changes, displays something for dos at least
  995. Revision 1.4 2001/04/10 21:57:55 pierre
  996. + first adds for Use_API define
  997. Revision 1.3 2001/04/10 21:29:54 pierre
  998. * import of Leon de Boer's files
  999. Revision 1.2 2000/08/24 11:43:13 marco
  1000. * Added CVS log and ID entries.
  1001. }
  1002. {******************[ REVISION HISTORY ]********************}
  1003. { Version Date Fix }
  1004. { ------- --------- --------------------------------- }
  1005. { 1.00 12 Dec 96 First multi platform release }
  1006. { 1.10 12 Sep 97 FPK pascal 0.92 conversion added. }
  1007. { 1.20 29 Aug 97 Platform.inc sort added. }
  1008. { 1.30 05 May 98 Virtual pascal 2.0 code added. }
  1009. { 1.40 22 Oct 99 Object registration added. }
  1010. { 1.50 22 Oct 99 Complete recheck preformed }
  1011. { 1.51 03 Nov 99 FPC Windows support added }
  1012. { 1.60 26 Nov 99 Graphics stuff moved to GFVGraph }