← Back to branch summary

~ubuntu-branches/ubuntu/feisty/fpc/feisty

« back to all changes in this revision

Viewing changes to fv/test/testapp.pas

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2007-01-27 20:08:50 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070127200850-9mrptaqqjsx9nwa7
Tags: 2.0.4-5
* Fixed Build-Depends.
* Add myself to Uploaders in debian/control.
* Make sure that the sources are really patched before building them.
* Build unit 'libc' on powerpc too.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fv/test/testapp.pas
1
 
{ $Id: testapp.pas,v 1.5 2005/02/14 17:13:18 peter Exp $ }
2
 
PROGRAM TestApp;
 
1
PROGRAM testapp;
3
2
 
4
3
{ $UNDEF OS2PM}
5
4
 
41
40
{$IFDEF OS2PM}
42
41
     {$IFDEF OS_OS2} Os2Def, os2PmApi,  {$ENDIF}
43
42
{$ENDIF OS2PM}
44
 
     Objects, Drivers, Views, Menus, Dialogs, App,             { Standard GFV units }
 
43
     Objects, Drivers, Views, Editors, Menus, Dialogs, App,             { Standard GFV units }
45
44
     FVConsts,
46
45
     {$ifdef TEST}
47
46
     AsciiTab,
49
48
     {$ifdef DEBUG}
50
49
     Gfvgraph,
51
50
     {$endif DEBUG}
52
 
     Gadgets, TimedDlg, MsgBox;
 
51
     Gadgets, TimedDlg, MsgBox, StdDlg;
53
52
 
54
53
 
55
54
CONST cmAppToolbar = 1000;
62
61
      cmCloseWindow2    = 1102;
63
62
      cmCloseWindow3    = 1103;
64
63
 
 
64
 
65
65
{---------------------------------------------------------------------------}
66
66
{          TTestAppp OBJECT - STANDARD APPLICATION WITH MENU                }
67
67
{---------------------------------------------------------------------------}
68
68
TYPE
69
69
   PTVDemo = ^TTVDemo;
 
70
 
 
71
   { TTVDemo }
 
72
 
70
73
   TTVDemo = OBJECT (TApplication)
 
74
        ClipboardWindow: PEditWindow;
71
75
        Clock: PClockView;
72
76
        Heap: PHeapView;
73
77
        P1,P2,P3 : PGroup;
79
83
      PROCEDURE HandleEvent(var Event : TEvent);virtual;
80
84
      PROCEDURE InitMenuBar; Virtual;
81
85
      PROCEDURE InitDeskTop; Virtual;
 
86
      PROCEDURE InitStatusLine; Virtual;
82
87
      PROCEDURE Window1;
83
88
      PROCEDURE Window2;
84
89
      PROCEDURE Window3;
85
90
      PROCEDURE TimedBox;
86
91
      PROCEDURE AsciiWindow;
 
92
      PROCEDURE ShowAboutBox;
 
93
      PROCEDURE NewEditWindow;
 
94
      PROCEDURE OpenFile;
87
95
      PROCEDURE CloseWindow(var P : PGroup);
88
96
    End;
89
97
 
94
102
CONSTRUCTOR TTvDemo.Init;
95
103
VAR R: TRect;
96
104
BEGIN
 
105
  EditorDialog := @StdEditorDialog;
97
106
  Inherited Init;
98
107
  { Initialize demo gadgets }
99
108
 
103
112
  Insert(Clock);
104
113
 
105
114
  GetExtent(R);
106
 
  Dec(R.B.X);
107
 
  R.A.X := R.B.X - 12; R.A.Y := R.B.Y - 1;
108
 
  Heap := New(PHeapView, Init(R));
109
 
  Insert(Heap);
 
115
  ClipboardWindow := New(PEditWindow, Init(R, '', wnNoNumber));
 
116
  if ValidView(ClipboardWindow) <> nil then
 
117
  begin
 
118
    ClipboardWindow^.Hide;
 
119
    ClipboardWindow^.Editor^.CanUndo := False;
 
120
    InsertWindow(ClipboardWindow);
 
121
    Clipboard := ClipboardWindow^.Editor;
 
122
  end;
110
123
END;
111
124
 
112
125
procedure TTVDemo.Idle;
150
163
   Inherited HandleEvent(Event);                      { Call ancestor }
151
164
   If (Event.What = evCommand) Then Begin
152
165
     Case Event.Command Of
 
166
       cmClipBoard:
 
167
         begin
 
168
           ClipboardWindow^.Select;
 
169
           ClipboardWindow^.Show;
 
170
         end;
 
171
       cmNew     : NewEditWindow;
 
172
       cmOpen    : OpenFile;
153
173
       cmWindow1 : Window1;
154
174
       cmWindow2 : Window2;
155
175
       cmWindow3 : Window3;
158
178
       cmCloseWindow1 : CloseWindow(P1);
159
179
       cmCloseWindow2 : CloseWindow(P2);
160
180
       cmCloseWindow3 : CloseWindow(P3);
 
181
       cmAbout: ShowAboutBox;
161
182
       Else Exit;                                     { Unhandled exit }
162
183
     End;
163
184
   End;
