← Back to branch summary

~ubuntu-branches/ubuntu/dapper/fpc/dapper

« back to all changes in this revision

Viewing changes to fv/menus.pas

  • Committer: Bazaar Package Importer
  • Author(s): Carlos Laviola
  • Date: 2005-05-30 11:59:10 UTC
  • mfrom: (1.2.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20050530115910-x5pbzm4qqta4i94h
Tags: 2.0.0-2
http://bugs.debian.org/310907
debian/fp-compiler.postinst.in: forgot to reapply the patch that
correctly creates the slave link to pc(1).  (Closes: #310907)

Show diffs side-by-side

added added

removed removed

Lines of Context:
fv/menus.pas
 
1
{ $Id: menus.pas,v 1.24 2005/02/14 17:13:18 peter Exp $ }
 
2
{********[ SOURCE FILE OF GRAPHICAL FREE VISION ]**********}
 
3
{                                                          }
 
4
{   System independent GRAPHICAL clone of MENUS.PAS        }
 
5
{                                                          }
 
6
{   Interface Copyright (c) 1992 Borland International     }
 
7
{                                                          }
 
8
{   Copyright (c) 1996, 1997, 1998, 1999 by Leon de Boer   }
 
9
{   ldeboer@attglobal.net  - primary e-mail addr           }
 
10
{   ldeboer@starwon.com.au - 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
 
 
29
UNIT Menus;
 
30
 
 
31
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
 
32
                                  INTERFACE
 
33
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
 
34
 
 
35
{====Include file to sort compiler platform out =====================}
 
36
{$I Platform.inc}
 
37
{====================================================================}
 
38
 
 
39
{==== Compiler directives ===========================================}
 
40
 
 
41
{$IFNDEF PPC_FPC}{ FPC doesn't support these switches }
 
42
  {$F-} { Near calls are okay }
 
43
  {$A+} { Word Align Data }
 
44
  {$B-} { Allow short circuit boolean evaluations }
 
45
  {$O+} { This unit may be overlaid }
 
46
  {$G+} { 286 Code optimization - if you're on an 8088 get a real computer }
 
47
  {$P-} { Normal string variables }
 
48
  {$N-} { No 80x87 code generation }
 
49
  {$E+} { Emulation is on }
 
50
{$ENDIF}
 
51
 
 
52
{$X+} { Extended syntax is ok }
 
53
{$R-} { Disable range checking }
 
54
{$S-} { Disable Stack Checking }
 
55
{$I-} { Disable IO Checking }
 
56
{$Q-} { Disable Overflow Checking }
 
57
{$V-} { Turn off strict VAR strings }
 
58
{====================================================================}
 
59
 
 
60
USES
 
61
   {$IFDEF OS_WINDOWS}                                { WIN/NT CODE }
 
62
     {$IFNDEF PPC_SPEED}                              { NON SPEED COMPILER }
 
63
       {$IFDEF PPC_FPC}                               { FPC WINDOWS COMPILER }
 
64
       Windows,                                       { Standard unit }
 
65
       {$ELSE}                                        { OTHER COMPILERS }
 
66
       WinTypes,WinProcs,                             { Standard units }
 
67
       {$ENDIF}
 
68
     {$ELSE}                                          { SPEEDSOFT COMPILER }
 
69
       WinBase, WinDef,                               { Standard units }
 
70
     {$ENDIF}
 
71
   {$ENDIF}
 
72
 
 
73
   objects, drivers, views, fvconsts;                 { GFV standard units }
 
74
 
 
75
{***************************************************************************}
 
76
{                              PUBLIC CONSTANTS                             }
 
77
{***************************************************************************}
 
78
 
 
79
{---------------------------------------------------------------------------}
 
80
{                               COLOUR PALETTES                             }
 
81
{---------------------------------------------------------------------------}
 
82
CONST
 
83
   CMenuView   = #2#3#4#5#6#7;                        { Menu colours }
 
84
   CStatusLine = #2#3#4#5#6#7;                        { Statusline colours }
 
85
 
 
86
{***************************************************************************}
 
87
{                            RECORD DEFINITIONS                             }
 
88
{***************************************************************************}
 
89
TYPE
 
90
   TMenuStr = String[31];                             { Menu string }
 
91
 
 
92
   PMenu = ^TMenu;                                    { Pointer to menu }
 
93
 
 
94
{---------------------------------------------------------------------------}
 
95
{                              TMenuItem RECORD                             }
 
96
{---------------------------------------------------------------------------}
 
97
   PMenuItem = ^TMenuItem;
 
98
   TMenuItem =
 
99
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
 
100
   PACKED
 
101
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
 
102
   RECORD
 
103
     Next: PMenuItem;                                 { Next menu item }
 
104
     Name: PString;                                   { Menu item name }
 
105
     Command: Word;                                   { Menu item command }
 
106
     Disabled: Boolean;                               { Menu item state }
 
107
     KeyCode: Word;                                   { Menu item keycode }
 
108
     HelpCtx: Word;                                   { Menu item help ctx }
 
109
     Case Integer Of
 
110
       0: (Param: PString);
 
111
       1: (SubMenu: PMenu);
 
112
   END;
 
113
 
 
114
{---------------------------------------------------------------------------}
 
115
{                                TMenu RECORD                               }
 
116
{---------------------------------------------------------------------------}
 
117
   TMenu =
 
118
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
 
119
   PACKED
 
120
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
 
121
   RECORD
 
122
     Items: PMenuItem;                                { Menu item list }
 
123
     Default: PMenuItem;                              { Default menu }
 
124
   END;
 
125
 
 
126
{---------------------------------------------------------------------------}
 
127
{                             TStatusItem RECORD                            }
 
128
{---------------------------------------------------------------------------}
 
129
TYPE
 
130
   PStatusItem = ^TStatusItem;
 
131
   TStatusItem =
 
132
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
 
133
   PACKED
 
134
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
 
135
   RECORD
 
136
     Next: PStatusItem;                               { Next status item }
 
137
     Text: PString;                                   { Text of status item }
 
138
     KeyCode: Word;                                   { Keycode of item }
 
139
     Command: Word;                                   { Command of item }
 
140
   END;
 
141
 
 
142
{---------------------------------------------------------------------------}
 
143
{                             TStatusDef RECORD                             }
 
144
{---------------------------------------------------------------------------}
 
145
TYPE
 
146
   PStatusDef = ^TStatusDef;
 
147
   TStatusDef =
 
148
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
 
149
   PACKED
 
150
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
 
151
   RECORD
 
152
     Next: PStatusDef;                                { Next status defined }
 
153
     Min, Max: Word;                                  { Range of item }
 
154
     Items: PStatusItem;                              { Item list }
 
155
   END;
 
156
 
 
157
{***************************************************************************}
 
158
{                            OBJECT DEFINITIONS                             }
 
159
{***************************************************************************}
 
160
 
 
161
{---------------------------------------------------------------------------}
 
162
{                TMenuView OBJECT - MENU VIEW ANCESTOR OBJECT               }
 
163
{---------------------------------------------------------------------------}
 
164
TYPE
 
165
   PMenuView = ^TMenuView;
 
166
   TMenuView = OBJECT (TView)
 
167
         ParentMenu: PMenuView;                       { Parent menu }
 
168
         Menu      : PMenu;                           { Menu item list }
 
169
         Current   : PMenuItem;                       { Current menu item }
 
170
         OldItem   : PMenuItem;                       { Old item for draws }
 
171
      CONSTRUCTOR Init (Var Bounds: TRect);
 
172
      CONSTRUCTOR Load (Var S: TStream);
 
173
      FUNCTION Execute: Word; Virtual;
 
174
      FUNCTION GetHelpCtx: Word; Virtual;
 
175
      FUNCTION GetPalette: PPalette; Virtual;
 
176
      FUNCTION FindItem (Ch: Char): PMenuItem;
 
177
      FUNCTION HotKey (KeyCode: Word): PMenuItem;
 
178
      FUNCTION NewSubView (Var Bounds: TRect; AMenu: PMenu;
 
179
        AParentMenu: PMenuView): PMenuView; Virtual;
 
180
      PROCEDURE Store (Var S: TStream);
 
181
      PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
 
182
      PROCEDURE GetItemRect (Item: PMenuItem; Var R: TRect); Virtual;
 
183
      private
 
184
      PROCEDURE GetItemRectX (Item: PMenuItem; Var R: TRect); Virtual;
 
185
   END;
 
186
 
 
187
{---------------------------------------------------------------------------}
 
188
{                    TMenuBar OBJECT - MENU BAR OBJECT                      }
 
189
{---------------------------------------------------------------------------}
 
190
TYPE
 
191
   TMenuBar = OBJECT (TMenuView)
 
192
      CONSTRUCTOR Init (Var Bounds: TRect; AMenu: PMenu);
 
193
      DESTRUCTOR Done; Virtual;
 
194
      PROCEDURE Draw; Virtual;
 
195
      private
 
196
      PROCEDURE GetItemRectX (Item: PMenuItem; Var R: TRect); Virtual;
 
197
   END;
 
198
   PMenuBar = ^TMenuBar;
 
199
 
 
200
{---------------------------------------------------------------------------}
 
201
{                   TMenuBox OBJECT - BOXED MENU OBJECT                     }
 
202
{---------------------------------------------------------------------------}
 
203
TYPE
 
204
   TMenuBox = OBJECT (TMenuView)
 
205
      CONSTRUCTOR Init (Var Bounds: TRect; AMenu: PMenu;
 
206
        AParentMenu: PMenuView);
 
207
      PROCEDURE Draw; Virtual;
 
208
      private
 
209
      PROCEDURE GetItemRectX (Item: PMenuItem; Var R: TRect); Virtual;
 
210
   END;
 
211
   PMenuBox = ^TMenuBox;
 
212
 
 
213
{---------------------------------------------------------------------------}
 
214
{                  TMenuPopUp OBJECT - POPUP MENU OBJECT                    }
 
215
{---------------------------------------------------------------------------}
 
216
TYPE
 
217
   TMenuPopup = OBJECT (TMenuBox)
 
218
      CONSTRUCTOR Init (Var Bounds: TRect; AMenu: PMenu);
 
219
      DESTRUCTOR Done; Virtual;
 
220
      PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
 
221
   END;
 
222
   PMenuPopup = ^TMenuPopup;
 
223
 
 
224
{---------------------------------------------------------------------------}
 
225
{                    TStatusLine OBJECT - STATUS LINE OBJECT                }
 
226
{---------------------------------------------------------------------------}
 
227
TYPE
 
228
   TStatusLine = OBJECT (TView)
 
229
         Items: PStatusItem;                          { Status line items }
 
230
         Defs : PStatusDef;                           { Status line default }
 
231
      CONSTRUCTOR Init (Var Bounds: TRect; ADefs: PStatusDef);
 
232
      CONSTRUCTOR Load (Var S: TStream);
 
233
      DESTRUCTOR Done; Virtual;
 
234
      FUNCTION GetPalette: PPalette; Virtual;
 
235
      FUNCTION Hint (AHelpCtx: Word): String; Virtual;
 
236
      PROCEDURE Draw; Virtual;
 
237
      PROCEDURE Update; Virtual;
 
238
      PROCEDURE Store (Var S: TStream);
 
239
      PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
 
240
      PRIVATE
 
241
      PROCEDURE FindItems;
 
242
      PROCEDURE DrawSelect (Selected: PStatusItem);
 
243
   END;
 
244
   PStatusLine = ^TStatusLine;
 
245
 
 
246
{***************************************************************************}
 
247
{                            INTERFACE ROUTINES                             }
 
248
{***************************************************************************}
 
249
 
 
250
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
251
{                           MENU INTERFACE ROUTINES                         }
 
252
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
253
 
 
254
{-NewMenu------------------------------------------------------------
 
255
Allocates and returns a pointer to a new TMenu record. Sets the Items
 
256
and Default fields of the record to the value given by the parameter.
 
257
An error creating will return a nil pointer.
 
258
14May98 LdB
 
259
---------------------------------------------------------------------}
 
260
FUNCTION NewMenu (Items: PMenuItem): PMenu;
 
261
 
 
262
{-DisposeMenu--------------------------------------------------------
 
263
Disposes of all the elements of the specified menu (and all submenus).
 
264
14May98 LdB
 
265
---------------------------------------------------------------------}
 
266
PROCEDURE DisposeMenu (Menu: PMenu);
 
267
 
 
268
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
269
{                             MENU ITEM ROUTINES                            }
 
270
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
271
 
 
272
{-NewLine------------------------------------------------------------
 
273
Allocates and returns a pointer to a new TMenuItem record that
 
274
represents a separator line in a menu box.
 
275
An error creating will return a nil pointer.
 
276
14May98 LdB
 
277
---------------------------------------------------------------------}
 
278
FUNCTION NewLine (Next: PMenuItem): PMenuItem;
 
279
 
 
280
{-NewItem------------------------------------------------------------
 
281
Allocates and returns a pointer to a new TMenuItem record that
 
282
represents a menu item (using NewStr to allocate the Name and Param).
 
283
An error creating will return a nil pointer.
 
284
14May98 LdB
 
285
---------------------------------------------------------------------}
 
286
FUNCTION NewItem (Name, Param: TMenuStr; KeyCode: Word; Command: Word;
 
287
  AHelpCtx: Word; Next: PMenuItem): PMenuItem;
 
288
 
 
289
{-NewSubMenu---------------------------------------------------------
 
290
Allocates and returns a pointer to a new TMenuItem record, which
 
291
represents a submenu (using NewStr to allocate the Name).
 
292
An error creating will return a nil pointer.
 
293
14May98 LdB
 
294
---------------------------------------------------------------------}
 
295
FUNCTION NewSubMenu (Name: TMenuStr; AHelpCtx: Word; SubMenu: PMenu;
 
296
  Next: PMenuItem): PMenuItem;
 
297
 
 
298
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
299
{                          STATUS INTERFACE ROUTINES                        }
 
300
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
301
 
 
302
{-NewStatusDef-------------------------------------------------------
 
303
Allocates and returns a pointer to a new TStatusDef record initialized
 
304
with the given parameter values. Calls to NewStatusDef can be nested.
 
305
An error creating will return a nil pointer.
 
306
15May98 LdB
 
307
---------------------------------------------------------------------}
 
308
FUNCTION NewStatusDef (AMin, AMax: Word; AItems: PStatusItem;
 
309
  ANext: PStatusDef): PStatusDef;
 
310
 
 
311
{-NewStatusKey-------------------------------------------------------
 
312
Allocates and returns a pointer to a new TStatusItem record initialized
 
313
with the given parameter values (using NewStr to allocate the Text).
 
314
An error in creating will return a nil pointer.
 
315
15May98 LdB
 
316
---------------------------------------------------------------------}
 
317
FUNCTION NewStatusKey (AText: String; AKeyCode: Word; ACommand: Word;
 
318
  ANext: PStatusItem): PStatusItem;
 
319
 
 
320
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
321
{                           OBJECT REGISTER ROUTINES                        }
 
322
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
323
{-RegisterMenus-------------------------------------------------------
 
324
Calls RegisterType for each of the object types defined in this unit.
 
325
15May98 LdB
 
326
---------------------------------------------------------------------}
 
327
PROCEDURE RegisterMenus;
 
328
 
 
329
{***************************************************************************}
 
330
{                           OBJECT REGISTRATION                             }
 
331
{***************************************************************************}
 
332
 
 
333
{---------------------------------------------------------------------------}
 
334
{                        TMenuBar STREAM REGISTRATION                       }
 
335
{---------------------------------------------------------------------------}
 
336
CONST
 
337
   RMenuBar: TStreamRec = (
 
338
     ObjType: idMenuBar;                              { Register id = 40 }
 
339
     {$IFDEF BP_VMTLink}                              { BP style VMT link }
 
340
     VmtLink: Ofs(TypeOf(TMenuBar)^);
 
341
     {$ELSE}                                          { Alt style VMT link }
 
342
     VmtLink: TypeOf(TMenuBar);
 
343
     {$ENDIF}
 
344
     Load:    @TMenuBar.Load;                         { Object load method }
 
345
     Store:   @TMenuBar.Store                         { Object store method }
 
346
   );
 
347
 
 
348
{---------------------------------------------------------------------------}
 
349
{                        TMenuBox STREAM REGISTRATION                       }
 
350
{---------------------------------------------------------------------------}
 
351
CONST
 
352
   RMenuBox: TStreamRec = (
 
353
     ObjType: idMenuBox;                              { Register id = 41 }
 
354
     {$IFDEF BP_VMTLink}                              { BP style VMT link }
 
355
     VmtLink: Ofs(TypeOf(TMenuBox)^);
 
356
     {$ELSE}                                          { Alt style VMT link }
 
357
     VmtLink: TypeOf(TMenuBox);
 
358
     {$ENDIF}
 
359
     Load:    @TMenuBox.Load;                         { Object load method }
 
360
     Store:   @TMenuBox.Store                         { Object store method }
 
361
   );
 
362
 
 
363
{---------------------------------------------------------------------------}
 
364
{                      TStatusLine STREAM REGISTRATION                      }
 
365
{---------------------------------------------------------------------------}
 
366
CONST
 
367
   RStatusLine: TStreamRec = (
 
368
     ObjType: 42;                                     { Register id = 42 }
 
369
     {$IFDEF BP_VMTLink}                              { BP style VMT link }
 
370
     VmtLink: Ofs(TypeOf(TStatusLine)^);
 
371
     {$ELSE}                                          { Alt style VMT link }
 
372
     VmtLink: TypeOf(TStatusLine);
 
373
     {$ENDIF}
 
374
     Load:    @TStatusLine.Load;                      { Object load method }
 
375
     Store:   @TStatusLine.Store                      { Object store method }
 
376
   );
 
377
 
 
378
{---------------------------------------------------------------------------}
 
379
{                       TMenuPopup STREAM REGISTRATION                      }
 
380
{---------------------------------------------------------------------------}
 
381
CONST
 
382
   RMenuPopup: TStreamRec = (
 
383
     ObjType: 43;                                     { Register id = 43 }
 
384
     {$IFDEF BP_VMTLink}                              { BP style VMT link }
 
385
     VmtLink: Ofs(TypeOf(TMenuPopup)^);
 
386
     {$ELSE}                                          { Alt style VMT link }
 
387
     VmtLink: TypeOf(TMenuPopup);
 
388
     {$ENDIF}
 
389
     Load:    @TMenuPopup.Load;                       { Object load method }
 
390
     Store:   @TMenuPopup.Store                       { Object store method }
 
391
   );
 
392
 
 
393
{***************************************************************************}
 
394
{                        INITIALIZED PUBLIC VARIABLES                       }
 
395
{***************************************************************************}
 
396
 
 
397
{---------------------------------------------------------------------------}
 
398
{                       INITIALIZED PUBLIC VARIABLES                        }
 
399
{---------------------------------------------------------------------------}
 
400
 
 
401
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
 
402
                                IMPLEMENTATION
 
403
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
 
404
USES
 
405
  Video;
 
406
 
 
407
CONST
 
408
  SubMenuChar : array[boolean] of char = ('>',#16);
 
409
  { SubMenuChar is the character displayed at right of submenu }
 
410
 
 
411
{***************************************************************************}
 
412
{                               OBJECT METHODS                              }
 
413
{***************************************************************************}
 
414
 
 
415
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
416
{                          TMenuView OBJECT METHODS                         }
 
417
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
418
 
 
419
{--TMenuView----------------------------------------------------------------}
 
420
{  Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 08May98 LdB              }
 
421
{---------------------------------------------------------------------------}
 
422
CONSTRUCTOR TMenuView.Init (Var Bounds: TRect);
 
423
BEGIN
 
424
   Inherited Init(Bounds);                            { Call ancestor }
 
425
   EventMask := EventMask OR evBroadcast;             { See broadcast events }
 
426
END;
 
427
 
 
428
{--TMenuView----------------------------------------------------------------}
 
429
{  Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB              }
 
430
{---------------------------------------------------------------------------}
 
431
CONSTRUCTOR TMenuView.Load (Var S: TStream);
 
432
 
 
433
   FUNCTION DoLoadMenu: PMenu;
 
434
   VAR Tok: Byte; Item: PMenuItem; Last: ^PMenuItem; Menu: PMenu;
 
435
   BEGIN
 
436
     New(Menu);                                       { Create new menu }
 
437
     Last := @Menu^.Items;                            { Start on first item }
 
438
     Item := Nil;                                     { Clear pointer }
 
439
     S.Read(Tok, SizeOf(Tok));                        { Read token }
 
440
     While (Tok <> 0) Do Begin
 
441
       New(Item);                                     { Create new item }
 
442
       Last^ := Item;                                 { First part of chain }
 
443
       If (Item <> Nil) Then Begin                    { Check item valid }
 
444
         Last := @Item^.Next;                         { Complete chain }
 
445
         With Item^ Do Begin
 
446
           Name := S.ReadStr;                         { Read menu name }
 
447
           S.Read(Command, SizeOf(Command));          { Menu item command }
 
448
           S.Read(Disabled, SizeOf(Disabled));        { Menu item state }
 
449
           S.Read(KeyCode, SizeOf(KeyCode));          { Menu item keycode }
 
450
           S.Read(HelpCtx, SizeOf(HelpCtx));          { Menu item help ctx }
 
451
           If (Name <> Nil) Then
 
452
             If Command = 0 Then
 
453
{$ifdef PPC_FPC}
 
454
               SubMenu := DoLoadMenu()                  { Load submenu }
 
455
{$else not PPC_FPC}
 
456
               SubMenu := DoLoadMenu                  { Load submenu }
 
457
{$endif not PPC_FPC}
 
458
                 Else Param := S.ReadStr;             { Read param string }
 
459
         End;
 
460
       End;
 
461
       S.Read(Tok, SizeOf(Tok));                      { Read token }
 
462
     End;
 
463
     Last^ := Nil;                                    { List complete }
 
464
     Menu^.Default := Menu^.Items;                    { Set menu default }
 
465
     DoLoadMenu := Menu;                              { Return menu }
 
466
   End;
 
467
 
 
468
BEGIN
 
469
   Inherited Load(S);                                 { Call ancestor }
 
470
   Menu := DoLoadMenu;                                { Load menu items }
 
471
END;
 
472
 
 
473
{--TMenuView----------------------------------------------------------------}
 
474
{  Execute -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB           }
 
475
{---------------------------------------------------------------------------}
 
476
FUNCTION TMenuView.Execute: Word;
 
477
TYPE MenuAction = (DoNothing, DoSelect, DoReturn);
 
478
VAR AutoSelect: Boolean; Action: MenuAction; Ch: Char; Res: Word; R: TRect;
 
479
  ItemShown, P: PMenuItem; Target: PMenuView; E: TEvent; MouseActive: Boolean;
 
480
 
 
481
   PROCEDURE TrackMouse;
 
482
   VAR Mouse: TPoint; R: TRect;
 
483
   BEGIN
 
484
     Mouse.X := E.Where.X - Origin.X;              { Local x position }
 
485
     Mouse.Y := E.Where.Y - oRigin.Y;              { Local y position }
 
486
     Current := Menu^.Items;                          { Start with current }
 
487
     While (Current <> Nil) Do Begin
 
488
       GetItemRectX(Current, R);                       { Get item rectangle }
 
489
       If R.Contains(Mouse) Then Begin                { Contains mouse }
 
490
         MouseActive := True;                         { Return true }
 
491
         Exit;                                        { Then exit }
 
492
       End;
 
493
       Current := Current^.Next;                      { Try next item }
 
494
     End;
 
495
   END;
 
496
 
 
497
   PROCEDURE TrackKey (FindNext: Boolean);
 
498
 
 
499
       PROCEDURE NextItem;
 
500
       BEGIN
 
501
         Current := Current^.Next;                    { Move to next item }
 
502
         If (Current = Nil) Then
 
503
           Current := Menu^.Items;                    { Return first menu }
 
504
       END;
 
505
 
 
506
       PROCEDURE PrevItem;
 
507
       VAR P: PMenuItem;
 
508
       BEGIN
 
509
         P := Current;                                { Start on current }
 
510
         If (P = Menu^.Items) Then P := Nil;          { Check if at start }
 
511
         Repeat NextItem Until Current^.Next = P;     { Prev item found }
 
512
       END;
 
513
 
 
514
   BEGIN
 
515
     If (Current <> Nil) Then                         { Current view valid }
 
516
       Repeat
 
517
         If FindNext Then NextItem Else PrevItem;     { Find next/prev item }
 
518
       Until (Current^.Name <> Nil);                  { Until we have name }
 
519
   END;
 
520
 
 
521
   FUNCTION MouseInOwner: Boolean;
 
522
   VAR Mouse: TPoint; R: TRect;
 
523
   BEGIN
 
524
     MouseInOwner := False;                           { Preset false }
 
525
     If (ParentMenu <> Nil) AND (ParentMenu^.Size.Y = 1)
 
526
     Then Begin                                       { Valid parent menu }
 
527
       Mouse.X := E.Where.X - ParentMenu^.Origin.X;{ Local x position }
 
528
       Mouse.Y := E.Where.Y - ParentMenu^.Origin.Y;{ Local y position }
 
529
       ParentMenu^.GetItemRectX(ParentMenu^.Current,R);{ Get item rect }
 
530
       MouseInOwner := R.Contains(Mouse);             { Return result }
 
531
     End;
 
532
   END;
 
533
 
 
534
   FUNCTION MouseInMenus: Boolean;
 
535
   VAR P: PMenuView;
 
536
   BEGIN
 
537
     P := ParentMenu;                                 { Parent menu }
 
538
     While (P <> Nil) AND NOT P^.MouseInView(E.Where)
 
539
       Do P := P^.ParentMenu;                         { Check next menu }
 
540
     MouseInMenus := (P <> Nil);                      { Return result }
 
541
   END;
 
542
 
 
543
   FUNCTION TopMenu: PMenuView;
 
544
   VAR P: PMenuView;
 
545
   BEGIN
 
546
     P := @Self;                                      { Start with self }
 
547
     While (P^.ParentMenu <> Nil) Do
 
548
       P := P^.ParentMenu;                            { Check next menu }
 
549
     TopMenu := P;                                    { Top menu }
 
550
   END;
 
551
 
 
552
BEGIN
 
553
   AutoSelect := False;                               { Clear select flag }
 
554
   MouseActive := False;                              { Clear mouse flag }
 
555
   Res := 0;                                          { Clear result }
 
556
   ItemShown := Nil;                                  { Clear item pointer }
 
557
   If (Menu <> Nil) Then Current := Menu^.Default     { Set current item }
 
558
     Else Current := Nil;                             { No menu = no current }
 
559
   Repeat
 
560
     Action := DoNothing;                             { Clear action flag }
 
561
     GetEvent(E);                                     { Get next event }
 
562
     Case E.What Of
 
563
       evMouseDown: If MouseInView(E.Where)           { Mouse in us }
 
564
         OR MouseInOwner Then Begin                   { Mouse in owner area }
 
565
           TrackMouse;                                { Track the mouse }
 
566
           If (Size.Y = 1) Then AutoSelect := True;   { Set select flag }
 
567
         End Else Action := DoReturn;                 { Set return action }
 
568
       evMouseUp: Begin
 
569
           TrackMouse;                                { Track the mouse }
 
570
           If MouseInOwner Then                       { Mouse in owner }
 
571
             Current := Menu^.Default                 { Set as current }
 
572
           Else If (Current <> Nil) AND
 
573
           (Current^.Name <> Nil) Then
 
574
             Action := DoSelect                       { Set select action }
 
575
           Else If MouseActive OR MouseInView(E.Where)
 
576
           Then Action := DoReturn                    { Set return action }
 
577
           Else Begin
 
578
             Current := Menu^.Default;                { Set current item }
 
579
             If (Current = Nil) Then
 
580
               Current := Menu^.Items;                { Select first item }
 
581
             Action := DoNothing;                     { Do nothing action }
 
582
           End;
 
583
         End;
 
584
       evMouseMove: If (E.Buttons <> 0) Then Begin    { Mouse moved }
 
585
           TrackMouse;                                { Track the mouse }
 
586
           If NOT (MouseInView(E.Where) OR MouseInOwner)
 
587
           AND MouseInMenus Then Action := DoReturn;  { Set return action }
 
588
         End;
 
589
       evKeyDown:
 
590
         Case CtrlToArrow(E.KeyCode) Of               { Check arrow keys }
 
591
           kbUp, kbDown: If (Size.Y <> 1) Then
 
592
             TrackKey(CtrlToArrow(E.KeyCode) = kbDown){ Track keyboard }
 
593
             Else If (E.KeyCode = kbDown) Then        { Down arrow }
 
594
             AutoSelect := True;                      { Select item }
 
595
           kbLeft, kbRight: If (ParentMenu = Nil) Then
 
596
             TrackKey(CtrlToArrow(E.KeyCode)=kbRight) { Track keyboard }
 
597
             Else Action := DoReturn;                 { Set return action }
 
598
           kbHome, kbEnd: If (Size.Y <> 1) Then Begin
 
599
               Current := Menu^.Items;                { Set to first item }
 
600
               If (E.KeyCode = kbEnd) Then            { If the 'end' key }
 
601
                 TrackKey(False);                     { Move to last item }
 
602
             End;
 
603
           kbEnter: Begin
 
604
               If Size.Y = 1 Then AutoSelect := True; { Select item }
 
605
               Action := DoSelect;                    { Return the item }
 
606
             End;
 
607
           kbEsc: Begin
 
608
               Action := DoReturn;                    { Set return action }
 
609
               If (ParentMenu = Nil) OR
 
610
               (ParentMenu^.Size.Y <> 1) Then         { Check parent }
 
611
                 ClearEvent(E);                       { Kill the event }
 
612
             End;
 
613
           Else Target := @Self;                      { Set target as self }
 
614
           Ch := GetAltChar(E.KeyCode);
 
615
           If (Ch = #0) Then Ch := E.CharCode Else
 
616
             Target := TopMenu;                       { Target is top menu }
 
617
           P := Target^.FindItem(Ch);                 { Check for item }
 
618
           If (P = Nil) Then Begin
 
619
             P := TopMenu^.HotKey(E.KeyCode);         { Check for hot key }
 
620
             If (P <> Nil) AND                        { Item valid }
 
621
             CommandEnabled(P^.Command) Then Begin    { Command enabled }
 
622
               Res := P^.Command;                     { Set return command }
 
623
               Action := DoReturn;                    { Set return action }
 
624
             End
 
625
           End Else If Target = @Self Then Begin
 
626
             If Size.Y = 1 Then AutoSelect := True;   { Set auto select }
 
627
             Action := DoSelect;                      { Select item }
 
628
             Current := P;                            { Set current item }
 
629
           End Else If (ParentMenu <> Target) OR
 
630
           (ParentMenu^.Current <> P) Then            { Item different }
 
631
              Action := DoReturn;                     { Set return action }
 
632
         End;
 
633
       evCommand: If (E.Command = cmMenu) Then Begin  { Menu command }
 
634
           AutoSelect := False;                       { Dont select item }
 
635
           If (ParentMenu <> Nil) Then
 
636
             Action := DoReturn;                      { Set return action }
 
637
         End Else Action := DoReturn;                 { Set return action }
 
638
     End;
 
639
     If (ItemShown <> Current) Then Begin             { New current item }
 
640
       OldItem := ItemShown;                          { Hold old item }
 
641
       ItemShown := Current;                          { Hold new item }
 
642
       DrawView;                                      { Redraw the items }
 
643
       OldItem := Nil;                                { Clear old item }
 
644
     End;
 
645
     If (Action = DoSelect) OR ((Action = DoNothing)
 
646
     AND AutoSelect) Then                             { Item is selecting }
 
647
       If (Current <> Nil) Then With Current^ Do      { Current item valid }
 
648
         If (Name <> Nil) Then                        { Item has a name }
 
649
           If (Command = 0) Then Begin                { Has no command }
 
650
             If (E.What AND (evMouseDown+evMouseMove) <> 0)
 
651
               Then PutEvent(E);                      { Put event on queue }
 
652
             GetItemRectX(Current, R);                 { Get area of item }
 
653
             R.A.X := R.A.X + Origin.X; { Left start point }
 
654
             R.A.Y := R.B.Y + Origin.Y;{ Top start point }
 
655
             R.B.X := Owner^.Size.X;                  { X screen area left }
 
656
             R.B.Y := Owner^.Size.Y;                  { Y screen area left }
 
657
             Target := TopMenu^.NewSubView(R, SubMenu,
 
658
               @Self);                                { Create drop menu }
 
659
             Res := Owner^.ExecView(Target);          { Execute dropped view }
 
660
             Dispose(Target, Done);                   { Dispose drop view }
 
661
           End Else If Action = DoSelect Then
 
662
             Res := Command;                          { Return result }
 
663
     If (Res <> 0) AND CommandEnabled(Res)            { Check command }
 
664
     Then Begin
 
665
       Action := DoReturn;                            { Return command }
 
666
       ClearEvent(E);                                 { Clear the event }
 
667
     End Else Res := 0;                               { Clear result }
 
668
   Until (Action = DoReturn);
 
669
   If (E.What <> evNothing) Then
 
670
     If (ParentMenu <> Nil) OR (E.What = evCommand)   { Check event type }
 
671
       Then PutEvent(E);                              { Put event on queue }
 
672
   If (Current <> Nil) Then Begin
 
673
     Menu^.Default := Current;                        { Set new default }
 
674
     Current := Nil;                                  { Clear current }
 
675
     DrawView;                                        { Redraw the view }
 
676
   End;
 
677
   Execute := Res;                                    { Return result }
 
678
END;
 
679
 
 
680
{--TMenuView----------------------------------------------------------------}
 
681
{  GetHelpCtx -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 08May98 LdB        }
 
682
{---------------------------------------------------------------------------}
 
683
FUNCTION TMenuView.GetHelpCtx: Word;
 
684
VAR C: PMenuView;
 
685
BEGIN
 
686
   C := @Self;                                        { Start at self }
 
687
   While (C <> Nil) AND ((C^.Current = Nil) OR
 
688
   (C^.Current^.HelpCtx = hcNoContext) OR             { Has no context }
 
689
   (C^.Current^.Name = Nil)) Do C := C^.ParentMenu;   { Parent menu context }
 
690
   If (C<>Nil) Then GetHelpCtx := C^.Current^.HelpCtx { Current context }
 
691
     Else GetHelpCtx := hcNoContext;                  { No help context }
 
692
END;
 
693
 
 
694
{--TMenuView----------------------------------------------------------------}
 
695
{  GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15May98 LdB        }
 
696
{---------------------------------------------------------------------------}
 
697
FUNCTION TMenuView.GetPalette: PPalette;
 
698
{$IFDEF PPC_DELPHI3}                                  { DELPHI3+ COMPILER }
 
699
CONST P: String = CMenuView;                          { Possible huge string }
 
700
{$ELSE}                                               { OTHER COMPILERS }
 
701
CONST P: String[Length(CMenuView)] = CMenuView;       { Always normal string }
 
702
{$ENDIF}
 
703
BEGIN
 
704
   GetPalette := @P;                                  { Return palette }
 
705
END;
 
706
 
 
707
{--TMenuView----------------------------------------------------------------}
 
708
{  FindItem -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 11May98 LdB          }
 
709
{---------------------------------------------------------------------------}
 
710
FUNCTION TMenuView.FindItem (Ch: Char): PMenuItem;
 
711
VAR I: Integer; P: PMenuItem;
 
712
BEGIN
 
713
   Ch := UpCase(Ch);                                  { Upper case of char }
 
714
   P := Menu^.Items;                                  { First menu item }
 
715
   While (P <> Nil) Do Begin                          { While item valid }
 
716
     If (P^.Name <> Nil) AND (NOT P^.Disabled)        { Valid enabled cmd }
 
717
     Then Begin
 
718
       I := Pos('~', P^.Name^);                       { Scan for highlight }
 
719
       If (I <> 0) AND (Ch = UpCase(P^.Name^[I+1]))   { Hotkey char found }
 
720
       Then Begin
 
721
         FindItem := P;                               { Return item }
 
722
         Exit;                                        { Now exit }
 
723
       End;
 
724
     End;
 
725
     P := P^.Next;                                    { Next item }
 
726
   End;
 
727
   FindItem := Nil;                                   { No item found }
 
728
END;
 
729
 
 
730
{--TMenuView----------------------------------------------------------------}
 
731
{  HotKey -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 11May98 LdB            }
 
732
{---------------------------------------------------------------------------}
 
733
FUNCTION TMenuView.HotKey (KeyCode: Word): PMenuItem;
 
734
 
 
735
   FUNCTION FindHotKey (P: PMenuItem): PMenuItem;
 
736
   VAR T: PMenuItem;
 
737
   BEGIN
 
738
     While (P <> Nil) Do Begin                        { While item valid }
 
739
       If (P^.Name <> Nil) Then                       { If valid name }
 
740
         If (P^.Command = 0) Then Begin               { Valid command }
 
741
           T := FindHotKey(P^.SubMenu^.Items);        { Search for hot key }
 
742
           If (T <> Nil) Then Begin
 
743
             FindHotKey := T;                         { Return hotkey }
 
744
             Exit;                                    { Now exit }
 
745
           End;
 
746
         End Else If NOT P^.Disabled AND              { Hotkey is enabled }
 
747
         (P^.KeyCode <> kbNoKey) AND                  { Valid keycode }
 
748
         (P^.KeyCode = KeyCode) Then Begin            { Key matches request }
 
749
           FindHotKey := P;                           { Return hotkey code }
 
750
           Exit;                                      { Exit }
 
751
         End;
 
752
         P := P^.Next;                                { Next item }
 
753
     End;
 
754
     FindHotKey := Nil;                               { No item found }
 
755
   END;
 
756
 
 
757
BEGIN
 
758
   HotKey := FindHotKey(Menu^.Items);                 { Hot key function }
 
759
END;
 
760
 
 
761
{--TMenuView----------------------------------------------------------------}
 
762
{  NewSubView -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 11May98 LdB        }
 
763
{---------------------------------------------------------------------------}
 
764
FUNCTION TMenuView.NewSubView (Var Bounds: TRect; AMenu: PMenu;
 
765
  AParentMenu: PMenuView): PMenuView;
 
766
BEGIN
 
767
   NewSubView := New(PMenuBox, Init(Bounds, AMenu,
 
768
     AParentMenu));                                   { Create a menu box }
 
769
END;
 
770
 
 
771
{--TMenuView----------------------------------------------------------------}
 
772
{  Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 11May98 LdB             }
 
773
{---------------------------------------------------------------------------}
 
774
PROCEDURE TMenuView.Store (Var S: TStream);
 
775
 
 
776
   PROCEDURE DoStoreMenu (Menu: PMenu);
 
777
   VAR Item: PMenuItem; Tok: Byte;
 
778
   BEGIN
 
779
     Tok := $FF;                                      { Preset max count }
 
780
     Item := Menu^.Items;                             { Start first item }
 
781
     While (Item <> Nil) Do Begin
 
782
       With Item^ Do Begin
 
783
         S.Write(Tok, SizeOf(Tok));                      { Write tok value }
 
784
         S.WriteStr(Name);                            { Write item name }
 
785
         S.Write(Command, SizeOf(Command));           { Menu item command }
 
786
         S.Write(Disabled, SizeOf(Disabled));         { Menu item state }
 
787
         S.Write(KeyCode, SizeOf(KeyCode));           { Menu item keycode }
 
788
         S.Write(HelpCtx, SizeOf(HelpCtx));           { Menu item help ctx }
 
789
         If (Name <> Nil) Then
 
790
           If Command = 0 Then DoStoreMenu(SubMenu)
 
791
           Else S.WriteStr(Param);                    { Write parameter }
 
792
       End;
 
793
       Item := Item^.Next;                            { Next item }
 
794
     End;
 
795
     Tok := 0;                                        { Clear tok count }
 
796
     S.Write(Tok, SizeOf(Tok));                       { Write tok value }
 
797
   END;
 
798
 
 
799
BEGIN
 
800
   TView.Store(S);                                    { TView.Store called }
 
801
   DoStoreMenu(Menu);                                 { Store menu items }
 
802
END;
 
803
 
 
804
{--TMenuView----------------------------------------------------------------}
 
805
{  HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 08May98 LdB       }
 
806
{---------------------------------------------------------------------------}
 
807
PROCEDURE TMenuView.HandleEvent (Var Event: TEvent);
 
808
VAR CallDraw: Boolean; P: PMenuItem;
 
809
 
 
810
   PROCEDURE UpdateMenu (Menu: PMenu);
 
811
   VAR P: PMenuItem; CommandState: Boolean;
 
812
   BEGIN
 
813
     P := Menu^.Items;                                { Start on first item }
 
814
     While (P <> Nil) Do Begin
 
815
       If (P^.Name <> Nil) Then                       { Valid name }
 
816
       If (P^.Command = 0) Then UpdateMenu(P^.SubMenu){ Update menu }
 
817
       Else Begin
 
818
         CommandState := CommandEnabled(P^.Command);  { Menu item state }
 
819
         If (P^.Disabled = CommandState) Then Begin
 
820
           P^.Disabled := NOT CommandState;           { Disable item }
 
821
           CallDraw := True;                          { Must draw }
 
822
         End;
 
823
       End;
 
824
       P := P^.Next;                                  { Next item }
 
825
     End;
 
826
   END;
 
827
 
 
828
   PROCEDURE DoSelect;
 
829
   BEGIN
 
830
     PutEvent(Event);                                 { Put event on queue }
 
831
     Event.Command := Owner^.ExecView(@Self);         { Execute view }
 
832
     If (Event.Command <> 0) AND
 
833
     CommandEnabled(Event.Command) Then Begin
 
834
       Event.What := evCommand;                       { Command event }
 
835
       Event.InfoPtr := Nil;                          { Clear info ptr }
 
836
       PutEvent(Event);                               { Put event on queue }
 
837
     End;
 
838
     ClearEvent(Event);                               { Clear the event }
 
839
   END;
 
840
 
 
841
BEGIN
 
842
   If (Menu <> Nil) Then
 
843
     Case Event.What Of
 
844
       evMouseDown: DoSelect;                         { Select menu item }
 
845
       evKeyDown:
 
846
         If (FindItem(GetAltChar(Event.KeyCode)) <> Nil)
 
847
         Then DoSelect Else Begin                     { Select menu item }
 
848
           P := HotKey(Event.KeyCode);                { Check for hotkey }
 
849
           If (P <> Nil) AND
 
850
           (CommandEnabled(P^.Command)) Then Begin
 
851
             Event.What := evCommand;                 { Command event }
 
852
             Event.Command := P^.Command;             { Set command event }
 
853
             Event.InfoPtr := Nil;                    { Clear info ptr }
 
854
             PutEvent(Event);                         { Put event on queue }
 
855
             ClearEvent(Event);                       { Clear the event }
 
856
           End;
 
857
         End;
 
858
       evCommand:
 
859
         If Event.Command = cmMenu Then DoSelect;     { Select menu item }
 
860
       evBroadcast:
 
861
         If (Event.Command = cmCommandSetChanged)     { Commands changed }
 
862
         Then Begin
 
863
           CallDraw := False;                         { Preset no redraw }
 
864
           UpdateMenu(Menu);                          { Update menu }
 
865
           If CallDraw Then DrawView;                 { Redraw if needed }
 
866
         End;
 
867
     End;
 
868
END;
 
869
 
 
870
{--TMenuView----------------------------------------------------------------}
 
871
{  GetItemRectX -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 08May98 LdB       }
 
872
{---------------------------------------------------------------------------}
 
873
PROCEDURE TMenuView.GetItemRectX (Item: PMenuItem; Var R: TRect);
 
874
BEGIN                                                 { Abstract method }
 
875
END;
 
876
 
 
877
{--TMenuView----------------------------------------------------------------}
 
878
{  GetItemRect -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 08May98 LdB       }
 
879
{---------------------------------------------------------------------------}
 
880
PROCEDURE TMenuView.GetItemRect (Item: PMenuItem; Var R: TRect);
 
881
BEGIN
 
882
  GetItemRectX(Item,R);
 
883
END;
 
884
 
 
885
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
886
{                        TMenuBar OBJECT METHODS                            }
 
887
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
888
 
 
889
{--TMenuBar-----------------------------------------------------------------}
 
890
{  Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 08May98 LdB              }
 
891
{---------------------------------------------------------------------------}
 
892
CONSTRUCTOR TMenuBar.Init (Var Bounds: TRect; AMenu: PMenu);
 
893
BEGIN
 
894
   Inherited Init(Bounds);                            { Call ancestor }
 
895
   GrowMode := gfGrowHiX;                             { Set grow mode }
 
896
   Menu := AMenu;                                     { Hold menu item }
 
897
   Options := Options OR ofPreProcess;                { Preprocessing view }
 
898
END;
 
899
 
 
900
{--TMenuBar-----------------------------------------------------------------}
 
901
{  Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 08May98 LdB              }
 
902
{---------------------------------------------------------------------------}
 
903
DESTRUCTOR TMenuBar.Done;
 
904
BEGIN
 
905
   If (Menu <> Nil) Then DisposeMenu(Menu);           { Dispose menu items }
 
906
   Inherited Done;                                    { Call ancestor }
 
907
END;
 
908
 
 
909
{--TMenuBar-----------------------------------------------------------------}
 
910
{  DrawBackGround -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 08May98 LdB    }
 
911
{---------------------------------------------------------------------------}
 
912
PROCEDURE TMenuBar.Draw;
 
913
VAR I, J, CNormal, CSelect, CNormDisabled, CSelDisabled, Color: Word;
 
914
    P: PMenuItem; B: TDrawBuffer;
 
915
BEGIN
 
916
   CNormal := GetColor($0301);                        { Normal colour }
 
917
   CSelect := GetColor($0604);                        { Select colour }
 
918
   CNormDisabled := GetColor($0202);                  { Disabled colour }
 
919
   CSelDisabled := GetColor($0505);                   { Select disabled }
 
920
   MoveChar(B, ' ', Byte(CNormal), Size.X);           { Empty bar }
 
921
   If (Menu <> Nil) Then Begin                        { Valid menu }
 
922
     I := 0;                                          { Set start position }
 
923
     P := Menu^.Items;                                { First item }
 
924
     While (P <> Nil) Do Begin
 
925
       If (P^.Name <> Nil) Then Begin                 { Name valid }
 
926
         If P^.Disabled Then Begin
 
927
           If (P = Current) Then Color := CSelDisabled{ Select disabled }
 
928
             Else Color := CNormDisabled              { Normal disabled }
 
929
         End Else Begin
 
930
           If (P = Current) Then Color := CSelect     { Select colour }
 
931
             Else Color := CNormal;                   { Normal colour }
 
932
         End;
 
933
         J := CStrLen(P^.Name^);                      { Length of string }
 
934
         MoveChar(B[I], ' ', Byte(Color), 1);
 
935
         MoveCStr(B[I+1], P^.Name^, Color);           { Name to buffer }
 
936
         MoveChar(B[I+1+J], ' ', Byte(Color), 1);
 
937
         Inc(I, J+2);                                 { Advance position }
 
938
       End;
 
939
       P := P^.Next;                                  { Next item }
 
940
     End;
 
941
   End;
 
942
  WriteBuf(0, 0, Size.X, 1, B);                       { Write the string }
 
943
END;
 
944
 
 
945
{--TMenuBar-----------------------------------------------------------------}
 
946
{  GetItemRectX -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 08May98 LdB      }
 
947
{---------------------------------------------------------------------------}
 
948
PROCEDURE TMenuBar.GetItemRectX (Item: PMenuItem; Var R: TRect);
 
949
VAR I: Integer; P: PMenuItem;
 
950
BEGIN
 
951
   I := 0;                                            { Preset to zero }
 
952
   R.Assign(0, 0, 0, 1);                     { Initial rect size }
 
953
   P := Menu^.Items;                                  { First item }
 
954
   While (P <> Nil) Do Begin                          { While valid item }
 
955
     R.A.X := I;                            { Move area along }
 
956
     If (P^.Name <> Nil) Then Begin                   { Valid name }
 
957
       R.B.X := R.A.X+CTextWidth(' ' + P^.Name^ + ' ');{ Add text width  }
 
958
       I := I + CStrLen(P^.Name^) + 2;                { Add item length }
 
959
     End Else R.B.X := R.A.X;
 
960
     If (P = Item) Then break;                        { Requested item found }
 
961
     P := P^.Next;                                    { Next item }
 
962
   End;
 
963
END;
 
964
 
 
965
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
966
{                          TMenuBox OBJECT METHODS                          }
 
967
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
968
 
 
969
{--TMenuBox-----------------------------------------------------------------}
 
970
{  Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 11May98 LdB              }
 
971
{---------------------------------------------------------------------------}
 
972
CONSTRUCTOR TMenuBox.Init (Var Bounds: TRect; AMenu: PMenu;
 
973
  AParentMenu: PMenuView);
 
974
VAR W, H, L: Integer; S: String; P: PMenuItem; R: TRect;
 
975
BEGIN
 
976
   W := 0;                                            { Clear initial width }
 
977
   H := 2;                                            { Set initial height }
 
978
   If (AMenu <> Nil) Then Begin                       { Valid menu }
 
979
     P := AMenu^.Items;                               { Start on first item }
 
980
     While (P <> Nil) Do Begin                        { If item valid }
 
981
       If (P^.Name <> Nil) Then Begin                 { Check for name }
 
982
         S := ' ' + P^.Name^ + ' ';                   { Transfer string }
 
983
         If (P^.Command <> 0) AND (P^.Param <> Nil)
 
984
           Then S := S + ' - ' + P^.Param^;           { Add any parameter }
 
985
       End;
 
986
       L := CTextWidth(S);                             { Width of string }
 
987
       If (L > W) Then W := L;                        { Hold maximum }
 
988
       Inc(H);                                        { Inc count of items }
 
989
       P := P^.Next;                                  { Move to next item }
 
990
     End;
 
991
   End;
 
992
   W := 5 + W;                        { Longest text width }
 
993
   R.Copy(Bounds);                                    { Copy the bounds }
 
994
   If (R.A.X + W < R.B.X) Then R.B.X := R.A.X + W     { Shorten if possible }
 
995
     Else R.A.X := R.B.X - W;                         { Insufficent space }
 
996
   R.B.X := R.A.X + W;
 
997
   If (R.A.Y + H < R.B.Y) Then R.B.Y := R.A.Y + H     { Shorten if possible }
 
998
     Else R.A.Y := R.B.Y - H;                         { Insufficent height }
 
999
   Inherited Init(R);                                 { Call ancestor }
 
1000
   State := State OR sfShadow;                        { Set shadow state }
 
1001
   Options := Options OR ofFramed or ofPreProcess;                { View pre processes }
 
1002
   Menu := AMenu;                                     { Hold menu }
 
1003
   ParentMenu := AParentMenu;                         { Hold parent }
 
1004
END;
 
1005
 
 
1006
{--TMenuBox-----------------------------------------------------------------}
 
1007
{  Draw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 11May98 LdB              }
 
1008
{---------------------------------------------------------------------------}
 
1009
PROCEDURE TMenuBox.Draw;
 
1010
VAR CNormal, CSelect, CSelectDisabled, CDisabled, Color: Word; Index, Y: Integer;
 
1011
    S: String; P: PMenuItem; B: TDrawBuffer;
 
1012
Type
 
1013
   FrameLineType = (UpperLine,NormalLine,SeparationLine,LowerLine);
 
1014
   FrameLineChars = Array[0..2] of char;
 
1015
Const
 
1016
   FrameLines : Array[FrameLineType] of FrameLineChars =
 
1017
     ('�Ŀ','� �','�Ĵ','���');
 
1018
  Procedure CreateBorder(LineType : FrameLineType);
 
1019
  Begin
 
1020
    MoveChar(B, ' ', CNormal, 1);
 
1021
    MoveChar(B[1], FrameLines[LineType][0], CNormal, 1);
 
1022
    MoveChar(B[2], FrameLines[LineType][1], Color, Size.X-4);
 
1023
    MoveChar(B[Size.X-2], FrameLines[LineType][2], CNormal, 1);
 
1024
    MoveChar(B[Size.X-1], ' ', CNormal, 1);
 
1025
  End;
 
1026
 
 
1027
 
 
1028
BEGIN
 
1029
   CNormal := GetColor($0301);                        { Normal colour }
 
1030
   CSelect := GetColor($0604);                        { Selected colour }
 
1031
   CDisabled := GetColor($0202);                      { Disabled colour }
 
1032
   CSelectDisabled := GetColor($0505);                { Selected, but disabled }
 
1033
   Color := CNormal;                              { Normal colour }
 
1034
   CreateBorder(UpperLine);
 
1035
   WriteBuf(0, 0, Size.X, 1, B);                  { Write the line }
 
1036
   Y := 1;
 
1037
   If (Menu <> Nil) Then Begin                        { We have a menu }
 
1038
     P := Menu^.Items;                                { Start on first }
 
1039
     While (P <> Nil) Do Begin                        { Valid menu item }
 
1040
       Color := CNormal;                              { Normal colour }
 
1041
       If (P^.Name <> Nil) Then Begin                 { Item has text }
 
1042
         If P^.Disabled Then
 
1043
           begin
 
1044
             if (P = Current) then
 
1045
               Color := CSelectDisabled
 
1046
             else
 
1047
               Color := CDisabled; { Is item disabled }
 
1048
           end
 
1049
         else
 
1050
           If (P = Current) Then Color := CSelect;    { Select colour }
 
1051
         CreateBorder(NormalLine);
 
1052
         Index:=2;
 
1053
         S := ' ' + P^.Name^ + ' ';                   { Menu string }
 
1054
         MoveCStr(B[Index], S, Color);                { Transfer string }
 
1055
        if P^.Command = 0 then
 
1056
          MoveChar(B[Size.X - 4],SubMenuChar[LowAscii],
 
1057
            Byte(Color), 1) else
 
1058
         If (P^.Command <> 0) AND(P^.Param <> Nil) Then
 
1059
         Begin
 
1060
            MoveCStr(B[Size.X - 3 - Length(P^.Param^)], P^.Param^, Color);  { Add param chars }
 
1061
            S := S + ' - ' + P^.Param^;                { Add to string }
 
1062
         End;
 
1063
         If (OldItem = Nil) OR (OldItem = P) OR
 
1064
            (Current = P) Then
 
1065
           Begin                     { We need to fix draw }
 
1066
             WriteBuf(0, Y, Size.X, 1, B);             { Write the whole line }
 
1067
         End;
 
1068
       End Else Begin { no text NewLine }
 
1069
         Color := CNormal;                              { Normal colour }
 
1070
         CreateBorder(SeparationLine);
 
1071
         WriteBuf(0, Y, Size.X, 1, B);                { Write the line }
 
1072
       End;
 
1073
       Inc(Y);                                        { Next line down }
 
1074
       P := P^.Next;                                  { fetch next item }
 
1075
     End;
 
1076
   End;
 
1077
   Color := CNormal;                              { Normal colour }
 
1078
   CreateBorder(LowerLine);
 
1079
   WriteBuf(0, Size.Y-1, Size.X, 1, B);                  { Write the line }
 
1080
END;
 
1081
 
 
1082
 
 
1083
{--TMenuBox-----------------------------------------------------------------}
 
1084
{  GetItemRectX -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 11May98 LdB      }
 
1085
{---------------------------------------------------------------------------}
 
1086
PROCEDURE TMenuBox.GetItemRectX (Item: PMenuItem; Var R: TRect);
 
1087
VAR X, Y: Integer; P: PMenuItem;
 
1088
BEGIN
 
1089
   Y := 1;                                   { Initial y position }
 
1090
   P := Menu^.Items;                                  { Initial item }
 
1091
   While (P <> Item) Do Begin                         { Valid item }
 
1092
     Inc(Y);                              { Inc position }
 
1093
     P := P^.Next;                                    { Next item }
 
1094
   End;
 
1095
   X := 2;                                { Left/Right margin }
 
1096
   R.Assign(X, Y, Size.X - X, Y + 1);     { Assign area }
 
1097
END;
 
1098
 
 
1099
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
1100
{                        TMenuPopUp OBJECT METHODS                          }
 
1101
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
1102
 
 
1103
{--TMenuPopUp---------------------------------------------------------------}
 
1104
{  Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15May98 LdB              }
 
1105
{---------------------------------------------------------------------------}
 
1106
CONSTRUCTOR TMenuPopup.Init (Var Bounds: TRect; AMenu: PMenu);
 
1107
BEGIN
 
1108
   Inherited Init(Bounds, AMenu, Nil);                { Call ancestor }
 
1109
END;
 
1110
 
 
1111
{--TMenuPopUp---------------------------------------------------------------}
 
1112
{  Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15May98 LdB              }
 
1113
{---------------------------------------------------------------------------}
 
1114
DESTRUCTOR TMenuPopup.Done;
 
1115
BEGIN
 
1116
   If (Menu <> Nil) Then DisposeMenu(Menu);           { Dispose menu items }
 
1117
   Inherited Done;                                    { Call ancestor }
 
1118
END;
 
1119
 
 
1120
{--TMenuPopUp---------------------------------------------------------------}
 
1121
{  HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15May98 LdB       }
 
1122
{---------------------------------------------------------------------------}
 
1123
PROCEDURE TMenuPopup.HandleEvent (Var Event: TEvent);
 
1124
VAR P: PMenuItem;
 
1125
BEGIN
 
1126
   Case Event.What Of
 
1127
     evKeyDown: Begin
 
1128
         P := FindItem(GetCtrlChar(Event.KeyCode));   { Find the item }
 
1129
         If (P = Nil) Then P := HotKey(Event.KeyCode);{ Try hot key }
 
1130
         If (P <> Nil) AND (CommandEnabled(P^.Command))
 
1131
         Then Begin                                   { Command valid }
 
1132
           Event.What := evCommand;                   { Command event }
 
1133
           Event.Command := P^.Command;               { Set command value }
 
1134
           Event.InfoPtr := Nil;                      { Clear info ptr }
 
1135
           PutEvent(Event);                           { Put event on queue }
 
1136
           ClearEvent(Event);                         { Clear the event }
 
1137
         End Else If (GetAltChar(Event.KeyCode) <> #0)
 
1138
           Then ClearEvent(Event);                    { Clear the event }
 
1139
       End;
 
1140
   End;
 
1141
   Inherited HandleEvent(Event);                      { Call ancestor }
 
1142
END;
 
1143
 
 
1144
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
1145
{                        TStatusLine OBJECT METHODS                         }
 
1146
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
1147
 
 
1148
{--TStatusLine--------------------------------------------------------------}
 
1149
{  Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 11May98 LdB              }
 
1150
{---------------------------------------------------------------------------}
 
1151
CONSTRUCTOR TStatusLine.Init (Var Bounds: TRect; ADefs: PStatusDef);
 
1152
BEGIN
 
1153
   Inherited Init(Bounds);                            { Call ancestor }
 
1154
   Options := Options OR ofPreProcess;                { Pre processing view }
 
1155
   EventMask := EventMask OR evBroadcast;             { See broadcasts }
 
1156
   GrowMode := gfGrowLoY + gfGrowHiX + gfGrowHiY;     { Set grow modes }
 
1157
   Defs := ADefs;                                     { Set default items }
 
1158
   FindItems;                                         { Find the items }
 
1159
END;
 
1160
 
 
1161
{--TStatusLine--------------------------------------------------------------}
 
1162
{  Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 11May98 LdB              }
 
1163
{---------------------------------------------------------------------------}
 
1164
CONSTRUCTOR TStatusLine.Load (Var S: TStream);
 
1165
 
 
1166
   FUNCTION DoLoadStatusItems: PStatusItem;
 
1167
   VAR Count: Integer; Cur, First: PStatusItem; Last: ^PStatusItem;
 
1168
   BEGIN
 
1169
     Cur := Nil;                                      { Preset nil }
 
1170
     Last := @First;                                  { Start on first item }
 
1171
     S.Read(Count, SizeOf(Count));                    { Read count }
 
1172
     While (Count > 0) Do Begin
 
1173
       New(Cur);                                      { New status item }
 
1174
       Last^ := Cur;                                  { First chain part }
 
1175
       If (Cur <> Nil) Then Begin                     { Check pointer valid }
 
1176
         Last := @Cur^.Next;                          { Chain complete }
 
1177
         Cur^.Text := S.ReadStr;                      { Read item text }
 
1178
         S.Read(Cur^.KeyCode, SizeOf(Cur^.KeyCode));  { Keycode of item }
 
1179
         S.Read(Cur^.Command, SizeOf(Cur^.Command));  { Command of item }
 
1180
       End;
 
1181
       Dec(Count);                                    { One item loaded }
 
1182
     End;
 
1183
     Last^ := Nil;                                    { Now chain end }
 
1184
     DoLoadStatusItems := First;                      { Return the list }
 
1185
   END;
 
1186
 
 
1187
   FUNCTION DoLoadStatusDefs: PStatusDef;
 
1188
   VAR Count: Integer; Cur, First: PStatusDef; Last: ^PStatusDef;
 
1189
   BEGIN
 
1190
     Last := @First;                                  { Start on first }
 
1191
     S.Read(Count, SizeOf(Count));                    { Read item count }
 
1192
     While (Count > 0) Do Begin
 
1193
       New(Cur);                                      { New status def }
 
1194
       Last^ := Cur;                                  { First part of chain }
 
1195
       If (Cur <> Nil) Then Begin                     { Check pointer valid }
 
1196
         Last := @Cur^.Next;                          { Chain complete }
 
1197
         S.Read(Cur^.Min, SizeOf(Cur^.Min));          { Read min data }
 
1198
         S.Read(Cur^.Max, SizeOf(Cur^.Max));          { Read max data }
 
1199
         Cur^.Items := DoLoadStatusItems;             { Set pointer }
 
1200
       End;
 
1201
       Dec(Count);                                    { One item loaded }
 
1202
     End;
 
1203
     Last^ := Nil;                                    { Now chain ends }
 
1204
     DoLoadStatusDefs := First;                       { Return item list }
 
1205
   END;
 
1206
 
 
1207
BEGIN
 
1208
   Inherited Load(S);                                 { Call ancestor }
 
1209
   Defs := DoLoadStatusDefs;                          { Retreive items }
 
1210
   FindItems;                                         { Find the items }
 
1211
END;
 
1212
 
 
1213
{--TStatusLine--------------------------------------------------------------}
 
1214
{  Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 11May98 LdB              }
 
1215
{---------------------------------------------------------------------------}
 
1216
DESTRUCTOR TStatusLine.Done;
 
1217
VAR T: PStatusDef;
 
1218
 
 
1219
   PROCEDURE DisposeItems (Item: PStatusItem);
 
1220
   VAR T: PStatusItem;
 
1221
   BEGIN
 
1222
     While (Item <> Nil) Do Begin                     { Item to dispose }
 
1223
       T := Item;                                     { Hold pointer }
 
1224
       Item := Item^.Next;                            { Move down chain }
 
1225
       DisposeStr(T^.Text);                           { Dispose string }
 
1226
       Dispose(T);                                    { Dispose item }
 
1227
     End;
 
1228
   END;
 
1229
 
 
1230
BEGIN
 
1231
   While (Defs <> Nil) Do Begin
 
1232
     T := Defs;                                       { Hold pointer }
 
1233
     Defs := Defs^.Next;                              { Move down chain }
 
1234
     DisposeItems(T^.Items);                          { Dispose the item }
 
1235
     Dispose(T);                                      { Dispose status item }
 
1236
   End;
 
1237
   Inherited Done;                                    { Call ancestor }
 
1238
END;
 
1239
 
 
1240
 
 
1241
{--TStatusLine--------------------------------------------------------------}
 
1242
{  GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 11May98 LdB        }
 
1243
{---------------------------------------------------------------------------}
 
1244
FUNCTION TStatusLine.GetPalette: PPalette;
 
1245
{$IFDEF PPC_DELPHI3}                                  { DELPHI3+ COMPILER }
 
1246
CONST P: String = CStatusLine;                        { Possible huge string }
 
1247
{$ELSE}                                               { OTHER COMPILERS }
 
1248
CONST P: String[Length(CStatusLine)] = CStatusLine;   { Always normal string }
 
1249
{$ENDIF}
 
1250
BEGIN
 
1251
   GetPalette := @P;                                  { Return palette }
 
1252
END;
 
1253
 
 
1254
{--TStatusLine--------------------------------------------------------------}
 
1255
{  Hint -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 11May98 LdB              }
 
1256
{---------------------------------------------------------------------------}
 
1257
FUNCTION TStatusLine.Hint (AHelpCtx: Word): String;
 
1258
BEGIN
 
1259
   Hint := '';                                        { Return nothing }
 
1260
END;
 
1261
 
 
1262
{--TStatusLine--------------------------------------------------------------}
 
1263
{  Draw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 11May98 LdB              }
 
1264
{---------------------------------------------------------------------------}
 
1265
PROCEDURE TStatusLine.Draw;
 
1266
BEGIN
 
1267
   DrawSelect(Nil);                                   { Call draw select }
 
1268
END;
 
1269
 
 
1270
{--TStatusLine--------------------------------------------------------------}
 
1271
{  Update -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15May98 LdB            }
 
1272
{---------------------------------------------------------------------------}
 
1273
PROCEDURE TStatusLine.Update;
 
1274
VAR H: Word; P: PView;
 
1275
BEGIN
 
1276
   P := TopView;                                      { Get topmost view }
 
1277
   If (P <> Nil) Then H := P^.GetHelpCtx Else         { Top views context }
 
1278
     H := hcNoContext;                                { No context }
 
1279
   If (HelpCtx <> H) Then Begin                       { Differs from last }
 
1280
     HelpCtx := H;                                    { Hold new context }
 
1281
     FindItems;                                       { Find the item }
 
1282
     DrawView;                                        { Redraw the view }
 
1283
   End;
 
1284
END;
 
1285
 
 
1286
{--TStatusLine--------------------------------------------------------------}
 
1287
{  Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 11May98 LdB             }
 
1288
{---------------------------------------------------------------------------}
 
1289
PROCEDURE TStatusLine.Store (Var S: TStream);
 
1290
 
 
1291
   PROCEDURE DoStoreStatusItems (Cur: PStatusItem);
 
1292
   VAR Count: Integer; T: PStatusItem;
 
1293
   BEGIN
 
1294
     Count := 0;                                      { Clear count }
 
1295
     T := Cur;                                        { Start on current }
 
1296
     While (T <> Nil) Do Begin
 
1297
       Inc(Count);                                    { Count items }
 
1298
       T := T^.Next;                                  { Next item }
 
1299
     End;
 
1300
     S.Write(Count, SizeOf(Count));                   { Write item count }
 
1301
     While (Cur <> Nil) Do Begin
 
1302
       S.WriteStr(Cur^.Text);                         { Store item text }
 
1303
       S.Write(Cur^.KeyCode, SizeOf(Cur^.KeyCode));   { Keycode of item }
 
1304
       S.Write(Cur^.Command, SizeOf(Cur^.Command));   { Command of item }
 
1305
       Cur := Cur^.Next;                              { Move to next item }
 
1306
     End;
 
1307
   END;
 
1308
 
 
1309
   PROCEDURE DoStoreStatusDefs (Cur: PStatusDef);
 
1310
   VAR Count: Integer; T: PStatusDef;
 
1311
   BEGIN
 
1312
     Count := 0;                                      { Clear count }
 
1313
     T := Cur;                                        { Current status item }
 
1314
     While (T <> Nil) Do Begin
 
1315
       Inc(Count);                                    { Count items }
 
1316
       T := T^.Next                                   { Next item }
 
1317
     End;
 
1318
     S.Write(Count, 2);                               { Write item count }
 
1319
     While (Cur <> Nil) Do Begin
 
1320
       With Cur^ Do Begin
 
1321
         S.Write(Cur^.Min, 2);                        { Write min data }
 
1322
         S.Write(Cur^.Max, 2);                        { Write max data }
 
1323
         DoStoreStatusItems(Items);                   { Store the items }
 
1324
       End;
 
1325
       Cur := Cur^.Next;                              { Next status item }
 
1326
     End;
 
1327
   END;
 
1328
 
 
1329
BEGIN
 
1330
   TView.Store(S);                                    { TView.Store called }
 
1331
   DoStoreStatusDefs(Defs);                           { Store status items }
 
1332
END;
 
1333
 
 
1334
{--TStatusLine--------------------------------------------------------------}
 
1335
{  HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 11May98 LdB       }
 
1336
{---------------------------------------------------------------------------}
 
1337
PROCEDURE TStatusLine.HandleEvent (Var Event: TEvent);
 
1338
VAR Mouse: TPoint; T, Tt: PStatusItem;
 
1339
 
 
1340
   FUNCTION ItemMouseIsIn: PStatusItem;
 
1341
   VAR X, Xi: Word; T: PStatusItem;
 
1342
   BEGIN
 
1343
     ItemMouseIsIn := Nil;                            { Preset fail }
 
1344
     If (Mouse.Y < 0) OR (Mouse.Y > 1)       { Outside view height }
 
1345
       Then Exit;                                     { Not in view exit }
 
1346
     X := 0;                                          { Zero x position }
 
1347
     T := Items;                                      { Start at first item }
 
1348
     While (T <> Nil) Do Begin                        { While item valid }
 
1349
       If (T^.Text <> Nil) Then Begin                 { Check valid text }
 
1350
         Xi := X;                                     { Hold initial x value }
 
1351
         X := Xi + CTextWidth(' ' + T^.Text^ + ' ');   { Add text width }
 
1352
         If (Mouse.X >= Xi) AND (Mouse.X < X)
 
1353
         Then Begin
 
1354
           ItemMouseIsIn := T;                        { Selected item }
 
1355
           Exit;                                      { Now exit }
 
1356
         End;
 
1357
       End;
 
1358
       T := T^.Next;                                  { Next item }
 
1359
     End;
 
1360
   END;
 
1361
 
 
1362
BEGIN
 
1363
   Inherited HandleEvent(Event);                      { Call ancestor }
 
1364
   Case Event.What Of
 
1365
     evMouseDown: Begin
 
1366
         T := Nil;                                    { Preset ptr to nil }
 
1367
         Repeat
 
1368
           Mouse.X := Event.Where.X - Origin.X;    { Local x position }
 
1369
           Mouse.Y := Event.Where.Y - Origin.Y;    { Local y position }
 
1370
           Tt := ItemMouseIsIn;                       { Find selected item }
 
1371
           If (T <> Tt) Then                          { Item has changed }
 
1372
             DrawSelect(Tt);                          { Draw new item }
 
1373
           T := Tt                                    { Transfer item }
 
1374
         Until NOT MouseEvent(Event, evMouseMove);    { Mouse stopped moving }
 
1375
         If (T <> Nil) AND CommandEnabled(T^.Command) { Check cmd enabled }
 
1376
         Then Begin
 
1377
           Event.What := evCommand;                   { Command event }
 
1378
           Event.Command := T^.Command;               { Set command value }
 
1379
           Event.InfoPtr := Nil;                      { No info ptr }
 
1380
           PutEvent(Event);                           { Put event on queue }
 
1381
         End;
 
1382
         ClearEvent(Event);                           { Clear the event }
 
1383
         DrawSelect(Nil);                             { Clear the highlight }
 
1384
       End;
 
1385
     evKeyDown: Begin                                 { Key down event }
 
1386
         T := Items;                                  { Start on first item }
 
1387
         While (T <> Nil) Do Begin                    { For each valid item }
 
1388
           If (Event.KeyCode = T^.KeyCode) AND        { Check for hot key }
 
1389
           CommandEnabled(T^.Command) Then Begin      { Check cmd enabled }
 
1390
             Event.What := evCommand;                 { Change to command }
 
1391
             Event.Command := T^.Command;             { Set command value }
 
1392
             Event.InfoPtr := Nil;                    { Clear info ptr }
 
1393
             Exit;                                    { Now exit }
 
1394
           End;
 
1395
           T := T^.Next;                              { Next item }
 
1396
         End;
 
1397
       End;
 
1398
     evBroadcast:
 
1399
       If (Event.Command = cmCommandSetChanged) Then  { Command set change }
 
1400
         DrawView;                                    { Redraw view }
 
1401
   End;
 
1402
END;
 
1403
 
 
1404
{***************************************************************************}
 
1405
{                    TStatusLine OBJECT PRIVATE METHODS                     }
 
1406
{***************************************************************************}
 
1407
 
 
1408
{--TStatusLine--------------------------------------------------------------}
 
1409
{  FindItems -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 11May98 LdB         }
 
1410
{---------------------------------------------------------------------------}
 
1411
PROCEDURE TStatusLine.FindItems;
 
1412
VAR P: PStatusDef;
 
1413
BEGIN
 
1414
   P := Defs;                                         { First status item }
 
1415
   While (P <> Nil) AND ((HelpCtx < P^.Min) OR
 
1416
   (HelpCtx > P^.Max)) Do P := P^.Next;               { Find status item }
 
1417
   If (P = Nil) Then Items := Nil Else
 
1418
     Items := P^.Items;                               { Return found item }
 
1419
END;
 
1420
 
 
1421
{--TStatusLine--------------------------------------------------------------}
 
1422
{  DrawSelect -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 11May98 LdB        }
 
1423
{---------------------------------------------------------------------------}
 
1424
PROCEDURE TStatusLine.DrawSelect (Selected: PStatusItem);
 
1425
VAR I, L: Integer; Color, CSelect, CNormal, CSelDisabled, CNormDisabled: Word;
 
1426
    HintBuf: String; B: TDrawBuffer; T: PStatusItem;
 
1427
BEGIN
 
1428
   CNormal := GetColor($0301);                        { Normal colour }
 
1429
   CSelect := GetColor($0604);                        { Select colour }
 
1430
   CNormDisabled := GetColor($0202);                  { Disabled colour }
 
1431
   CSelDisabled := GetColor($0505);                   { Select disabled }
 
1432
   MoveChar(B, ' ', Byte(CNormal), Size.X);      { Clear the buffer }
 
1433
   T := Items;                                        { First item }
 
1434
   I := 0;                                            { Clear the count }
 
1435
   L := 0;
 
1436
   While (T <> Nil) Do Begin                          { While valid item }
 
1437
     If (T^.Text <> Nil) Then Begin                   { While valid text }
 
1438
       L := CStrLen(' '+T^.Text^+' ');                { Text length }
 
1439
       If CommandEnabled(T^.Command) Then Begin       { Command enabled }
 
1440
         If T = Selected Then Color := CSelect        { Selected colour }
 
1441
           Else Color := CNormal                      { Normal colour }
 
1442
       End Else
 
1443
         If T = Selected Then Color := CSelDisabled   { Selected disabled }
 
1444
           Else Color := CNormDisabled;               { Disabled colour }
 
1445
       MoveCStr(B[I], ' '+T^.Text^+' ', Color);       { Move text to buf }
 
1446
       Inc(I, L);                                     { Advance position }
 
1447
     End;
 
1448
     T := T^.Next;                                    { Next item }
 
1449
   End;
 
1450
   HintBuf := Hint(HelpCtx);                          { Get hint string }
 
1451
   If (HintBuf <> '') Then Begin                      { Hint present }
 
1452
     {$IFNDEF OS_WINDOWS}
 
1453
     MoveChar(B[I], #179, Byte(CNormal), 1);          { '|' char to buffer }
 
1454
     {$ELSE}
 
1455
     MoveChar(B[I], #166, Byte(CNormal), 1);          { '|' char to buffer }
 
1456
     {$ENDIF}
 
1457
     Inc(I, 2);                                       { Move along }
 
1458
     MoveStr(B[I], HintBuf, Byte(CNormal));           { Move hint to buffer }
 
1459
     I := I + Length(HintBuf);                        { Hint length }
 
1460
   End;
 
1461
   WriteLine(0, 0, Size.X, 1, B);                          { Write the buffer }
 
1462
END;
 
1463
 
 
1464
{***************************************************************************}
 
1465
{                            INTERFACE ROUTINES                             }
 
1466
{***************************************************************************}
 
1467
 
 
1468
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
1469
{                           MENU INTERFACE ROUTINES                         }
 
1470
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
1471
 
 
1472
{---------------------------------------------------------------------------}
 
1473
{  NewMenu -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 14May98 LdB           }
 
1474
{---------------------------------------------------------------------------}
 
1475
FUNCTION NewMenu (Items: PMenuItem): PMenu;
 
1476
VAR P: PMenu;
 
1477
BEGIN
 
1478
   New(P);                                            { Create new menu }
 
1479
   FillChar(P^,sizeof(TMenu),0);
 
1480
   If (P <> Nil) Then Begin                           { Check valid pointer }
 
1481
     P^.Items := Items;                               { Hold item list }
 
1482
     P^.Default := Items;                             { Set default item }
 
1483
   End;
 
1484
   NewMenu := P;                                      { Return menu }
 
1485
END;
 
1486
 
 
1487
{---------------------------------------------------------------------------}
 
1488
{  DisposeMenu -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 14May98 LdB       }
 
1489
{---------------------------------------------------------------------------}
 
1490
PROCEDURE DisposeMenu (Menu: PMenu);
 
1491
VAR P, Q: PMenuItem;
 
1492
BEGIN
 
1493
   If (Menu <> Nil) Then Begin                        { Valid menu item }
 
1494
     P := Menu^.Items;                                { First item in list }
 
1495
     While (P <> Nil) Do Begin                        { Item is valid }
 
1496
       If (P^.Name <> Nil) Then Begin                 { Valid name pointer }
 
1497
         DisposeStr(P^.Name);                         { Dispose of name }
 
1498
         If (P^.Command <> 0) Then
 
1499
           DisposeStr(P^.Param) Else                  { Dispose parameter }
 
1500
           DisposeMenu(P^.SubMenu);                   { Dispose submenu }
 
1501
       End;
 
1502
       Q := P;                                        { Hold pointer }
 
1503
       P := P^.Next;                                  { Move to next item }
 
1504
       Dispose(Q);                                    { Dispose of item }
 
1505
     End;
 
1506
     Dispose(Menu);                                   { Dispose of menu }
 
1507
   End;
 
1508
END;
 
1509
 
 
1510
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
1511
{                             MENU ITEM ROUTINES                            }
 
1512
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
1513
 
 
1514
{---------------------------------------------------------------------------}
 
1515
{  NewLine -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 14May98 LdB           }
 
1516
{---------------------------------------------------------------------------}
 
1517
FUNCTION NewLine (Next: PMenuItem): PMenuItem;
 
1518
VAR P: PMenuItem;
 
1519
BEGIN
 
1520
   New(P);                                            { Allocate memory }
 
1521
   FillChar(P^,sizeof(TMenuItem),0);
 
1522
   If (P <> Nil) Then Begin                           { Check valid pointer }
 
1523
     P^.Next := Next;                                 { Hold next menu item }
 
1524
   End;
 
1525
   NewLine := P;                                      { Return new line }
 
1526
END;
 
1527
 
 
1528
{---------------------------------------------------------------------------}
 
1529
{  NewItem -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 14May98 LdB           }
 
1530
{---------------------------------------------------------------------------}
 
1531
FUNCTION NewItem (Name, Param: TMenuStr; KeyCode: Word; Command: Word;
 
1532
  AHelpCtx: Word; Next: PMenuItem): PMenuItem;
 
1533
VAR P: PMenuItem; R: TRect; T: PView;
 
1534
BEGIN
 
1535
   If (Name <> '') AND (Command <> 0) Then Begin
 
1536
     New(P);                                          { Allocate memory }
 
1537
     FillChar(P^,sizeof(TMenuItem),0);
 
1538
     If (P <> Nil) Then Begin                         { Check valid pointer }
 
1539
       P^.Next := Next;                               { Hold next item }
 
1540
       P^.Name := NewStr(Name);                       { Hold item name }
 
1541
       P^.Command := Command;                         { Hold item command }
 
1542
       R.Assign(1, 1, 10, 10);                        { Random assignment }
 
1543
       T := New(PView, Init(R));                      { Create a view }
 
1544
       If (T <> Nil) Then Begin
 
1545
         P^.Disabled := NOT T^.CommandEnabled(Command);
 
1546
         Dispose(T, Done);                            { Dispose of view }
 
1547
       End Else P^.Disabled := True;
 
1548
       P^.KeyCode := KeyCode;                         { Hold item keycode }
 
1549
       P^.HelpCtx := AHelpCtx;                        { Hold help context }
 
1550
       P^.Param := NewStr(Param);                     { Hold parameter }
 
1551
     End;
 
1552
     NewItem := P;                                    { Return item }
 
1553
   End Else NewItem := Next;                          { Move forward }
 
1554
END;
 
1555
 
 
1556
{---------------------------------------------------------------------------}
 
1557
{  NewSubMenu -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 14May98 LdB        }
 
1558
{---------------------------------------------------------------------------}
 
1559
FUNCTION NewSubMenu (Name: TMenuStr; AHelpCtx: Word; SubMenu: PMenu;
 
1560
  Next: PMenuItem): PMenuItem;
 
1561
VAR P: PMenuItem;
 
1562
BEGIN
 
1563
   If (Name <> '') AND (SubMenu <> Nil) Then Begin
 
1564
     New(P);                                          { Allocate memory }
 
1565
     FillChar(P^,sizeof(TMenuItem),0);
 
1566
     If (P <> Nil) Then Begin                         { Check valid pointer }
 
1567
       P^.Next := Next;                               { Hold next item }
 
1568
       P^.Name := NewStr(Name);                       { Hold submenu name }
 
1569
       P^.HelpCtx := AHelpCtx;                        { Set help context }
 
1570
       P^.SubMenu := SubMenu;                         { Hold next submenu }
 
1571
     End;
 
1572
     NewSubMenu := P;                                 { Return submenu }
 
1573
   End Else NewSubMenu := Next;                       { Return next item }
 
1574
END;
 
1575
 
 
1576
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
1577
{                          STATUS INTERFACE ROUTINES                        }
 
1578
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
1579
 
 
1580
{---------------------------------------------------------------------------}
 
1581
{  NewStatusDef -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15May98 LdB      }
 
1582
{---------------------------------------------------------------------------}
 
1583
FUNCTION NewStatusDef (AMin, AMax: Word; AItems: PStatusItem;
 
1584
ANext:PStatusDef): PStatusDef;
 
1585
VAR T: PStatusDef;
 
1586
BEGIN
 
1587
   New(T);                                            { Allocate memory }
 
1588
   If (T <> Nil) Then Begin                           { Check valid pointer }
 
1589
     T^.Next := ANext;                                { Set next item }
 
1590
     T^.Min := AMin;                                  { Hold min value }
 
1591
     T^.Max := AMax;                                  { Hold max value }
 
1592
     T^.Items := AItems;                              { Hold item list }
 
1593
   End;
 
1594
   NewStatusDef := T;                                 { Return status }
 
1595
END;
 
1596
 
 
1597
{---------------------------------------------------------------------------}
 
1598
{  NewStatusKey -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15May98 LdB      }
 
1599
{---------------------------------------------------------------------------}
 
1600
FUNCTION NewStatusKey (AText: String; AKeyCode: Word; ACommand: Word;
 
1601
  ANext: PStatusItem): PStatusItem;
 
1602
VAR T: PStatusItem;
 
1603
BEGIN
 
1604
   New(T);                                            { Allocate memory }
 
1605
   If (T <> Nil) Then Begin                           { Check valid pointer }
 
1606
     T^.Text := NewStr(AText);                        { Hold text string }
 
1607
     T^.KeyCode := AKeyCode;                          { Hold keycode }
 
1608
     T^.Command := ACommand;                          { Hold command }
 
1609
     T^.Next := ANext;                                { Pointer to next }
 
1610
   End;
 
1611
   NewStatusKey := T;                                 { Return status item }
 
1612
END;
 
1613
 
 
1614
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
1615
{                           OBJECT REGISTER ROUTINES                        }
 
1616
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
 
1617
 
 
1618
{---------------------------------------------------------------------------}
 
1619
{  RegisterMenus -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 15May98 LdB     }
 
1620
{---------------------------------------------------------------------------}
 
1621
PROCEDURE RegisterMenus;
 
1622
BEGIN
 
1623
   RegisterType(RMenuBar);                            { Register bar menu }
 
1624
   RegisterType(RMenuBox);                            { Register menu box }
 
1625
   RegisterType(RStatusLine);                         { Register status line }
 
1626
   RegisterType(RMenuPopup);                          { Register popup menu }
 
1627
END;
 
1628
 
 
1629
END.
 
1630
{
 
1631
 $Log: menus.pas,v $
 
1632
 Revision 1.24  2005/02/14 17:13:18  peter
 
1633
   * truncate log
 
1634
 
 
1635
}