4 package MSComctlLib_Slider is
7 -- ###### BorderStyleConstants{76B523C0-8579-11D1-B16A-00C0F0283628} ######
9 ccNone : constant := 0;
11 ccFixedSingle : constant := 1;
13 -- ###### MousePointerConstants{76B523C1-8579-11D1-B16A-00C0F0283628} ######
15 ccDefault : constant := 0;
16 -- Arrow mouse pointer
17 ccArrow : constant := 1;
18 -- Cross mouse pointer
19 ccCross : constant := 2;
20 -- I-Beam mouse pointer
21 ccIBeam : constant := 3;
23 ccIcon : constant := 4;
25 ccSize : constant := 5;
26 -- Size NE SW mouse pointer
27 ccSizeNESW : constant := 6;
28 -- Size N S mouse pointer
29 ccSizeNS : constant := 7;
30 -- Size NW SE mouse pointer
31 ccSizeNWSE : constant := 8;
32 -- Size W E mouse pointer
33 ccSizeEW : constant := 9;
34 -- Up arrow mouse pointer
35 ccUpArrow : constant := 10;
36 -- Hourglass mouse pointer
37 ccHourglass : constant := 11;
38 -- No drop mouse pointer
39 ccNoDrop : constant := 12;
40 -- Arrow and Hourglass mouse pointer
41 ccArrowHourglass : constant := 13;
42 -- Arrow and Question mark mouse pointer
43 ccArrowQuestion : constant := 14;
44 -- Size all mouse pointer
45 ccSizeAll : constant := 15;
46 -- Custom mouse pointer icon specified by the MouseIcon property
47 ccCustom : constant := 99;
49 -- ###### AppearanceConstants{76B523C2-8579-11D1-B16A-00C0F0283628} ######
51 ccFlat : constant := 0;
55 -- ###### VB4AppearanceConstants{00000000-0000-0000-0000-000000000000} ######
57 vbFlat : constant := 0;
61 -- ###### ScrollingConstants{76B523C3-8579-11D1-B16A-00C0F0283628} ######
63 ccScrollingStandard : constant := 0;
65 ccScrollingSmooth : constant := 1;
67 -- ###### OrientationConstants{76B523C4-8579-11D1-B16A-00C0F0283628} ######
69 ccOrientationHorizontal : constant := 0;
71 ccOrientationVertical : constant := 1;
73 -- ###### OLEDragConstants{D8898460-742F-11CF-8AEA-00AA00C00905} ######
74 -- OLE drag/drop will be initialized only under programmatic control.
75 ccOLEDragManual : constant := 0;
76 -- OLE drag/drop will be initialized when the user drags 'out' of the control,
77 -- or under programmatic control.
78 ccOLEDragAutomatic : constant := 1;
80 -- ###### OLEDropConstants{D8898461-742F-11CF-8AEA-00AA00C00905} ######
81 -- Accepts no OLE drag/drop operations.
82 ccOLEDropNone : constant := 0;
83 -- Accepts an OLE drag/drop under programmatic control only.
84 ccOLEDropManual : constant := 1;
86 -- ###### DragOverConstants{D8898464-742F-11CF-8AEA-00AA00C00905} ######
87 -- Source control dragged into target.
88 ccEnter : constant := 0;
89 -- Source control dragged out of target.
90 ccLeave : constant := 1;
91 -- Source control dragged from one position in target to another.
92 ccOver : constant := 2;
94 -- ###### ClipBoardConstants{D8898462-742F-11CF-8AEA-00AA00C00905} ######
96 ccCFText : constant := 1;
97 -- Bitmap (.bmp file).
98 ccCFBitmap : constant := 2;
99 -- Metafile (.wmf file).
100 ccCFMetafile : constant := 3;
101 -- Device-independent bitmap.
102 ccCFDIB : constant := 8;
104 ccCFPalette : constant := 9;
105 -- Enhanced metafile (.emf file).
106 ccCFEMetafile : constant := 14;
107 -- Filename list (Microsoft Windows Explorer)
108 ccCFFiles : constant := 15;
109 -- Rich Text Format (.rtf file).
110 ccCFRTF : constant := -16639;
112 -- ###### OLEDropEffectConstants{D8898463-742F-11CF-8AEA-00AA00C00905} ######
113 -- No OLE drag/drop operation has taken place/would take place.
114 ccOLEDropEffectNone : constant := 0;
115 -- A mask to indicate that a copy has taken place/would take place.
116 ccOLEDropEffectCopy : constant := 1;
117 -- A mask to indicate that a move has taken place/would take place.
118 ccOLEDropEffectMove : constant := 2;
119 -- A mask to indicate that the drop target window has scrolled/would scroll.
120 ccOLEDropEffectScroll : constant := -2147483648;
122 -- ###### ErrorConstants{76B523C5-8579-11D1-B16A-00C0F0283628} ######
123 -- Invalid procedure call
124 ccInvalidProcedureCall : constant := 5;
126 ccOutOfMemory : constant := 7;
128 ccTypeMismatch : constant := 13;
129 -- Object variable or With block variable not set
130 ccObjectVariableNotSet : constant := 91;
131 -- Invalid property value
132 ccInvalidPropertyValue : constant := 380;
133 -- Property cannot be set at runtime
134 ccSetNotSupportedAtRuntime : constant := 382;
135 -- Property is read-only
136 ccSetNotSupported : constant := 383;
137 -- Property can't be set on this control
138 ccSetNotPermitted : constant := 387;
139 -- Property is write-only
140 ccGetNotSupported : constant := 394;
142 ccInvalidPicture : constant := 481;
143 -- Invalid object use
144 ccInvalidObjectUse : constant := 425;
145 -- Specified format doesn't match format of data
146 ccWrongClipboardFormat : constant := 461;
147 -- DataObject formats list may not be cleared or expanded outside of the OLEStartDrag event
148 ccDataObjectLocked : constant := 672;
149 -- Expected at least one argument.
150 ccExpectedAnArgument : constant := 673;
151 -- Illegal recursive invocation of OLE drag and drop
152 ccRecursiveOleDrag : constant := 674;
153 -- Non-intrinsic OLE drag and drop formats used with SetData require Byte
154 -- array data. GetData may return more bytes than were given to SetData.
155 ccFormatNotByteArray : constant := 675;
156 -- Requested data was not supplied to the DataObject during the OLESetData event.
157 ccDataNotSetForFormat : constant := 676;
158 -- Index out of bounds
159 ccIndexOutOfBounds : constant := 35600;
161 ccElemNotFound : constant := 35601;
162 -- Key is not unique in collection
163 ccNonUniqueKey : constant := 35602;
165 ccInvalidKey : constant := 35603;
166 -- This item's control has been deleted
167 ccElemNotPartOfCollection : constant := 35605;
168 -- Control's collection has been modified
169 ccCollectionChangedDuringEnum : constant := 35606;
170 -- This would introduce a cycle
171 ccWouldIntroduceCycle : constant := 35614;
172 -- Required argument is missing
173 ccMissingRequiredArg : constant := 35607;
175 ccBadObjectReference : constant := 35610;
176 -- Circular object referencing is not allowed
177 ccCircularReference : constant := 35700;
178 -- The first column in a ListView control must be left aligned
179 ccCol1MustBeLeftAligned : constant := 35604;
180 -- Property is read-only if image list contains images
181 ccReadOnlyIfHasImages : constant := 35611;
182 -- ImageList must be initialized before it can be used
183 ccImageListMustBeInitialized : constant := 35613;
184 -- All images in list must be same size
185 ccNotSameSize : constant := 35615;
186 -- ImageList cannot be modified while another control is bound to it
187 ccImageListLocked : constant := 35617;
188 -- Maximum Panels Exceeded
189 ccMaxPanelsExceeded : constant := 35616;
190 -- Maximum Buttons Exceeded
191 ccMaxButtonsExceeded : constant := 35619;
192 -- Invalid procedure call in safe mode
193 ccInvalidSafeModeProcCall : constant := 680;
195 -- ###### TabWidthStyleConstants{1EFB6590-857C-11D1-B16A-00C0F0283628} ######
197 tabJustified : constant := 0;
199 tabNonJustified : constant := 1;
201 tabFixed : constant := 2;
203 -- ###### TabStyleConstants{1EFB6591-857C-11D1-B16A-00C0F0283628} ######
205 tabTabs : constant := 0;
207 tabButtons : constant := 1;
209 tabFlatButtons : constant := 2;
211 -- ###### PlacementConstants{1EFB6592-857C-11D1-B16A-00C0F0283628} ######
213 tabPlacementTop : constant := 0;
215 tabPlacementBottom : constant := 1;
217 tabPlacementLeft : constant := 2;
219 tabPlacementRight : constant := 3;
221 -- ###### TabSelStyleConstants{1EFB6593-857C-11D1-B16A-00C0F0283628} ######
223 tabTabStandard : constant := 0;
225 tabTabOpposite : constant := 1;
227 -- ###### ButtonStyleConstants{66833FE0-8583-11D1-B16A-00C0F0283628} ######
229 tbrDefault : constant := 0;
231 tbrCheck : constant := 1;
233 tbrButtonGroup : constant := 2;
235 tbrSeparator : constant := 3;
237 tbrPlaceholder : constant := 4;
239 tbrDropdown : constant := 5;
241 -- ###### ValueConstants{66833FE1-8583-11D1-B16A-00C0F0283628} ######
243 tbrUnpressed : constant := 0;
245 tbrPressed : constant := 1;
247 -- ###### ToolbarStyleConstants{66833FE2-8583-11D1-B16A-00C0F0283628} ######
249 tbrStandard : constant := 0;
251 tbrFlat : constant := 1;
253 -- ###### ToolbarTextAlignConstants{66833FE3-8583-11D1-B16A-00C0F0283628} ######
255 tbrTextAlignBottom : constant := 0;
257 tbrTextAlignRight : constant := 1;
259 -- ###### SbarStyleConstants{8E3867A0-8586-11D1-B16A-00C0F0283628} ######
261 sbrNormal : constant := 0;
262 -- Single panel simple text
263 sbrSimple : constant := 1;
265 -- ###### PanelAlignmentConstants{8E3867A6-8586-11D1-B16A-00C0F0283628} ######
267 sbrLeft : constant := 0;
269 sbrCenter : constant := 1;
271 sbrRight : constant := 2;
273 -- ###### PanelAutoSizeConstants{8E3867A7-8586-11D1-B16A-00C0F0283628} ######
275 sbrNoAutoSize : constant := 0;
277 sbrSpring : constant := 1;
279 sbrContents : constant := 2;
281 -- ###### PanelBevelConstants{8E3867A8-8586-11D1-B16A-00C0F0283628} ######
283 sbrNoBevel : constant := 0;
285 sbrInset : constant := 1;
287 sbrRaised : constant := 2;
289 -- ###### PanelStyleConstants{8E3867A9-8586-11D1-B16A-00C0F0283628} ######
291 sbrText : constant := 0;
293 sbrCaps : constant := 1;
295 sbrNum : constant := 2;
297 sbrIns : constant := 3;
299 sbrScrl : constant := 4;
301 sbrTime : constant := 5;
303 sbrDate : constant := 6;
305 sbrKana : constant := 7;
307 -- ###### LabelEditConstants{C74190B0-8589-11D1-B16A-00C0F0283628} ######
309 tvwAutomatic : constant := 0;
311 tvwManual : constant := 1;
313 -- ###### TreeLineStyleConstants{C74190B1-8589-11D1-B16A-00C0F0283628} ######
315 tvwTreeLines : constant := 0;
317 tvwRootLines : constant := 1;
319 -- ###### TreeStyleConstants{C74190B2-8589-11D1-B16A-00C0F0283628} ######
321 tvwTextOnly : constant := 0;
323 tvwPictureText : constant := 1;
324 -- Plus/Minus and Text
325 tvwPlusMinusText : constant := 2;
326 -- Plus/Minus, Picture and Text
327 tvwPlusPictureText : constant := 3;
328 -- Treelines and Text
329 tvwTreelinesText : constant := 4;
330 -- Treelines, Picture and Text
331 tvwTreelinesPictureText : constant := 5;
332 -- Treelines, Plus/Minus and Text
333 tvwTreelinesPlusMinusText : constant := 6;
334 -- Treelines, Plus/Minus, Picture and Text
335 tvwTreelinesPlusMinusPictureText : constant := 7;
337 -- ###### TreeRelationshipConstants{C74190B3-8589-11D1-B16A-00C0F0283628} ######
339 tvwFirst : constant := 0;
341 tvwLast : constant := 1;
343 tvwNext : constant := 2;
345 tvwPrevious : constant := 3;
347 tvwChild : constant := 4;
349 -- ###### ListTextBackgroundConstants{BDD1F040-858B-11D1-B16A-00C0F0283628} ######
350 -- Draws ListItem text with transparent background
351 lvwTransparent : constant := 0;
352 -- Draws ListItem text with opaque background using Background color property
353 lvwOpaque : constant := 1;
355 -- ###### ListArrangeConstants{BDD1F041-858B-11D1-B16A-00C0F0283628} ######
357 lvwNone : constant := 0;
359 lvwAutoLeft : constant := 1;
361 lvwAutoTop : constant := 2;
363 -- ###### ListPictureAlignmentConstants{BDD1F042-858B-11D1-B16A-00C0F0283628} ######
364 -- Aligns background picture to the upper left.
365 lvwTopLeft : constant := 0;
366 -- Aligns background picture to the upper right.
367 lvwTopRight : constant := 1;
368 -- Aligns background picture to the lower left.
369 lvwBottomLeft : constant := 2;
370 -- Aligns background picture to the lower right.
371 lvwBottomRight : constant := 3;
372 -- Aligns background picture to the center.
373 lvwCenter : constant := 4;
374 -- Tiles the picture to fill the ListView background.
375 lvwTile : constant := 5;
377 -- ###### ListLabelEditConstants{BDD1F043-858B-11D1-B16A-00C0F0283628} ######
379 lvwAutomatic : constant := 0;
381 lvwManual : constant := 1;
383 -- ###### ListSortOrderConstants{BDD1F044-858B-11D1-B16A-00C0F0283628} ######
385 lvwAscending : constant := 0;
387 lvwDescending : constant := 1;
389 -- ###### ListViewConstants{BDD1F045-858B-11D1-B16A-00C0F0283628} ######
391 lvwIcon : constant := 0;
393 lvwSmallIcon : constant := 1;
395 lvwList : constant := 2;
397 lvwReport : constant := 3;
399 -- ###### ListColumnAlignmentConstants{BDD1F046-858B-11D1-B16A-00C0F0283628} ######
401 lvwColumnLeft : constant := 0;
403 lvwColumnRight : constant := 1;
405 lvwColumnCenter : constant := 2;
407 -- ###### ListFindItemWhereConstants{BDD1F047-858B-11D1-B16A-00C0F0283628} ######
409 lvwText : constant := 0;
411 lvwSubItem : constant := 1;
413 lvwTag : constant := 2;
415 -- ###### ListFindItemHowConstants{BDD1F048-858B-11D1-B16A-00C0F0283628} ######
417 lvwWhole : constant := 0;
419 lvwPartial : constant := 1;
421 -- ###### ImageDrawConstants{2C247F20-8591-11D1-B16A-00C0F0283628} ######
423 imlNormal : constant := 0;
425 imlTransparent : constant := 1;
427 imlSelected : constant := 2;
429 imlFocus : constant := 3;
431 -- ###### TickStyleConstants{F08DF950-8592-11D1-B16A-00C0F0283628} ######
433 sldBottomRight : constant := 0;
435 sldTopLeft : constant := 1;
437 sldBoth : constant := 2;
439 sldNoTicks : constant := 3;
441 -- ###### TextPositionConstants{F08DF951-8592-11D1-B16A-00C0F0283628} ######
443 sldAboveLeft : constant := 0;
445 sldBelowRight : constant := 1;
447 -- ###### Events ######
448 -- Click: Occurs when the user presses and then releases a mouse button over an object.
449 procedure Click_Proc;
450 type Click_Access is access procedure;
452 -- KeyDown: Occurs when the user presses a key while an object has the focus.
453 procedure KeyDown_Proc(KeyCode : gb.PSHORT; Shift : gb.SHORT);
454 type KeyDown_Access is access procedure (KeyCode : gb.PSHORT; Shift : gb.SHORT);
456 -- KeyPress: Occurs when the user presses and releases an ANSI key.
457 procedure KeyPress_Proc(KeyAscii : gb.PSHORT);
458 type KeyPress_Access is access procedure (KeyAscii : gb.PSHORT);
460 -- KeyUp: Occurs when the user releases a key while an object has the focus.
461 procedure KeyUp_Proc(KeyCode : gb.PSHORT; Shift : gb.SHORT);
462 type KeyUp_Access is access procedure (KeyCode : gb.PSHORT; Shift : gb.SHORT);
464 -- MouseDown: Occurs when the user presses the mouse button while an object has the focus.
465 procedure MouseDown_Proc(Button : gb.SHORT; Shift : gb.SHORT;
466 x : gb.LONG; y : gb.LONG);
467 type MouseDown_Access is access procedure (Button : gb.SHORT; Shift : gb.SHORT;
468 x : gb.LONG; y : gb.LONG);
470 -- MouseMove: Occurs when the user moves the mouse.
471 procedure MouseMove_Proc(Button : gb.SHORT; Shift : gb.SHORT;
472 x : gb.LONG; y : gb.LONG);
473 type MouseMove_Access is access procedure (Button : gb.SHORT; Shift : gb.SHORT;
474 x : gb.LONG; y : gb.LONG);
476 -- MouseUp: Occurs when the user releases the mouse button while an object has the focus.
477 procedure MouseUp_Proc(Button : gb.SHORT; Shift : gb.SHORT;
478 x : gb.LONG; y : gb.LONG);
479 type MouseUp_Access is access procedure (Button : gb.SHORT; Shift : gb.SHORT;
480 x : gb.LONG; y : gb.LONG);
482 -- Scroll: Slider scroll event
483 procedure Scroll_Proc;
484 type Scroll_Access is access procedure;
486 -- Change: Indicates that the contents of a control have changed.
487 procedure Change_Proc;
488 type Change_Access is access procedure;
490 -- OLEStartDrag: OLEStartDrag event
491 procedure OLEStartDrag_Proc(Data : gb.LPDISPATCH; AllowedEffects : gb.PLONG);
492 type OLEStartDrag_Access is access procedure (Data : gb.LPDISPATCH; AllowedEffects : gb.PLONG);
494 -- OLEGiveFeedback: OLEGiveFeedback event
495 procedure OLEGiveFeedback_Proc(Effect : gb.PLONG; DefaultCursors : gb.PVARIANT_BOOL);
496 type OLEGiveFeedback_Access is access procedure (Effect : gb.PLONG; DefaultCursors : gb.PVARIANT_BOOL);
498 -- OLESetData: OLESetData event
499 procedure OLESetData_Proc(Data : gb.LPDISPATCH; DataFormat : gb.PSHORT);
500 type OLESetData_Access is access procedure (Data : gb.LPDISPATCH; DataFormat : gb.PSHORT);
502 -- OLECompleteDrag: OLECompleteDrag event
503 procedure OLECompleteDrag_Proc(Effect : gb.PLONG);
504 type OLECompleteDrag_Access is access procedure (Effect : gb.PLONG);
506 -- OLEDragOver: OLEDragOver event
507 procedure OLEDragOver_Proc(Data : gb.LPDISPATCH; Effect : gb.PLONG;
508 Button : gb.PSHORT; Shift : gb.PSHORT; x : gb.PFLOAT;
509 y : gb.PFLOAT; State : gb.PSHORT);
510 type OLEDragOver_Access is access procedure (Data : gb.LPDISPATCH; Effect : gb.PLONG;
511 Button : gb.PSHORT; Shift : gb.PSHORT; x : gb.PFLOAT;
512 y : gb.PFLOAT; State : gb.PSHORT);
514 -- OLEDragDrop: OLEDragDrop event
515 procedure OLEDragDrop_Proc(Data : gb.LPDISPATCH; Effect : gb.PLONG;
516 Button : gb.PSHORT; Shift : gb.PSHORT; x : gb.PFLOAT;
518 type OLEDragDrop_Access is access procedure (Data : gb.LPDISPATCH; Effect : gb.PLONG;
519 Button : gb.PSHORT; Shift : gb.PSHORT; x : gb.PFLOAT;
522 -- ###### Object Declaration ######
523 type SliderCtrl(Parent : access gb.Object'class) is
524 new gb.OleControl(Parent) with
526 Click : Click_Access := Click_Proc'access;
527 KeyDown : KeyDown_Access := KeyDown_Proc'access;
528 KeyPress : KeyPress_Access := KeyPress_Proc'access;
529 KeyUp : KeyUp_Access := KeyUp_Proc'access;
530 MouseDown : MouseDown_Access := MouseDown_Proc'access;
531 MouseMove : MouseMove_Access := MouseMove_Proc'access;
532 MouseUp : MouseUp_Access := MouseUp_Proc'access;
533 Scroll : Scroll_Access := Scroll_Proc'access;
534 Change : Change_Access := Change_Proc'access;
535 OLEStartDrag : OLEStartDrag_Access := OLEStartDrag_Proc'access;
536 OLEGiveFeedback : OLEGiveFeedback_Access := OLEGiveFeedback_Proc'access;
537 OLESetData : OLESetData_Access := OLESetData_Proc'access;
538 OLECompleteDrag : OLECompleteDrag_Access := OLECompleteDrag_Proc'access;
539 OLEDragOver : OLEDragOver_Access := OLEDragOver_Proc'access;
540 OLEDragDrop : OLEDragDrop_Access := OLEDragDrop_Proc'access;
542 type SliderCtrlRef is access all SliderCtrl'class;
544 procedure Initialize(Obj : in out SliderCtrl);
546 -- ###### Methods ######
548 procedure QueryInterface(Obj : SliderCtrl; riid : gb.LPDISPATCH; ppvObj : gb.PVOID);
551 function AddRef(Obj : SliderCtrl) return gb.ULONG;
554 function Release(Obj : SliderCtrl) return gb.ULONG;
557 procedure GetTypeInfoCount(Obj : SliderCtrl; pctinfo : gb.PUINT);
560 procedure GetTypeInfo(Obj : SliderCtrl; itinfo : gb.UINT; lcid : gb.ULONG;
564 procedure GetIDsOfNames(Obj : SliderCtrl; riid : gb.LPDISPATCH; rgszNames : gb.PCHAR;
565 cNames : gb.UINT; lcid : gb.ULONG; rgdispid : gb.PLONG);
568 procedure Invoke(Obj : SliderCtrl; dispidMember : gb.LONG; riid : gb.LPDISPATCH;
569 lcid : gb.ULONG; wFlags : gb.USHORT; pdispparams : gb.LPDISPATCH;
570 pvarResult : gb.LPVARIANT; pexcepinfo : gb.LPDISPATCH; puArgErr : gb.PUINT);
572 -- LargeChange: Returns/sets the increment value when the PageDown or PageUp
574 function LargeChange(Obj : SliderCtrl) return gb.LONG;
576 -- LargeChange: Returns/sets the increment value when the PageDown or PageUp
578 procedure LargeChange(Obj : SliderCtrl; Param1 : gb.LONG);
580 -- SmallChange: Returns/sets the increment value when the left or right arrow
582 function SmallChange(Obj : SliderCtrl) return gb.LONG;
584 -- SmallChange: Returns/sets the increment value when the left or right arrow
586 procedure SmallChange(Obj : SliderCtrl; Param1 : gb.LONG);
588 -- Max: Returns/sets the maximum value of a control.
589 function Max(Obj : SliderCtrl) return gb.LONG;
591 -- Max: Returns/sets the maximum value of a control.
592 procedure Max(Obj : SliderCtrl; Param1 : gb.LONG);
594 -- Min: Returns/sets the minimum value of a control.
595 function Min(Obj : SliderCtrl) return gb.LONG;
597 -- Min: Returns/sets the minimum value of a control.
598 procedure Min(Obj : SliderCtrl; Param1 : gb.LONG);
600 -- Orientation: Returns/sets the orientation of a Slider control, horizontal or vertical.
601 function Orientation(Obj : SliderCtrl) return gb.INT;
603 -- Orientation: Returns/sets the orientation of a Slider control, horizontal or vertical.
604 procedure Orientation(Obj : SliderCtrl; Param1 : gb.INT);
606 -- SelectRange: Returns/sets whether or not a Slider control can have a select range.
607 function SelectRange(Obj : SliderCtrl) return gb.BOOL;
609 -- SelectRange: Returns/sets whether or not a Slider control can have a select range.
610 procedure SelectRange(Obj : SliderCtrl; Param1 : gb.BOOL);
612 -- SelStart: Returns/sets the value where a selection starts.
613 function SelStart(Obj : SliderCtrl) return gb.LONG;
615 -- SelStart: Returns/sets the value where a selection starts.
616 procedure SelStart(Obj : SliderCtrl; Param1 : gb.LONG);
618 -- SelLength: Returns/sets the length of a selection.
619 function SelLength(Obj : SliderCtrl) return gb.LONG;
621 -- SelLength: Returns/sets the length of a selection.
622 procedure SelLength(Obj : SliderCtrl; Param1 : gb.LONG);
624 -- TickStyle: Returns/sets where ticks appear on a Slider control.
625 function TickStyle(Obj : SliderCtrl) return gb.INT;
627 -- TickStyle: Returns/sets where ticks appear on a Slider control.
628 procedure TickStyle(Obj : SliderCtrl; Param1 : gb.INT);
630 -- TickFrequency: Returns/sets the ratio of ticks on a Slider control; 1tick
631 -- every n increments.
632 function TickFrequency(Obj : SliderCtrl) return gb.LONG;
634 -- TickFrequency: Returns/sets the ratio of ticks on a Slider control; 1tick
635 -- every n increments.
636 procedure TickFrequency(Obj : SliderCtrl; Param1 : gb.LONG);
638 -- Value: Returns/sets the value of an object.
639 function Value(Obj : SliderCtrl) return gb.LONG;
641 -- Value: Returns/sets the value of an object.
642 procedure Value(Obj : SliderCtrl; Param1 : gb.LONG);
644 -- MouseIcon: Sets a custom mouse icon.
645 function MouseIcon(Obj : SliderCtrl) return gb.LPDISPATCH;
647 -- MouseIcon: Sets a custom mouse icon.
648 procedure MouseIcon(Obj : SliderCtrl; Param1 : gb.LPDISPATCH);
650 -- MousePointer: Returns/sets the type of mouse pointer displayed when over
651 -- part of an object.
652 function MousePointer(Obj : SliderCtrl) return gb.INT;
654 -- MousePointer: Returns/sets the type of mouse pointer displayed when over
655 -- part of an object.
656 procedure MousePointer(Obj : SliderCtrl; Param1 : gb.INT);
658 -- Enabled: Returns/sets a value that determines whether a form or control
659 -- can respond to user-generated events.
660 function Enabled(Obj : SliderCtrl) return gb.BOOL;
662 -- Enabled: Returns/sets a value that determines whether a form or control
663 -- can respond to user-generated events.
664 procedure Enabled(Obj : SliderCtrl; Param1 : gb.BOOL);
666 -- hWnd: Returns a handle to a form or control.
667 function hWnd(Obj : SliderCtrl) return gb.INT;
669 -- hWnd: Returns a handle to a form or control.
670 procedure hWnd(Obj : SliderCtrl; Param1 : gb.INT);
672 -- BorderStyle: Returns/sets the border style for an object.
673 function BorderStyle(Obj : SliderCtrl) return gb.INT;
675 -- BorderStyle: Returns/sets the border style for an object.
676 procedure BorderStyle(Obj : SliderCtrl; Param1 : gb.INT);
678 -- OLEDropMode: Returns/Sets whether this control can act as an OLE drop target.
679 function OLEDropMode(Obj : SliderCtrl) return gb.INT;
681 -- OLEDropMode: Returns/Sets whether this control can act as an OLE drop target.
682 procedure OLEDropMode(Obj : SliderCtrl; Param1 : gb.INT);
684 -- Refresh: Forces a complete repaint of a form or control.
685 procedure Refresh(Obj : SliderCtrl);
687 -- ClearSel: Sets the SelLength to 0.
688 procedure ClearSel(Obj : SliderCtrl);
690 -- DoClick: Hidden method that can be used to invoke the Click event
691 procedure DoClick(Obj : SliderCtrl);
693 -- GetNumTicks: Returns the number of visible ticks on a Slider control.
694 function GetNumTicks(Obj : SliderCtrl) return gb.LONG;
696 -- OLEDrag: Starts an OLE drag/drop event with the given control as the source.
697 procedure OLEDrag(Obj : SliderCtrl);
700 procedure AboutBox(Obj : SliderCtrl);
702 -- Text: Returns/sets the string displayed in the ToolTip as the slider's position changes.
703 function Text(Obj : SliderCtrl) return String;
705 -- Text: Returns/sets the string displayed in the ToolTip as the slider's position changes.
706 procedure Text(Obj : SliderCtrl; Param1 : String);
708 -- TextPosition: Returns/sets a value that determines where the tooltip displaying
709 -- the Slider's changing position is displayed.
710 function TextPosition(Obj : SliderCtrl) return gb.INT;
712 -- TextPosition: Returns/sets a value that determines where the tooltip displaying
713 -- the Slider's changing position is displayed.
714 procedure TextPosition(Obj : SliderCtrl; Param1 : gb.INT);
716 end MSComctlLib_Slider;
719 package body MSComctlLib_Slider is
721 pragma Suppress(Discriminant_Check);
726 -- ###### Methods ######
727 procedure QueryInterface(Obj : SliderCtrl; riid : gb.LPDISPATCH; ppvObj : gb.PVOID) is
728 myVariants : array (1..2) of gb.Variant;
730 myVariants(2) := (gb.VT_DISPATCH, 0, 0, 0, (gb.VT_DISPATCH, riid));
731 myVariants(1) := (gb.VT_BYREF or gb.VT_VOID, 0, 0, 0, (gb.VT_BYREF or gb.VT_VOID, ppvObj));
732 gb.DoMethod(Obj, 1610612736, 1, 2, gb.Convert(myVariants'address));
735 function AddRef(Obj : SliderCtrl) return gb.ULONG is
736 myResult : aliased gb.Variant;
738 gb.DoMethod(Obj, 1610612737, 1, 0, null, myResult'unchecked_access);
739 return myResult.u.ulVal;
742 function Release(Obj : SliderCtrl) return gb.ULONG is
743 myResult : aliased gb.Variant;
745 gb.DoMethod(Obj, 1610612738, 1, 0, null, myResult'unchecked_access);
746 return myResult.u.ulVal;
749 procedure GetTypeInfoCount(Obj : SliderCtrl; pctinfo : gb.PUINT) is
750 myVariants : array (1..1) of gb.Variant;
752 myVariants(1) := (gb.VT_BYREF or gb.VT_UINT, 0, 0, 0, (gb.VT_BYREF or gb.VT_UINT, pctinfo));
753 gb.DoMethod(Obj, 1610678272, 1, 1, gb.Convert(myVariants'address));
754 end GetTypeInfoCount;
756 procedure GetTypeInfo(Obj : SliderCtrl; itinfo : gb.UINT; lcid : gb.ULONG;
757 pptinfo : gb.PVOID) is
758 myVariants : array (1..3) of gb.Variant;
760 myVariants(3) := (gb.VT_UINT, 0, 0, 0, (gb.VT_UINT, itinfo));
761 myVariants(2) := (gb.VT_UI4, 0, 0, 0, (gb.VT_UI4, lcid));
762 myVariants(1) := (gb.VT_BYREF or gb.VT_VOID, 0, 0, 0, (gb.VT_BYREF or gb.VT_VOID, pptinfo));
763 gb.DoMethod(Obj, 1610678273, 1, 3, gb.Convert(myVariants'address));
766 procedure GetIDsOfNames(Obj : SliderCtrl; riid : gb.LPDISPATCH; rgszNames : gb.PCHAR;
767 cNames : gb.UINT; lcid : gb.ULONG; rgdispid : gb.PLONG) is
768 myVariants : array (1..5) of gb.Variant;
770 myVariants(5) := (gb.VT_DISPATCH, 0, 0, 0, (gb.VT_DISPATCH, riid));
771 myVariants(4) := (gb.VT_BYREF or gb.VT_I1, 0, 0, 0, (gb.VT_BYREF or gb.VT_I1, rgszNames));
772 myVariants(3) := (gb.VT_UINT, 0, 0, 0, (gb.VT_UINT, cNames));
773 myVariants(2) := (gb.VT_UI4, 0, 0, 0, (gb.VT_UI4, lcid));
774 myVariants(1) := (gb.VT_BYREF or gb.VT_I4, 0, 0, 0, (gb.VT_BYREF or gb.VT_I4, rgdispid));
775 gb.DoMethod(Obj, 1610678274, 1, 5, gb.Convert(myVariants'address));
778 procedure Invoke(Obj : SliderCtrl; dispidMember : gb.LONG; riid : gb.LPDISPATCH;
779 lcid : gb.ULONG; wFlags : gb.USHORT; pdispparams : gb.LPDISPATCH;
780 pvarResult : gb.LPVARIANT; pexcepinfo : gb.LPDISPATCH; puArgErr : gb.PUINT) is
781 myVariants : array (1..8) of gb.Variant;
783 myVariants(8) := (gb.VT_I4, 0, 0, 0, (gb.VT_I4, dispidMember));
784 myVariants(7) := (gb.VT_DISPATCH, 0, 0, 0, (gb.VT_DISPATCH, riid));
785 myVariants(6) := (gb.VT_UI4, 0, 0, 0, (gb.VT_UI4, lcid));
786 myVariants(5) := (gb.VT_UI2, 0, 0, 0, (gb.VT_UI2, wFlags));
787 myVariants(4) := (gb.VT_DISPATCH, 0, 0, 0, (gb.VT_DISPATCH, pdispparams));
788 myVariants(3) := pvarResult.all;
789 myVariants(2) := (gb.VT_DISPATCH, 0, 0, 0, (gb.VT_DISPATCH, pexcepinfo));
790 myVariants(1) := (gb.VT_BYREF or gb.VT_UINT, 0, 0, 0, (gb.VT_BYREF or gb.VT_UINT, puArgErr));
791 gb.DoMethod(Obj, 1610678275, 1, 8, gb.Convert(myVariants'address));
794 function LargeChange(Obj : SliderCtrl) return gb.LONG is
795 myResult : aliased gb.Variant;
797 gb.DoMethod(Obj, 1, 2, 0, null, myResult'unchecked_access);
798 return myResult.u.lVal;
801 procedure LargeChange(Obj : SliderCtrl; Param1 : gb.LONG) is
802 myVariants : array (1..1) of gb.Variant;
804 myVariants(1) := (gb.VT_I4, 0, 0, 0, (gb.VT_I4, Param1));
805 gb.DoMethod(Obj, 1, 4, 1, gb.Convert(myVariants'address));
808 function SmallChange(Obj : SliderCtrl) return gb.LONG is
809 myResult : aliased gb.Variant;
811 gb.DoMethod(Obj, 2, 2, 0, null, myResult'unchecked_access);
812 return myResult.u.lVal;
815 procedure SmallChange(Obj : SliderCtrl; Param1 : gb.LONG) is
816 myVariants : array (1..1) of gb.Variant;
818 myVariants(1) := (gb.VT_I4, 0, 0, 0, (gb.VT_I4, Param1));
819 gb.DoMethod(Obj, 2, 4, 1, gb.Convert(myVariants'address));
822 function Max(Obj : SliderCtrl) return gb.LONG is
823 myResult : aliased gb.Variant;
825 gb.DoMethod(Obj, 3, 2, 0, null, myResult'unchecked_access);
826 return myResult.u.lVal;
829 procedure Max(Obj : SliderCtrl; Param1 : gb.LONG) is
830 myVariants : array (1..1) of gb.Variant;
832 myVariants(1) := (gb.VT_I4, 0, 0, 0, (gb.VT_I4, Param1));
833 gb.DoMethod(Obj, 3, 4, 1, gb.Convert(myVariants'address));
836 function Min(Obj : SliderCtrl) return gb.LONG is
837 myResult : aliased gb.Variant;
839 gb.DoMethod(Obj, 4, 2, 0, null, myResult'unchecked_access);
840 return myResult.u.lVal;
843 procedure Min(Obj : SliderCtrl; Param1 : gb.LONG) is
844 myVariants : array (1..1) of gb.Variant;
846 myVariants(1) := (gb.VT_I4, 0, 0, 0, (gb.VT_I4, Param1));
847 gb.DoMethod(Obj, 4, 4, 1, gb.Convert(myVariants'address));
850 function Orientation(Obj : SliderCtrl) return gb.INT is
851 myResult : aliased gb.Variant;
853 gb.DoMethod(Obj, 5, 2, 0, null, myResult'unchecked_access);
854 return myResult.u.intVal;
857 procedure Orientation(Obj : SliderCtrl; Param1 : gb.INT) is
858 myVariants : array (1..1) of gb.Variant;
860 myVariants(1) := (gb.VT_INT, 0, 0, 0, (gb.VT_INT, Param1));
861 gb.DoMethod(Obj, 5, 4, 1, gb.Convert(myVariants'address));
864 function SelectRange(Obj : SliderCtrl) return gb.BOOL is
865 myResult : aliased gb.Variant;
867 gb.DoMethod(Obj, 6, 2, 0, null, myResult'unchecked_access);
868 return gb.Convert(myResult.u.bool);
871 procedure SelectRange(Obj : SliderCtrl; Param1 : gb.BOOL) is
872 myVariants : array (1..1) of gb.Variant;
874 myVariants(1) := (gb.VT_BOOL, 0, 0, 0, (gb.VT_BOOL, gb.Convert(Param1)));
875 gb.DoMethod(Obj, 6, 4, 1, gb.Convert(myVariants'address));
878 function SelStart(Obj : SliderCtrl) return gb.LONG is
879 myResult : aliased gb.Variant;
881 gb.DoMethod(Obj, 7, 2, 0, null, myResult'unchecked_access);
882 return myResult.u.lVal;
885 procedure SelStart(Obj : SliderCtrl; Param1 : gb.LONG) is
886 myVariants : array (1..1) of gb.Variant;
888 myVariants(1) := (gb.VT_I4, 0, 0, 0, (gb.VT_I4, Param1));
889 gb.DoMethod(Obj, 7, 4, 1, gb.Convert(myVariants'address));
892 function SelLength(Obj : SliderCtrl) return gb.LONG is
893 myResult : aliased gb.Variant;
895 gb.DoMethod(Obj, 8, 2, 0, null, myResult'unchecked_access);
896 return myResult.u.lVal;
899 procedure SelLength(Obj : SliderCtrl; Param1 : gb.LONG) is
900 myVariants : array (1..1) of gb.Variant;
902 myVariants(1) := (gb.VT_I4, 0, 0, 0, (gb.VT_I4, Param1));
903 gb.DoMethod(Obj, 8, 4, 1, gb.Convert(myVariants'address));
906 function TickStyle(Obj : SliderCtrl) return gb.INT is
907 myResult : aliased gb.Variant;
909 gb.DoMethod(Obj, 9, 2, 0, null, myResult'unchecked_access);
910 return myResult.u.intVal;
913 procedure TickStyle(Obj : SliderCtrl; Param1 : gb.INT) is
914 myVariants : array (1..1) of gb.Variant;
916 myVariants(1) := (gb.VT_INT, 0, 0, 0, (gb.VT_INT, Param1));
917 gb.DoMethod(Obj, 9, 4, 1, gb.Convert(myVariants'address));
920 function TickFrequency(Obj : SliderCtrl) return gb.LONG is
921 myResult : aliased gb.Variant;
923 gb.DoMethod(Obj, 10, 2, 0, null, myResult'unchecked_access);
924 return myResult.u.lVal;
927 procedure TickFrequency(Obj : SliderCtrl; Param1 : gb.LONG) is
928 myVariants : array (1..1) of gb.Variant;
930 myVariants(1) := (gb.VT_I4, 0, 0, 0, (gb.VT_I4, Param1));
931 gb.DoMethod(Obj, 10, 4, 1, gb.Convert(myVariants'address));
934 function Value(Obj : SliderCtrl) return gb.LONG is
935 myResult : aliased gb.Variant;
937 gb.DoMethod(Obj, 11, 2, 0, null, myResult'unchecked_access);
938 return myResult.u.lVal;
941 procedure Value(Obj : SliderCtrl; Param1 : gb.LONG) is
942 myVariants : array (1..1) of gb.Variant;
944 myVariants(1) := (gb.VT_I4, 0, 0, 0, (gb.VT_I4, Param1));
945 gb.DoMethod(Obj, 11, 4, 1, gb.Convert(myVariants'address));
948 function MouseIcon(Obj : SliderCtrl) return gb.LPDISPATCH is
949 myResult : aliased gb.Variant;
951 gb.DoMethod(Obj, 12, 2, 0, null, myResult'unchecked_access);
952 return myResult.u.pdispVal;
955 procedure MouseIcon(Obj : SliderCtrl; Param1 : gb.LPDISPATCH) is
956 myVariants : array (1..1) of gb.Variant;
958 myVariants(1) := (gb.VT_DISPATCH, 0, 0, 0, (gb.VT_DISPATCH, Param1));
959 gb.DoMethod(Obj, 12, 4, 1, gb.Convert(myVariants'address));
962 function MousePointer(Obj : SliderCtrl) return gb.INT is
963 myResult : aliased gb.Variant;
965 gb.DoMethod(Obj, 13, 2, 0, null, myResult'unchecked_access);
966 return myResult.u.intVal;
969 procedure MousePointer(Obj : SliderCtrl; Param1 : gb.INT) is
970 myVariants : array (1..1) of gb.Variant;
972 myVariants(1) := (gb.VT_INT, 0, 0, 0, (gb.VT_INT, Param1));
973 gb.DoMethod(Obj, 13, 4, 1, gb.Convert(myVariants'address));
976 function Enabled(Obj : SliderCtrl) return gb.BOOL is
977 myResult : aliased gb.Variant;
979 gb.DoMethod(Obj, -514, 2, 0, null, myResult'unchecked_access);
980 return gb.Convert(myResult.u.bool);
983 procedure Enabled(Obj : SliderCtrl; Param1 : gb.BOOL) is
984 myVariants : array (1..1) of gb.Variant;
986 myVariants(1) := (gb.VT_BOOL, 0, 0, 0, (gb.VT_BOOL, gb.Convert(Param1)));
987 gb.DoMethod(Obj, -514, 4, 1, gb.Convert(myVariants'address));
990 function hWnd(Obj : SliderCtrl) return gb.INT is
991 myResult : aliased gb.Variant;
993 gb.DoMethod(Obj, -515, 2, 0, null, myResult'unchecked_access);
994 return myResult.u.intVal;
997 procedure hWnd(Obj : SliderCtrl; Param1 : gb.INT) is
998 myVariants : array (1..1) of gb.Variant;
1000 myVariants(1) := (gb.VT_INT, 0, 0, 0, (gb.VT_INT, Param1));
1001 gb.DoMethod(Obj, -515, 4, 1, gb.Convert(myVariants'address));
1004 function BorderStyle(Obj : SliderCtrl) return gb.INT is
1005 myResult : aliased gb.Variant;
1007 gb.DoMethod(Obj, -504, 2, 0, null, myResult'unchecked_access);
1008 return myResult.u.intVal;
1011 procedure BorderStyle(Obj : SliderCtrl; Param1 : gb.INT) is
1012 myVariants : array (1..1) of gb.Variant;
1014 myVariants(1) := (gb.VT_INT, 0, 0, 0, (gb.VT_INT, Param1));
1015 gb.DoMethod(Obj, -504, 4, 1, gb.Convert(myVariants'address));
1018 function OLEDropMode(Obj : SliderCtrl) return gb.INT is
1019 myResult : aliased gb.Variant;
1021 gb.DoMethod(Obj, 1551, 2, 0, null, myResult'unchecked_access);
1022 return myResult.u.intVal;
1025 procedure OLEDropMode(Obj : SliderCtrl; Param1 : gb.INT) is
1026 myVariants : array (1..1) of gb.Variant;
1028 myVariants(1) := (gb.VT_INT, 0, 0, 0, (gb.VT_INT, Param1));
1029 gb.DoMethod(Obj, 1551, 4, 1, gb.Convert(myVariants'address));
1032 procedure Refresh(Obj : SliderCtrl) is
1034 gb.DoMethod(Obj, -550, 1);
1037 procedure ClearSel(Obj : SliderCtrl) is
1039 gb.DoMethod(Obj, 14, 1);
1042 procedure DoClick(Obj : SliderCtrl) is
1044 gb.DoMethod(Obj, -551, 1);
1047 function GetNumTicks(Obj : SliderCtrl) return gb.LONG is
1048 myResult : aliased gb.Variant;
1050 gb.DoMethod(Obj, 15, 2, 0, null, myResult'unchecked_access);
1051 return myResult.u.lVal;
1054 procedure OLEDrag(Obj : SliderCtrl) is
1056 gb.DoMethod(Obj, 1552, 1);
1059 procedure AboutBox(Obj : SliderCtrl) is
1061 gb.DoMethod(Obj, -552, 1);
1064 function Text(Obj : SliderCtrl) return String is
1065 myResult : aliased gb.Variant;
1067 gb.DoMethod(Obj, 16, 2, 0, null, myResult'unchecked_access);
1068 return gb.To_ASCII(myResult.u.bstrVal);
1071 procedure Text(Obj : SliderCtrl; Param1 : String) is
1072 myBSTR1 : aliased gb.BSTR := gb.AllocBSTR(Param1);
1073 myVariants : array (1..1) of gb.Variant;
1075 myVariants(1) := (gb.VT_BSTR, 0, 0, 0, (gb.VT_BSTR, myBSTR1));
1076 gb.DoMethod(Obj, 16, 4, 1, gb.Convert(myVariants'address));
1077 gb.FreeBSTR(myBSTR1);
1080 function TextPosition(Obj : SliderCtrl) return gb.INT is
1081 myResult : aliased gb.Variant;
1083 gb.DoMethod(Obj, 17, 2, 0, null, myResult'unchecked_access);
1084 return myResult.u.intVal;
1087 procedure TextPosition(Obj : SliderCtrl; Param1 : gb.INT) is
1088 myVariants : array (1..1) of gb.Variant;
1090 myVariants(1) := (gb.VT_INT, 0, 0, 0, (gb.VT_INT, Param1));
1091 gb.DoMethod(Obj, 17, 4, 1, gb.Convert(myVariants'address));
1094 -- ###### Event Dispatch ######
1095 procedure DispatchEvent_Proc(Obj : gb.OleControlRef; dispidMember : gb.DISPID;
1096 pdispparams : access gb.DISPPARAMS) is
1098 u : aliased gb.UINT;
1099 myVariant1 : aliased gb.VARIANT;
1100 myVariant2 : aliased gb.VARIANT;
1101 myVariant3 : aliased gb.VARIANT;
1102 myVariant4 : aliased gb.VARIANT;
1103 myVariant5 : aliased gb.VARIANT;
1104 myVariant6 : aliased gb.VARIANT;
1105 myVariant7 : aliased gb.VARIANT;
1107 if dispidMember = -600 then
1108 SliderCtrl(Obj.all).Click.all;
1109 elsif dispidMember = -602 then
1110 hr := gb.DispGetParam(pdispparams, 0, gb.VT_BYREF or gb.VT_I2, myVariant1'access, u'access);
1111 hr := gb.DispGetParam(pdispparams, 1, gb.VT_I2, myVariant2'access, u'access);
1112 SliderCtrl(Obj.all).KeyDown(myVariant1.u.iVal'unchecked_access, myVariant2.u.iVal);
1113 hr := gb.VariantClear(myVariant1'access);
1114 hr := gb.VariantClear(myVariant2'access);
1115 elsif dispidMember = -603 then
1116 hr := gb.DispGetParam(pdispparams, 0, gb.VT_BYREF or gb.VT_I2, myVariant1'access, u'access);
1117 SliderCtrl(Obj.all).KeyPress(myVariant1.u.iVal'unchecked_access);
1118 hr := gb.VariantClear(myVariant1'access);
1119 elsif dispidMember = -604 then
1120 hr := gb.DispGetParam(pdispparams, 0, gb.VT_BYREF or gb.VT_I2, myVariant1'access, u'access);
1121 hr := gb.DispGetParam(pdispparams, 1, gb.VT_I2, myVariant2'access, u'access);
1122 SliderCtrl(Obj.all).KeyUp(myVariant1.u.iVal'unchecked_access, myVariant2.u.iVal);
1123 hr := gb.VariantClear(myVariant1'access);
1124 hr := gb.VariantClear(myVariant2'access);
1125 elsif dispidMember = -605 then
1126 hr := gb.DispGetParam(pdispparams, 0, gb.VT_I2, myVariant1'access, u'access);
1127 hr := gb.DispGetParam(pdispparams, 1, gb.VT_I2, myVariant2'access, u'access);
1128 hr := gb.DispGetParam(pdispparams, 2, gb.VT_I4, myVariant3'access, u'access);
1129 hr := gb.DispGetParam(pdispparams, 3, gb.VT_I4, myVariant4'access, u'access);
1130 SliderCtrl(Obj.all).MouseDown(myVariant1.u.iVal, myVariant2.u.iVal,
1131 myVariant3.u.lVal, myVariant4.u.lVal);
1132 hr := gb.VariantClear(myVariant1'access);
1133 hr := gb.VariantClear(myVariant2'access);
1134 hr := gb.VariantClear(myVariant3'access);
1135 hr := gb.VariantClear(myVariant4'access);
1136 elsif dispidMember = -606 then
1137 hr := gb.DispGetParam(pdispparams, 0, gb.VT_I2, myVariant1'access, u'access);
1138 hr := gb.DispGetParam(pdispparams, 1, gb.VT_I2, myVariant2'access, u'access);
1139 hr := gb.DispGetParam(pdispparams, 2, gb.VT_I4, myVariant3'access, u'access);
1140 hr := gb.DispGetParam(pdispparams, 3, gb.VT_I4, myVariant4'access, u'access);
1141 SliderCtrl(Obj.all).MouseMove(myVariant1.u.iVal, myVariant2.u.iVal,
1142 myVariant3.u.lVal, myVariant4.u.lVal);
1143 hr := gb.VariantClear(myVariant1'access);
1144 hr := gb.VariantClear(myVariant2'access);
1145 hr := gb.VariantClear(myVariant3'access);
1146 hr := gb.VariantClear(myVariant4'access);
1147 elsif dispidMember = -607 then
1148 hr := gb.DispGetParam(pdispparams, 0, gb.VT_I2, myVariant1'access, u'access);
1149 hr := gb.DispGetParam(pdispparams, 1, gb.VT_I2, myVariant2'access, u'access);
1150 hr := gb.DispGetParam(pdispparams, 2, gb.VT_I4, myVariant3'access, u'access);
1151 hr := gb.DispGetParam(pdispparams, 3, gb.VT_I4, myVariant4'access, u'access);
1152 SliderCtrl(Obj.all).MouseUp(myVariant1.u.iVal, myVariant2.u.iVal,
1153 myVariant3.u.lVal, myVariant4.u.lVal);
1154 hr := gb.VariantClear(myVariant1'access);
1155 hr := gb.VariantClear(myVariant2'access);
1156 hr := gb.VariantClear(myVariant3'access);
1157 hr := gb.VariantClear(myVariant4'access);
1158 elsif dispidMember = 1 then
1159 SliderCtrl(Obj.all).Scroll.all;
1160 elsif dispidMember = 2 then
1161 SliderCtrl(Obj.all).Change.all;
1162 elsif dispidMember = 1550 then
1163 hr := gb.DispGetParam(pdispparams, 0, gb.VT_DISPATCH, myVariant1'access, u'access);
1164 hr := gb.DispGetParam(pdispparams, 1, gb.VT_BYREF or gb.VT_I4, myVariant2'access, u'access);
1165 SliderCtrl(Obj.all).OLEStartDrag(myVariant1.u.pdispVal, myVariant2.u.lVal'unchecked_access);
1166 hr := gb.VariantClear(myVariant1'access);
1167 hr := gb.VariantClear(myVariant2'access);
1168 elsif dispidMember = 1551 then
1169 hr := gb.DispGetParam(pdispparams, 0, gb.VT_BYREF or gb.VT_I4, myVariant1'access, u'access);
1170 hr := gb.DispGetParam(pdispparams, 1, gb.VT_BYREF or gb.VT_BOOL, myVariant2'access, u'access);
1171 SliderCtrl(Obj.all).OLEGiveFeedback(myVariant1.u.lVal'unchecked_access, myVariant2.u.bool'unchecked_access);
1172 hr := gb.VariantClear(myVariant1'access);
1173 hr := gb.VariantClear(myVariant2'access);
1174 elsif dispidMember = 1552 then
1175 hr := gb.DispGetParam(pdispparams, 0, gb.VT_DISPATCH, myVariant1'access, u'access);
1176 hr := gb.DispGetParam(pdispparams, 1, gb.VT_BYREF or gb.VT_I2, myVariant2'access, u'access);
1177 SliderCtrl(Obj.all).OLESetData(myVariant1.u.pdispVal, myVariant2.u.iVal'unchecked_access);
1178 hr := gb.VariantClear(myVariant1'access);
1179 hr := gb.VariantClear(myVariant2'access);
1180 elsif dispidMember = 1553 then
1181 hr := gb.DispGetParam(pdispparams, 0, gb.VT_BYREF or gb.VT_I4, myVariant1'access, u'access);
1182 SliderCtrl(Obj.all).OLECompleteDrag(myVariant1.u.lVal'unchecked_access);
1183 hr := gb.VariantClear(myVariant1'access);
1184 elsif dispidMember = 1554 then
1185 hr := gb.DispGetParam(pdispparams, 0, gb.VT_DISPATCH, myVariant1'access, u'access);
1186 hr := gb.DispGetParam(pdispparams, 1, gb.VT_BYREF or gb.VT_I4, myVariant2'access, u'access);
1187 hr := gb.DispGetParam(pdispparams, 2, gb.VT_BYREF or gb.VT_I2, myVariant3'access, u'access);
1188 hr := gb.DispGetParam(pdispparams, 3, gb.VT_BYREF or gb.VT_I2, myVariant4'access, u'access);
1189 hr := gb.DispGetParam(pdispparams, 4, gb.VT_BYREF or gb.VT_R4, myVariant5'access, u'access);
1190 hr := gb.DispGetParam(pdispparams, 5, gb.VT_BYREF or gb.VT_R4, myVariant6'access, u'access);
1191 hr := gb.DispGetParam(pdispparams, 6, gb.VT_BYREF or gb.VT_I2, myVariant7'access, u'access);
1192 SliderCtrl(Obj.all).OLEDragOver(myVariant1.u.pdispVal, myVariant2.u.lVal'unchecked_access,
1193 myVariant3.u.iVal'unchecked_access, myVariant4.u.iVal'unchecked_access, myVariant5.u.fltVal'unchecked_access,
1194 myVariant6.u.fltVal'unchecked_access, myVariant7.u.iVal'unchecked_access);
1195 hr := gb.VariantClear(myVariant1'access);
1196 hr := gb.VariantClear(myVariant2'access);
1197 hr := gb.VariantClear(myVariant3'access);
1198 hr := gb.VariantClear(myVariant4'access);
1199 hr := gb.VariantClear(myVariant5'access);
1200 hr := gb.VariantClear(myVariant6'access);
1201 hr := gb.VariantClear(myVariant7'access);
1202 elsif dispidMember = 1555 then
1203 hr := gb.DispGetParam(pdispparams, 0, gb.VT_DISPATCH, myVariant1'access, u'access);
1204 hr := gb.DispGetParam(pdispparams, 1, gb.VT_BYREF or gb.VT_I4, myVariant2'access, u'access);
1205 hr := gb.DispGetParam(pdispparams, 2, gb.VT_BYREF or gb.VT_I2, myVariant3'access, u'access);
1206 hr := gb.DispGetParam(pdispparams, 3, gb.VT_BYREF or gb.VT_I2, myVariant4'access, u'access);
1207 hr := gb.DispGetParam(pdispparams, 4, gb.VT_BYREF or gb.VT_R4, myVariant5'access, u'access);
1208 hr := gb.DispGetParam(pdispparams, 5, gb.VT_BYREF or gb.VT_R4, myVariant6'access, u'access);
1209 SliderCtrl(Obj.all).OLEDragDrop(myVariant1.u.pdispVal, myVariant2.u.lVal'unchecked_access,
1210 myVariant3.u.iVal'unchecked_access, myVariant4.u.iVal'unchecked_access, myVariant5.u.fltVal'unchecked_access,
1211 myVariant6.u.fltVal'unchecked_access);
1212 hr := gb.VariantClear(myVariant1'access);
1213 hr := gb.VariantClear(myVariant2'access);
1214 hr := gb.VariantClear(myVariant3'access);
1215 hr := gb.VariantClear(myVariant4'access);
1216 hr := gb.VariantClear(myVariant5'access);
1217 hr := gb.VariantClear(myVariant6'access);
1219 end DispatchEvent_Proc;
1221 procedure Initialize(Obj : in out SliderCtrl) is
1223 Obj.i_DispatchEvent := DispatchEvent_Proc'access;
1224 Obj.i_ProgID(1..21) := gb.To_OleChar("MSComctlLib.Slider.2");
1225 Obj.i_EventDispatchIID(1..39) := gb.To_OleChar("{F08DF953-8592-11D1-B16A-00C0F0283628}");
1228 -- ###### Events ######
1229 procedure Click_Proc is
1234 procedure KeyDown_Proc(KeyCode : gb.PSHORT; Shift : gb.SHORT) is
1239 procedure KeyPress_Proc(KeyAscii : gb.PSHORT) is
1244 procedure KeyUp_Proc(KeyCode : gb.PSHORT; Shift : gb.SHORT) is
1249 procedure MouseDown_Proc(Button : gb.SHORT; Shift : gb.SHORT;
1250 x : gb.LONG; y : gb.LONG) is
1255 procedure MouseMove_Proc(Button : gb.SHORT; Shift : gb.SHORT;
1256 x : gb.LONG; y : gb.LONG) is
1261 procedure MouseUp_Proc(Button : gb.SHORT; Shift : gb.SHORT;
1262 x : gb.LONG; y : gb.LONG) is
1267 procedure Scroll_Proc is
1272 procedure Change_Proc is
1277 procedure OLEStartDrag_Proc(Data : gb.LPDISPATCH; AllowedEffects : gb.PLONG) is
1280 end OLEStartDrag_Proc;
1282 procedure OLEGiveFeedback_Proc(Effect : gb.PLONG; DefaultCursors : gb.PVARIANT_BOOL) is
1285 end OLEGiveFeedback_Proc;
1287 procedure OLESetData_Proc(Data : gb.LPDISPATCH; DataFormat : gb.PSHORT) is
1290 end OLESetData_Proc;
1292 procedure OLECompleteDrag_Proc(Effect : gb.PLONG) is
1295 end OLECompleteDrag_Proc;
1297 procedure OLEDragOver_Proc(Data : gb.LPDISPATCH; Effect : gb.PLONG;
1298 Button : gb.PSHORT; Shift : gb.PSHORT; x : gb.PFLOAT;
1299 y : gb.PFLOAT; State : gb.PSHORT) is
1302 end OLEDragOver_Proc;
1304 procedure OLEDragDrop_Proc(Data : gb.LPDISPATCH; Effect : gb.PLONG;
1305 Button : gb.PSHORT; Shift : gb.PSHORT; x : gb.PFLOAT;
1309 end OLEDragDrop_Proc;
1311 end MSComctlLib_Slider;