Module cSplitter.pkg
1Use Windows.pkg
2
3Define R2_BLACK for |CI1 // 0
4Define R2_NOTMERGEPEN for |CI2 // DPon
5Define R2_MASKNOTPEN for |CI3 // DPna
6Define R2_NOTCOPYPEN for |CI4 // PN
7Define R2_MASKPENNOT for |CI5 // PDna
8Define R2_NOT for |CI6 // Dn
9Define R2_XORPEN for |CI7 // DPx
10Define R2_NOTMASKPEN for |CI8 // DPan
11Define R2_MASKPEN for |CI9 // DPa
12Define R2_NOTXORPEN for |CI10 // DPxn
13Define R2_NOP for |CI11 // D
14Define R2_MERGENOTPEN for |CI12 // DPno
15Define R2_COPYPEN for |CI13 // P
16Define R2_MERGEPENNOT for |CI14 // PDno
17Define R2_MERGEPEN for |CI15 // DPo
18Define R2_WHITE for |CI16 // 1
19Define R2_LAST for |CI16
20
21{ ClassType=Abstract }
22{ Visibility=Private }
23Class cAbstractSplitter is a DFBaseControl
24
25
26 Procedure Construct_Object
27 Forward Send Construct_Object
28
29 Property Boolean pbSplitVertical False
30 Property Integer piMinLocation 20
31 Property Integer piMaxLocation 20
32 Property Integer piLastLocation 0
33 Property Integer piMinTrack
34 Property Integer piMaxTrack
35
36 Set Color to clBtnFace
37 Set Skip_state To True // this tells switch/switch back to not try to give this the focus
38 Set Focus_Mode to NonFocusable // is paged as part of client activation but never gets the focus
39
40 // class name and external messages must be defined in the sub-class
41 End_Procedure // Construct_Object
42
43 Procedure DrawDrag Integer iPos
44 Integer iLastY iLastX
45 Integer yScreen xScreen x y
46 Integer iVoid xy cx cy
47 Handle hDC hBrush hBrushOld hPen hPenOld hWnd
48 Pointer lpPoint
49 tWinPoint APoint
50 Boolean bVertical
51
52 Get pbSplitVertical to bVertical
53
54 Get GuiLocation to xy
55 Move (Hi(xy)) to APoint.y
56 Move (Low(xy)) to APoint.x
57 Move (AddressOf(APoint)) to lpPoint
58 Delegate Get Window_Handle to hWnd // Get the parent container's window handle
59 Move (ClientToScreen(hWnd, lpPoint)) to iVoid
60
61 If bVertical Begin
62 Move (Hi(GuiSize(Self))) to cy
63 Get piLastLocation to iLastX
64 Move iPos to x
65 Move APoint.y to y
66 Move APoint.x to xScreen
67
68 Move (x + xScreen) to x
69 End
70 Else Begin
71 Move (low(GuiSize(Self))) to cx
72 Get piLastLocation to iLastY
73 Move iPos to y
74 Move APoint.x to x
75 Move APoint.y to yScreen
76
77 Move (y + yScreen) to y
78 End
79
80 Move (GetDC(0)) to hDC
81
82 Move (CreatePen(PS_SOLID, 1, clGray)) to hPen
83 Move (GetStockObject(GRAY_BRUSH)) to hBrush
84 Move (SelectObject(hDC, hPen)) to hPenOld
85 Move (SelectObject(hDC, hBrush)) to hBrushOld
86 Move (SetROP2(hDC, R2_NOTXORPEN)) to iVoid
87
88 If bVertical Begin
89 If (iLastX <> 65536) Begin
90 Move (Rectangle(hDC, iLastX, y+1, iLastX+4, y+cy)) to iVoid // erase last line
91 End
92 Move (Rectangle(hDC, x, y+1, x+4, y+cy)) to iVoid
93 End
94 Else Begin
95 If (iLastY <> 65536) Begin
96 Move (Rectangle(hDC, x+1, iLastY, x+cx, iLastY+4)) to iVoid // erase last line
97 End
98 Move (Rectangle(hDC, x+1, y, x+cx, y+4)) to iVoid
99 End
100
101 Move (SelectObject(hDC, hPenOld)) to iVoid
102 Move (SelectObject(hDC, hBrushOld)) to iVoid
103 Move (DeleteObject(hPen)) to iVoid
104 Move (ReleaseDC(0, hDC)) to iVoid
105
106 Set piLastLocation to (If(bVertical,x, y))
107 End_Procedure // DrawDrag
108
109
110 Procedure WMSG_OnMouseDown Integer wParam Integer lParam
111 Integer y cxy cy cyParent
112 Integer x cx cxParent
113 Boolean bVertical
114 Integer iMin iMax
115
116 Get pbSplitVertical to bVertical
117 Send Set_Mouse_Capture
118
119 Get piMinLocation to iMin
120 Get piMaxLocation to iMax
121
122 Get GuiLocation to cx
123 Delegate Get GuiSize to cxy
124 If bVertical Begin
125 Move (Low(lParam)) to x
126 Move (Low(cx)) to cx
127 Move (Low(cxy)) to cxParent
128 End
129 Else Begin
130 Move (Hi(lParam)) to x
131 Move (Hi(cx)) to cx
132 Move (Hi(cxy)) to cxParent
133 End
134 Move (Cast(x,Short)) to x
135
136 // these are delta tracking positions from the current splitter location
137 Set piMinTrack to ( iMin -cx )
138 Set piMaxTrack to ( cxParent - iMax - cx )
139
140 Set piLastLocation to 65536
141 Send DrawDrag x
142 End_Procedure
143
144 Function AdjustTrackPos Integer iTrack returns Integer
145 Boolean bVertical
146 Integer iSz iMax iMin
147
148 Get pbSplitVertical to bVertical
149 Delegate Get GuiClientSize to iSz
150 If bVertical Begin
151 Move (Low(iSz)) to iSz
152 End
153 Else Begin
154 Move (hi(iSz)) to iSz
155 End
156 Move (Cast(iTrack,Short)) to iTrack
157
158 Get piMinTrack to iMin
159 Get piMaxTrack to iMax
160 Move (iMin max iTrack) to iTrack
161 Move (iMax min iTrack) to iTrack
162 Function_Return iTrack
163 End_Function
164
165
166 // reposition and resize all the objects..
167 Procedure WMSG_OnMouseUp Integer wParam Integer lParam
168 Integer iTrack
169 Boolean bVertical
170
171 Get pbSplitVertical to bVertical
172
173 Send Release_Mouse_Capture
174
175 If bVertical Begin
176 Move (Low(lParam)) to iTrack
177 end
178 Else Begin
179 Move (Hi(lParam)) to iTrack
180 End
181 Get AdjustTrackPos iTrack to iTrack
182 Set piLastLocation to 65536
183 Send DrawDrag iTrack
184
185 Send MoveSplitter iTrack
186
187 End_Procedure
188
189 Procedure MoveSplitter Integer iTrack
190 // normally we just ask the parent to handle this for us.
191 Delegate Send MoveSplitter iTrack
192 End_Procedure
193
194 Procedure WMSG_OnMouseMove Integer wParam Integer lParam
195 Integer iTrack
196 Boolean bVertical
197
198
199 If (wParam IAND MK_LBUTTON) Begin
200
201 Get pbSplitVertical to bVertical
202
203 If bVertical Begin
204 Move (Low(lParam)) to iTrack
205 end
206 Else Begin
207 Move (Hi(lParam)) to iTrack
208 end
209 Get AdjustTrackPos iTrack to iTrack
210 Send DrawDrag iTrack
211 End
212 End_Procedure
213
214
215 // Determines which cursor shape should be displayed.
216 Procedure SetCursor
217 Integer hCursor retval hWnd iVoid hLib
218 String sCursor
219 Boolean bVertical
220 Get pbSplitVertical to bVertical
221 Get Window_Handle To hWnd
222 Move (LoadLibrary("ComCtl32.dll")) To hLib
223 Move (If(bVertical,"#107","#135")) to sCursor
224 Move (LoadCursor(hLib, addressof(sCursor))) to hCursor // splitter cursor
225 Move (SetClassLong(hWnd, GCL_HCURSOR, hCursor )) to retval
226 Move (FreeLibrary(hLib)) to iVoid
227 End_Procedure
228
229 Procedure Page Integer iState
230 Forward Send Page iState
231 If (iState =1) Send SetCursor
232 End_Procedure
233
234End_Class
235
236// we need different external classes or horizontal and vertical because
237// we are changing a class property in SetCursor
238
239{ Visibility=Private }
240Class cVerticalSplitter is a cAbstractSplitter
241 Procedure Construct_Object
242 Forward Send Construct_Object
243 Set pbSplitVertical to True
244
245 Set External_Class_Name "DFVerticalSplitter" to "Static"
246
247 Set External_Message WM_LBUTTONDOWN to msg_WMSG_OnMouseDown
248 Set External_Message WM_LBUTTONUP to msg_WMSG_OnMouseUp
249 Set External_Message WM_MOUSEMOVE to msg_WMSG_OnMouseMove
250 Set Window_Style to SS_NOTIFY True
251 End_Procedure
252
253End_Class
254
255{ Visibility=Private }
256Class cHorizontalSplitter is a cAbstractSplitter
257 Procedure Construct_Object
258 Forward Send Construct_Object
259 Set pbSplitVertical to False
260
261 Set External_Class_Name "DFHorizontalSplitter" to "Static"
262
263 Set External_Message WM_LBUTTONDOWN to msg_WMSG_OnMouseDown
264 Set External_Message WM_LBUTTONUP to msg_WMSG_OnMouseUp
265 Set External_Message WM_MOUSEMOVE to msg_WMSG_OnMouseMove
266 Set Window_Style to SS_NOTIFY True
267 End_Procedure
268
269End_Class
270