176
197
    NewSubMenu('~F~ile', 0, NewMenu(
177
198
      StdFileMenuItems(Nil)),                         { Standard file menu }
178
199
    NewSubMenu('~E~dit', 0, NewMenu(
179
 
      StdEditMenuItems(Nil)),                         { Standard edit menu }
 
200
      StdEditMenuItems(
 
201
      NewLine(
 
202
      NewItem('~V~iew Clipboard', '', kbNoKey, cmClipboard, hcNoContext,
 
203
      nil)))),                 { Standard edit menu plus view clipboard}
180
204
    NewSubMenu('~T~est', 0, NewMenu(
181
 
      NewItem('Ascii Chart','',kbNoKey,cmAscii,hcNoContext,
182
 
      NewItem('Window 1','',kbNoKey,cmWindow1,hcNoContext,
183
 
      NewItem('Window 2','',kbNoKey,cmWindow2,hcNoContext,
184
 
      NewItem('Window 3','',kbNoKey,cmWindow3,hcNoContext,
185
 
      NewItem('Timed Box','',kbNoKey,cmTimedBox,hcNoContext,
 
205
      NewItem('~A~scii Chart','',kbNoKey,cmAscii,hcNoContext,
 
206
      NewItem('Window ~1~','',kbNoKey,cmWindow1,hcNoContext,
 
207
      NewItem('Window ~2~','',kbNoKey,cmWindow2,hcNoContext,
 
208
      NewItem('Window ~3~','',kbNoKey,cmWindow3,hcNoContext,
 
209
      NewItem('~T~imed Box','',kbNoKey,cmTimedBox,hcNoContext,
186
210
      NewItem('Close Window 1','',kbNoKey,cmCloseWindow1,hcNoContext,
187
211
      NewItem('Close Window 2','',kbNoKey,cmCloseWindow2,hcNoContext,
188
212
      NewItem('Close Window 3','',kbNoKey,cmCloseWindow3,hcNoContext,
189
213
      Nil))))))))),
190
214
    NewSubMenu('~W~indow', 0, NewMenu(
191
 
      StdWindowMenuItems(Nil)), Nil)))))));            { Standard window  menu }
 
215
      StdWindowMenuItems(Nil)),        { Standard window  menu }
 
216
    NewSubMenu('~H~elp', hcNoContext, NewMenu(
 
217
      NewItem('~A~bout...','',kbNoKey,cmAbout,hcNoContext,
 
218
      nil)),
 
219
    nil))))) //end NewSubMenus
 
220
   ))); //end MenuBar
192
221
END;
193
222
 
194
223
{--TTvDemo------------------------------------------------------------------}
219
248
   Desktop := New(PDeskTop, Init(R));
220
249
END;
221
250
 
 
251
procedure TTVDemo.InitStatusLine;
 
252
var
 
253
   R: TRect;
 
254
begin
 
255
  GetExtent(R);
 
256
  R.A.Y := R.B.Y - 1;
 
257
  R.B.X := R.B.X - 12;
 
258
  New(StatusLine,
 
259
    Init(R,
 
260
      NewStatusDef(0, $EFFF,
 
261
        NewStatusKey('~F3~ Open', kbF3, cmOpen,
 
262
        NewStatusKey('~F4~ New', kbF4, cmNew,
 
263
        NewStatusKey('~Alt+F3~ Close', kbAltF3, cmClose,
 
264
        StdStatusKeys(nil
 
265
        )))),nil
 
266
      )
 
267
    )
 
268
  );
 
269
 
 
270
  GetExtent(R);
 
271
  R.A.X := R.B.X - 12; R.A.Y := R.B.Y - 1;
 
272
  Heap := New(PHeapView, Init(R));
 
273
  Insert(Heap);
 
274
end;
 
275
 
222
276
PROCEDURE TTvDemo.Window1;
223
277
VAR R: TRect; P: PGroup;
224
278
BEGIN
254
308
{$endif TEST}
255
309
end;
256
310
 
 
311
PROCEDURE TTVDemo.ShowAboutBox;
 
312
begin
 
313
  MessageBox(#3'Free Vision TUI Framework'#13 +
 
314
    #3'Test/Demo Application'#13+
 
315
    #3'(www.freepascal.org)',
 
316
    nil, mfInformation or mfOKButton);
 
317
end;
 
318
 
 
319
PROCEDURE TTVDemo.NewEditWindow;
 
320
var
 
321
  R: TRect;
 
322
begin
 
323
  R.Assign(0, 0, 60, 20);
 
324
  InsertWindow(New(PEditWindow, Init(R, '', wnNoNumber)));
 
325
end;
 
326
 
 
327
PROCEDURE TTVDemo.OpenFile;
 
328
var
 
329
  R: TRect;
 
330
  FileDialog: PFileDialog;
 
331
  FileName: FNameStr;
 
332
const
 
333
  FDOptions: Word = fdOKButton or fdOpenButton;
 
334
begin
 
335
  FileName := '*.*';
 
336
  New(FileDialog, Init(FileName, 'Open file', '~F~ile name', FDOptions, 1));
 
337
  if ExecuteDialog(FileDialog, @FileName) <> cmCancel then
 
338
  begin
 
339
    R.Assign(0, 0, 75, 20);
 
340
    InsertWindow(New(PEditWindow, Init(R, FileName, wnNoNumber)));
 
341
  end;
 
342
end;
257
343
 
258
344
PROCEDURE TTvDemo.TimedBox;
259
345
var
281
367
      P:=Nil;
282
368
    END;
283
369
END;
 
370
 
284
371
PROCEDURE TTvDemo.Window2;
285
372
VAR R: TRect; P: PGroup;
286
373
BEGIN
363
450
   End;*)
364
451
 
365
452
   MyApp.Init;                                        { Initialize app }
366
 
 
367
 
 
368
453
   MyApp.Run;                                         { Run the app }
369
454
{$IFDEF OS2PM}
370
455
   {$IFDEF OS_OS2}
381
466
 
382
467
   {DisposeRGBPalette(SystemPalette);}
383
468
END.
384
 
 
385
 
 
386
 
{
387
 
 $Log: testapp.pas,v $
388
 
 Revision 1.5  2005/02/14 17:13:18  peter
389
 
   * truncate log
390
 
 
391
 
}