testapp.pas 16 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468
  1. PROGRAM testapp;
  2. { $UNDEF OS2PM}
  3. {$IFDEF OS2PM}
  4. {&PMTYPE PM} { FULL GUI MODE }
  5. {$ENDIF OS2PM}
  6. { ******************************* REMARK ****************************** }
  7. { This is a basic test program to test the app framework. In use will }
  8. { be menus, statuslines, windows, dialogs, scrollbars, statictext, }
  9. { radiobuttons, check boxes, list boxes and input lines. }
  10. { }
  11. { Working compilers: }
  12. { WINDOWS BPW, VP2, Delphi1, FPC WIN (0.9912) }
  13. { DOS has draw bugs but works for BP and FPC DOS (GO32V2) }
  14. { OS2 dows not work still some PM bits to do }
  15. { }
  16. { Not working: }
  17. { Delphi3, Delphi5 (sus 4) will compile but Tgroup.ForEach etc U/S. }
  18. { Sybil2 Win32 should work but to big for demo mode so unsure! }
  19. { }
  20. { Special things to try out: }
  21. { Check out the standard windows minimize etc icons. }
  22. { }
  23. { }
  24. { Comments: }
  25. { There is alot that may seem more complex than it needs to but }
  26. { I have much more elaborate objects operating such as bitmaps, }
  27. { bitmap buttons, percentage bars etc and they need these hooks. }
  28. { Basically the intention is to be able to port existing TV apps }
  29. { as a start point and then start to optimize and use the new }
  30. { GUI specific objects. I will try to get some documentation }
  31. { done on how everything works because some things are hard to }
  32. { follow in windows. }
  33. { ****************************** END REMARK *** Leon de Boer, 06Nov99 * }
  34. {$I Platform.inc}
  35. USES
  36. {$IFDEF OS2PM}
  37. {$IFDEF OS_OS2} Os2Def, os2PmApi, {$ENDIF}
  38. {$ENDIF OS2PM}
  39. Objects, Drivers, Views, Editors, Menus, Dialogs, App, { Standard GFV units }
  40. FVConsts,
  41. {$ifdef TEST}
  42. AsciiTab,
  43. {$endif TEST}
  44. {$ifdef DEBUG}
  45. Gfvgraph,
  46. {$endif DEBUG}
  47. Gadgets, TimedDlg, MsgBox, StdDlg;
  48. CONST cmAppToolbar = 1000;
  49. cmWindow1 = 1001;
  50. cmWindow2 = 1002;
  51. cmWindow3 = 1003;
  52. cmTimedBox = 1004;
  53. cmAscii = 1010;
  54. cmCloseWindow1 = 1101;
  55. cmCloseWindow2 = 1102;
  56. cmCloseWindow3 = 1103;
  57. {---------------------------------------------------------------------------}
  58. { TTestAppp OBJECT - STANDARD APPLICATION WITH MENU }
  59. {---------------------------------------------------------------------------}
  60. TYPE
  61. PTVDemo = ^TTVDemo;
  62. { TTVDemo }
  63. TTVDemo = OBJECT (TApplication)
  64. ClipboardWindow: PEditWindow;
  65. Clock: PClockView;
  66. Heap: PHeapView;
  67. P1,P2,P3 : PGroup;
  68. {$ifdef TEST}
  69. ASCIIChart : PAsciiChart;
  70. {$endif TEST}
  71. CONSTRUCTOR Init;
  72. PROCEDURE Idle; Virtual;
  73. PROCEDURE HandleEvent(var Event : TEvent);virtual;
  74. PROCEDURE InitMenuBar; Virtual;
  75. PROCEDURE InitDeskTop; Virtual;
  76. PROCEDURE InitStatusLine; Virtual;
  77. PROCEDURE Window1;
  78. PROCEDURE Window2;
  79. PROCEDURE Window3;
  80. PROCEDURE TimedBox;
  81. PROCEDURE AsciiWindow;
  82. PROCEDURE ShowAboutBox;
  83. PROCEDURE NewEditWindow;
  84. PROCEDURE OpenFile;
  85. PROCEDURE CloseWindow(var P : PGroup);
  86. End;
  87. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  88. { TTvDemo OBJECT METHODS }
  89. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  90. CONSTRUCTOR TTvDemo.Init;
  91. VAR R: TRect;
  92. BEGIN
  93. EditorDialog := @StdEditorDialog;
  94. Inherited Init;
  95. { Initialize demo gadgets }
  96. GetExtent(R);
  97. R.A.X := R.B.X - 9; R.B.Y := R.A.Y + 1;
  98. Clock := New(PClockView, Init(R));
  99. Insert(Clock);
  100. GetExtent(R);
  101. ClipboardWindow := New(PEditWindow, Init(R, '', wnNoNumber));
  102. if ValidView(ClipboardWindow) <> nil then
  103. begin
  104. ClipboardWindow^.Hide;
  105. ClipboardWindow^.Editor^.CanUndo := False;
  106. InsertWindow(ClipboardWindow);
  107. Clipboard := ClipboardWindow^.Editor;
  108. end;
  109. END;
  110. procedure TTVDemo.Idle;
  111. function IsTileable(P: PView): Boolean; far;
  112. begin
  113. IsTileable := (P^.Options and ofTileable <> 0) and
  114. (P^.State and sfVisible <> 0);
  115. end;
  116. {$ifdef DEBUG}
  117. Var
  118. WasSet : boolean;
  119. {$endif DEBUG}
  120. begin
  121. inherited Idle;
  122. {$ifdef DEBUG}
  123. if WriteDebugInfo then
  124. begin
  125. WasSet:=true;
  126. WriteDebugInfo:=false;
  127. end
  128. else
  129. WasSet:=false;
  130. if WriteDebugInfo then
  131. {$endif DEBUG}
  132. Clock^.Update;
  133. Heap^.Update;
  134. {$ifdef DEBUG}
  135. if WasSet then
  136. WriteDebugInfo:=true;
  137. {$endif DEBUG}
  138. if Desktop^.FirstThat(@IsTileable) <> nil then
  139. EnableCommands([cmTile, cmCascade])
  140. else
  141. DisableCommands([cmTile, cmCascade]);
  142. end;
  143. PROCEDURE TTVDemo.HandleEvent(var Event : TEvent);
  144. BEGIN
  145. Inherited HandleEvent(Event); { Call ancestor }
  146. If (Event.What = evCommand) Then Begin
  147. Case Event.Command Of
  148. cmClipBoard:
  149. begin
  150. ClipboardWindow^.Select;
  151. ClipboardWindow^.Show;
  152. end;
  153. cmNew : NewEditWindow;
  154. cmOpen : OpenFile;
  155. cmWindow1 : Window1;
  156. cmWindow2 : Window2;
  157. cmWindow3 : Window3;
  158. cmTimedBox: TimedBox;
  159. cmAscii : AsciiWindow;
  160. cmCloseWindow1 : CloseWindow(P1);
  161. cmCloseWindow2 : CloseWindow(P2);
  162. cmCloseWindow3 : CloseWindow(P3);
  163. cmAbout: ShowAboutBox;
  164. Else Exit; { Unhandled exit }
  165. End;
  166. End;
  167. ClearEvent(Event);
  168. END;
  169. {--TTvDemo------------------------------------------------------------------}
  170. { InitMenuBar -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Nov99 LdB }
  171. {---------------------------------------------------------------------------}
  172. PROCEDURE TTVDemo.InitMenuBar;
  173. VAR R: TRect;
  174. BEGIN
  175. GetExtent(R); { Get view extents }
  176. R.B.Y := R.A.Y + 1; { One line high }
  177. MenuBar := New(PMenuBar, Init(R, NewMenu(
  178. NewSubMenu('~F~ile', 0, NewMenu(
  179. StdFileMenuItems(Nil)), { Standard file menu }
  180. NewSubMenu('~E~dit', 0, NewMenu(
  181. StdEditMenuItems(
  182. NewLine(
  183. NewItem('~V~iew Clipboard', '', kbNoKey, cmClipboard, hcNoContext,
  184. nil)))), { Standard edit menu plus view clipboard}
  185. NewSubMenu('~T~est', 0, NewMenu(
  186. NewItem('~A~scii Chart','',kbNoKey,cmAscii,hcNoContext,
  187. NewItem('Window ~1~','',kbNoKey,cmWindow1,hcNoContext,
  188. NewItem('Window ~2~','',kbNoKey,cmWindow2,hcNoContext,
  189. NewItem('Window ~3~','',kbNoKey,cmWindow3,hcNoContext,
  190. NewItem('~T~imed Box','',kbNoKey,cmTimedBox,hcNoContext,
  191. NewItem('Close Window 1','',kbNoKey,cmCloseWindow1,hcNoContext,
  192. NewItem('Close Window 2','',kbNoKey,cmCloseWindow2,hcNoContext,
  193. NewItem('Close Window 3','',kbNoKey,cmCloseWindow3,hcNoContext,
  194. Nil))))))))),
  195. NewSubMenu('~W~indow', 0, NewMenu(
  196. StdWindowMenuItems(Nil)), { Standard window menu }
  197. NewSubMenu('~H~elp', hcNoContext, NewMenu(
  198. NewItem('~A~bout...','',kbNoKey,cmAbout,hcNoContext,
  199. nil)),
  200. nil))))) //end NewSubMenus
  201. ))); //end MenuBar
  202. END;
  203. {--TTvDemo------------------------------------------------------------------}
  204. { InitDesktop -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 08Nov99 LdB }
  205. {---------------------------------------------------------------------------}
  206. PROCEDURE TTvDemo.InitDesktop;
  207. VAR R: TRect; {ToolBar: PToolBar;}
  208. BEGIN
  209. GetExtent(R); { Get app extents }
  210. Inc(R.A.Y); { Adjust top down }
  211. Dec(R.B.Y); { Adjust bottom up }
  212. (* ToolBar := New(PToolBar, Init(R.A.X*FontWidth,
  213. R.A.Y*FontHeight, (R.B.X-R.A.X)*FontWidth, 20,
  214. cmAppToolBar));
  215. If (ToolBar <> Nil) Then Begin
  216. R.A.X := R.A.X*FontWidth;
  217. R.A.Y := R.A.Y*FontHeight + 25;
  218. R.B.X := -R.B.X*FontWidth;
  219. R.B.Y := -R.B.Y*Fontheight;
  220. ToolBar^.AddTool(NewToolEntry(cmQuit, True,
  221. '20X20EXIT', 'ToolBar.Res'));
  222. ToolBar^.AddTool(NewToolEntry(cmNew, True,
  223. '20X20NEW', 'ToolBar.Res'));
  224. ToolBar^.AddTool(NewToolEntry(cmOpen, True,
  225. '20X20LOAD', 'ToolBar.Res'));
  226. Insert(ToolBar);
  227. End;*)
  228. Desktop := New(PDeskTop, Init(R));
  229. END;
  230. procedure TTVDemo.InitStatusLine;
  231. var
  232. R: TRect;
  233. begin
  234. GetExtent(R);
  235. R.A.Y := R.B.Y - 1;
  236. R.B.X := R.B.X - 12;
  237. New(StatusLine,
  238. Init(R,
  239. NewStatusDef(0, $EFFF,
  240. NewStatusKey('~F3~ Open', kbF3, cmOpen,
  241. NewStatusKey('~F4~ New', kbF4, cmNew,
  242. NewStatusKey('~Alt+F3~ Close', kbAltF3, cmClose,
  243. StdStatusKeys(nil
  244. )))),nil
  245. )
  246. )
  247. );
  248. GetExtent(R);
  249. R.A.X := R.B.X - 12; R.A.Y := R.B.Y - 1;
  250. Heap := New(PHeapView, Init(R));
  251. Insert(Heap);
  252. end;
  253. PROCEDURE TTvDemo.Window1;
  254. VAR R: TRect; P: PGroup;
  255. BEGIN
  256. { Create a basic window with static text and radio }
  257. { buttons. The buttons should be orange and white }
  258. R.Assign(5, 1, 35, 16); { Assign area }
  259. P := New(PWindow, Init(R, 'TEST WINDOW 1', 1)); { Create a window }
  260. If (P <> Nil) Then Begin { Window valid }
  261. R.Assign(5, 5, 20, 6); { Assign area }
  262. P^.Insert(New(PInputLine, Init(R, 30)));
  263. R.Assign(5, 8, 20, 9); { Assign area }
  264. P^.Insert(New(PRadioButtons, Init(R,
  265. NewSItem('Test',
  266. NewSITem('Item 2', Nil))))); { Red radio button }
  267. R.Assign(5, 10, 28, 11); { Assign area }
  268. P^.Insert(New(PStaticText, Init(R,
  269. 'SOME STATIC TEXT'))); { Insert static text }
  270. End;
  271. Desktop^.Insert(P); { Insert into desktop }
  272. P1:=P;
  273. END;
  274. PROCEDURE TTvDemo.AsciiWindow;
  275. begin
  276. {$ifdef TEST}
  277. if ASCIIChart=nil then
  278. begin
  279. New(ASCIIChart, Init);
  280. Desktop^.Insert(ASCIIChart);
  281. end
  282. else
  283. ASCIIChart^.Focus;
  284. {$endif TEST}
  285. end;
  286. PROCEDURE TTVDemo.ShowAboutBox;
  287. begin
  288. MessageBox(#3'Free Vision TUI Framework'#13 +
  289. #3'Test/Demo Application'#13+
  290. #3'(www.freepascal.org)',
  291. nil, mfInformation or mfOKButton);
  292. end;
  293. PROCEDURE TTVDemo.NewEditWindow;
  294. var
  295. R: TRect;
  296. begin
  297. R.Assign(0, 0, 60, 20);
  298. InsertWindow(New(PEditWindow, Init(R, '', wnNoNumber)));
  299. end;
  300. PROCEDURE TTVDemo.OpenFile;
  301. var
  302. R: TRect;
  303. FileDialog: PFileDialog;
  304. FileName: FNameStr;
  305. const
  306. FDOptions: Word = fdOKButton or fdOpenButton;
  307. begin
  308. FileName := '*.*';
  309. New(FileDialog, Init(FileName, 'Open file', '~F~ile name', FDOptions, 1));
  310. if ExecuteDialog(FileDialog, @FileName) <> cmCancel then
  311. begin
  312. R.Assign(0, 0, 75, 20);
  313. InsertWindow(New(PEditWindow, Init(R, FileName, wnNoNumber)));
  314. end;
  315. end;
  316. PROCEDURE TTvDemo.TimedBox;
  317. var
  318. X: longint;
  319. S: string;
  320. begin
  321. X := TimedMessageBox ('Everything OK?', nil, mfConfirmation or mfOKCancel, 10);
  322. case X of
  323. cmCancel: MessageBox ('cmCancel', nil, mfOKButton);
  324. cmOK: MessageBox ('cmOK', nil, mfOKButton);
  325. else
  326. begin
  327. Str (X, S);
  328. MessageBox (S, nil, mfOKButton);
  329. end;
  330. end;
  331. end;
  332. PROCEDURE TTvDemo.CloseWindow(var P : PGroup);
  333. BEGIN
  334. If Assigned(P) then
  335. BEGIN
  336. Desktop^.Delete(P);
  337. Dispose(P,Done);
  338. P:=Nil;
  339. END;
  340. END;
  341. PROCEDURE TTvDemo.Window2;
  342. VAR R: TRect; P: PGroup;
  343. BEGIN
  344. { Create a basic window with check boxes. The }
  345. { check boxes should be orange and white }
  346. R.Assign(15, 3, 45, 18); { Assign area }
  347. P := New(PWindow, Init(R, 'TEST WINDOW 2', 2)); { Create window 2 }
  348. If (P <> Nil) Then Begin { Window valid }
  349. R.Assign(5, 5, 20, 7); { Assign area }
  350. P^.Insert(New(PCheckBoxes, Init(R,
  351. NewSItem('Test check',
  352. NewSITem('Item 2', Nil))))); { Create check box }
  353. End;
  354. Desktop^.Insert(P); { Insert into desktop }
  355. P2:=P;
  356. END;
  357. PROCEDURE TTvDemo.Window3;
  358. VAR R: TRect; P: PGroup; B: PScrollBar;
  359. List: PStrCollection; Lb: PListBox;
  360. BEGIN
  361. { Create a basic dialog box. In it are buttons, }
  362. { list boxes, scrollbars, inputlines, checkboxes }
  363. R.Assign(32, 2, 77, 18); { Assign screen area }
  364. P := New(PDialog, Init(R, 'TEST DIALOG')); { Create dialog }
  365. If (P <> Nil) Then Begin { Dialog valid }
  366. R.Assign(5, 5, 20, 7); { Allocate area }
  367. P^.Insert(New(PCheckBoxes, Init(R,
  368. NewSItem('Test',
  369. NewSITem('Item 2', Nil))))); { Insert check box }
  370. R.Assign(5, 2, 20, 3); { Assign area }
  371. B := New(PScrollBar, Init(R)); { Insert scroll bar }
  372. If (B <> Nil) Then Begin { Scrollbar valid }
  373. B^.SetRange(0, 100); { Set scrollbar range }
  374. B^.SetValue(50); { Set position }
  375. P^.Insert(B); { Insert scrollbar }
  376. End;
  377. R.Assign(5, 10, 20, 11); { Assign area }
  378. P^.Insert(New(PInputLine, Init(R, 60))); { Create input line }
  379. R.Assign(5, 13, 20, 14); { Assign area }
  380. P^.Insert(New(PInputLine, Init(R, 60))); { Create input line }
  381. R.Assign(40, 8, 41, 14); { Assign area }
  382. B := New(PScrollBar, Init(R)); { Create scrollbar }
  383. P^.Insert(B); { Insert scrollbar }
  384. R.Assign(25, 8, 40, 14); { Assign area }
  385. Lb := New(PListBox, Init(R, 1, B)); { Create listbox }
  386. P^.Insert(Lb); { Insert listbox }
  387. List := New(PStrCollection, Init(10, 5)); { Create string list }
  388. List^.AtInsert(0, NewStr('Zebra')); { Insert text }
  389. List^.AtInsert(1, NewStr('Apple')); { Insert text }
  390. List^.AtInsert(2, NewStr('Third')); { Insert text }
  391. List^.AtInsert(3, NewStr('Peach')); { Insert text }
  392. List^.AtInsert(4, NewStr('Rabbit')); { Insert text }
  393. List^.AtInsert(5, NewStr('Item six')); { Insert text }
  394. List^.AtInsert(6, NewStr('Jaguar')); { Insert text }
  395. List^.AtInsert(7, NewStr('Melon')); { Insert text }
  396. List^.AtInsert(8, NewStr('Ninth')); { Insert text }
  397. List^.AtInsert(9, NewStr('Last item')); { Insert text }
  398. Lb^.Newlist(List); { Give list to listbox }
  399. R.Assign(30, 2, 40, 4); { Assign area }
  400. P^.Insert(New(PButton, Init(R, '~O~k', 100, bfGrabFocus)));{ Create okay button }
  401. R.Assign(30, 15, 40, 17); { Assign area }
  402. Desktop^.Insert(P); { Insert dialog }
  403. P3:=P;
  404. End;
  405. END;
  406. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  407. { MAIN PROGRAM START }
  408. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  409. VAR I: Integer; R: TRect; P: PGroup; MyApp: TTvDemo;
  410. {$IFDEF OS2PM}
  411. {$IFDEF OS_OS2} Message: QMSg; Event: TEvent; {$ENDIF}
  412. {$ENDIF OS2PM}
  413. BEGIN
  414. (*SystemPalette := CreateRGBPalette(256); { Create palette }
  415. For I := 0 To 15 Do Begin
  416. GetSystemRGBEntry(I, RGB); { Get palette entry }
  417. AddToRGBPalette(RGB, SystemPalette); { Add entry to palette }
  418. End;*)
  419. MyApp.Init; { Initialize app }
  420. MyApp.Run; { Run the app }
  421. {$IFDEF OS2PM}
  422. {$IFDEF OS_OS2}
  423. while (MyApp.EndState = 0)
  424. AND WinGetMsg(Anchor, Message, 0, 0, 0) Do Begin
  425. WinDispatchMsg(Anchor, Message);
  426. NextQueuedEvent(Event);
  427. If (event.What <> evNothing)
  428. Then MyApp.handleEvent(Event);
  429. End;
  430. {$ENDIF}
  431. {$ENDIF OS2PM}
  432. MyApp.Done; { Dispose of app }
  433. {DisposeRGBPalette(SystemPalette);}
  434. END.