1
{ $Id: dialogs.pas,v 1.34 2005/03/06 21:31:15 florian Exp $ }
2
{********[ SOURCE FILE OF GRAPHICAL FREE VISION ]**********}
4
{ System independent GRAPHICAL clone of DIALOGS.PAS }
6
{ Interface Copyright (c) 1992 Borland International }
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 }
12
{****************[ THIS CODE IS FREEWARE ]*****************}
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 }
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. }
23
{*****************[ SUPPORTED PLATFORMS ]******************}
25
{ Only Free Pascal Compiler supported }
27
{**********************************************************}
31
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
33
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
35
{====Include file to sort compiler platform out =====================}
37
{====================================================================}
39
{==== Compiler directives ===========================================}
42
{$X+} { Extended syntax is ok }
43
{$R-} { Disable range checking }
44
{$S-} { Disable Stack Checking }
45
{$I-} { Disable IO Checking }
46
{$Q-} { Disable Overflow Checking }
47
{$V-} { Turn off strict VAR strings }
48
{====================================================================}
51
{$IFDEF OS_WINDOWS} { WIN/NT CODE }
52
Windows, { Standard units }
55
{$IFDEF OS_OS2} { OS2 CODE }
56
OS2Def, DosCalls, PMWIN, { Standard units }
59
FVCommon, FVConsts, Objects, Drivers, Views, Validate; { Standard GFV units }
61
{***************************************************************************}
63
{***************************************************************************}
65
{---------------------------------------------------------------------------}
66
{ COLOUR PALETTE DEFINITIONS }
67
{---------------------------------------------------------------------------}
69
CGrayDialog = #32#33#34#35#36#37#38#39#40#41#42#43#44#45#46#47 +
70
#48#49#50#51#52#53#54#55#56#57#58#59#60#61#62#63;
71
CBlueDialog = #64#65#66#67#68#69#70#71#72#73#74#75#76#77#78#79 +
72
#80#81#82#83#84#85#86#87#88#89#90#91#92#92#94#95;
73
CCyanDialog = #96#97#98#99#100#101#102#103#104#105#106#107#108 +
74
#109#110#111#112#113#114#115#116#117#118#119#120 +
75
#121#122#123#124#125#126#127;
76
CStaticText = #6#7#8#9;
78
CButton = #10#11#12#13#14#14#14#15;
79
CCluster = #16#17#18#18#31#6;
80
CInputLine = #19#19#20#21#14;
82
CHistoryWindow = #19#19#21#24#25#19#20;
83
CHistoryViewer = #6#6#7#6#6;
85
CDialog = CGrayDialog; { Default palette }
93
ldNewEditDelete = ldNew or ldEdit or ldDelete;
95
ldAllButtons = ldNew or ldEdit or ldDelete or ldHelp;
99
ldAllIcons = ldNewIcon or ldEditIcon or ldDeleteIcon;
100
ldAll = ldAllIcons or ldAllButtons;
102
ldNoScrollBar = $0100;
108
ofNewEditDelete = ofNew or ofDelete or ofEdit;
110
{---------------------------------------------------------------------------}
111
{ TDialog PALETTE COLOUR CONSTANTS }
112
{---------------------------------------------------------------------------}
114
dpBlueDialog = 0; { Blue dialog colour }
115
dpCyanDialog = 1; { Cyan dialog colour }
116
dpGrayDialog = 2; { Gray dialog colour }
118
{---------------------------------------------------------------------------}
119
{ TButton FLAGS MASKS }
120
{---------------------------------------------------------------------------}
122
bfNormal = $00; { Normal displayed }
123
bfDefault = $01; { Default command }
124
bfLeftJust = $02; { Left just text }
125
bfBroadcast = $04; { Broadcast command }
126
bfGrabFocus = $08; { Grab focus }
128
{---------------------------------------------------------------------------}
129
{ TMultiCheckBoxes FLAGS - (HiByte = Bits LoByte = Mask) }
130
{---------------------------------------------------------------------------}
132
cfOneBit = $0101; { One bit masks }
133
cfTwoBits = $0203; { Two bit masks }
134
cfFourBits = $040F; { Four bit masks }
135
cfEightBits = $08FF; { Eight bit masks }
137
{---------------------------------------------------------------------------}
138
{ DIALOG BROADCAST COMMANDS }
139
{---------------------------------------------------------------------------}
141
cmRecordHistory = 60; { Record history cmd }
143
{***************************************************************************}
144
{ RECORD DEFINITIONS }
145
{***************************************************************************}
147
{---------------------------------------------------------------------------}
148
{ ITEM RECORD DEFINITION }
149
{---------------------------------------------------------------------------}
153
Value: PString; { Item string }
154
Next: PSItem; { Next item }
157
{***************************************************************************}
158
{ OBJECT DEFINITIONS }
159
{***************************************************************************}
161
{---------------------------------------------------------------------------}
162
{ TInputLine OBJECT - INPUT LINE OBJECT }
163
{---------------------------------------------------------------------------}
165
TInputLine = OBJECT (TView)
166
MaxLen: Sw_Integer; { Max input length }
167
CurPos: Sw_Integer; { Cursor position }
168
FirstPos: Sw_Integer; { First position }
169
SelStart: Sw_Integer; { Selected start }
170
SelEnd: Sw_Integer; { Selected end }
171
Data: PString; { Input line data }
172
Validator: PValidator; { Validator of view }
173
CONSTRUCTOR Init (Var Bounds: TRect; AMaxLen: Sw_Integer);
174
CONSTRUCTOR Load (Var S: TStream);
175
DESTRUCTOR Done; Virtual;
176
FUNCTION DataSize: Sw_Word; Virtual;
177
FUNCTION GetPalette: PPalette; Virtual;
178
FUNCTION Valid (Command: Word): Boolean; Virtual;
179
PROCEDURE Draw; Virtual;
180
PROCEDURE DrawCursor; Virtual;
181
PROCEDURE SelectAll (Enable: Boolean);
182
PROCEDURE SetValidator (AValid: PValidator);
183
PROCEDURE SetState (AState: Word; Enable: Boolean); Virtual;
184
PROCEDURE GetData (Var Rec); Virtual;
185
PROCEDURE SetData (Var Rec); Virtual;
186
PROCEDURE Store (Var S: TStream);
187
PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
189
FUNCTION CanScroll (Delta: Sw_Integer): Boolean;
191
PInputLine = ^TInputLine;
193
{---------------------------------------------------------------------------}
194
{ TButton OBJECT - BUTTON ANCESTOR OBJECT }
195
{---------------------------------------------------------------------------}
197
TButton = OBJECT (TView)
198
AmDefault: Boolean; { If default button }
199
Flags : Byte; { Button flags }
200
Command : Word; { Button command }
201
Title : PString; { Button title }
202
CONSTRUCTOR Init (Var Bounds: TRect; ATitle: TTitleStr; ACommand: Word;
204
CONSTRUCTOR Load (Var S: TStream);
205
DESTRUCTOR Done; Virtual;
206
FUNCTION GetPalette: PPalette; Virtual;
207
PROCEDURE Press; Virtual;
208
PROCEDURE Draw; Virtual;
209
PROCEDURE DrawState (Down: Boolean);
210
PROCEDURE MakeDefault (Enable: Boolean);
211
PROCEDURE SetState (AState: Word; Enable: Boolean); Virtual;
212
PROCEDURE Store (Var S: TStream);
213
PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
219
{---------------------------------------------------------------------------}
220
{ TCluster OBJECT - CLUSTER ANCESTOR OBJECT }
221
{---------------------------------------------------------------------------}
225
{ 2 = Selected text }
226
{ 3 = Normal shortcut }
227
{ 4 = Selected shortcut }
228
{ 5 = Disabled text }
230
TCluster = OBJECT (TView)
231
Id : Sw_Integer; { New communicate id }
232
Sel : Sw_Integer; { Selected item }
233
Value : LongInt; { Bit value }
234
EnableMask: LongInt; { Mask enable bits }
235
Strings : TStringCollection; { String collection }
236
CONSTRUCTOR Init (Var Bounds: TRect; AStrings: PSItem);
237
CONSTRUCTOR Load (Var S: TStream);
238
DESTRUCTOR Done; Virtual;
239
FUNCTION DataSize: Sw_Word; Virtual;
240
FUNCTION GetHelpCtx: Word; Virtual;
241
FUNCTION GetPalette: PPalette; Virtual;
242
FUNCTION Mark (Item: Sw_Integer): Boolean; Virtual;
243
FUNCTION MultiMark (Item: Sw_Integer): Byte; Virtual;
244
FUNCTION ButtonState (Item: Sw_Integer): Boolean;
245
PROCEDURE Draw; Virtual;
246
PROCEDURE Press (Item: Sw_Integer); Virtual;
247
PROCEDURE MovedTo (Item: Sw_Integer); Virtual;
248
PROCEDURE SetState (AState: Word; Enable: Boolean); Virtual;
249
PROCEDURE DrawMultiBox (Const Icon, Marker: String);
250
PROCEDURE DrawBox (Const Icon: String; Marker: Char);
251
PROCEDURE SetButtonState (AMask: Longint; Enable: Boolean);
252
PROCEDURE GetData (Var Rec); Virtual;
253
PROCEDURE SetData (Var Rec); Virtual;
254
PROCEDURE Store (Var S: TStream);
255
PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
257
FUNCTION FindSel (P: TPoint): Sw_Integer;
258
FUNCTION Row (Item: Sw_Integer): Sw_Integer;
259
FUNCTION Column (Item: Sw_Integer): Sw_Integer;
261
PCluster = ^TCluster;
263
{---------------------------------------------------------------------------}
264
{ TRadioButtons OBJECT - RADIO BUTTON OBJECT }
265
{---------------------------------------------------------------------------}
269
{ 2 = Selected text }
270
{ 3 = Normal shortcut }
271
{ 4 = Selected shortcut }
275
TRadioButtons = OBJECT (TCluster)
276
FUNCTION Mark (Item: Sw_Integer): Boolean; Virtual;
277
PROCEDURE Draw; Virtual;
278
PROCEDURE Press (Item: Sw_Integer); Virtual;
279
PROCEDURE MovedTo(Item: Sw_Integer); Virtual;
280
PROCEDURE SetData (Var Rec); Virtual;
282
PRadioButtons = ^TRadioButtons;
284
{---------------------------------------------------------------------------}
285
{ TCheckBoxes OBJECT - CHECK BOXES OBJECT }
286
{---------------------------------------------------------------------------}
290
{ 2 = Selected text }
291
{ 3 = Normal shortcut }
292
{ 4 = Selected shortcut }
295
TCheckBoxes = OBJECT (TCluster)
296
FUNCTION Mark (Item: Sw_Integer): Boolean; Virtual;
297
PROCEDURE Draw; Virtual;
298
PROCEDURE Press (Item: Sw_Integer); Virtual;
300
PCheckBoxes = ^TCheckBoxes;
302
{---------------------------------------------------------------------------}
303
{ TMultiCheckBoxes OBJECT - CHECK BOXES OBJECT }
304
{---------------------------------------------------------------------------}
308
{ 2 = Selected text }
309
{ 3 = Normal shortcut }
310
{ 4 = Selected shortcut }
313
TMultiCheckBoxes = OBJECT (TCluster)
314
SelRange: Byte; { Select item range }
315
Flags : Word; { Select flags }
316
States : PString; { Strings }
317
CONSTRUCTOR Init (Var Bounds: TRect; AStrings: PSItem;
318
ASelRange: Byte; AFlags: Word; Const AStates: String);
319
CONSTRUCTOR Load (Var S: TStream);
320
DESTRUCTOR Done; Virtual;
321
FUNCTION DataSize: Sw_Word; Virtual;
322
FUNCTION MultiMark (Item: Sw_Integer): Byte; Virtual;
323
PROCEDURE Draw; Virtual;
324
PROCEDURE Press (Item: Sw_Integer); Virtual;
325
PROCEDURE GetData (Var Rec); Virtual;
326
PROCEDURE SetData (Var Rec); Virtual;
327
PROCEDURE Store (Var S: TStream);
329
PMultiCheckBoxes = ^TMultiCheckBoxes;
331
{---------------------------------------------------------------------------}
332
{ TListBox OBJECT - LIST BOX OBJECT }
333
{---------------------------------------------------------------------------}
343
TListBox = OBJECT (TListViewer)
344
List: PCollection; { List of strings }
345
CONSTRUCTOR Init (Var Bounds: TRect; ANumCols: Sw_Word;
346
AScrollBar: PScrollBar);
347
CONSTRUCTOR Load (Var S: TStream);
348
FUNCTION DataSize: Sw_Word; Virtual;
349
FUNCTION GetText (Item: Sw_Integer; MaxLen: Sw_Integer): String; Virtual;
350
PROCEDURE NewList(AList: PCollection); Virtual;
351
PROCEDURE GetData (Var Rec); Virtual;
352
PROCEDURE SetData (Var Rec); Virtual;
353
PROCEDURE Store (Var S: TStream);
354
procedure DeleteFocusedItem; virtual;
355
{ DeleteFocusedItem deletes the focused item and redraws the view. }
356
{#X FreeFocusedItem }
357
procedure DeleteItem (Item : Sw_Integer); virtual;
358
{ DeleteItem deletes Item from the associated collection. }
360
procedure FreeAll; virtual;
361
{ FreeAll deletes and disposes of all items in the associated
363
{ FreeFocusedItem FreeItem }
364
procedure FreeFocusedItem; virtual;
365
{ FreeFocusedItem deletes and disposes of the focused item then redraws
367
{#X FreeAll FreeItem }
368
procedure FreeItem (Item : Sw_Integer); virtual;
369
{ FreeItem deletes Item from the associated collection and disposes of
370
it, then redraws the listbox. }
371
{#X FreeFocusedItem FreeAll }
372
function GetFocusedItem : Pointer; virtual;
373
{ GetFocusedItem is a more readable method of returning the focused
374
item from the listbox. It is however slightly slower than: }
377
Item := ListBox^.List^.At(ListBox^.Focused); }
379
procedure Insert (Item : Pointer); virtual;
380
{ Insert inserts Item into the collection, adjusts the listbox's range,
381
then redraws the listbox. }
383
procedure SetFocusedItem (Item : Pointer); virtual;
384
{ SetFocusedItem changes the focused item to Item then redraws the
388
PListBox = ^TListBox;
390
{---------------------------------------------------------------------------}
391
{ TStaticText OBJECT - STATIC TEXT OBJECT }
392
{---------------------------------------------------------------------------}
394
TStaticText = OBJECT (TView)
395
Text: PString; { Text string ptr }
396
CONSTRUCTOR Init (Var Bounds: TRect; Const AText: String);
397
CONSTRUCTOR Load (Var S: TStream);
398
DESTRUCTOR Done; Virtual;
399
FUNCTION GetPalette: PPalette; Virtual;
400
PROCEDURE Draw; Virtual;
401
PROCEDURE Store (Var S: TStream);
402
PROCEDURE GetText (Var S: String); Virtual;
404
PStaticText = ^TStaticText;
406
{---------------------------------------------------------------------------}
407
{ TParamText OBJECT - PARMETER STATIC TEXT OBJECT }
408
{---------------------------------------------------------------------------}
414
TParamText = OBJECT (TStaticText)
415
ParamCount: Sw_Integer; { Parameter count }
416
ParamList : Pointer; { Parameter list }
417
CONSTRUCTOR Init (Var Bounds: TRect; Const AText: String;
418
AParamCount: Sw_Integer);
419
CONSTRUCTOR Load (Var S: TStream);
420
FUNCTION DataSize: Sw_Word; Virtual;
421
PROCEDURE GetData (Var Rec); Virtual;
422
PROCEDURE SetData (Var Rec); Virtual;
423
PROCEDURE Store (Var S: TStream);
424
PROCEDURE GetText (Var S: String); Virtual;
426
PParamText = ^TParamText;
428
{---------------------------------------------------------------------------}
429
{ TLabel OBJECT - LABEL OBJECT }
430
{---------------------------------------------------------------------------}
432
TLabel = OBJECT (TStaticText)
434
Link: PView; { Linked view }
435
CONSTRUCTOR Init (Var Bounds: TRect; CONST AText: String; ALink: PView);
436
CONSTRUCTOR Load (Var S: TStream);
437
FUNCTION GetPalette: PPalette; Virtual;
438
PROCEDURE Draw; Virtual;
439
PROCEDURE Store (Var S: TStream);
440
PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
444
{---------------------------------------------------------------------------}
445
{ THistoryViewer OBJECT - HISTORY VIEWER OBJECT }
446
{---------------------------------------------------------------------------}
456
THistoryViewer = OBJECT (TListViewer)
457
HistoryId: Word; { History id }
458
CONSTRUCTOR Init(Var Bounds: TRect; AHScrollBar, AVScrollBar: PScrollBar;
460
FUNCTION HistoryWidth: Sw_Integer;
461
FUNCTION GetPalette: PPalette; Virtual;
462
FUNCTION GetText (Item: Sw_Integer; MaxLen: Sw_Integer): String; Virtual;
463
PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
465
PHistoryViewer = ^THistoryViewer;
467
{---------------------------------------------------------------------------}
468
{ THistoryWindow OBJECT - HISTORY WINDOW OBJECT }
469
{---------------------------------------------------------------------------}
472
{ 1 = Frame passive }
475
{ 4 = ScrollBar page area }
476
{ 5 = ScrollBar controls }
477
{ 6 = HistoryViewer normal text }
478
{ 7 = HistoryViewer selected text }
481
THistoryWindow = OBJECT (TWindow)
482
Viewer: PListViewer; { List viewer object }
483
CONSTRUCTOR Init (Var Bounds: TRect; HistoryId: Word);
484
FUNCTION GetSelection: String; Virtual;
485
FUNCTION GetPalette: PPalette; Virtual;
486
PROCEDURE InitViewer (HistoryId: Word); Virtual;
488
PHistoryWindow = ^THistoryWindow;
490
{---------------------------------------------------------------------------}
491
{ THistory OBJECT - HISTORY OBJECT }
492
{---------------------------------------------------------------------------}
499
THistory = OBJECT (TView)
502
CONSTRUCTOR Init (Var Bounds: TRect; ALink: PInputLine; AHistoryId: Word);
503
CONSTRUCTOR Load (Var S: TStream);
504
FUNCTION GetPalette: PPalette; Virtual;
505
FUNCTION InitHistoryWindow (Var Bounds: TRect): PHistoryWindow; Virtual;
506
PROCEDURE Draw; Virtual;
507
PROCEDURE RecordHistory (CONST S: String); Virtual;
508
PROCEDURE Store (Var S: TStream);
509
PROCEDURE HandleEvent (Var Event: TEvent); Virtual;
511
PHistory = ^THistory;
514
PBrowseInputLine = ^TBrowseInputLine;
515
TBrowseInputLine = Object(TInputLine)
517
constructor Init(var Bounds: TRect; AMaxLen: Sw_Integer; AHistory: Sw_Word);
518
constructor Load(var S: TStream);
519
function DataSize: Sw_Word; virtual;
520
procedure GetData(var Rec); virtual;
521
procedure SetData(var Rec); virtual;
522
procedure Store(var S: TStream);
523
end; { of TBrowseInputLine }
525
TBrowseInputLineRec = record
528
end; { of TBrowseInputLineRec }
530
PBrowseButton = ^TBrowseButton;
532
TBrowseButton = Object(TButton)
533
Link: PBrowseInputLine;
534
constructor Init(var Bounds: TRect; ATitle: TTitleStr; ACommand: Word;
535
AFlags: Byte; ALink: PBrowseInputLine);
536
constructor Load(var S: TStream);
537
procedure Press; virtual;
538
procedure Store(var S: TStream);
539
end; { of TBrowseButton }
543
PCommandIcon = ^TCommandIcon;
545
TCommandIcon = Object(TStaticText)
546
{ A TCommandIcon sends an evCommand message to its owner with
547
Event.Command set to #Command# when it is clicked with a mouse. }
548
constructor Init (var Bounds : TRect; AText : String; ACommand : Word);
549
{ Creates an instance of a TCommandIcon and sets #Command# to
550
ACommand. AText is the text which is displayed as the icon. If an
551
error occurs Init fails. }
552
procedure HandleEvent (var Event : TEvent); virtual;
553
{ Captures mouse events within its borders and sends an evCommand to
554
its owner in response to the mouse event. }
558
{ Command is the command sent to the command icon's owner when it is
560
end; { of TCommandIcon }
564
PCommandSItem = ^TCommandSItem;
566
TCommandSItem = record
567
{ A TCommandSItem is the data structure used to initialize command
568
clusters with #NewCommandSItem# rather than the standarad #NewSItem#.
569
It is used to associate a command with an individual cluster item. }
570
{#X TCommandCheckBoxes TCommandRadioButtons }
572
{ Value is the text displayed for the cluster item. }
575
{ Command is the command broadcast when the cluster item is pressed. }
577
Next : PCommandSItem;
578
{ Next is a pointer to the next item in the cluster. }
580
end; { of TCommandSItem }
583
TCommandArray = array[0..15] of Word;
584
{ TCommandArray holds a list of commands which are associated with a
586
{#X TCommandCheckBoxes TCommandRadioButtons }
590
PCommandCheckBoxes = ^TCommandCheckBoxes;
592
TCommandCheckBoxes = Object(TCheckBoxes)
593
{ TCommandCheckBoxes function as normal TCheckBoxes, except that when a
594
cluster item is pressed it broadcasts a command associated with the
595
cluster item to the cluster's owner.
597
TCommandCheckBoxes are useful when other parts of a dialog should be
598
enabled or disabled in response to a check box's status. }
599
CommandList : TCommandArray;
600
{ CommandList is the list of commands associated with each check box
602
{#X Init Load Store }
603
constructor Init (var Bounds : TRect; ACommandStrings : PCommandSItem);
604
{ Init calls the inherited constructor, then sets up the #CommandList#
605
with the specified commands. If an error occurs Init fails. }
606
{#X NewCommandSItem }
607
constructor Load (var S : TStream);
608
{ Load calls the inherited constructor, then loads the #CommandList#
609
from the stream S. If an error occurs Load fails. }
611
procedure Press (Item : Sw_Integer); virtual;
612
{ Press calls the inherited Press then broadcasts the command
613
associated with the cluster item that was pressed to the check boxes'
616
procedure Store (var S : TStream); { store should never be virtual;}
617
{ Store calls the inherited Store method then writes the #CommandList#
620
end; { of TCommandCheckBoxes }
624
PCommandRadioButtons = ^TCommandRadioButtons;
626
TCommandRadioButtons = Object(TRadioButtons)
627
{ TCommandRadioButtons function as normal TRadioButtons, except that when
628
a cluster item is pressed it broadcasts a command associated with the
629
cluster item to the cluster's owner.
631
TCommandRadioButtons are useful when other parts of a dialog should be
632
enabled or disabled in response to a radiobutton's status. }
633
CommandList : TCommandArray; { commands for each possible value }
634
{ The list of commands associated with each radio button item. }
635
{#X Init Load Store }
636
constructor Init (var Bounds : TRect; ACommandStrings : PCommandSItem);
637
{ Init calls the inherited constructor and sets up the #CommandList#
638
with the specified commands. If an error occurs Init disposes of the
639
command strings then fails. }
640
{#X NewCommandSItem }
641
constructor Load (var S : TStream);
642
{ Load calls the inherited constructor then loads the #CommandList#
643
from the stream S. If an error occurs Load fails. }
645
procedure MovedTo (Item : Sw_Integer); virtual;
646
{ MovedTo calls the inherited MoveTo, then broadcasts the command of
647
the newly selected cluster item to the cluster's owner. }
648
{#X Press CommandList }
649
procedure Press (Item : Sw_Integer); virtual;
650
{ Press calls the inherited Press then broadcasts the command
651
associated with the cluster item that was pressed to the check boxes
653
{#X CommandList MovedTo }
654
procedure Store (var S : TStream); { store should never be virtual;}
655
{ Store calls the inherited Store method then writes the #CommandList#
658
end; { of TCommandRadioButtons }
660
PEditListBox = ^TEditListBox;
661
TEditListBox = Object(TListBox)
662
CurrentField : Integer;
663
constructor Init (Bounds : TRect; ANumCols: Word;
664
AVScrollBar : PScrollBar);
665
constructor Load (var S : TStream);
666
function FieldValidator : PValidator; virtual;
667
function FieldWidth : Integer; virtual;
668
procedure GetField (InputLine : PInputLine); virtual;
669
function GetPalette : PPalette; virtual;
670
procedure HandleEvent (var Event : TEvent); virtual;
671
procedure SetField (InputLine : PInputLine); virtual;
672
function StartColumn : Integer; virtual;
674
procedure EditField (var Event : TEvent);
675
end; { of TEditListBox }
678
PModalInputLine = ^TModalInputLine;
679
TModalInputLine = Object(TInputLine)
680
function Execute : Word; virtual;
681
procedure HandleEvent (var Event : TEvent); virtual;
682
procedure SetState (AState : Word; Enable : Boolean); virtual;
685
end; { of TModalInputLine }
687
{---------------------------------------------------------------------------}
688
{ TDialog OBJECT - DIALOG OBJECT }
689
{---------------------------------------------------------------------------}
692
{ 1 = Frame passive }
695
{ 4 = ScrollBar page area }
696
{ 5 = ScrollBar controls }
699
{ 8 = Label selected }
700
{ 9 = Label shortcut }
701
{ 10 = Button normal }
702
{ 11 = Button default }
703
{ 12 = Button selected }
704
{ 13 = Button disabled }
705
{ 14 = Button shortcut }
706
{ 15 = Button shadow }
707
{ 16 = Cluster normal }
708
{ 17 = Cluster selected }
709
{ 18 = Cluster shortcut }
710
{ 19 = InputLine normal text }
711
{ 20 = InputLine selected text }
712
{ 21 = InputLine arrows }
713
{ 22 = History arrow }
714
{ 23 = History sides }
715
{ 24 = HistoryWindow scrollbar page area }
716
{ 25 = HistoryWindow scrollbar controls }
717
{ 26 = ListViewer normal }
718
{ 27 = ListViewer focused }
719
{ 28 = ListViewer selected }
720
{ 29 = ListViewer divider }
722
{ 31 = Cluster disabled }
726
TDialog = object(TWindow)
727
constructor Init(var Bounds: TRect; ATitle: TTitleStr);
728
constructor Load(var S: TStream);
729
procedure Cancel (ACommand : Word); virtual;
730
{ If the dialog is a modal dialog, Cancel calls EndModal(ACommand). If
731
the dialog is non-modal Cancel calls Close.
733
Cancel may be overridden to provide special processing prior to
734
destructing the dialog. }
735
procedure ChangeTitle (ANewTitle : TTitleStr); virtual;
736
{ ChangeTitle disposes of the current title, assigns ANewTitle to Title,
737
then redraws the dialog. }
738
procedure FreeSubView (ASubView : PView); virtual;
739
{ FreeSubView deletes and disposes ASubView from the dialog. }
740
{#X FreeAllSubViews IsSubView }
741
procedure FreeAllSubViews; virtual;
742
{ Deletes then disposes all subviews in the dialog. }
743
{#X FreeSubView IsSubView }
744
function GetPalette: PPalette; virtual;
745
procedure HandleEvent(var Event: TEvent); virtual;
746
function IsSubView (AView : PView) : Boolean; virtual;
747
{ IsSubView returns True if AView is non-nil and is a subview of the
749
{#X FreeSubView FreeAllSubViews }
750
function NewButton (X, Y, W, H : Sw_Integer; ATitle : TTitleStr;
751
ACommand, AHelpCtx : Word;
752
AFlags : Byte) : PButton;
753
{ Creates and inserts into the dialog a new TButton with the
754
help context AHelpCtx.
756
A pointer to the new button is returned for checking validity of the
758
{#X NewInputLine NewLabel }
759
function NewLabel (X, Y : Sw_Integer; AText : String;
760
ALink : PView) : PLabel;
761
{ NewLabel creates and inserts into the dialog a new TLabel and
762
associates it with ALink. }
763
{#X NewButton NewInputLine }
764
function NewInputLine (X, Y, W, AMaxLen : Sw_Integer; AHelpCtx : Word
765
; AValidator : PValidator) : PInputLine;
766
{ NewInputLine creates and inserts into the dialog a new TBSDInputLine
767
with the help context to AHelpCtx and the validator AValidator.
769
A pointer to the inputline is returned for checking validity of the
771
{#X NewButton NewLabel }
772
function Valid(Command: Word): Boolean; virtual;
775
PListDlg = ^TListDlg;
776
TListDlg = object(TDialog)
777
{ TListDlg displays a listbox of items, with optional New, Edit, and
778
Delete buttons displayed according to the options bit set in the
779
dialog. Use the ofXXXX flags declared in this unit OR'd with the
780
standard ofXXXX flags to set the appropriate bits in Options.
782
If enabled, when the New or Edit buttons are pressed, an evCommand
783
message is sent to the application with a Command value of NewCommand
784
or EditCommand, respectively. Using this mechanism in combination with
785
the declared Init parameters, a standard TListDlg can be used with any
786
type of list displayable in a TListBox or its descendant. }
791
constructor Init (ATitle: TTitleStr; Items: string; AButtons: Word;
792
AListBox: PListBox; AEditCommand, ANewCommand: Word);
793
constructor Load(var S: TStream);
794
procedure HandleEvent(var Event: TEvent); virtual;
795
procedure Store(var S: TStream); { store should never be virtual;}
799
{***************************************************************************}
800
{ INTERFACE ROUTINES }
801
{***************************************************************************}
803
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
804
{ ITEM STRING ROUTINES }
805
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
807
{-NewSItem-----------------------------------------------------------
808
Allocates memory for a new TSItem record and sets the text field
809
and chains to the next TSItem. This allows easy construction of
810
singly-linked lists of strings, to end a chain the next TSItem
813
---------------------------------------------------------------------}
814
FUNCTION NewSItem (Const Str: String; ANext: PSItem): PSItem;
816
{ NewCommandSItem allocates and returns a pointer to a new #TCommandSItem#
817
record. The Value and Next fields of the record are set to NewStr(Str)
818
and ANext, respectively. The NewSItem function and the TSItem record type
819
allow easy construction of singly-linked lists of command strings. }
820
function NewCommandSItem (Str : String; ACommand : Word;
821
ANext : PCommandSItem) : PCommandSItem;
823
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
824
{ DIALOG OBJECT REGISTRATION PROCEDURE }
825
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
827
{-RegisterDialogs----------------------------------------------------
828
This registers all the view type objects used in this unit.
830
---------------------------------------------------------------------}
831
PROCEDURE RegisterDialogs;
833
{***************************************************************************}
834
{ STREAM REGISTRATION RECORDS }
835
{***************************************************************************}
837
{---------------------------------------------------------------------------}
838
{ TDialog STREAM REGISTRATION }
839
{---------------------------------------------------------------------------}
841
RDialog: TStreamRec = (
842
ObjType: idDialog; { Register id = 10 }
843
VmtLink: TypeOf(TDialog);
844
Load: @TDialog.Load; { Object load method }
845
Store: @TDialog.Store { Object store method }
848
{---------------------------------------------------------------------------}
849
{ TInputLine STREAM REGISTRATION }
850
{---------------------------------------------------------------------------}
852
RInputLine: TStreamRec = (
853
ObjType: idInputLine; { Register id = 11 }
854
VmtLink: TypeOf(TInputLine);
855
Load: @TInputLine.Load; { Object load method }
856
Store: @TInputLine.Store { Object store method }
859
{---------------------------------------------------------------------------}
860
{ TButton STREAM REGISTRATION }
861
{---------------------------------------------------------------------------}
863
RButton: TStreamRec = (
864
ObjType: idButton; { Register id = 12 }
865
VmtLink: TypeOf(TButton);
866
Load: @TButton.Load; { Object load method }
867
Store: @TButton.Store { Object store method }
870
{---------------------------------------------------------------------------}
871
{ TCluster STREAM REGISTRATION }
872
{---------------------------------------------------------------------------}
874
RCluster: TStreamRec = (
875
ObjType: idCluster; { Register id = 13 }
876
VmtLink: TypeOf(TCluster);
877
Load: @TCluster.Load; { Object load method }
878
Store: @TCluster.Store { Objects store method }
881
{---------------------------------------------------------------------------}
882
{ TRadioButtons STREAM REGISTRATION }
883
{---------------------------------------------------------------------------}
885
RRadioButtons: TStreamRec = (
886
ObjType: idRadioButtons; { Register id = 14 }
887
VmtLink: TypeOf(TRadioButtons);
888
Load: @TRadioButtons.Load; { Object load method }
889
Store: @TRadioButtons.Store { Object store method }
892
{---------------------------------------------------------------------------}
893
{ TCheckBoxes STREAM REGISTRATION }
894
{---------------------------------------------------------------------------}
896
RCheckBoxes: TStreamRec = (
897
ObjType: idCheckBoxes; { Register id = 15 }
898
VmtLink: TypeOf(TCheckBoxes);
899
Load: @TCheckBoxes.Load; { Object load method }
900
Store: @TCheckBoxes.Store { Object store method }
903
{---------------------------------------------------------------------------}
904
{ TMultiCheckBoxes STREAM REGISTRATION }
905
{---------------------------------------------------------------------------}
907
RMultiCheckBoxes: TStreamRec = (
908
ObjType: idMultiCheckBoxes; { Register id = 27 }
909
VmtLink: TypeOf(TMultiCheckBoxes);
910
Load: @TMultiCheckBoxes.Load; { Object load method }
911
Store: @TMultiCheckBoxes.Store { Object store method }
914
{---------------------------------------------------------------------------}
915
{ TListBox STREAM REGISTRATION }
916
{---------------------------------------------------------------------------}
918
RListBox: TStreamRec = (
919
ObjType: idListBox; { Register id = 16 }
920
VmtLink: TypeOf(TListBox);
921
Load: @TListBox.Load; { Object load method }
922
Store: @TListBox.Store { Object store method }
925
{---------------------------------------------------------------------------}
926
{ TStaticText STREAM REGISTRATION }
927
{---------------------------------------------------------------------------}
929
RStaticText: TStreamRec = (
930
ObjType: idStaticText; { Register id = 17 }
931
VmtLink: TypeOf(TStaticText);
932
Load: @TStaticText.Load; { Object load method }
933
Store: @TStaticText.Store { Object store method }
936
{---------------------------------------------------------------------------}
937
{ TLabel STREAM REGISTRATION }
938
{---------------------------------------------------------------------------}
940
RLabel: TStreamRec = (
941
ObjType: idLabel; { Register id = 18 }
942
VmtLink: TypeOf(TLabel);
943
Load: @TLabel.Load; { Object load method }
944
Store: @TLabel.Store { Object store method }
947
{---------------------------------------------------------------------------}
948
{ THistory STREAM REGISTRATION }
949
{---------------------------------------------------------------------------}
951
RHistory: TStreamRec = (
952
ObjType: idHistory; { Register id = 19 }
953
VmtLink: TypeOf(THistory);
954
Load: @THistory.Load; { Object load method }
955
Store: @THistory.Store { Object store method }
958
{---------------------------------------------------------------------------}
959
{ TParamText STREAM REGISTRATION }
960
{---------------------------------------------------------------------------}
962
RParamText: TStreamRec = (
963
ObjType: idParamText; { Register id = 20 }
964
VmtLink: TypeOf(TParamText);
965
Load: @TParamText.Load; { Object load method }
966
Store: @TParamText.Store { Object store method }
969
RCommandCheckBoxes : TStreamRec = (
970
ObjType : idCommandCheckBoxes;
971
VmtLink : Ofs(TypeOf(TCommandCheckBoxes)^);
972
Load : @TCommandCheckBoxes.Load;
973
Store : @TCommandCheckBoxes.Store);
975
RCommandRadioButtons : TStreamRec = (
976
ObjType : idCommandRadioButtons;
977
VmtLink : Ofs(TypeOf(TCommandRadioButtons)^);
978
Load : @TCommandRadioButtons.Load;
979
Store : @TCommandRadioButtons.Store);
981
RCommandIcon : TStreamRec = (
982
ObjType : idCommandIcon;
983
VmtLink : Ofs(Typeof(TCommandIcon)^);
984
Load : @TCommandIcon.Load;
985
Store : @TCommandIcon.Store);
987
RBrowseButton: TStreamRec = (
988
ObjType : idBrowseButton;
989
VmtLink : Ofs(TypeOf(TBrowseButton)^);
990
Load : @TBrowseButton.Load;
991
Store : @TBrowseButton.Store);
993
REditListBox : TStreamRec = (
994
ObjType : idEditListBox;
995
VmtLink : Ofs(TypeOf(TEditListBox)^);
996
Load : @TEditListBox.Load;
997
Store : @TEditListBox.Store);
999
RListDlg : TStreamRec = (
1000
ObjType : idListDlg;
1001
VmtLink : Ofs(TypeOf(TListDlg)^);
1002
Load : @TListDlg.Load;
1003
Store : @TListDlg.Store);
1005
RModalInputLine : TStreamRec = (
1006
ObjType : idModalInputLine;
1007
VmtLink : Ofs(TypeOf(TModalInputLine)^);
1008
Load : @TModalInputLine.Load;
1009
Store : @TModalInputLine.Store);
1012
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
1014
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
1016
USES App,HistList; { Standard GFV unit }
1018
{***************************************************************************}
1019
{ PRIVATE DEFINED CONSTANTS }
1020
{***************************************************************************}
1022
{---------------------------------------------------------------------------}
1023
{ LEFT AND RIGHT ARROW CHARACTER CONSTANTS }
1024
{---------------------------------------------------------------------------}
1025
CONST LeftArr = '<'; RightArr = '>';
1027
{---------------------------------------------------------------------------}
1028
{ TButton MESSAGES }
1029
{---------------------------------------------------------------------------}
1031
cmGrabDefault = 61; { Grab default }
1032
cmReleaseDefault = 62; { Release default }
1034
{---------------------------------------------------------------------------}
1035
{ IsBlank -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 08Jun98 LdB }
1036
{---------------------------------------------------------------------------}
1037
FUNCTION IsBlank (Ch: Char): Boolean;
1039
IsBlank := (Ch = ' ') OR (Ch = #13) OR (Ch = #10); { Check for characters }
1042
{---------------------------------------------------------------------------}
1043
{ HotKey -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 08Jun98 LdB }
1044
{---------------------------------------------------------------------------}
1045
FUNCTION HotKey (Const S: String): Char;
1048
HotKey := #0; { Preset fail }
1049
If (S <> '') Then Begin { Valid string }
1050
I := Pos('~', S); { Search for tilde }
1051
If (I <> 0) Then HotKey := UpCase(S[I+1]); { Return hotkey }
1055
{***************************************************************************}
1057
{***************************************************************************}
1059
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
1060
{ TDialog OBJECT METHODS }
1061
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
1063
{--TDialog------------------------------------------------------------------}
1064
{ Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB }
1065
{---------------------------------------------------------------------------}
1066
CONSTRUCTOR TDialog.Init (Var Bounds: TRect; ATitle: TTitleStr);
1068
Inherited Init(Bounds, ATitle, wnNoNumber); { Call ancestor }
1069
Options := Options OR ofVersion20; { Version two dialog }
1070
GrowMode := 0; { Clear grow mode }
1071
Flags := wfMove + wfClose; { Close/moveable flags }
1072
Palette := dpGrayDialog; { Default gray colours }
1075
{--TDialog------------------------------------------------------------------}
1076
{ Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB }
1077
{---------------------------------------------------------------------------}
1078
CONSTRUCTOR TDialog.Load (Var S: TStream);
1080
Inherited Load(S); { Call ancestor }
1081
If (Options AND ofVersion = ofVersion10) Then Begin
1082
Palette := dpGrayDialog; { Set gray palette }
1083
Options := Options OR ofVersion20; { Update version flag }
1087
{--TDialog------------------------------------------------------------------}
1088
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB }
1089
{---------------------------------------------------------------------------}
1090
FUNCTION TDialog.GetPalette: PPalette;
1091
CONST P: Array[dpBlueDialog..dpGrayDialog] Of String[Length(CBlueDialog)] =
1092
(CBlueDialog, CCyanDialog, CGrayDialog); { Always normal string }
1094
GetPalette := @P[Palette]; { Return palette }
1097
{--TDialog------------------------------------------------------------------}
1098
{ Valid -> Platforms DOS/DPMI/WIN/NT/Os2 - Updated 25Apr98 LdB }
1099
{---------------------------------------------------------------------------}
1100
FUNCTION TDialog.Valid (Command: Word): Boolean;
1102
If (Command = cmCancel) Then Valid := True { Cancel returns true }
1103
Else Valid := TGroup.Valid(Command); { Call group ancestor }
1106
{--TDialog------------------------------------------------------------------}
1107
{ HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB }
1108
{---------------------------------------------------------------------------}
1109
PROCEDURE TDialog.HandleEvent (Var Event: TEvent);
1111
Inherited HandleEvent(Event); { Call ancestor }
1113
evNothing: Exit; { Speed up exit }
1114
evKeyDown: { Key down event }
1115
Case Event.KeyCode Of
1116
kbEsc: Begin { Escape key press }
1117
Event.What := evCommand; { Command event }
1118
Event.Command := cmCancel; { cancel command }
1119
Event.InfoPtr := Nil; { Clear info ptr }
1120
PutEvent(Event); { Put event on queue }
1121
ClearEvent(Event); { Clear the event }
1123
kbEnter: Begin { Enter key press }
1124
Event.What := evBroadcast; { Broadcast event }
1125
Event.Command := cmDefault; { Default command }
1126
Event.InfoPtr := Nil; { Clear info ptr }
1127
PutEvent(Event); { Put event on queue }
1128
ClearEvent(Event); { Clear the event }
1131
evCommand: { Command event }
1132
Case Event.Command Of
1133
cmOk, cmCancel, cmYes, cmNo: { End dialog cmds }
1134
If (State AND sfModal <> 0) Then Begin { View is modal }
1135
EndModal(Event.Command); { End modal state }
1136
ClearEvent(Event); { Clear the event }
1142
{****************************************************************************}
1144
{****************************************************************************}
1145
procedure TDialog.Cancel (ACommand : Word);
1147
if State and sfModal = sfModal then
1152
{****************************************************************************}
1153
{ TDialog.ChangeTitle }
1154
{****************************************************************************}
1155
procedure TDialog.ChangeTitle (ANewTitle : TTitleStr);
1157
if (Title <> nil) then
1159
Title := NewStr(ANewTitle);
1163
{****************************************************************************}
1164
{ TDialog.FreeSubView }
1165
{****************************************************************************}
1166
procedure TDialog.FreeSubView (ASubView : PView);
1168
if IsSubView(ASubView) then begin
1170
Dispose(ASubView,Done);
1175
{****************************************************************************}
1176
{ TDialog.FreeAllSubViews }
1177
{****************************************************************************}
1178
procedure TDialog.FreeAllSubViews;
1185
if (P <> nil) then begin
1193
{****************************************************************************}
1194
{ TDialog.IsSubView }
1195
{****************************************************************************}
1196
function TDialog.IsSubView (AView : PView) : Boolean;
1200
while (P <> nil) and (P <> AView) do
1202
IsSubView := ((P <> nil) and (P = AView));
1205
{****************************************************************************}
1206
{ TDialog.NewButton }
1207
{****************************************************************************}
1208
function TDialog.NewButton (X, Y, W, H : Sw_Integer; ATitle : TTitleStr;
1209
ACommand, AHelpCtx : Word;
1210
AFlags : Byte) : PButton;
1215
R.Assign(X,Y,X+W,Y+H);
1216
B := New(PButton,Init(R,ATitle,ACommand,AFlags));
1217
if (B <> nil) then begin
1218
B^.HelpCtx := AHelpCtx;
1224
{****************************************************************************}
1225
{ TDialog.NewInputLine }
1226
{****************************************************************************}
1227
function TDialog.NewInputLine (X, Y, W, AMaxLen : Sw_Integer; AHelpCtx : Word
1228
; AValidator : PValidator) : PInputLine;
1233
R.Assign(X,Y,X+W,Y+1);
1234
P := New(PInputLine,Init(R,AMaxLen));
1235
if (P <> nil) then begin
1236
P^.SetValidator(AValidator);
1237
P^.HelpCtx := AHelpCtx;
1243
{****************************************************************************}
1244
{ TDialog.NewLabel }
1245
{****************************************************************************}
1246
function TDialog.NewLabel (X, Y : Sw_Integer; AText : String;
1247
ALink : PView) : PLabel;
1252
R.Assign(X,Y,X+CStrLen(AText)+1,Y+1);
1253
P := New(PLabel,Init(R,AText,ALink));
1259
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
1260
{ TInputLine OBJECT METHODS }
1261
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
1263
{--TInputLine---------------------------------------------------------------}
1264
{ Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
1265
{---------------------------------------------------------------------------}
1266
CONSTRUCTOR TInputLine.Init (Var Bounds: TRect; AMaxLen: Sw_Integer);
1268
Inherited Init(Bounds); { Call ancestor }
1269
State := State OR sfCursorVis; { Cursor visible }
1270
Options := Options OR (ofSelectable + ofFirstClick
1271
+ ofVersion20); { Set options }
1272
If (MaxAvail > AMaxLen + 1) Then Begin { Check enough memory }
1273
GetMem(Data, AMaxLen + 1); { Allocate memory }
1274
Data^ := ''; { Data = empty string }
1276
MaxLen := AMaxLen; { Hold maximum length }
1279
{--TInputLine---------------------------------------------------------------}
1280
{ Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
1281
{---------------------------------------------------------------------------}
1282
CONSTRUCTOR TInputLine.Load (Var S: TStream);
1286
Inherited Load(S); { Call ancestor }
1287
S.Read(W, sizeof(w)); MaxLen:=W; { Read max length }
1288
S.Read(W, sizeof(w)); CurPos:=w; { Read cursor position }
1289
S.Read(W, sizeof(w)); FirstPos:=w; { Read first position }
1290
S.Read(W, sizeof(w)); SelStart:=w; { Read selected start }
1291
S.Read(W, sizeof(w)); SelEnd:=w; { Read selected end }
1292
S.Read(B, SizeOf(B)); { Read string length }
1293
GetMem(Data, B + 1); { Allocate memory }
1294
S.Read(Data^[1], B); { Read string data }
1295
SetLength(Data^, B); { Xfer string length }
1296
If (Options AND ofVersion >= ofVersion20) Then { Version 2 or above }
1297
Validator := PValidator(S.Get); { Get any validator }
1298
Options := Options OR ofVersion20; { Set version 2 flag }
1301
{--TInputLine---------------------------------------------------------------}
1302
{ Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
1303
{---------------------------------------------------------------------------}
1304
DESTRUCTOR TInputLine.Done;
1306
If (Data <> Nil) Then FreeMem(Data, MaxLen + 1); { Release any memory }
1307
SetValidator(Nil); { Clear any validator }
1308
Inherited Done; { Call ancestor }
1311
{--TInputLine---------------------------------------------------------------}
1312
{ DataSize -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
1313
{---------------------------------------------------------------------------}
1314
FUNCTION TInputLine.DataSize: Sw_Word;
1317
DSize := 0; { Preset zero datasize }
1318
If (Validator <> Nil) AND (Data <> Nil) Then
1319
DSize := Validator^.Transfer(Data^, Nil,
1320
vtDataSize); { Add validator size }
1321
If (DSize <> 0) Then DataSize := DSize { Use validtor size }
1322
Else DataSize := MaxLen + 1; { No validator use size }
1325
{--TInputLine---------------------------------------------------------------}
1326
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
1327
{---------------------------------------------------------------------------}
1328
FUNCTION TInputLine.GetPalette: PPalette;
1329
CONST P: String[Length(CInputLine)] = CInputLine; { Always normal string }
1331
GetPalette := @P; { Return palette }
1334
{--TInputLine---------------------------------------------------------------}
1335
{ Valid -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
1336
{---------------------------------------------------------------------------}
1337
FUNCTION TInputLine.Valid (Command: Word): Boolean;
1339
FUNCTION AppendError (Validator: PValidator): Boolean;
1341
AppendError := False; { Preset false }
1342
If (Data <> Nil) Then
1344
If (Options AND voOnAppend <> 0) AND { Check options }
1345
(CurPos <> Length(Data^)) AND { Exceeds max length }
1346
NOT IsValidInput(Data^, True) Then Begin { Check data valid }
1347
Error; { Call error }
1348
AppendError := True; { Return true }
1353
Valid := Inherited Valid(Command); { Call ancestor }
1354
If (Validator <> Nil) AND (Data <> Nil) AND { Validator present }
1355
(State AND sfDisabled = 0) Then { Not disabled }
1356
If (Command = cmValid) Then { Valid command }
1357
Valid := Validator^.Status = vsOk { Validator result }
1358
Else If (Command <> cmCancel) Then { Not cancel command }
1359
If AppendError(Validator) OR { Append any error }
1360
NOT Validator^.Valid(Data^) Then Begin { Check validator }
1361
Select; { Reselect view }
1362
Valid := False; { Return false }
1366
{--TInputLine---------------------------------------------------------------}
1367
{ Draw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
1368
{---------------------------------------------------------------------------}
1369
PROCEDURE TInputLine.Draw;
1370
VAR Color: Byte; L, R: Sw_Integer;
1373
if Options and ofSelectable = 0 then
1374
Color := GetColor(5)
1376
If (State AND sfFocused = 0) Then
1377
Color := GetColor(1) { Not focused colour }
1379
Color := GetColor(2); { Focused colour }
1380
MoveChar(B, ' ', Color, Size.X);
1381
MoveStr(B[1], Copy(Data^, FirstPos + 1, Size.X - 2), Color);
1382
if CanScroll(1) then
1383
MoveChar(B[Size.X - 1], RightArr, GetColor(4), 1);
1384
if (State and sfFocused <> 0) and
1385
(Options and ofSelectable <> 0) then
1387
if CanScroll(-1) then
1388
MoveChar(B[0], LeftArr, GetColor(4), 1);
1389
{ Highlighted part }
1390
L := SelStart - FirstPos;
1391
R := SelEnd - FirstPos;
1394
if R > Size.X - 2 then
1397
MoveChar(B[L + 1], #0, GetColor(3), R - L);
1398
SetCursor(CurPos - FirstPos + 1, 0);
1400
WriteLine(0, 0, Size.X, Size.Y, B);
1404
{--TInputLine---------------------------------------------------------------}
1405
{ DrawCursor -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Oct99 LdB }
1406
{---------------------------------------------------------------------------}
1407
PROCEDURE TInputLine.DrawCursor;
1409
If (State AND sfFocused <> 0) Then
1410
Begin { Focused window }
1412
Cursor.X:=CurPos-FirstPos+1;
1417
{--TInputLine---------------------------------------------------------------}
1418
{ SelectAll -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
1419
{---------------------------------------------------------------------------}
1420
PROCEDURE TInputLine.SelectAll (Enable: Boolean);
1422
CurPos := 0; { Cursor to start }
1423
FirstPos := 0; { First pos to start }
1424
SelStart := 0; { Selected at start }
1425
If Enable AND (Data <> Nil) Then
1426
SelEnd := Length(Data^) Else SelEnd := 0; { Selected which end }
1427
DrawView; { Now redraw the view }
1430
{--TInputLine---------------------------------------------------------------}
1431
{ SetValidator -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
1432
{---------------------------------------------------------------------------}
1433
PROCEDURE TInputLine.SetValidator (AValid: PValidator);
1435
If (Validator <> Nil) Then Validator^.Free; { Release validator }
1436
Validator := AValid; { Set new validator }
1439
{--TInputLine---------------------------------------------------------------}
1440
{ SetState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
1441
{---------------------------------------------------------------------------}
1442
PROCEDURE TInputLine.SetState (AState: Word; Enable: Boolean);
1444
Inherited SetState(AState, Enable); { Call ancestor }
1445
If (AState = sfSelected) OR ((AState = sfActive)
1446
AND (State and sfSelected <> 0)) Then
1447
SelectAll(Enable) Else { Call select all }
1448
If (AState = sfFocused) Then DrawView; { Redraw for focus }
1451
{--TInputLine---------------------------------------------------------------}
1452
{ GetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
1453
{---------------------------------------------------------------------------}
1454
PROCEDURE TInputLine.GetData (Var Rec);
1456
If (Data <> Nil) Then Begin { Data ptr valid }
1457
If (Validator = Nil) OR (Validator^.Transfer(Data^,
1458
@Rec, vtGetData) = 0) Then Begin { No validator/data }
1459
FillChar(Rec, DataSize, #0); { Clear the data area }
1460
Move(Data^, Rec, Length(Data^) + 1); { Transfer our data }
1462
End Else FillChar(Rec, DataSize, #0); { Clear the data area }
1465
{--TInputLine---------------------------------------------------------------}
1466
{ SetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
1467
{---------------------------------------------------------------------------}
1468
PROCEDURE TInputLine.SetData (Var Rec);
1470
If (Data <> Nil) Then Begin { Data ptr valid }
1471
If (Validator = Nil) OR (Validator^.Transfer(
1472
Data^, @Rec, vtSetData) = 0) Then { No validator/data }
1473
Move(Rec, Data^[0], DataSize); { Set our data }
1475
SelectAll(True); { Now select all }
1478
{--TInputLine---------------------------------------------------------------}
1479
{ Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
1480
{---------------------------------------------------------------------------}
1481
PROCEDURE TInputLine.Store (Var S: TStream);
1484
TView.Store(S); { Implict TView.Store }
1485
w:=MaxLen;S.Write(w, SizeOf(w)); { Read max length }
1486
w:=CurPos;S.Write(w, SizeOf(w)); { Read cursor position }
1487
w:=FirstPos;S.Write(w, SizeOf(w)); { Read first position }
1488
w:=SelStart;S.Write(w, SizeOf(w)); { Read selected start }
1489
w:=SelEnd;S.Write(w, SizeOf(w)); { Read selected end }
1490
S.WriteStr(Data); { Write the data }
1491
S.Put(Validator); { Write any validator }
1494
{--TInputLine---------------------------------------------------------------}
1495
{ HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
1496
{---------------------------------------------------------------------------}
1497
PROCEDURE TInputLine.HandleEvent (Var Event: TEvent);
1498
CONST PadKeys = [$47, $4B, $4D, $4F, $73, $74];
1499
VAR WasAppending: Boolean; ExtendBlock: Boolean; OldData: String;
1500
Delta, Anchor, OldCurPos, OldFirstPos, OldSelStart, OldSelEnd: Sw_Integer;
1502
FUNCTION MouseDelta: Sw_Integer;
1505
MakeLocal(Event.Where, Mouse);
1506
if Mouse.X <= 0 then
1508
else if Mouse.X >= Size.X - 1 then
1514
FUNCTION MousePos: Sw_Integer;
1515
VAR Pos: Sw_Integer;
1518
MakeLocal(Event.Where, Mouse);
1519
if Mouse.X < 1 then Mouse.X := 1;
1520
Pos := Mouse.X + FirstPos - 1;
1521
if Pos < 0 then Pos := 0;
1522
if Pos > Length(Data^) then Pos := Length(Data^);
1526
PROCEDURE DeleteSelect;
1528
If (SelStart <> SelEnd) Then Begin { An area selected }
1529
If (Data <> Nil) Then
1530
Delete(Data^, SelStart+1, SelEnd-SelStart); { Delete the text }
1531
CurPos := SelStart; { Set cursor position }
1535
PROCEDURE AdjustSelectBlock;
1537
If (CurPos < Anchor) Then Begin { Selection backwards }
1538
SelStart := CurPos; { Start of select }
1539
SelEnd := Anchor; { End of select }
1541
SelStart := Anchor; { Start of select }
1542
SelEnd := CurPos; { End of select }
1546
PROCEDURE SaveState;
1548
If (Validator <> Nil) Then Begin { Check for validator }
1549
If (Data <> Nil) Then OldData := Data^; { Hold data }
1550
OldCurPos := CurPos; { Hold cursor position }
1551
OldFirstPos := FirstPos; { Hold first position }
1552
OldSelStart := SelStart; { Hold select start }
1553
OldSelEnd := SelEnd; { Hold select end }
1554
If (Data = Nil) Then WasAppending := True { Invalid data ptr }
1555
Else WasAppending := Length(Data^) = CurPos; { Hold appending state }
1559
PROCEDURE RestoreState;
1561
If (Validator <> Nil) Then Begin { Validator valid }
1562
If (Data <> Nil) Then Data^ := OldData; { Restore data }
1563
CurPos := OldCurPos; { Restore cursor pos }
1564
FirstPos := OldFirstPos; { Restore first pos }
1565
SelStart := OldSelStart; { Restore select start }
1566
SelEnd := OldSelEnd; { Restore select end }
1570
FUNCTION CheckValid (NoAutoFill: Boolean): Boolean;
1571
VAR OldLen: Sw_Integer; NewData: String;
1573
If (Validator <> Nil) Then Begin { Validator valid }
1574
CheckValid := False; { Preset false return }
1575
If (Data <> Nil) Then OldLen := Length(Data^); { Hold old length }
1576
If (Validator^.Options AND voOnAppend = 0) OR
1577
(WasAppending AND (CurPos = OldLen)) Then Begin
1578
If (Data <> Nil) Then NewData := Data^ { Hold current data }
1579
Else NewData := ''; { Set empty string }
1580
If NOT Validator^.IsValidInput(NewData,
1581
NoAutoFill) Then RestoreState Else Begin
1582
If (Length(NewData) > MaxLen) Then { Exceeds maximum }
1583
SetLength(NewData, MaxLen); { Set string length }
1584
If (Data <> Nil) Then Data^ := NewData; { Set data value }
1585
If (Data <> Nil) AND (CurPos >= OldLen) { Cursor beyond end }
1586
AND (Length(Data^) > OldLen) Then { Cursor beyond string }
1587
CurPos := Length(Data^); { Set cursor position }
1588
CheckValid := True; { Return true result }
1591
CheckValid := True; { Preset true return }
1592
If (CurPos = OldLen) AND (Data <> Nil) Then { Lengths match }
1593
If NOT Validator^.IsValidInput(Data^,
1594
False) Then Begin { Check validator }
1595
Validator^.Error; { Call error }
1596
CheckValid := False; { Return false result }
1599
End Else CheckValid := True; { No validator }
1603
Inherited HandleEvent(Event); { Call ancestor }
1604
If (State AND sfSelected <> 0) Then Begin { View is selected }
1606
evNothing: Exit; { Speed up exit }
1607
evMouseDown: Begin { Mouse down event }
1608
Delta := MouseDelta; { Calc scroll value }
1609
If CanScroll(Delta) Then Begin { Can scroll }
1611
If CanScroll(Delta) Then Begin { Still can scroll }
1612
Inc(FirstPos, Delta); { Move start position }
1613
DrawView; { Redraw the view }
1615
Until NOT MouseEvent(Event, evMouseAuto); { Until no mouse auto }
1616
End Else If Event.Double Then { Double click }
1617
SelectAll(True) Else Begin { Select whole text }
1618
Anchor := MousePos; { Start of selection }
1620
If (Event.What = evMouseAuto) { Mouse auto event }
1622
Delta := MouseDelta; { New position }
1623
If CanScroll(Delta) Then { If can scroll }
1624
Inc(FirstPos, Delta);
1626
CurPos := MousePos; { Set cursor position }
1627
AdjustSelectBlock; { Adjust selected }
1628
DrawView; { Redraw the view }
1629
Until NOT MouseEvent(Event, evMouseMove
1630
+ evMouseAuto); { Until mouse released }
1632
ClearEvent(Event); { Clear the event }
1635
SaveState; { Save state of view }
1636
Event.KeyCode := CtrlToArrow(Event.KeyCode); { Convert keycode }
1637
If (Event.ScanCode IN PadKeys) AND
1638
(GetShiftState AND $03 <> 0) Then Begin { Mark selection active }
1639
Event.CharCode := #0; { Clear char code }
1640
If (CurPos = SelEnd) Then { Find if at end }
1641
Anchor := SelStart Else { Anchor from start }
1642
Anchor := SelEnd; { Anchor from end }
1643
ExtendBlock := True; { Extended block true }
1644
End Else ExtendBlock := False; { No extended block }
1645
Case Event.KeyCode Of
1646
kbLeft: If (CurPos > 0) Then Dec(CurPos); { Move cursor left }
1647
kbRight: If (Data <> Nil) AND { Move right cursor }
1648
(CurPos < Length(Data^)) Then Begin { Check not at end }
1649
Inc(CurPos); { Move cursor }
1650
CheckValid(True); { Check if valid }
1652
kbHome: CurPos := 0; { Move to line start }
1653
kbEnd: Begin { Move to line end }
1654
If (Data = Nil) Then CurPos := 0 { Invalid data ptr }
1655
Else CurPos := Length(Data^); { Set cursor position }
1656
CheckValid(True); { Check if valid }
1658
kbBack: If (Data <> Nil) AND (CurPos > 0) { Not at line start }
1660
Delete(Data^, CurPos, 1); { Backspace over char }
1661
Dec(CurPos); { Move cursor back one }
1662
If (FirstPos > 0) Then Dec(FirstPos); { Move first position }
1663
CheckValid(True); { Check if valid }
1665
kbDel: If (Data <> Nil) Then Begin { Delete character }
1666
If (SelStart = SelEnd) Then { Select all on }
1667
If (CurPos < Length(Data^)) Then Begin { Cursor not at end }
1668
SelStart := CurPos; { Set select start }
1669
SelEnd := CurPos + 1; { Set select end }
1671
DeleteSelect; { Deselect selection }
1672
CheckValid(True); { Check if valid }
1674
kbIns: SetState(sfCursorIns, State AND
1675
sfCursorIns = 0); { Flip insert state }
1676
Else Case Event.CharCode Of
1677
' '..#255: If (Data <> Nil) Then Begin { Character key }
1678
If (State AND sfCursorIns <> 0) Then
1679
Delete(Data^, CurPos + 1, 1) Else { Overwrite character }
1680
DeleteSelect; { Deselect selected }
1681
If CheckValid(True) Then Begin { Check data valid }
1682
If (Length(Data^) < MaxLen) Then { Must not exceed maxlen }
1684
If (FirstPos > CurPos) Then
1685
FirstPos := CurPos; { Advance first position }
1686
Inc(CurPos); { Increment cursor }
1687
Insert(Event.CharCode, Data^,
1688
CurPos); { Insert the character }
1690
CheckValid(False); { Check data valid }
1693
^Y: If (Data <> Nil) Then Begin { Clear all data }
1694
Data^ := ''; { Set empty string }
1695
CurPos := 0; { Cursor to start }
1697
Else Exit; { Unused key }
1700
If ExtendBlock Then AdjustSelectBlock { Extended block }
1702
SelStart := CurPos; { Set select start }
1703
SelEnd := CurPos; { Set select end }
1705
If (FirstPos > CurPos) Then
1706
FirstPos := CurPos; { Advance first pos }
1707
If (Data <> Nil) Then OldData := Copy(Data^,
1708
FirstPos+1, CurPos-FirstPos) { Text area string }
1709
Else OldData := ''; { Empty string }
1710
Delta := 1; { Safety = 1 char }
1711
While (TextWidth(OldData) > (Size.X-Delta)
1712
- TextWidth(LeftArr) - TextWidth(RightArr)) { Check text fits }
1714
Inc(FirstPos); { Advance first pos }
1715
OldData := Copy(Data^, FirstPos+1,
1716
CurPos-FirstPos) { Text area string }
1718
DrawView; { Redraw the view }
1719
ClearEvent(Event); { Clear the event }
1725
{***************************************************************************}
1726
{ TInputLine OBJECT PRIVATE METHODS }
1727
{***************************************************************************}
1728
{--TInputLine---------------------------------------------------------------}
1729
{ CanScroll -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
1730
{---------------------------------------------------------------------------}
1731
FUNCTION TInputLine.CanScroll (Delta: Sw_Integer): Boolean;
1734
If (Delta < 0) Then CanScroll := FirstPos > 0 { Check scroll left }
1735
Else If (Delta > 0) Then Begin
1736
If (Data = Nil) Then S := '' Else { Data ptr invalid }
1737
S := Copy(Data^, FirstPos+1, Length(Data^)
1738
- FirstPos); { Fetch max string }
1739
CanScroll := (TextWidth(S)) > (Size.X -
1740
TextWidth(LeftArr) - TextWidth(RightArr)); { Check scroll right }
1741
End Else CanScroll := False; { Zero so no scroll }
1744
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
1745
{ TButton OBJECT METHODS }
1746
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
1748
{--TButton------------------------------------------------------------------}
1749
{ Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB }
1750
{---------------------------------------------------------------------------}
1751
CONSTRUCTOR TButton.Init (Var Bounds: TRect; ATitle: TTitleStr;
1752
ACommand: Word; AFlags: Word);
1754
Inherited Init(Bounds); { Call ancestor }
1755
EventMask := EventMask OR evBroadcast; { Handle broadcasts }
1756
Options := Options OR (ofSelectable + ofFirstClick
1757
+ ofPreProcess + ofPostProcess); { Set option flags }
1758
If NOT CommandEnabled(ACommand) Then
1759
State := State OR sfDisabled; { Check command state }
1760
Flags := AFlags; { Hold flags }
1761
If (AFlags AND bfDefault <> 0) Then AmDefault := True
1762
Else AmDefault := False; { Check if default }
1763
Title := NewStr(ATitle); { Hold title string }
1764
Command := ACommand; { Hold button command }
1765
TabMask := TabMask OR (tmLeft + tmRight +
1766
tmTab + tmShiftTab + tmUp + tmDown); { Set tab masks }
1769
{--TButton------------------------------------------------------------------}
1770
{ Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB }
1771
{---------------------------------------------------------------------------}
1772
CONSTRUCTOR TButton.Load (Var S: TStream);
1774
Inherited Load(S); { Call ancestor }
1775
Title := S.ReadStr; { Read title }
1776
S.Read(Command, SizeOf(Command)); { Read command }
1777
S.Read(Flags, SizeOf(Flags)); { Read flags }
1778
S.Read(AmDefault, SizeOf(AmDefault)); { Read if default }
1779
If NOT CommandEnabled(Command) Then { Check command state }
1780
State := State OR sfDisabled Else { Command disabled }
1781
State := State AND NOT sfDisabled; { Command enabled }
1784
{--TButton------------------------------------------------------------------}
1785
{ Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB }
1786
{---------------------------------------------------------------------------}
1787
DESTRUCTOR TButton.Done;
1789
If (Title <> Nil) Then DisposeStr(Title); { Dispose title }
1790
Inherited Done; { Call ancestor }
1793
{--TButton------------------------------------------------------------------}
1794
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 25Apr98 LdB }
1795
{---------------------------------------------------------------------------}
1796
FUNCTION TButton.GetPalette: PPalette;
1797
CONST P: String[Length(CButton)] = CButton; { Always normal string }
1799
GetPalette := @P; { Get button palette }
1802
{--TButton------------------------------------------------------------------}
1803
{ Press -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 29Apr98 LdB }
1804
{---------------------------------------------------------------------------}
1805
PROCEDURE TButton.Press;
1808
Message(Owner, evBroadcast, cmRecordHistory, Nil); { Message for history }
1809
If (Flags AND bfBroadcast <> 0) Then { Broadcasting button }
1810
Message(Owner, evBroadcast, Command, @Self) { Send message }
1812
E.What := evCommand; { Command event }
1813
E.Command := Command; { Set command value }
1814
E.InfoPtr := @Self; { Pointer to self }
1815
PutEvent(E); { Put event on queue }
1819
{--TButton------------------------------------------------------------------}
1820
{ Draw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB }
1821
{---------------------------------------------------------------------------}
1822
PROCEDURE TButton.Draw;
1823
VAR I, J, Pos: Sw_Integer;
1824
Bc: Word; Db: TDrawBuffer;
1827
If (State AND sfDisabled <> 0) Then { Button disabled }
1828
Bc := GetColor($0404) Else Begin { Disabled colour }
1829
Bc := GetColor($0501); { Set normal colour }
1830
If (State AND sfActive <> 0) Then { Button is active }
1831
If (State AND sfSelected <> 0) Then
1832
Bc := GetColor($0703) Else { Set selected colour }
1833
If AmDefault Then Bc := GetColor($0602); { Set is default colour }
1835
If (Title <> Nil) Then Begin { We have a title }
1836
If (Flags AND bfLeftJust = 0) Then Begin { Not left set title }
1837
I := CTextWidth(Title^); { Fetch title width }
1838
I := (Size.X - I) DIV 2; { Centre in button }
1841
I := 1; { Left edge of button }
1844
MoveChar(Db[0],' ',GetColor(8),1);
1850
MoveChar(Db[pos+j],' ',Bc,1);
1851
MoveCStr(Db[I+pos], Title^, Bc); { Move title to buffer }
1852
For j:=pos+CStrLen(Title^)+I to size.X-2 do
1853
MoveChar(Db[j],' ',Bc,1);
1854
If not DownFlag then
1856
MoveChar(Db[Size.X-1],' ',Bc,1);
1857
WriteLine(0, 0, Size.X,
1858
1, Db); { Write the title }
1859
If Size.Y>1 then Begin
1861
if not DownFlag then
1864
MoveChar(Db,c,Bc,1);
1865
WriteLine(Size.X-1, 0, 1, 1, Db);
1867
MoveChar(Db,' ',Bc,1);
1868
if DownFlag then c:=' '
1870
MoveChar(Db[1],c,Bc,Size.X-1);
1871
WriteLine(0, 1, Size.X, 1, Db);
1876
{--TButton------------------------------------------------------------------}
1877
{ DrawState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB }
1878
{---------------------------------------------------------------------------}
1879
PROCEDURE TButton.DrawState (Down: Boolean);
1881
DownFlag := Down; { Set down flag }
1882
DrawView; { Redraw the view }
1885
{--TButton------------------------------------------------------------------}
1886
{ MakeDefault -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
1887
{---------------------------------------------------------------------------}
1888
PROCEDURE TButton.MakeDefault (Enable: Boolean);
1891
If (Flags AND bfDefault=0) Then Begin { Not default }
1892
If Enable Then C := cmGrabDefault
1893
Else C := cmReleaseDefault; { Change default }
1894
Message(Owner, evBroadcast, C, @Self); { Message to owner }
1895
AmDefault := Enable; { Set default flag }
1896
DrawView; { Now redraw button }
1900
{--TButton------------------------------------------------------------------}
1901
{ SetState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Oct99 LdB }
1902
{---------------------------------------------------------------------------}
1903
PROCEDURE TButton.SetState (AState: Word; Enable: Boolean);
1905
Inherited SetState(AState, Enable); { Call ancestor }
1906
If (AState AND (sfSelected + sfActive) <> 0) { Changing select }
1907
Then DrawView; { Redraw required }
1908
If (AState AND sfFocused <> 0) Then
1909
MakeDefault(Enable); { Check for default }
1912
{--TButton------------------------------------------------------------------}
1913
{ Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
1914
{---------------------------------------------------------------------------}
1915
PROCEDURE TButton.Store (Var S: TStream);
1917
TView.Store(S); { Implict TView.Store }
1918
S.WriteStr(Title); { Store title string }
1919
S.Write(Command, SizeOf(Command)); { Store command }
1920
S.Write(Flags, SizeOf(Flags)); { Store flags }
1921
S.Write(AmDefault, SizeOf(AmDefault)); { Store default flag }
1924
{--TButton------------------------------------------------------------------}
1925
{ HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Sep99 LdB }
1926
{---------------------------------------------------------------------------}
1927
PROCEDURE TButton.HandleEvent (Var Event: TEvent);
1928
VAR Down: Boolean; C: Char; ButRect: TRect;
1931
ButRect.A.X := 0; { Get origin point }
1932
ButRect.A.Y := 0; { Get origin point }
1933
ButRect.B.X := Size.X + 2; { Calc right side }
1934
ButRect.B.Y := Size.Y + 1; { Calc bottom }
1935
If (Event.What = evMouseDown) Then Begin { Mouse down event }
1936
MakeLocal(Event.Where, Mouse);
1937
If NOT ButRect.Contains(Mouse) Then Begin { If point not in view }
1938
ClearEvent(Event); { Clear the event }
1939
Exit; { Speed up exit }
1942
If (Flags AND bfGrabFocus <> 0) Then { Check focus grab }
1943
Inherited HandleEvent(Event); { Call ancestor }
1945
evNothing: Exit; { Speed up exit }
1947
If (State AND sfDisabled = 0) Then Begin { Button not disabled }
1948
Down := False; { Clear down flag }
1950
MakeLocal(Event.Where, Mouse);
1951
If (Down <> ButRect.Contains(Mouse)) { State has changed }
1953
Down := NOT Down; { Invert down flag }
1954
DrawState(Down); { Redraw button }
1956
Until NOT MouseEvent(Event, evMouseMove); { Wait for mouse move }
1957
If Down Then Begin { Button is down }
1958
Press; { Send out command }
1959
DrawState(False); { Draw button up }
1962
ClearEvent(Event); { Event was handled }
1965
If (Title <> Nil) Then C := HotKey(Title^) { Key title hotkey }
1966
Else C := #0; { Invalid title }
1967
If (Event.KeyCode = GetAltCode(C)) OR { Alt char }
1968
(Owner^.Phase = phPostProcess) AND (C <> #0)
1969
AND (Upcase(Event.CharCode) = C) OR { Matches hotkey }
1970
(State AND sfFocused <> 0) AND { View focused }
1971
((Event.CharCode = ' ') OR { Space bar }
1972
(Event.KeyCode=kbEnter)) Then Begin { Enter key }
1973
DrawState(True); { Draw button down }
1974
Press; { Send out command }
1975
ClearEvent(Event); { Clear the event }
1976
DrawState(False); { Draw button up }
1980
Case Event.Command of
1981
cmDefault: If AmDefault AND { Default command }
1982
(State AND sfDisabled = 0) Then Begin { Button enabled }
1983
Press; { Send out command }
1984
ClearEvent(Event); { Clear the event }
1986
cmGrabDefault, cmReleaseDefault: { Grab and release cmd }
1987
If (Flags AND bfDefault <> 0) Then Begin { Change button state }
1988
AmDefault := Event.Command = cmReleaseDefault;
1989
DrawView; { Redraw the view }
1991
cmCommandSetChanged: Begin { Command set changed }
1992
SetState(sfDisabled, NOT
1993
CommandEnabled(Command)); { Set button state }
1994
DrawView; { Redraw the view }
2000
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
2001
{ TCluster OBJECT METHODS }
2002
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
2004
CONST TvClusterClassName = 'TVCLUSTER';
2006
{--TCluster-----------------------------------------------------------------}
2007
{ Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28May98 LdB }
2008
{---------------------------------------------------------------------------}
2009
CONSTRUCTOR TCluster.Init (Var Bounds: TRect; AStrings: PSItem);
2010
VAR I: Sw_Integer; P: PSItem;
2012
Inherited Init(Bounds); { Call ancestor }
2013
Options := Options OR (ofSelectable + ofFirstClick
2014
+ ofPreProcess + ofPostProcess + ofVersion20); { Set option masks }
2015
I := 0; { Zero string count }
2016
P := AStrings; { First item }
2017
While (P <> Nil) Do Begin
2018
Inc(I); { Count 1 item }
2019
P := P^.Next; { Move to next item }
2021
Strings.Init(I, 0); { Create collection }
2022
While (AStrings <> Nil) Do Begin
2023
P := AStrings; { Transfer item ptr }
2024
Strings.AtInsert(Strings.Count, AStrings^.Value);{ Insert string }
2025
AStrings := AStrings^.Next; { Move to next item }
2026
Dispose(P); { Dispose prior item }
2031
EnableMask := Sw_Integer($FFFFFFFF); { Enable bit masks }
2034
{--TCluster-----------------------------------------------------------------}
2035
{ Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Oct99 LdB }
2036
{---------------------------------------------------------------------------}
2037
CONSTRUCTOR TCluster.Load (Var S: TStream);
2040
Inherited Load(S); { Call ancestor }
2041
If ((Options AND ofVersion) >= ofVersion20) Then { Version 2 TV view }
2043
S.Read(Value, SizeOf(Value)); { Read value }
2044
S.Read(Sel, Sizeof(Sel)); { Read select item }
2045
S.Read(EnableMask, SizeOf(EnableMask)) { Read enable masks }
2050
S.Read(w, SizeOf(w)); Value:=w; { Read value }
2051
S.Read(Sel, SizeOf(Sel)); { Read select item }
2052
EnableMask := Sw_integer($FFFFFFFF); { Enable all masks }
2053
Options := Options OR ofVersion20; { Set version 2 mask }
2055
Strings.Load(S); { Load string data }
2056
SetButtonState(0, True); { Set button state }
2059
{--TCluster-----------------------------------------------------------------}
2060
{ Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Jul99 LdB }
2061
{---------------------------------------------------------------------------}
2062
DESTRUCTOR TCluster.Done;
2064
Strings.Done; { Dispose of strings }
2065
Inherited Done; { Call ancestor }
2068
{--TCluster-----------------------------------------------------------------}
2069
{ DataSize -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB }
2070
{---------------------------------------------------------------------------}
2071
FUNCTION TCluster.DataSize: Sw_Word;
2073
DataSize := SizeOf(Sw_Word); { Exchanges a word }
2076
{--TCluster-----------------------------------------------------------------}
2077
{ GetHelpCtx -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB }
2078
{---------------------------------------------------------------------------}
2079
FUNCTION TCluster.GetHelpCtx: Word;
2081
If (HelpCtx = hcNoContext) Then { View has no help }
2082
GetHelpCtx := hcNoContext Else { No help context }
2083
GetHelpCtx := HelpCtx + Sel; { Help of selected }
2086
{--TCluster-----------------------------------------------------------------}
2087
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB }
2088
{---------------------------------------------------------------------------}
2089
FUNCTION TCluster.GetPalette: PPalette;
2090
CONST P: String[Length(CCluster)] = CCluster; { Always normal string }
2092
GetPalette := @P; { Cluster palette }
2095
{--TCluster-----------------------------------------------------------------}
2096
{ Mark -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04May98 LdB }
2097
{---------------------------------------------------------------------------}
2098
FUNCTION TCluster.Mark (Item: Sw_Integer): Boolean;
2100
Mark := False; { Default false }
2103
{--TCluster-----------------------------------------------------------------}
2104
{ MultiMark -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04May98 LdB }
2105
{---------------------------------------------------------------------------}
2106
FUNCTION TCluster.MultiMark (Item: Sw_Integer): Byte;
2108
MultiMark := Byte(Mark(Item) = True); { Return multi mark }
2111
{--TCluster-----------------------------------------------------------------}
2112
{ ButtonState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB }
2113
{---------------------------------------------------------------------------}
2114
FUNCTION TCluster.ButtonState (Item: Sw_Integer): Boolean;
2116
If (Item > 31) Then ButtonState := False Else { Impossible item }
2117
ButtonState := ((1 SHL Item) AND EnableMask)<>0; { Return true/false }
2120
{--TCluster-----------------------------------------------------------------}
2121
{ Draw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Jul99 LdB }
2122
{---------------------------------------------------------------------------}
2123
PROCEDURE TCluster.Draw;
2127
{--TCluster-----------------------------------------------------------------}
2128
{ Press -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB }
2129
{---------------------------------------------------------------------------}
2130
PROCEDURE TCluster.Press (Item: Sw_Integer);
2134
If (Id <> 0) AND (P <> Nil) Then NewMessage(P,
2135
evCommand, cmIdCommunicate, Id, Value, @Self); { Send new message }
2138
{--TCluster-----------------------------------------------------------------}
2139
{ MovedTo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB }
2140
{---------------------------------------------------------------------------}
2141
PROCEDURE TCluster.MovedTo (Item: Sw_Integer);
2142
BEGIN { Abstract method }
2145
{--TCluster-----------------------------------------------------------------}
2146
{ SetState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB }
2147
{---------------------------------------------------------------------------}
2148
PROCEDURE TCluster.SetState (AState: Word; Enable: Boolean);
2150
Inherited SetState(AState, Enable); { Call ancestor }
2151
If (AState AND sfFocused <> 0) Then Begin
2152
DrawView; { Redraw masked areas }
2156
{--TCluster-----------------------------------------------------------------}
2157
{ DrawMultiBox -> Platforms DOS/DPMI/WIN/NT - Updated 05Jun98 LdB }
2158
{---------------------------------------------------------------------------}
2159
PROCEDURE TCluster.DrawMultiBox (Const Icon, Marker: String);
2160
VAR I, J, Cur, Col: Sw_Integer; CNorm, CSel, CDis, Color: Word; B: TDrawBuffer;
2162
CNorm := GetColor($0301); { Normal colour }
2163
CSel := GetColor($0402); { Selected colour }
2164
CDis := GetColor($0505); { Disabled colour }
2165
For I := 0 To Size.Y-1 Do Begin { For each line }
2166
MoveChar(B, ' ', Byte(CNorm), Size.X); { Fill buffer }
2167
For J := 0 To (Strings.Count - 1) DIV Size.Y + 1
2169
Cur := J*Size.Y + I; { Current line }
2170
If (Cur < Strings.Count) Then Begin
2171
Col := Column(Cur); { Calc column }
2172
If (Col + CStrLen(PString(Strings.At(Cur))^)+
2173
5 < Sizeof(TDrawBuffer) DIV SizeOf(Word))
2174
AND (Col < Size.X) Then Begin { Text fits in column }
2175
If NOT ButtonState(Cur) Then
2176
Color := CDis Else If (Cur = Sel) AND { Disabled colour }
2177
(State and sfFocused <> 0) Then
2178
Color := CSel Else { Selected colour }
2179
Color := CNorm; { Normal colour }
2180
MoveChar(B[Col], ' ', Byte(Color),
2181
Size.X-Col); { Set this colour }
2182
MoveStr(B[Col], Icon, Byte(Color)); { Transfer icon string }
2183
WordRec(B[Col+2]).Lo := Byte(Marker[
2184
MultiMark(Cur) + 1]); { Transfer marker }
2185
MoveCStr(B[Col+5], PString(Strings.At(
2186
Cur))^, Color); { Transfer item string }
2187
If ShowMarkers AND (State AND sfFocused <> 0)
2188
AND (Cur = Sel) Then Begin { Current is selected }
2189
WordRec(B[Col]).Lo := Byte(SpecialChars[0]);
2190
WordRec(B[Column(Cur+Size.Y)-1]).Lo
2191
:= Byte(SpecialChars[1]); { Set special character }
2196
WriteBuf(0, I, Size.X, 1, B); { Write buffer }
2198
SetCursor(Column(Sel)+2,Row(Sel));
2201
{--TCluster-----------------------------------------------------------------}
2202
{ DrawBox -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB }
2203
{---------------------------------------------------------------------------}
2204
PROCEDURE TCluster.DrawBox (Const Icon: String; Marker: Char);
2206
DrawMultiBox(Icon, ' '+Marker); { Call draw routine }
2209
{--TCluster-----------------------------------------------------------------}
2210
{ SetButtonState -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB }
2211
{---------------------------------------------------------------------------}
2212
PROCEDURE TCluster.SetButtonState (AMask: Longint; Enable: Boolean);
2213
VAR I: Sw_Integer; M: Longint;
2215
If Enable Then EnableMask := EnableMask OR AMask { Set enable bit mask }
2216
Else EnableMask := EnableMask AND NOT AMask; { Disable bit mask }
2217
If (Strings.Count <= 32) Then Begin { Valid string number }
2218
M := 1; { Preset bit masks }
2219
For I := 1 To Strings.Count Do Begin { For each item string }
2220
If ((M AND EnableMask) <> 0) Then Begin { Bit enabled }
2221
Options := Options OR ofSelectable; { Set selectable option }
2224
M := M SHL 1; { Create newbit mask }
2226
Options := Options AND NOT ofSelectable; { Make not selectable }
2230
{--TCluster-----------------------------------------------------------------}
2231
{ GetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04May98 LdB }
2232
{---------------------------------------------------------------------------}
2233
PROCEDURE TCluster.GetData (Var Rec);
2235
sw_Word(Rec) := Value; { Return current value }
2238
{--TCluster-----------------------------------------------------------------}
2239
{ SetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04May98 LdB }
2240
{---------------------------------------------------------------------------}
2241
PROCEDURE TCluster.SetData (Var Rec);
2243
Value :=sw_Word(Rec); { Set current value }
2244
DrawView; { Redraw masked areas }
2247
{--TCluster-----------------------------------------------------------------}
2248
{ Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB }
2249
{---------------------------------------------------------------------------}
2250
PROCEDURE TCluster.Store (Var S: TStream);
2254
TView.Store(S); { TView.Store called }
2255
If ((Options AND ofVersion) >= ofVersion20) { Version 2 TV view }
2257
S.Write(Value, SizeOf(Value)); { Write value }
2258
S.Write(Sel, SizeOf(Sel)); { Write select item }
2259
S.Write(EnableMask, SizeOf(EnableMask)); { Write enable masks }
2262
S.Write(w, SizeOf(Word)); { Write value }
2263
S.Write(Sel, SizeOf(Sel)); { Write select item }
2265
Strings.Store(S); { Store strings }
2268
{--TCluster-----------------------------------------------------------------}
2269
{ HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04Jun98 LdB }
2270
{---------------------------------------------------------------------------}
2271
PROCEDURE TCluster.HandleEvent (Var Event: TEvent);
2272
VAR C: Char; I, S, Vh: Sw_Integer; Key: Word; Mouse: TPoint; Ts: PString;
2276
If (I <= Strings.Count) Then Begin
2277
Sel := S; { Set selected item }
2278
MovedTo(Sel); { Move to selected }
2279
DrawView; { Now draw changes }
2284
Inherited HandleEvent(Event); { Call ancestor }
2285
If ((Options AND ofSelectable) = 0) Then Exit; { Check selectable }
2286
If (Event.What = evMouseDown) Then Begin { MOUSE EVENT }
2287
MakeLocal(Event.Where, Mouse); { Make point local }
2288
I := FindSel(Mouse); { Find selected item }
2289
If (I <> -1) Then { Check in view }
2290
If ButtonState(I) Then Sel := I; { If enabled select }
2291
DrawView; { Now draw changes }
2293
MakeLocal(Event.Where, Mouse); { Make point local }
2294
Until NOT MouseEvent(Event, evMouseMove); { Wait for mouse up }
2295
MakeLocal(Event.Where, Mouse); { Make point local }
2296
If (FindSel(Mouse) = Sel) AND ButtonState(Sel) { If valid/selected }
2298
Press(Sel); { Call pressed }
2299
DrawView; { Now draw changes }
2301
ClearEvent(Event); { Event was handled }
2302
End Else If (Event.What = evKeyDown) Then Begin { KEY EVENT }
2303
Vh := Size.Y; { View height }
2304
S := Sel; { Hold current item }
2305
Key := CtrlToArrow(Event.KeyCode); { Convert keystroke }
2307
kbUp, kbDown, kbRight, kbLeft:
2308
If (State AND sfFocused <> 0) Then Begin { Focused key event }
2309
I := 0; { Zero process count }
2311
Inc(I); { Inc process count }
2313
kbUp: Dec(S); { Next item up }
2314
kbDown: Inc(S); { Next item down }
2315
kbRight: Begin { Next column across }
2316
Inc(S, Vh); { Move to next column }
2317
If (S >= Strings.Count) Then { No next column check }
2318
S := (S+1) MOD Vh; { Move to last column }
2320
kbLeft: Begin { Prior column across }
2321
Dec(S, Vh); { Move to prior column }
2322
If (S < 0) Then S := ((Strings.Count +
2323
Vh - 1) DIV Vh) * Vh + S - 1; { No prior column check }
2326
If (S >= Strings.Count) Then S := 0; { Roll up to top }
2327
If (S < 0) Then S := Strings.Count - 1; { Roll down to bottom }
2328
Until ButtonState(S) OR (I > Strings.Count); { Repeat until select }
2329
MoveSel; { Move to selected }
2330
ClearEvent(Event); { Event was handled }
2332
Else Begin { Not an arrow key }
2333
For I := 0 To Strings.Count-1 Do Begin { Scan each item }
2334
Ts := Strings.At(I); { Fetch string pointer }
2335
If (Ts <> Nil) Then C := HotKey(Ts^) { Check for hotkey }
2336
Else C := #0; { No valid string }
2337
If (GetAltCode(C) = Event.KeyCode) OR { Hot key for item }
2338
(((Owner^.Phase = phPostProcess) OR { Owner in post process }
2339
(State AND sfFocused <> 0)) AND (C <> #0) { Non zero hotkey }
2340
AND (UpCase(Event.CharCode) = C)) { Matches current key }
2342
If ButtonState(I) Then Begin { Check mask enabled }
2343
If Focus Then Begin { Check view focus }
2344
Sel := I; { Set selected }
2345
MovedTo(Sel); { Move to selected }
2346
Press(Sel); { Call pressed }
2347
DrawView; { Now draw changes }
2349
ClearEvent(Event); { Event was handled }
2354
If (Event.CharCode = ' ') AND { Spacebar key }
2355
(State AND sfFocused <> 0) AND { Check focused view }
2356
ButtonState(Sel) Then Begin { Check item enabled }
2357
Press(Sel); { Call pressed }
2358
DrawView; { Now draw changes }
2359
ClearEvent(Event); { Event was handled }
2366
{***************************************************************************}
2367
{ TCluster OBJECT PRIVATE METHODS }
2368
{***************************************************************************}
2370
{--TCluster-----------------------------------------------------------------}
2371
{ FindSel -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB }
2372
{---------------------------------------------------------------------------}
2373
FUNCTION TCluster.FindSel (P: TPoint): Sw_Integer;
2374
VAR I, S, Vh: Sw_Integer; R: TRect;
2376
GetExtent(R); { Get view extents }
2377
If R.Contains(P) Then Begin { Point in view }
2378
Vh := Size.Y; { View height }
2379
I := 0; { Preset zero value }
2380
While (P.X >= Column(I+Vh)) Do Inc(I, Vh); { Inc view size }
2381
S := I + P.Y; { Line to select }
2382
If ((S >= 0) AND (S < Strings.Count)) { Valid selection }
2383
Then FindSel := S Else FindSel := -1; { Return selected item }
2384
End Else FindSel := -1; { Point outside view }
2387
{--TCluster-----------------------------------------------------------------}
2388
{ Row -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB }
2389
{---------------------------------------------------------------------------}
2390
FUNCTION TCluster.Row (Item: Sw_Integer): Sw_Integer;
2392
Row := Item MOD Size.Y; { Normal mod value }
2395
{--TCluster-----------------------------------------------------------------}
2396
{ Column -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 03Jun98 LdB }
2397
{---------------------------------------------------------------------------}
2398
FUNCTION TCluster.Column (Item: Sw_Integer): Sw_Integer;
2399
VAR I, Col, Width, L, Vh: Sw_Integer; Ts: PString;
2401
Vh := Size.Y; { Vertical size }
2402
If (Item >= Vh) Then Begin { Valid selection }
2403
Width := 0; { Zero width }
2404
Col := -6; { Start column at -6 }
2405
For I := 0 To Item Do Begin { For each item }
2406
If (I MOD Vh = 0) Then Begin { Start next column }
2407
Inc(Col, Width + 6); { Add column width }
2408
Width := 0; { Zero width }
2410
If (I < Strings.Count) Then Begin { Valid string }
2411
Ts := Strings.At(I); { Transfer string }
2412
If (Ts <> Nil) Then L := CStrLen(Ts^) { Length of string }
2413
Else L := 0; { No string }
2415
If (L > Width) Then Width := L; { Hold longest string }
2417
Column := Col; { Return column }
2418
End Else Column := 0; { Outside select area }
2421
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
2422
{ TRadioButtons OBJECT METHODS }
2423
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
2425
{--TRadioButtons------------------------------------------------------------}
2426
{ Mark -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB }
2427
{---------------------------------------------------------------------------}
2428
FUNCTION TRadioButtons.Mark (Item: Sw_Integer): Boolean;
2430
Mark := Item = Value; { True if item = value }
2433
{--TRadioButtons------------------------------------------------------------}
2434
{ Draw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04May98 LdB }
2435
{---------------------------------------------------------------------------}
2436
PROCEDURE TRadioButtons.Draw;
2437
CONST Button = ' ( ) ';
2440
DrawMultiBox(Button, ' *'); { Redraw the text }
2443
{--TRadioButtons------------------------------------------------------------}
2444
{ Press -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB }
2445
{---------------------------------------------------------------------------}
2446
PROCEDURE TRadioButtons.Press (Item: Sw_Integer);
2448
Value := Item; { Set value field }
2449
Inherited Press(Item); { Call ancestor }
2452
{--TRadioButtons------------------------------------------------------------}
2453
{ MovedTo -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04May98 LdB }
2454
{---------------------------------------------------------------------------}
2455
PROCEDURE TRadioButtons.MovedTo (Item: Sw_Integer);
2457
Value := Item; { Set value to item }
2458
If (Id <> 0) Then NewMessage(Owner, evCommand,
2459
cmIdCommunicate, Id, Value, @Self); { Send new message }
2462
{--TRadioButtons------------------------------------------------------------}
2463
{ SetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04May98 LdB }
2464
{---------------------------------------------------------------------------}
2465
PROCEDURE TRadioButtons.SetData (Var Rec);
2467
Sel := Sw_word(Rec); { Set selection }
2468
Inherited SetData(Rec); { Call ancestor }
2471
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
2472
{ TCheckBoxes OBJECT METHODS }
2473
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
2475
{--TCheckBoxes--------------------------------------------------------------}
2476
{ Mark -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB }
2477
{---------------------------------------------------------------------------}
2478
FUNCTION TCheckBoxes.Mark(Item: Sw_Integer): Boolean;
2480
If (Value AND (1 SHL Item) <> 0) Then { Check if item ticked }
2481
Mark := True Else Mark := False; { Return result }
2484
{--TCheckBoxes--------------------------------------------------------------}
2485
{ Draw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 04May98 LdB }
2486
{---------------------------------------------------------------------------}
2487
PROCEDURE TCheckBoxes.Draw;
2488
CONST Button = ' [ ] ';
2491
DrawMultiBox(Button, ' X'); { Redraw the text }
2494
{--TCheckBoxes--------------------------------------------------------------}
2495
{ Press -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Apr98 LdB }
2496
{---------------------------------------------------------------------------}
2497
PROCEDURE TCheckBoxes.Press (Item: Sw_Integer);
2499
Value := Value XOR (1 SHL Item); { Flip the item mask }
2500
Inherited Press(Item); { Call ancestor }
2503
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
2504
{ TMultiCheckBoxes OBJECT METHODS }
2505
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
2507
{--TMultiCheckBoxes---------------------------------------------------------}
2508
{ Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 05Jun98 LdB }
2509
{---------------------------------------------------------------------------}
2510
CONSTRUCTOR TMultiCheckBoxes.Init (Var Bounds: TRect; AStrings: PSItem;
2511
ASelRange: Byte; AFlags: Word; Const AStates: String);
2513
Inherited Init(Bounds, AStrings); { Call ancestor }
2514
SelRange := ASelRange; { Hold select range }
2515
Flags := AFlags; { Hold flags }
2516
States := NewStr(AStates); { Hold string }
2519
{--TMultiCheckBoxes---------------------------------------------------------}
2520
{ Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
2521
{---------------------------------------------------------------------------}
2522
CONSTRUCTOR TMultiCheckBoxes.Load (Var S: TStream);
2524
Inherited Load(S); { Call ancestor }
2525
S.Read(SelRange, SizeOf(SelRange)); { Read select range }
2526
S.Read(Flags, SizeOf(Flags)); { Read flags }
2527
States := S.ReadStr; { Read strings }
2530
{--TMultiCheckBoxes---------------------------------------------------------}
2531
{ Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
2532
{---------------------------------------------------------------------------}
2533
DESTRUCTOR TMultiCheckBoxes.Done;
2535
If (States <> Nil) Then DisposeStr(States); { Dispose strings }
2536
Inherited Done; { Call ancestor }
2539
{--TMultiCheckBoxes---------------------------------------------------------}
2540
{ DataSize -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
2541
{---------------------------------------------------------------------------}
2542
FUNCTION TMultiCheckBoxes.DataSize: Sw_Word;
2544
DataSize := SizeOf(LongInt); { Size to exchange }
2547
{--TMultiCheckBoxes---------------------------------------------------------}
2548
{ MultiMark -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
2549
{---------------------------------------------------------------------------}
2550
FUNCTION TMultiCheckBoxes.MultiMark (Item: Sw_Integer): Byte;
2552
MultiMark := (Value SHR (Word(Item) *
2553
WordRec(Flags).Hi)) AND WordRec(Flags).Lo; { Return mark state }
2556
{--TMultiCheckBoxes---------------------------------------------------------}
2557
{ Draw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
2558
{---------------------------------------------------------------------------}
2559
PROCEDURE TMultiCheckBoxes.Draw;
2560
CONST Button = ' [ ] ';
2563
DrawMultiBox(Button, States^); { Draw the items }
2566
{--TMultiCheckBoxes---------------------------------------------------------}
2567
{ Press -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
2568
{---------------------------------------------------------------------------}
2569
PROCEDURE TMultiCheckBoxes.Press (Item: Sw_Integer);
2570
VAR CurState: ShortInt;
2572
CurState := (Value SHR (Word(Item) *
2573
WordRec(Flags).Hi)) AND WordRec(Flags).Lo; { Hold current state }
2574
Dec(CurState); { One down }
2575
If (CurState >= SelRange) OR (CurState < 0) Then
2576
CurState := SelRange - 1; { Roll if needed }
2577
Value := (Value AND NOT (LongInt(WordRec(Flags).Lo)
2578
SHL (Word(Item) * WordRec(Flags).Hi))) OR
2579
(LongInt(CurState) SHL (Word(Item) *
2580
WordRec(Flags).Hi)); { Calculate value }
2581
Inherited Press(Item); { Call ancestor }
2584
{--TMultiCheckBoxes---------------------------------------------------------}
2585
{ GetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
2586
{---------------------------------------------------------------------------}
2587
PROCEDURE TMultiCheckBoxes.GetData (Var Rec);
2589
Longint(Rec) := Value; { Return value }
2592
{--TMultiCheckBoxes---------------------------------------------------------}
2593
{ SetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
2594
{---------------------------------------------------------------------------}
2595
PROCEDURE TMultiCheckBoxes.SetData (Var Rec);
2597
Value := Longint(Rec); { Set value }
2598
DrawView; { Redraw masked areas }
2601
{--TMultiCheckBoxes---------------------------------------------------------}
2602
{ Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
2603
{---------------------------------------------------------------------------}
2604
PROCEDURE TMultiCheckBoxes.Store (Var S: TStream);
2606
TCluster.Store(S); { TCluster store called }
2607
S.Write(SelRange, SizeOf(SelRange)); { Write select range }
2608
S.Write(Flags, SizeOf(Flags)); { Write select flags }
2609
S.WriteStr(States); { Write strings }
2612
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
2613
{ TListBox OBJECT METHODS }
2614
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
2617
TListBoxRec = PACKED RECORD
2618
List: PCollection; { List collection ptr }
2619
Selection: sw_integer; { Selected item }
2622
{--TListBox-----------------------------------------------------------------}
2623
{ Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
2624
{---------------------------------------------------------------------------}
2625
CONSTRUCTOR TListBox.Init (Var Bounds: TRect; ANumCols: Sw_Word;
2626
AScrollBar: PScrollBar);
2628
Inherited Init(Bounds, ANumCols, Nil, AScrollBar); { Call ancestor }
2629
SetRange(0); { Set range to zero }
2632
{--TListBox-----------------------------------------------------------------}
2633
{ Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
2634
{---------------------------------------------------------------------------}
2635
CONSTRUCTOR TListBox.Load (Var S: TStream);
2637
Inherited Load(S); { Call ancestor }
2638
List := PCollection(S.Get); { Fetch collection }
2641
{--TListBox-----------------------------------------------------------------}
2642
{ DataSize -> Platforms DOS/DPMI/WIN/NT/Os2 - Updated 06Jun98 LdB }
2643
{---------------------------------------------------------------------------}
2644
FUNCTION TListBox.DataSize: Sw_Word;
2646
DataSize := SizeOf(TListBoxRec); { Xchg data size }
2649
{--TListBox-----------------------------------------------------------------}
2650
{ GetText -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
2651
{---------------------------------------------------------------------------}
2652
FUNCTION TListBox.GetText (Item: Sw_Integer; MaxLen: Sw_Integer): String;
2655
GetText := ''; { Preset return }
2656
If (List <> Nil) Then Begin { A list exists }
2657
P := PString(List^.At(Item)); { Get string ptr }
2658
If (P <> Nil) Then GetText := P^; { Return string }
2662
{--TListBox-----------------------------------------------------------------}
2663
{ NewList -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
2664
{---------------------------------------------------------------------------}
2665
PROCEDURE TListBox.NewList (AList: PCollection);
2667
If (List <> Nil) Then Dispose(List, Done); { Dispose old list }
2668
List := AList; { Hold new list }
2669
If (AList <> Nil) Then SetRange(AList^.Count) { Set new item range }
2670
Else SetRange(0); { Set zero range }
2671
If (Range > 0) Then FocusItem(0); { Focus first item }
2672
DrawView; { Redraw all view }
2675
{--TListBox-----------------------------------------------------------------}
2676
{ GetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
2677
{---------------------------------------------------------------------------}
2678
PROCEDURE TListBox.GetData (Var Rec);
2680
TListBoxRec(Rec).List := List; { Return current list }
2681
TListBoxRec(Rec).Selection := Focused; { Return focused item }
2684
{--TListBox-----------------------------------------------------------------}
2685
{ SetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
2686
{---------------------------------------------------------------------------}
2687
PROCEDURE TListBox.SetData (Var Rec);
2689
NewList(TListBoxRec(Rec).List); { Hold new list }
2690
FocusItem(TListBoxRec(Rec).Selection); { Focus selected item }
2691
DrawView; { Redraw all view }
2694
{--TListBox-----------------------------------------------------------------}
2695
{ Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
2696
{---------------------------------------------------------------------------}
2697
PROCEDURE TListBox.Store (Var S: TStream);
2699
TListViewer.Store(S); { TListViewer store }
2700
S.Put(List); { Store list to stream }
2703
{****************************************************************************}
2704
{ TListBox.DeleteFocusedItem }
2705
{****************************************************************************}
2706
procedure TListBox.DeleteFocusedItem;
2708
DeleteItem(Focused);
2711
{****************************************************************************}
2712
{ TListBox.DeleteItem }
2713
{****************************************************************************}
2714
procedure TListBox.DeleteItem (Item : Sw_Integer);
2716
if (List <> nil) and (List^.Count > 0) and
2717
((Item < List^.Count) and (Item > -1)) then begin
2718
if IsSelected(Item) and (Item > 0) then
2719
FocusItem(Item - 1);
2720
List^.AtDelete(Item);
2721
SetRange(List^.Count);
2725
{****************************************************************************}
2726
{ TListBox.FreeAll }
2727
{****************************************************************************}
2728
procedure TListBox.FreeAll;
2730
if (List <> nil) then
2733
SetRange(List^.Count);
2737
{****************************************************************************}
2738
{ TListBox.FreeFocusedItem }
2739
{****************************************************************************}
2740
procedure TListBox.FreeFocusedItem;
2745
{****************************************************************************}
2746
{ TListBox.FreeItem }
2747
{****************************************************************************}
2748
procedure TListBox.FreeItem (Item : Sw_Integer);
2750
if (Item > -1) and (Item < Range) then
2753
if (Range > 1) and (Focused >= List^.Count) then
2755
SetRange(List^.Count);
2759
{****************************************************************************}
2760
{ TListBox.SetFocusedItem }
2761
{****************************************************************************}
2762
procedure TListBox.SetFocusedItem (Item : Pointer);
2764
FocusItem(List^.IndexOf(Item));
2767
{****************************************************************************}
2768
{ TListBox.GetFocusedItem }
2769
{****************************************************************************}
2770
function TListBox.GetFocusedItem : Pointer;
2772
if (List = nil) or (List^.Count = 0) then
2773
GetFocusedItem := nil
2774
else GetFocusedItem := List^.At(Focused);
2777
{****************************************************************************}
2779
{****************************************************************************}
2780
procedure TListBox.Insert (Item : Pointer);
2782
if (List <> nil) then
2785
SetRange(List^.Count);
2790
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
2791
{ TStaticText OBJECT METHODS }
2792
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
2794
{--TStaticText--------------------------------------------------------------}
2795
{ Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
2796
{---------------------------------------------------------------------------}
2797
CONSTRUCTOR TStaticText.Init (Var Bounds: TRect; Const AText: String);
2799
Inherited Init(Bounds); { Call ancestor }
2800
Text := NewStr(AText); { Create string ptr }
2803
{--TStaticText--------------------------------------------------------------}
2804
{ Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
2805
{---------------------------------------------------------------------------}
2806
CONSTRUCTOR TStaticText.Load (Var S: TStream);
2808
Inherited Load(S); { Call ancestor }
2809
Text := S.ReadStr; { Read text string }
2812
{--TStaticText--------------------------------------------------------------}
2813
{ Done -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
2814
{---------------------------------------------------------------------------}
2815
DESTRUCTOR TStaticText.Done;
2817
If (Text <> Nil) Then DisposeStr(Text); { Dispose string }
2818
Inherited Done; { Call ancestor }
2821
{--TStaticText--------------------------------------------------------------}
2822
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
2823
{---------------------------------------------------------------------------}
2824
FUNCTION TStaticText.GetPalette: PPalette;
2825
CONST P: String[Length(CStaticText)] = CStaticText; { Always normal string }
2827
GetPalette := @P; { Return palette }
2830
{--TStaticText--------------------------------------------------------------}
2831
{ DrawBackGround -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
2832
{---------------------------------------------------------------------------}
2833
PROCEDURE TStaticText.Draw;
2834
VAR Just: Byte; I, J, P, Y, L: Sw_Integer; S: String;
2838
GetText(S); { Fetch text to write }
2839
Color := GetColor(1);
2840
P := 1; { X start position }
2841
Y := 0; { Y start position }
2842
L := Length(S); { Length of text }
2843
While (Y < Size.Y) Do Begin
2844
MoveChar(B, ' ', Color, Size.X);
2847
Just := 0; { Default left justify }
2848
If (S[P] = #2) Then Begin { Right justify char }
2849
Just := 2; { Set right justify }
2850
Inc(P); { Next character }
2852
If (S[P] = #3) Then Begin { Centre justify char }
2853
Just := 1; { Set centre justify }
2854
Inc(P); { Next character }
2856
I := P; { Start position }
2859
while (P <= L) and (S[P] = ' ') do
2861
while (P <= L) and (S[P] <> ' ') and (S[P] <> #13) do
2863
until (P > L) or (P >= I + Size.X) or (S[P] = #13);
2864
If P > I + Size.X Then { Text to long }
2870
0: J := 0; { Left justify }
2871
1: J := (Size.X - (P-I)) DIV 2; { Centre justify }
2872
2: J := Size.X - (P-I); { Right justify }
2874
MoveBuf(B[J], S[I], Color, P - I);
2875
While (P <= L) AND (P-I <= Size.X) AND ((S[P] = #13) OR (S[P] = #10))
2876
Do Inc(P); { Remove CR/LF }
2878
WriteLine(0, Y, Size.X, 1, B);
2879
Inc(Y); { Next line }
2883
{--TStaticText--------------------------------------------------------------}
2884
{ Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
2885
{---------------------------------------------------------------------------}
2886
PROCEDURE TStaticText.Store (Var S: TStream);
2888
TView.Store(S); { Call TView store }
2889
S.WriteStr(Text); { Write text string }
2892
{--TStaticText--------------------------------------------------------------}
2893
{ GetText -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
2894
{---------------------------------------------------------------------------}
2895
PROCEDURE TStaticText.GetText (Var S: String);
2897
If (Text <> Nil) Then S := Text^ { Copy text string }
2898
Else S := ''; { Return empty string }
2901
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
2902
{ TParamText OBJECT METHODS }
2903
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
2905
{--TParamText---------------------------------------------------------------}
2906
{ Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
2907
{---------------------------------------------------------------------------}
2908
CONSTRUCTOR TParamText.Init (Var Bounds: TRect; Const AText: String;
2909
AParamCount: Sw_Integer);
2911
Inherited Init(Bounds, AText); { Call ancestor }
2912
ParamCount := AParamCount; { Hold param count }
2915
{--TParamText---------------------------------------------------------------}
2916
{ Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
2917
{---------------------------------------------------------------------------}
2918
CONSTRUCTOR TParamText.Load (Var S: TStream);
2921
Inherited Load(S); { Call ancestor }
2922
S.Read(w, SizeOf(w)); ParamCount:=w; { Read parameter count }
2925
{--TParamText---------------------------------------------------------------}
2926
{ DataSize -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
2927
{---------------------------------------------------------------------------}
2928
FUNCTION TParamText.DataSize: Sw_Word;
2930
DataSize := ParamCount * SizeOf(Pointer); { Return data size }
2933
{--TParamText---------------------------------------------------------------}
2934
{ GetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
2935
{---------------------------------------------------------------------------}
2936
PROCEDURE TParamText.GetData (Var Rec);
2938
Pointer(Rec) := @ParamList; { Return parm ptr }
2941
{--TParamText---------------------------------------------------------------}
2942
{ SetData -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 06Jun98 LdB }
2943
{---------------------------------------------------------------------------}
2944
PROCEDURE TParamText.SetData (Var Rec);
2946
ParamList := @Rec; { Fetch parameter list }
2947
DrawView; { Redraw all the view }
2950
{--TParamText---------------------------------------------------------------}
2951
{ Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
2952
{---------------------------------------------------------------------------}
2953
PROCEDURE TParamText.Store (Var S: TStream);
2956
TStaticText.Store(S); { Statictext store }
2957
w:=ParamCount;S.Write(w, SizeOf(w)); { Store param count }
2960
{--TParamText---------------------------------------------------------------}
2961
{ GetText -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
2962
{---------------------------------------------------------------------------}
2963
PROCEDURE TParamText.GetText (Var S: String);
2965
If (Text = Nil) Then S := '' Else { Return empty string }
2966
FormatStr(S, Text^, ParamList^); { Return text string }
2969
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
2970
{ TLabel OBJECT METHODS }
2971
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
2973
{--TLabel-------------------------------------------------------------------}
2974
{ Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
2975
{---------------------------------------------------------------------------}
2976
CONSTRUCTOR TLabel.Init (Var Bounds: TRect; CONST AText: String; ALink: PView);
2978
Inherited Init(Bounds, AText); { Call ancestor }
2979
Link := ALink; { Hold link }
2980
Options := Options OR (ofPreProcess+ofPostProcess);{ Set pre/post process }
2981
EventMask := EventMask OR evBroadcast; { Sees broadcast events }
2984
{--TLabel-------------------------------------------------------------------}
2985
{ Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
2986
{---------------------------------------------------------------------------}
2987
CONSTRUCTOR TLabel.Load (Var S: TStream);
2989
Inherited Load(S); { Call ancestor }
2990
GetPeerViewPtr(S, Link); { Load link view }
2993
{--TLabel-------------------------------------------------------------------}
2994
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
2995
{---------------------------------------------------------------------------}
2996
FUNCTION TLabel.GetPalette: PPalette;
2997
CONST P: String[Length(CLabel)] = CLabel; { Always normal string }
2999
GetPalette := @P; { Return palette }
3002
{--TLabel-------------------------------------------------------------------}
3003
{ DrawBackGround -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
3004
{---------------------------------------------------------------------------}
3005
PROCEDURE TLabel.Draw;
3006
VAR SCOff: Byte; Color: Word; B: TDrawBuffer;
3008
If Light Then Begin { Light colour select }
3009
Color := GetColor($0402); { Choose light colour }
3010
SCOff := 0; { Zero offset }
3012
Color := GetColor($0301); { Darker colour }
3013
SCOff := 4; { Set offset }
3015
MoveChar(B[0], ' ', Byte(Color), Size.X); { Clear the buffer }
3016
If (Text <> Nil) Then MoveCStr(B[1], Text^, Color);{ Transfer label text }
3017
If ShowMarkers Then WordRec(B[0]).Lo := Byte(
3018
SpecialChars[SCOff]); { Show marker if req }
3019
WriteLine(0, 0, Size.X, 1, B); { Write the text }
3022
{--TLabel-------------------------------------------------------------------}
3023
{ Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
3024
{---------------------------------------------------------------------------}
3025
PROCEDURE TLabel.Store (Var S: TStream);
3027
TStaticText.Store(S); { TStaticText.Store }
3028
PutPeerViewPtr(S, Link); { Store link view }
3031
{--TLabel-------------------------------------------------------------------}
3032
{ HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
3033
{---------------------------------------------------------------------------}
3034
PROCEDURE TLabel.HandleEvent (Var Event: TEvent);
3037
PROCEDURE FocusLink;
3039
If (Link <> Nil) AND (Link^.Options AND
3040
ofSelectable <> 0) Then Link^.Focus; { Focus link view }
3041
ClearEvent(Event); { Clear the event }
3045
Inherited HandleEvent(Event); { Call ancestor }
3047
evNothing: Exit; { Speed up exit }
3048
evMouseDown: FocusLink; { Focus link view }
3051
if assigned(text) then
3053
C := HotKey(Text^); { Check for hotkey }
3054
If (GetAltCode(C) = Event.KeyCode) OR { Alt plus char }
3055
((C <> #0) AND (Owner^.Phase = phPostProcess) { Post process phase }
3056
AND (UpCase(Event.CharCode) = C)) Then { Upper case match }
3057
FocusLink; { Focus link view }
3060
evBroadcast: If ((Event.Command = cmReceivedFocus)
3061
OR (Event.Command = cmReleasedFocus)) AND { Focus state change }
3062
(Link <> Nil) Then Begin
3063
Light := Link^.State AND sfFocused <> 0; { Change light state }
3064
DrawView; { Now redraw change }
3069
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
3070
{ THistoryViewer OBJECT METHODS }
3071
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
3073
{--THistoryViewer-----------------------------------------------------------}
3074
{ Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
3075
{---------------------------------------------------------------------------}
3076
CONSTRUCTOR THistoryViewer.Init (Var Bounds: TRect; AHScrollBar,
3077
AVScrollBar: PScrollBar; AHistoryId: Word);
3079
Inherited Init(Bounds, 1, AHScrollBar,
3080
AVScrollBar); { Call ancestor }
3081
HistoryId := AHistoryId; { Hold history id }
3082
SetRange(HistoryCount(AHistoryId)); { Set history range }
3083
If (Range > 1) Then FocusItem(1); { Set to item 1 }
3084
If (HScrollBar <> Nil) Then
3085
HScrollBar^.SetRange(1, HistoryWidth-Size.X + 3);{ Set scrollbar range }
3088
{--THistoryViewer-----------------------------------------------------------}
3089
{ HistoryWidth -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
3090
{---------------------------------------------------------------------------}
3091
FUNCTION THistoryViewer.HistoryWidth: Sw_Integer;
3092
VAR Width, T, Count, I: Sw_Integer;
3094
Width := 0; { Zero width variable }
3095
Count := HistoryCount(HistoryId); { Hold count value }
3096
For I := 0 To Count-1 Do Begin { For each item }
3097
T := Length(HistoryStr(HistoryId, I)); { Get width of item }
3098
If (T > Width) Then Width := T; { Set width to max }
3100
HistoryWidth := Width; { Return max item width }
3103
{--THistoryViewer-----------------------------------------------------------}
3104
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
3105
{---------------------------------------------------------------------------}
3106
FUNCTION THistoryViewer.GetPalette: PPalette;
3107
CONST P: String[Length(CHistoryViewer)] = CHistoryViewer;{ Always normal string }
3109
GetPalette := @P; { Return palette }
3112
{--THistoryViewer-----------------------------------------------------------}
3113
{ GetText -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
3114
{---------------------------------------------------------------------------}
3115
FUNCTION THistoryViewer.GetText (Item: Sw_Integer; MaxLen: Sw_Integer): String;
3117
GetText := HistoryStr(HistoryId, Item); { Return history string }
3120
{--THistoryViewer-----------------------------------------------------------}
3121
{ HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
3122
{---------------------------------------------------------------------------}
3123
PROCEDURE THistoryViewer.HandleEvent (Var Event: TEvent);
3125
If ((Event.What = evMouseDown) AND (Event.Double)) { Double click mouse }
3126
OR ((Event.What = evKeyDown) AND
3127
(Event.KeyCode = kbEnter)) Then Begin { Enter key press }
3128
EndModal(cmOk); { End with cmOk }
3129
ClearEvent(Event); { Event was handled }
3130
End Else If ((Event.What = evKeyDown) AND
3131
(Event.KeyCode = kbEsc)) OR { Esc key press }
3132
((Event.What = evCommand) AND
3133
(Event.Command = cmCancel)) Then Begin { Cancel command }
3134
EndModal(cmCancel); { End with cmCancel }
3135
ClearEvent(Event); { Event was handled }
3136
End Else Inherited HandleEvent(Event); { Call ancestor }
3139
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
3140
{ THistoryWindow OBJECT METHODS }
3141
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
3143
{--THistoryWindow-----------------------------------------------------------}
3144
{ Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
3145
{---------------------------------------------------------------------------}
3146
CONSTRUCTOR THistoryWindow.Init (Var Bounds: TRect; HistoryId: Word);
3148
Inherited Init(Bounds, '', wnNoNumber); { Call ancestor }
3149
Flags := wfClose; { Close flag only }
3150
InitViewer(HistoryId); { Create list view }
3153
{--THistoryWindow-----------------------------------------------------------}
3154
{ GetSelection -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
3155
{---------------------------------------------------------------------------}
3156
FUNCTION THistoryWindow.GetSelection: String;
3158
If (Viewer = Nil) Then GetSelection := '' Else { Return empty string }
3159
GetSelection := Viewer^.GetText(Viewer^.Focused,
3160
255); { Get focused string }
3163
{--THistoryWindow-----------------------------------------------------------}
3164
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
3165
{---------------------------------------------------------------------------}
3166
FUNCTION THistoryWindow.GetPalette: PPalette;
3167
CONST P: String[Length(CHistoryWindow)] = CHistoryWindow;{ Always normal string }
3169
GetPalette := @P; { Return the palette }
3172
{--THistoryWindow-----------------------------------------------------------}
3173
{ InitViewer -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
3174
{---------------------------------------------------------------------------}
3175
PROCEDURE THistoryWindow.InitViewer(HistoryId: Word);
3178
GetExtent(R); { Get extents }
3179
R.Grow(-1,-1); { Grow inside }
3180
Viewer := New(PHistoryViewer, Init(R,
3181
StandardScrollBar(sbHorizontal + sbHandleKeyboard),
3182
StandardScrollBar(sbVertical + sbHandleKeyboard),
3183
HistoryId)); { Create the viewer }
3184
If (Viewer <> Nil) Then Insert(Viewer); { Insert viewer }
3187
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
3188
{ THistory OBJECT METHODS }
3189
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
3191
{--THistory-----------------------------------------------------------------}
3192
{ Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
3193
{---------------------------------------------------------------------------}
3194
CONSTRUCTOR THistory.Init (Var Bounds: TRect; ALink: PInputLine;
3197
Inherited Init(Bounds); { Call ancestor }
3198
Options := Options OR ofPostProcess; { Set post process }
3199
EventMask := EventMask OR evBroadcast; { See broadcast events }
3200
Link := ALink; { Hold link view }
3201
HistoryId := AHistoryId; { Hold history id }
3204
{--THistory-----------------------------------------------------------------}
3205
{ Load -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
3206
{---------------------------------------------------------------------------}
3207
CONSTRUCTOR THistory.Load (Var S: TStream);
3209
Inherited Load(S); { Call ancestor }
3210
GetPeerViewPtr(S, Link); { Load link view }
3211
S.Read(HistoryId, SizeOf(HistoryId)); { Read history id }
3214
{--THistory-----------------------------------------------------------------}
3215
{ GetPalette -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
3216
{---------------------------------------------------------------------------}
3217
FUNCTION THistory.GetPalette: PPalette;
3218
CONST P: String[Length(CHistory)] = CHistory; { Always normal string }
3220
GetPalette := @P; { Return the palette }
3223
{--THistory-----------------------------------------------------------------}
3224
{ InitHistoryWindow -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
3225
{---------------------------------------------------------------------------}
3226
FUNCTION THistory.InitHistoryWindow (Var Bounds: TRect): PHistoryWindow;
3227
VAR P: PHistoryWindow;
3229
P := New(PHistoryWindow, Init(Bounds, HistoryId)); { Create history window }
3230
If (Link <> Nil) Then
3231
P^.HelpCtx := Link^.HelpCtx; { Set help context }
3232
InitHistoryWindow := P; { Return history window }
3235
PROCEDURE THistory.Draw;
3238
MoveCStr(B,#222'~v~'#221, GetColor($0102)); { Set buffer data }
3239
WriteLine(0, 0, Size.X, Size.Y, B); { Write buffer }
3242
{--THistory-----------------------------------------------------------------}
3243
{ RecordHistory -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
3244
{---------------------------------------------------------------------------}
3245
PROCEDURE THistory.RecordHistory (CONST S: String);
3247
HistoryAdd(HistoryId, S); { Add to history }
3250
{--THistory-----------------------------------------------------------------}
3251
{ Store -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
3252
{---------------------------------------------------------------------------}
3253
PROCEDURE THistory.Store (Var S: TStream);
3255
TView.Store(S); { TView.Store called }
3256
PutPeerViewPtr(S, Link); { Store link view }
3257
S.Write(HistoryId, SizeOf(HistoryId)); { Store history id }
3260
{--THistory-----------------------------------------------------------------}
3261
{ HandleEvent -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 26Oct99 LdB }
3262
{---------------------------------------------------------------------------}
3263
PROCEDURE THistory.HandleEvent (Var Event: TEvent);
3264
VAR C: Word; Rslt: String; R, P: TRect; HistoryWindow: PHistoryWindow;
3266
Inherited HandleEvent(Event); { Call ancestor }
3267
If (Link = Nil) Then Exit; { No link view exits }
3268
If (Event.What = evMouseDown) OR { Mouse down event }
3269
((Event.What = evKeyDown) AND
3270
(CtrlToArrow(Event.KeyCode) = kbDown) AND { Down arrow key }
3271
(Link^.State AND sfFocused <> 0)) Then Begin { Link view selected }
3272
If NOT Link^.Focus Then Begin
3273
ClearEvent(Event); { Event was handled }
3276
RecordHistory(Link^.Data^); { Record current data }
3277
Link^.GetBounds(R); { Get view bounds }
3278
Dec(R.A.X); { One char in from us }
3279
Inc(R.B.X); { One char short of us }
3280
Inc(R.B.Y, 7); { Seven lines down }
3281
Dec(R.A.Y,1); { One line below us }
3282
Owner^.GetExtent(P); { Get owner extents }
3283
R.Intersect(P); { Intersect views }
3284
Dec(R.B.Y,1); { Shorten length by one }
3285
HistoryWindow := InitHistoryWindow(R); { Create history window }
3286
If (HistoryWindow <> Nil) Then Begin { Window crested okay }
3287
C := Owner^.ExecView(HistoryWindow); { Execute this window }
3288
If (C = cmOk) Then Begin { Result was okay }
3289
Rslt := HistoryWindow^.GetSelection; { Get history selection }
3290
If Length(Rslt) > Link^.MaxLen Then
3291
SetLength(Rslt, Link^.MaxLen); { Hold new length }
3292
Link^.Data^ := Rslt; { Hold new selection }
3293
Link^.SelectAll(True); { Select all string }
3294
Link^.DrawView; { Redraw link view }
3296
Dispose(HistoryWindow, Done); { Dispose of window }
3298
ClearEvent(Event); { Event was handled }
3299
End Else If (Event.What = evBroadcast) Then { Broadcast event }
3300
If ((Event.Command = cmReleasedFocus) AND
3301
(Event.InfoPtr = Link)) OR
3302
(Event.Command = cmRecordHistory) Then { Record command }
3303
RecordHistory(Link^.Data^); { Record the history }
3306
{****************************************************************************}
3307
{ TBrowseButton Object }
3308
{****************************************************************************}
3309
{****************************************************************************}
3310
{ TBrowseButton.Init }
3311
{****************************************************************************}
3312
constructor TBrowseButton.Init(var Bounds: TRect; ATitle: TTitleStr;
3313
ACommand: Word; AFlags: Byte; ALink: PBrowseInputLine);
3315
if not inherited Init(Bounds,ATitle,ACommand,AFlags) then
3320
{****************************************************************************}
3321
{ TBrowseButton.Load }
3322
{****************************************************************************}
3323
constructor TBrowseButton.Load(var S: TStream);
3325
if not inherited Load(S) then
3327
GetPeerViewPtr(S,Link);
3330
{****************************************************************************}
3331
{ TBrowseButton.Press }
3332
{****************************************************************************}
3333
procedure TBrowseButton.Press;
3337
Message(Owner, evBroadcast, cmRecordHistory, nil);
3338
if Flags and bfBroadcast <> 0 then
3339
Message(Owner, evBroadcast, Command, Link) else
3341
E.What := evCommand;
3342
E.Command := Command;
3348
{****************************************************************************}
3349
{ TBrowseButton.Store }
3350
{****************************************************************************}
3351
procedure TBrowseButton.Store(var S: TStream);
3354
PutPeerViewPtr(S,Link);
3358
{****************************************************************************}
3359
{ TBrowseInputLine Object }
3360
{****************************************************************************}
3361
{****************************************************************************}
3362
{ TBrowseInputLine.Init }
3363
{****************************************************************************}
3364
constructor TBrowseInputLine.Init(var Bounds: TRect; AMaxLen: Sw_Integer; AHistory: Sw_Word);
3366
if not inherited Init(Bounds,AMaxLen) then
3368
History := AHistory;
3371
{****************************************************************************}
3372
{ TBrowseInputLine.Load }
3373
{****************************************************************************}
3374
constructor TBrowseInputLine.Load(var S: TStream);
3376
if not inherited Load(S) then
3378
S.Read(History,SizeOf(History));
3379
if (S.Status <> stOk) then
3383
{****************************************************************************}
3384
{ TBrowseInputLine.DataSize }
3385
{****************************************************************************}
3386
function TBrowseInputLine.DataSize: Sw_Word;
3388
DataSize := SizeOf(TBrowseInputLineRec);
3391
{****************************************************************************}
3392
{ TBrowseInputLine.GetData }
3393
{****************************************************************************}
3394
procedure TBrowseInputLine.GetData(var Rec);
3396
LocalRec: TBrowseInputLineRec absolute Rec;
3398
if (Validator = nil) or
3399
(Validator^.Transfer(Data^,@LocalRec.Text, vtGetData) = 0) then
3401
FillChar(LocalRec.Text, DataSize, #0);
3402
Move(Data^, LocalRec.Text, Length(Data^) + 1);
3404
LocalRec.History := History;
3407
{****************************************************************************}
3408
{ TBrowseInputLine.SetData }
3409
{****************************************************************************}
3410
procedure TBrowseInputLine.SetData(var Rec);
3412
LocalRec: TBrowseInputLineRec absolute Rec;
3414
if (Validator = nil) or
3415
(Validator^.Transfer(Data^, @LocalRec.Text, vtSetData) = 0) then
3416
Move(LocalRec.Text, Data^[0], MaxLen + 1);
3417
History := LocalRec.History;
3421
{****************************************************************************}
3422
{ TBrowseInputLine.Store }
3423
{****************************************************************************}
3424
procedure TBrowseInputLine.Store(var S: TStream);
3427
S.Write(History,SizeOf(History));
3431
{****************************************************************************}
3432
{ TCommandCheckBoxes Object }
3433
{****************************************************************************}
3434
{****************************************************************************}
3435
{ TCommandCheckBoxes.Init }
3436
{****************************************************************************}
3437
constructor TCommandCheckBoxes.Init (var Bounds : TRect;
3438
ACommandStrings : PCommandSItem);
3439
var StartSItem, S : PSItem;
3440
CItems : PCommandSItem;
3443
if ACommandStrings = nil then
3445
{ set up string list }
3446
StartSItem := NewSItem(ACommandStrings^.Value,nil);
3448
CItems := ACommandStrings^.Next;
3449
while (CItems <> nil) do begin
3450
S^.Next := NewSItem(CItems^.Value,nil);
3452
CItems := CItems^.Next;
3454
{ construct check boxes }
3455
if not TCheckBoxes.Init(Bounds,StartSItem) then begin
3456
while (StartSItem <> nil) do begin
3458
StartSItem := StartSItem^.Next;
3459
if (S^.Value <> nil) then
3460
DisposeStr(S^.Value);
3465
{ set up CommandList and dispose of memory used by ACommandList }
3467
while (ACommandStrings <> nil) do begin
3468
CommandList[i] := ACommandStrings^.Command;
3469
CItems := ACommandStrings;
3470
ACommandStrings := ACommandStrings^.Next;
3476
{****************************************************************************}
3477
{ TCommandCheckBoxes.Load }
3478
{****************************************************************************}
3479
constructor TCommandCheckBoxes.Load (var S : TStream);
3481
if not TCheckBoxes.Load(S) then
3483
S.Read(CommandList,SizeOf(CommandList));
3484
if (S.Status <> stOk) then begin
3490
{****************************************************************************}
3491
{ TCommandCheckBoxes.Press }
3492
{****************************************************************************}
3493
procedure TCommandCheckBoxes.Press (Item : Sw_Integer);
3494
var Temp : Sw_Integer;
3497
TCheckBoxes.Press(Item);
3498
if (Value <> Temp) then { value changed - notify peers }
3499
Message(Owner,evCommand,CommandList[Item],@Value);
3502
{****************************************************************************}
3503
{ TCommandCheckBoxes.Store }
3504
{****************************************************************************}
3505
procedure TCommandCheckBoxes.Store (var S : TStream);
3507
TCheckBoxes.Store(S);
3508
S.Write(CommandList,SizeOf(CommandList));
3511
{****************************************************************************}
3512
{ TCommandIcon Object }
3513
{****************************************************************************}
3514
{****************************************************************************}
3515
{ TCommandIcon.Init }
3516
{****************************************************************************}
3517
constructor TCommandIcon.Init (var Bounds : TRect; AText : String;
3520
if not TStaticText.Init(Bounds,AText) then
3522
Options := Options or ofPostProcess;
3523
Command := ACommand;
3526
{****************************************************************************}
3527
{ TCommandIcon.HandleEvent }
3528
{****************************************************************************}
3529
procedure TCommandIcon.HandleEvent (var Event : TEvent);
3531
if ((Event.What = evMouseDown) and MouseInView(MouseWhere)) then begin
3533
Message(Owner,evCommand,Command,nil);
3535
TStaticText.HandleEvent(Event);
3538
{****************************************************************************}
3539
{ TCommandInputLine Object }
3540
{****************************************************************************}
3541
{****************************************************************************}
3542
{ TCommandInputLine.Changed }
3543
{****************************************************************************}
3544
{procedure TCommandInputLine.Changed;
3546
Message(Owner,evBroadcast,cmInputLineChanged,@Self);
3549
{****************************************************************************}
3550
{ TCommandInputLine.HandleEvent }
3551
{****************************************************************************}
3552
{procedure TCommandInputLine.HandleEvent (var Event : TEvent);
3556
TBSDInputLine.HandleEvent(Event);
3557
if ((E.What and evKeyBoard = evKeyBoard) and (Event.KeyCode = kbEnter))
3561
{****************************************************************************}
3562
{ TCommandRadioButtons Object }
3563
{****************************************************************************}
3565
{****************************************************************************}
3566
{ TCommandRadioButtons.Init }
3567
{****************************************************************************}
3568
constructor TCommandRadioButtons.Init (var Bounds : TRect;
3569
ACommandStrings : PCommandSItem);
3571
StartSItem, S : PSItem;
3572
CItems : PCommandSItem;
3575
if ACommandStrings = nil
3577
{ set up string list }
3578
StartSItem := NewSItem(ACommandStrings^.Value,nil);
3580
CItems := ACommandStrings^.Next;
3581
while (CItems <> nil) do begin
3582
S^.Next := NewSItem(CItems^.Value,nil);
3584
CItems := CItems^.Next;
3586
{ construct check boxes }
3587
if not TRadioButtons.Init(Bounds,StartSItem) then begin
3588
while (StartSItem <> nil) do begin
3590
StartSItem := StartSItem^.Next;
3591
if (S^.Value <> nil) then
3592
DisposeStr(S^.Value);
3597
{ set up command list }
3599
while (ACommandStrings <> nil) do begin
3600
CommandList[i] := ACommandStrings^.Command;
3601
CItems := ACommandStrings;
3602
ACommandStrings := ACommandStrings^.Next;
3608
{****************************************************************************}
3609
{ TCommandRadioButtons.Load }
3610
{****************************************************************************}
3611
constructor TCommandRadioButtons.Load (var S : TStream);
3613
if not TRadioButtons.Load(S) then
3615
S.Read(CommandList,SizeOf(CommandList));
3616
if (S.Status <> stOk) then begin
3622
{****************************************************************************}
3623
{ TCommandRadioButtons.MoveTo }
3624
{****************************************************************************}
3625
procedure TCommandRadioButtons.MovedTo (Item : Sw_Integer);
3626
var Temp : Sw_Integer;
3629
TRadioButtons.MovedTo(Item);
3630
if (Value <> Temp) then { value changed - notify peers }
3631
Message(Owner,evCommand,CommandList[Item],@Value);
3634
{****************************************************************************}
3635
{ TCommandRadioButtons.Press }
3636
{****************************************************************************}
3637
procedure TCommandRadioButtons.Press (Item : Sw_Integer);
3638
var Temp : Sw_Integer;
3641
TRadioButtons.Press(Item);
3642
if (Value <> Temp) then { value changed - notify peers }
3643
Message(Owner,evCommand,CommandList[Item],@Value);
3646
{****************************************************************************}
3647
{ TCommandRadioButtons.Store }
3648
{****************************************************************************}
3649
procedure TCommandRadioButtons.Store (var S : TStream);
3651
TRadioButtons.Store(S);
3652
S.Write(CommandList,SizeOf(CommandList));
3655
{****************************************************************************}
3656
{ TEditListBox Object }
3657
{****************************************************************************}
3658
{****************************************************************************}
3659
{ TEditListBox.Init }
3660
{****************************************************************************}
3661
constructor TEditListBox.Init (Bounds : TRect; ANumCols: Word;
3662
AVScrollBar : PScrollBar);
3665
if not inherited Init(Bounds,ANumCols,AVScrollBar)
3670
{****************************************************************************}
3671
{ TEditListBox.Load }
3672
{****************************************************************************}
3673
constructor TEditListBox.Load (var S : TStream);
3675
if not inherited Load(S)
3680
{****************************************************************************}
3681
{ TEditListBox.EditField }
3682
{****************************************************************************}
3683
procedure TEditListBox.EditField (var Event : TEvent);
3685
InputLine : PModalInputLine;
3687
R.Assign(StartColumn,(Origin.Y + Focused - TopItem),
3688
(StartColumn + FieldWidth + 2),(Origin.Y + Focused - TopItem + 1));
3689
Owner^.MakeGlobal(R.A,R.A);
3690
Owner^.MakeGlobal(R.B,R.B);
3691
InputLine := New(PModalInputLine,Init(R,FieldWidth));
3692
InputLine^.SetValidator(FieldValidator);
3695
{ Use TInputLine^.SetData so that data validation occurs }
3696
{ because TInputLine.Data is allocated memory large enough }
3697
{ to hold a string of MaxLen. It is also faster. }
3698
GetField(InputLine);
3699
if (Application^.ExecView(InputLine) = cmOk)
3700
then SetField(InputLine);
3701
Dispose(InputLine,done);
3705
{****************************************************************************}
3706
{ TEditListBox.FieldValidator }
3707
{****************************************************************************}
3708
function TEditListBox.FieldValidator : PValidator;
3709
{ In a multiple field listbox FieldWidth should return the width }
3710
{ appropriate for Field. The default is an inputline for editing }
3711
{ a string of length large enough to fill the listbox field. }
3713
FieldValidator := nil;
3716
{****************************************************************************}
3717
{ TEditListBox.FieldWidth }
3718
{****************************************************************************}
3719
function TEditListBox.FieldWidth : Integer;
3720
{ In a multiple field listbox FieldWidth should return the width }
3721
{ appropriate for CurrentField. }
3723
FieldWidth := Size.X - 2;
3726
{****************************************************************************}
3727
{ TEditListBox.GetField }
3728
{****************************************************************************}
3729
procedure TEditListBox.GetField (InputLine : PInputLine);
3730
{ Places a string appropriate to Field and Focused into InputLine that }
3731
{ will be edited. Override this method for complex data types. }
3733
InputLine^.SetData(PString(List^.At(Focused))^);
3736
{****************************************************************************}
3737
{ TEditListBox.GetPalette }
3738
{****************************************************************************}
3739
function TEditListBox.GetPalette : PPalette;
3741
GetPalette := inherited GetPalette;
3744
{****************************************************************************}
3745
{ TEditListBox.HandleEvent }
3746
{****************************************************************************}
3747
procedure TEditListBox.HandleEvent (var Event : TEvent);
3749
if (Event.What = evKeyboard) and (Event.KeyCode = kbAltE)
3750
then begin { edit field }
3755
inherited HandleEvent(Event);
3758
{****************************************************************************}
3759
{ TEditListBox.SetField }
3760
{****************************************************************************}
3761
procedure TEditListBox.SetField (InputLine : PInputLine);
3762
{ Override this method for field types other than PStrings. }
3765
Item := NewStr(InputLine^.Data^);
3768
List^.AtFree(Focused);
3770
SetFocusedItem(Item);
3774
{****************************************************************************}
3775
{ TEditListBox.StartColumn }
3776
{****************************************************************************}
3777
function TEditListBox.StartColumn : Integer;
3779
StartColumn := Origin.X;
3782
{****************************************************************************}
3784
{****************************************************************************}
3785
{****************************************************************************}
3787
{****************************************************************************}
3788
constructor TListDlg.Init (ATitle : TTitleStr; Items:
3789
String; AButtons: Word; AListBox: PListBox; AEditCommand, ANewCommand :
3795
i, j, Gap, Line: Integer;
3796
Scrollbar: PScrollbar;
3798
HasButtons: Boolean;
3799
HasScrollBar: Boolean;
3802
if AListBox = nil then
3805
ListBox := AListBox;
3806
HasFrame := ((AButtons and ldNoFrame) = 0);
3807
HasButtons := ((AButtons and ldAllButtons) <> 0);
3808
HasScrollBar := ((AButtons and ldNoScrollBar) = 0);
3809
HasItems := (Items <> '');
3812
if (AButtons and ($0001 shl 1)) <> 0 then
3814
{ Make sure dialog is large enough for buttons }
3815
ListBox^.GetExtent(Bounds);
3816
Bounds.Move(ListBox^.Origin.X,ListBox^.Origin.Y);
3825
if Bounds.B.Y < (ButtonCount * 2) + 4 then
3826
Bounds.B.Y := (ButtonCount * 2) + 5;
3830
if not TDialog.Init(Bounds,ATitle) then
3832
NewCommand := ANewCommand;
3833
EditCommand := AEditCommand;
3834
Options := Options or ofNewEditDelete;
3835
if (not HasFrame) and (Frame <> nil) then
3838
Dispose(Frame,Done);
3840
Options := Options and not ofFramed;
3842
HelpCtx := hcListDlg;
3843
{ position and insert ListBox }
3844
ListBox := AListBox;
3848
ListBox^.MoveTo(2,2)
3849
else ListBox^.MoveTo(0,2)
3852
ListBox^.MoveTo(1,1)
3853
else ListBox^.MoveTo(0,0);
3855
if ListBox^.Size.Y < (ButtonCount * 2) then
3856
ListBox^.GrowTo(ListBox^.Size.X,ButtonCount * 2);
3860
Bounds.Assign(1,1,CStrLen(Items)+2,2);
3861
Insert(New(PLabel,Init(Bounds,Items,ListBox)));
3864
if HasScrollBar then
3866
Bounds.Assign(ListBox^.Size.X+ListBox^.Origin.X,ListBox^.Origin.Y,
3867
ListBox^.Size.X + ListBox^.Origin.X + 1,
3868
ListBox^.Size.Y + ListBox^.Origin.Y { origin });
3869
ScrollBar := New(PScrollBar,Init(Bounds));
3870
Bounds.Assign(Origin.X,Origin.Y,Origin.X + Size.X + 1, Origin.Y + Size.Y);
3871
ChangeBounds(Bounds);
3875
begin { do buttons }
3879
if ((j shl i) and AButtons) <> 0 then
3881
Gap := ((Size.Y - 2) div (Gap + 2));
3886
if (AButtons and ldNew) = ldNew then
3888
Insert(NewButton(Size.X - 12,Line,10,2,'~N~ew',cmNew,hcInsert,bfNormal));
3891
if (AButtons and ldEdit) = ldEdit then
3893
Insert(NewButton(Size.X - 12,Line,10,2,'~E~dit',cmEdit,hcEdit,
3897
if (AButtons and ldDelete) = ldDelete then
3899
Insert(NewButton(Size.X - 12,Line,10,2,'~D~elete',cmDelete,hcDelete,
3903
Insert(NewButton(Size.X - 12,Line,10,2,'O~k~',cmOK,hcOk,bfDefault or
3906
Insert(NewButton(Size.X - 12,Line,10,2,'Cancel',cmCancel,hcCancel,
3908
if (AButtons and ldHelp) = ldHelp then
3911
Insert(NewButton(Size.X - 12,Line,10,2,'~H~elp',cmHelp,hcNoContext,
3915
if HasFrame and ((AButtons and ldAllIcons) <> 0) then
3918
if (AButtons and ldNewIcon) = ldNewIcon then
3920
Bounds.Assign(Line,Size.Y-1,Line+5,Size.Y);
3921
Insert(New(PCommandIcon,Init(Bounds,' Ins ',cmNew)));
3923
if (AButtons and (ldEditIcon or ldDeleteIcon)) <> 0 then
3925
Bounds.Assign(Line,Size.Y-1,Line+1,Size.Y);
3926
Insert(New(PStaticText,Init(Bounds,'/')));
3930
if (AButtons and ldEditIcon) = ldEditIcon then
3932
Bounds.Assign(Line,Size.Y-1,Line+6,Size.Y);
3933
Insert(New(PCommandIcon,Init(Bounds,' Edit ',cmEdit)));
3935
if (AButtons and ldDeleteIcon) <> 0 then
3937
Bounds.Assign(Line,Size.Y-1,Line+1,Size.Y);
3938
Insert(New(PStaticText,Init(Bounds,'/')));
3942
if (AButtons and ldNewIcon) = ldNewIcon then
3944
Bounds.Assign(Line,Size.Y-1,Line+5,Size.Y);
3945
Insert(New(PCommandIcon,Init(Bounds,' Del ',cmDelete)));
3948
{ Set focus to list boLine when dialog opens }
3952
{****************************************************************************}
3954
{****************************************************************************}
3955
constructor TListDlg.Load (var S : TStream);
3957
if not TDialog.Load(S) then
3959
S.Read(NewCommand,SizeOf(NewCommand));
3960
S.Read(EditCommand,SizeOf(EditCommand));
3961
GetSubViewPtr(S,ListBox);
3964
{****************************************************************************}
3965
{ TListDlg.HandleEvent }
3966
{****************************************************************************}
3967
procedure TListDlg.HandleEvent (var Event : TEvent);
3969
TargetCommands: TCommandSet = [cmNew, cmEdit, cmDelete];
3971
if ((Event.What and evCommand) <> 0) and
3972
(Event.Command in TargetCommands) then
3973
case Event.Command of
3975
if Options and ofDelete = ofDelete then
3977
ListBox^.FreeFocusedItem;
3982
if Options and ofNew = ofNew then
3984
Message(Application,evCommand,NewCommand,nil);
3985
ListBox^.SetRange(ListBox^.List^.Count);
3990
if Options and ofEdit = ofEdit then
3992
Message(Application,evCommand,EditCommand,ListBox^.GetFocusedItem);
3997
if (Event.What and evBroadcast > 0) and
3998
(Event.Command = cmListItemSelected) then
3999
begin { use PutEvent instead of Message so that a window list box works }
4000
Event.What := evCommand;
4001
Event.Command := cmOk;
4002
Event.InfoPtr := nil;
4005
TDialog.HandleEvent(Event);
4008
{****************************************************************************}
4010
{****************************************************************************}
4011
procedure TListDlg.Store (var S : TStream);
4014
S.Write(NewCommand,SizeOf(NewCommand));
4015
S.Write(EditCommand,SizeOf(EditCommand));
4016
PutSubViewPtr(S,ListBox);
4019
{****************************************************************************}
4020
{ TModalInputLine Object }
4021
{****************************************************************************}
4022
{****************************************************************************}
4023
{ TModalInputLine.Execute }
4024
{****************************************************************************}
4025
function TModalInputLine.Execute : Word;
4033
if Event.What <> evNothing
4034
then Owner^.EventError(Event); { may change this to ClearEvent }
4035
until (EndState <> 0);
4036
until Valid(EndState);
4037
Execute := EndState;
4040
{****************************************************************************}
4041
{ TModalInputLine.HandleEvent }
4042
{****************************************************************************}
4043
procedure TModalInputLine.HandleEvent (var Event : TEvent);
4046
evKeyboard : case Event.KeyCode of
4047
kbUp, kbDown : EndModal(cmCancel);
4048
kbEnter : EndModal(cmOk);
4049
else inherited HandleEvent(Event);
4051
evMouse : if MouseInView(Event.Where)
4052
then inherited HandleEvent(Event)
4053
else EndModal(cmCancel);
4054
else inherited HandleEvent(Event);
4058
{****************************************************************************}
4059
{ TModalInputLine.SetState }
4060
{****************************************************************************}
4061
procedure TModalInputLine.SetState (AState : Word; Enable : Boolean);
4064
if (AState = sfSelected)
4067
inherited SetState(AState,Enable);
4074
else inherited SetState(AState,Enable);
4078
{***************************************************************************}
4079
{ INTERFACE ROUTINES }
4080
{***************************************************************************}
4082
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
4083
{ ITEM STRING ROUTINES }
4084
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
4086
{---------------------------------------------------------------------------}
4087
{ NewSItem -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 28Apr98 LdB }
4088
{---------------------------------------------------------------------------}
4089
FUNCTION NewSItem (Const Str: String; ANext: PSItem): PSItem;
4092
New(Item); { Allocate item }
4093
Item^.Value := NewStr(Str); { Hold item string }
4094
Item^.Next := ANext; { Chain the ptr }
4095
NewSItem := Item; { Return item }
4098
{****************************************************************************}
4100
{****************************************************************************}
4101
function NewCommandSItem (Str : String; ACommand : Word;
4102
ANext : PCommandSItem) : PCommandSItem;
4103
var Temp : PCommandSItem;
4106
if (Temp <> nil) then
4109
Temp^.Command := ACommand;
4110
Temp^.Next := ANext;
4112
NewCommandSItem := Temp;
4116
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
4117
{ DIALOG OBJECT REGISTRATION ROUTINES }
4118
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
4120
{---------------------------------------------------------------------------}
4121
{ RegisterDialogs -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
4122
{---------------------------------------------------------------------------}
4123
PROCEDURE RegisterDialogs;
4125
RegisterType(RDialog); { Register dialog }
4126
RegisterType(RInputLine); { Register inputline }
4127
RegisterType(RButton); { Register button }
4128
RegisterType(RCluster); { Register cluster }
4129
RegisterType(RRadioButtons); { Register radiobutton }
4130
RegisterType(RCheckBoxes); { Register check boxes }
4131
RegisterType(RMultiCheckBoxes); { Register multi boxes }
4132
RegisterType(RListBox); { Register list box }
4133
RegisterType(RStaticText); { Register static text }
4134
RegisterType(RLabel); { Register label }
4135
RegisterType(RHistory); { Register history }
4136
RegisterType(RParamText); { Register parm text }
4137
RegisterType(RCommandCheckBoxes);
4138
RegisterType(RCommandIcon);
4139
RegisterType(RCommandRadioButtons);
4140
RegisterType(REditListBox);
4141
RegisterType(RModalInputLine);
4142
RegisterType(RListDlg);
4147
$Log: dialogs.pas,v $
4148
Revision 1.34 2005/03/06 21:31:15 florian
4149
* fixed crash with empty labels
4151
Revision 1.33 2005/02/14 17:13:18 peter
added
removed
fv/dialogs.pas
