Module Dfpcklst.pkg
1//************************************************************************
2//
3// Copyright (c) 1997 Data Access Corporation, Miami Florida,
4// All rights reserved.
5// DataFlex is a registered trademark of Data Access Corporation.
6//
7// 08/19/94 JJT - Blended Classes from CB and DAF
8//
9//************************************************************************
10// 3.1 Changes
11// 07/23/96 JJT - New Class names
12// 05/31/96 JJT - added layer so image passing is optional
13// 03/28/95 JJT - Removed Layer for 0 class
14// changed name to dfpcklst.pkg
15//************************************************************************
16
17Use DFWide.pkg
18Use Picklist.pkg
19
20{ ClassType=Abstract }
21{ HelpTopic=PickList_ }
22Class PickList_ is a WideList
23 Import_Class_Protocol Pick_List_mixin
24End_Class
25
26{ ClassType=Abstract }
27{ OverrideProperty=Gridline_Mode InitialValue=Grid_Visible_Vert }
28{ HelpTopic=PickList }
29Class PickList is a Picklist_
30 Procedure Construct_Object
31 Forward Send Construct_Object No_Image
32 // We've always used an odd method to figure out if a list
33 // is a lookup list or an entry list. This makes this process
34 // manual. Normally a list does a move out. If you do not want this
35 // change this property.
36 Set Move_Value_Out_State to TRUE
37 Set Select_Mode to No_Select
38 Set Header_Visible_State to False
39 Set Gridline_Mode to GRID_VISIBLE_VERT
40 Set CurrentCellColor to clAqua // by default highlight color will be same as background
41
42 Set Auto_Top_Item_State to False
43
44 // Added for new scroll bar support. Only support batch style
45
46 // This determines if the scroll occurs when the thumb is dragged
47 // When false, it scrolls when the thumb is released. Only set it to
48 // false if the scroll takes a long time.
49 { Category=Behavior }
50 { PropertyType=Boolean }
51 Property Integer ScrollOnThumbTrackState True
52 // This determines if thumb should be sized proportionally to the scroll
53 // area. When true it acts like a normal windows list. When false, you get
54 // old vdf behavior where thumb is small and scroll moves up down one line at
55 // a time
56 { Category=Behavior }
57 { PropertyType=Boolean }
58 Property Integer ThumbScrollState True
59 // If the developer wishes to augment the vScroll messages they can shut
60 // the existing customizations by setting this true
61 { Category=Behavior }
62 { PropertyType=Boolean }
63 Property Integer CustomScrollState False
64 End_Procedure // Construct_Object
65
66 { MethodType=Event NoDoc=True }
67 Procedure Mouse_Up
68 end_procedure
69
70 { MethodType=Event }
71 Procedure Mouse_Click
72 Send Ok
73 End_Procedure
74
75 // Added for new scroll bar support. Only support batch style
76 //
77 { Visibility=Private }
78 Procedure SetVScrollInfo Integer iMin Integer iMax Integer iPage
79 If not (CustomScrollState(self)) Begin
80 // if batch, set range of 0 to numRows-1
81 // If Thumb does lineup/down set page size to 1 (1 row)
82 // If thumb does scroll set page size to number of displayable rows
83 Move 0 to iMin
84 Move (Row_Count(self)-1) to iMax
85 Move (if(ThumbScrollState(self), displayable_rows(self), 1 )) to iPage
86 End
87 Forward Send SetVScrollInfo iMin iMax iPage
88 End_Procedure
89
90 { Visibility=Private }
91 Procedure SetVScrollPos Integer iPos
92 If not (CustomScrollState(self)) Begin
93 If (ThumbScrollState(self)) ;
94 Move (top_item(self)/line_size(self)) to iPos
95 //Showln "SetVScrollPos" iPos
96 End
97 Forward Send SetVScrollPos iPos
98 End_Procedure
99
100 { Visibility=Private }
101 Procedure SetVScrollbox Integer iType Integer iData
102 integer iPos
103 integer iTop bFast
104 If not (CustomScrollState(self)) Begin
105 //Showln "SetVScrollBox" iType ", " iData
106 If (iType=SB_THUMBPOSITION or iType=SB_THUMBTRACK) Begin
107 get ScrollOnThumbTrackState to bFast
108 If (( iType=SB_THUMBPOSITION and bFast) OR ;
109 (iType=SB_THUMBTRACK and not(bFast))) ;
110 procedure_return
111 If Not (ThumbScrollState(self)) ;
112 Move SB_THUMBPOSITION to iType // will cuse RT to react
113 Else Begin
114 Move (Top_item(self)/line_size(self)) to iTop
115 If (iTop<>iData) Begin
116 If (iTop>iData) send scroll upward_direction (iTop-iData)
117 else send Scroll downward_direction (iData-iTop)
118 End
119 procedure_return
120 End
121 End
122 End
123 Forward Send SetVScrollBox iType iData
124 End_Procedure
125
126 // the DFBaseEntryList class has it's own special Set_Top_item message (as of 9.0) which does not
127 // set current_item. When used for non-batch lists, we don't want the set_current_item and
128 // that is why it was removed. This fixes a problem when scrolling down/up when the entire
129 // grid is shifted horizontally to the right. When you scroll, the grid would shift to col 0.
130 // However, with batch lists we want the normal set_top_item or we get other problems. So we
131 // we modify the method here to make it do a normal top_item (ie. set current_item).
132 // While this top_item addition was added in 9.0 for DataLists classes it was not added to PickList classes,
133 // which is the other branch off of Widelist. Since Picklists are always non-batch, this setting of
134 // current_item is required and was added as of 11.1
135 { MethodType=Property NoDoc=True }
136 procedure set top_item integer iNewTop integer iNewCurrent
137 forward set top_item to iNewTop // we know the C code augmentation ignores any 2nd param
138 // Make top_item set the current_item
139 if (Item_count(self)) ;
140 set current_item to (if(num_arguments=1,iNewTop,iNewCurrent))
141 end_procedure
142
143End_Class // DfPick_List
144