+
+with gb;
+
+package MSComctlLib_Slider is
+
+
+ -- ###### BorderStyleConstants{76B523C0-8579-11D1-B16A-00C0F0283628} ######
+ -- None
+ ccNone : constant := 0;
+ -- Fixed Single
+ ccFixedSingle : constant := 1;
+
+ -- ###### MousePointerConstants{76B523C1-8579-11D1-B16A-00C0F0283628} ######
+ -- Default
+ ccDefault : constant := 0;
+ -- Arrow mouse pointer
+ ccArrow : constant := 1;
+ -- Cross mouse pointer
+ ccCross : constant := 2;
+ -- I-Beam mouse pointer
+ ccIBeam : constant := 3;
+ -- Icon mouse pointer
+ ccIcon : constant := 4;
+ -- Size mouse pointer
+ ccSize : constant := 5;
+ -- Size NE SW mouse pointer
+ ccSizeNESW : constant := 6;
+ -- Size N S mouse pointer
+ ccSizeNS : constant := 7;
+ -- Size NW SE mouse pointer
+ ccSizeNWSE : constant := 8;
+ -- Size W E mouse pointer
+ ccSizeEW : constant := 9;
+ -- Up arrow mouse pointer
+ ccUpArrow : constant := 10;
+ -- Hourglass mouse pointer
+ ccHourglass : constant := 11;
+ -- No drop mouse pointer
+ ccNoDrop : constant := 12;
+ -- Arrow and Hourglass mouse pointer
+ ccArrowHourglass : constant := 13;
+ -- Arrow and Question mark mouse pointer
+ ccArrowQuestion : constant := 14;
+ -- Size all mouse pointer
+ ccSizeAll : constant := 15;
+ -- Custom mouse pointer icon specified by the MouseIcon property
+ ccCustom : constant := 99;
+
+ -- ###### AppearanceConstants{76B523C2-8579-11D1-B16A-00C0F0283628} ######
+ -- Flat
+ ccFlat : constant := 0;
+ -- 3D
+ cc3D : constant := 1;
+
+ -- ###### VB4AppearanceConstants{00000000-0000-0000-0000-000000000000} ######
+ -- Flat
+ vbFlat : constant := 0;
+ -- 3D
+ vb3D : constant := 1;
+
+ -- ###### ScrollingConstants{76B523C3-8579-11D1-B16A-00C0F0283628} ######
+ -- Standard Scrolling
+ ccScrollingStandard : constant := 0;
+ -- Smooth Scrolling
+ ccScrollingSmooth : constant := 1;
+
+ -- ###### OrientationConstants{76B523C4-8579-11D1-B16A-00C0F0283628} ######
+ -- Horizontal
+ ccOrientationHorizontal : constant := 0;
+ -- Vertical
+ ccOrientationVertical : constant := 1;
+
+ -- ###### OLEDragConstants{D8898460-742F-11CF-8AEA-00AA00C00905} ######
+ -- OLE drag/drop will be initialized only under programmatic control.
+ ccOLEDragManual : constant := 0;
+ -- OLE drag/drop will be initialized when the user drags 'out' of the control,
+ -- or under programmatic control.
+ ccOLEDragAutomatic : constant := 1;
+
+ -- ###### OLEDropConstants{D8898461-742F-11CF-8AEA-00AA00C00905} ######
+ -- Accepts no OLE drag/drop operations.
+ ccOLEDropNone : constant := 0;
+ -- Accepts an OLE drag/drop under programmatic control only.
+ ccOLEDropManual : constant := 1;
+
+ -- ###### DragOverConstants{D8898464-742F-11CF-8AEA-00AA00C00905} ######
+ -- Source control dragged into target.
+ ccEnter : constant := 0;
+ -- Source control dragged out of target.
+ ccLeave : constant := 1;
+ -- Source control dragged from one position in target to another.
+ ccOver : constant := 2;
+
+ -- ###### ClipBoardConstants{D8898462-742F-11CF-8AEA-00AA00C00905} ######
+ -- Text (.txt file).
+ ccCFText : constant := 1;
+ -- Bitmap (.bmp file).
+ ccCFBitmap : constant := 2;
+ -- Metafile (.wmf file).
+ ccCFMetafile : constant := 3;
+ -- Device-independent bitmap.
+ ccCFDIB : constant := 8;
+ -- Color palette.
+ ccCFPalette : constant := 9;
+ -- Enhanced metafile (.emf file).
+ ccCFEMetafile : constant := 14;
+ -- Filename list (Microsoft Windows Explorer)
+ ccCFFiles : constant := 15;
+ -- Rich Text Format (.rtf file).
+ ccCFRTF : constant := -16639;
+
+ -- ###### OLEDropEffectConstants{D8898463-742F-11CF-8AEA-00AA00C00905} ######
+ -- No OLE drag/drop operation has taken place/would take place.
+ ccOLEDropEffectNone : constant := 0;
+ -- A mask to indicate that a copy has taken place/would take place.
+ ccOLEDropEffectCopy : constant := 1;
+ -- A mask to indicate that a move has taken place/would take place.
+ ccOLEDropEffectMove : constant := 2;
+ -- A mask to indicate that the drop target window has scrolled/would scroll.
+ ccOLEDropEffectScroll : constant := -2147483648;
+
+ -- ###### ErrorConstants{76B523C5-8579-11D1-B16A-00C0F0283628} ######
+ -- Invalid procedure call
+ ccInvalidProcedureCall : constant := 5;
+ -- Out of memory
+ ccOutOfMemory : constant := 7;
+ -- Type mismatch
+ ccTypeMismatch : constant := 13;
+ -- Object variable or With block variable not set
+ ccObjectVariableNotSet : constant := 91;
+ -- Invalid property value
+ ccInvalidPropertyValue : constant := 380;
+ -- Property cannot be set at runtime
+ ccSetNotSupportedAtRuntime : constant := 382;
+ -- Property is read-only
+ ccSetNotSupported : constant := 383;
+ -- Property can't be set on this control
+ ccSetNotPermitted : constant := 387;
+ -- Property is write-only
+ ccGetNotSupported : constant := 394;
+ -- Invalid picture
+ ccInvalidPicture : constant := 481;
+ -- Invalid object use
+ ccInvalidObjectUse : constant := 425;
+ -- Specified format doesn't match format of data
+ ccWrongClipboardFormat : constant := 461;
+ -- DataObject formats list may not be cleared or expanded outside of the OLEStartDrag event
+ ccDataObjectLocked : constant := 672;
+ -- Expected at least one argument.
+ ccExpectedAnArgument : constant := 673;
+ -- Illegal recursive invocation of OLE drag and drop
+ ccRecursiveOleDrag : constant := 674;
+ -- Non-intrinsic OLE drag and drop formats used with SetData require Byte
+ -- array data. GetData may return more bytes than were given to SetData.
+ ccFormatNotByteArray : constant := 675;
+ -- Requested data was not supplied to the DataObject during the OLESetData event.
+ ccDataNotSetForFormat : constant := 676;
+ -- Index out of bounds
+ ccIndexOutOfBounds : constant := 35600;
+ -- Element not found
+ ccElemNotFound : constant := 35601;
+ -- Key is not unique in collection
+ ccNonUniqueKey : constant := 35602;
+ -- Invalid key
+ ccInvalidKey : constant := 35603;
+ -- This item's control has been deleted
+ ccElemNotPartOfCollection : constant := 35605;
+ -- Control's collection has been modified
+ ccCollectionChangedDuringEnum : constant := 35606;
+ -- This would introduce a cycle
+ ccWouldIntroduceCycle : constant := 35614;
+ -- Required argument is missing
+ ccMissingRequiredArg : constant := 35607;
+ -- Invalid object
+ ccBadObjectReference : constant := 35610;
+ -- Circular object referencing is not allowed
+ ccCircularReference : constant := 35700;
+ -- The first column in a ListView control must be left aligned
+ ccCol1MustBeLeftAligned : constant := 35604;
+ -- Property is read-only if image list contains images
+ ccReadOnlyIfHasImages : constant := 35611;
+ -- ImageList must be initialized before it can be used
+ ccImageListMustBeInitialized : constant := 35613;
+ -- All images in list must be same size
+ ccNotSameSize : constant := 35615;
+ -- ImageList cannot be modified while another control is bound to it
+ ccImageListLocked : constant := 35617;
+ -- Maximum Panels Exceeded
+ ccMaxPanelsExceeded : constant := 35616;
+ -- Maximum Buttons Exceeded
+ ccMaxButtonsExceeded : constant := 35619;
+ -- Invalid procedure call in safe mode
+ ccInvalidSafeModeProcCall : constant := 680;
+
+ -- ###### TabWidthStyleConstants{1EFB6590-857C-11D1-B16A-00C0F0283628} ######
+ -- Justified
+ tabJustified : constant := 0;
+ -- Non-Justified
+ tabNonJustified : constant := 1;
+ -- Fixed
+ tabFixed : constant := 2;
+
+ -- ###### TabStyleConstants{1EFB6591-857C-11D1-B16A-00C0F0283628} ######
+ -- Tabs
+ tabTabs : constant := 0;
+ -- Buttons
+ tabButtons : constant := 1;
+ -- Flat Buttons
+ tabFlatButtons : constant := 2;
+
+ -- ###### PlacementConstants{1EFB6592-857C-11D1-B16A-00C0F0283628} ######
+ -- Top
+ tabPlacementTop : constant := 0;
+ -- Bottom
+ tabPlacementBottom : constant := 1;
+ -- Left
+ tabPlacementLeft : constant := 2;
+ -- Right
+ tabPlacementRight : constant := 3;
+
+ -- ###### TabSelStyleConstants{1EFB6593-857C-11D1-B16A-00C0F0283628} ######
+ -- Standard
+ tabTabStandard : constant := 0;
+ -- Opposite
+ tabTabOpposite : constant := 1;
+
+ -- ###### ButtonStyleConstants{66833FE0-8583-11D1-B16A-00C0F0283628} ######
+ -- Default
+ tbrDefault : constant := 0;
+ -- Check
+ tbrCheck : constant := 1;
+ -- ButtonGroup
+ tbrButtonGroup : constant := 2;
+ -- Separator
+ tbrSeparator : constant := 3;
+ -- Placeholder
+ tbrPlaceholder : constant := 4;
+ -- Dropdown
+ tbrDropdown : constant := 5;
+
+ -- ###### ValueConstants{66833FE1-8583-11D1-B16A-00C0F0283628} ######
+ -- Unpressed
+ tbrUnpressed : constant := 0;
+ -- Pressed
+ tbrPressed : constant := 1;
+
+ -- ###### ToolbarStyleConstants{66833FE2-8583-11D1-B16A-00C0F0283628} ######
+ -- Standard
+ tbrStandard : constant := 0;
+ -- Transparent
+ tbrFlat : constant := 1;
+
+ -- ###### ToolbarTextAlignConstants{66833FE3-8583-11D1-B16A-00C0F0283628} ######
+ -- Bottom
+ tbrTextAlignBottom : constant := 0;
+ -- Right
+ tbrTextAlignRight : constant := 1;
+
+ -- ###### SbarStyleConstants{8E3867A0-8586-11D1-B16A-00C0F0283628} ######
+ -- Multiple panels
+ sbrNormal : constant := 0;
+ -- Single panel simple text
+ sbrSimple : constant := 1;
+
+ -- ###### PanelAlignmentConstants{8E3867A6-8586-11D1-B16A-00C0F0283628} ######
+ -- Left
+ sbrLeft : constant := 0;
+ -- Center
+ sbrCenter : constant := 1;
+ -- Right
+ sbrRight : constant := 2;
+
+ -- ###### PanelAutoSizeConstants{8E3867A7-8586-11D1-B16A-00C0F0283628} ######
+ -- None
+ sbrNoAutoSize : constant := 0;
+ -- Spring
+ sbrSpring : constant := 1;
+ -- Contents
+ sbrContents : constant := 2;
+
+ -- ###### PanelBevelConstants{8E3867A8-8586-11D1-B16A-00C0F0283628} ######
+ -- None
+ sbrNoBevel : constant := 0;
+ -- Inset
+ sbrInset : constant := 1;
+ -- Raised
+ sbrRaised : constant := 2;
+
+ -- ###### PanelStyleConstants{8E3867A9-8586-11D1-B16A-00C0F0283628} ######
+ -- Text
+ sbrText : constant := 0;
+ -- Caps
+ sbrCaps : constant := 1;
+ -- Num
+ sbrNum : constant := 2;
+ -- Ins
+ sbrIns : constant := 3;
+ -- Scrl
+ sbrScrl : constant := 4;
+ -- Time
+ sbrTime : constant := 5;
+ -- Date
+ sbrDate : constant := 6;
+ -- Kana
+ sbrKana : constant := 7;
+
+ -- ###### LabelEditConstants{C74190B0-8589-11D1-B16A-00C0F0283628} ######
+ -- Automatic
+ tvwAutomatic : constant := 0;
+ -- Manual
+ tvwManual : constant := 1;
+
+ -- ###### TreeLineStyleConstants{C74190B1-8589-11D1-B16A-00C0F0283628} ######
+ -- TreeLines
+ tvwTreeLines : constant := 0;
+ -- RootLines
+ tvwRootLines : constant := 1;
+
+ -- ###### TreeStyleConstants{C74190B2-8589-11D1-B16A-00C0F0283628} ######
+ -- Text Only
+ tvwTextOnly : constant := 0;
+ -- Picture and Text
+ tvwPictureText : constant := 1;
+ -- Plus/Minus and Text
+ tvwPlusMinusText : constant := 2;
+ -- Plus/Minus, Picture and Text
+ tvwPlusPictureText : constant := 3;
+ -- Treelines and Text
+ tvwTreelinesText : constant := 4;
+ -- Treelines, Picture and Text
+ tvwTreelinesPictureText : constant := 5;
+ -- Treelines, Plus/Minus and Text
+ tvwTreelinesPlusMinusText : constant := 6;
+ -- Treelines, Plus/Minus, Picture and Text
+ tvwTreelinesPlusMinusPictureText : constant := 7;
+
+ -- ###### TreeRelationshipConstants{C74190B3-8589-11D1-B16A-00C0F0283628} ######
+ -- First sibling
+ tvwFirst : constant := 0;
+ -- Last sibling
+ tvwLast : constant := 1;
+ -- Next sibling
+ tvwNext : constant := 2;
+ -- Previous sibling
+ tvwPrevious : constant := 3;
+ -- Child
+ tvwChild : constant := 4;
+
+ -- ###### ListTextBackgroundConstants{BDD1F040-858B-11D1-B16A-00C0F0283628} ######
+ -- Draws ListItem text with transparent background
+ lvwTransparent : constant := 0;
+ -- Draws ListItem text with opaque background using Background color property
+ lvwOpaque : constant := 1;
+
+ -- ###### ListArrangeConstants{BDD1F041-858B-11D1-B16A-00C0F0283628} ######
+ -- None
+ lvwNone : constant := 0;
+ -- Left
+ lvwAutoLeft : constant := 1;
+ -- Top
+ lvwAutoTop : constant := 2;
+
+ -- ###### ListPictureAlignmentConstants{BDD1F042-858B-11D1-B16A-00C0F0283628} ######
+ -- Aligns background picture to the upper left.
+ lvwTopLeft : constant := 0;
+ -- Aligns background picture to the upper right.
+ lvwTopRight : constant := 1;
+ -- Aligns background picture to the lower left.
+ lvwBottomLeft : constant := 2;
+ -- Aligns background picture to the lower right.
+ lvwBottomRight : constant := 3;
+ -- Aligns background picture to the center.
+ lvwCenter : constant := 4;
+ -- Tiles the picture to fill the ListView background.
+ lvwTile : constant := 5;
+
+ -- ###### ListLabelEditConstants{BDD1F043-858B-11D1-B16A-00C0F0283628} ######
+ -- Automatic
+ lvwAutomatic : constant := 0;
+ -- Manual
+ lvwManual : constant := 1;
+
+ -- ###### ListSortOrderConstants{BDD1F044-858B-11D1-B16A-00C0F0283628} ######
+ -- Ascending
+ lvwAscending : constant := 0;
+ -- Descending
+ lvwDescending : constant := 1;
+
+ -- ###### ListViewConstants{BDD1F045-858B-11D1-B16A-00C0F0283628} ######
+ -- Icon
+ lvwIcon : constant := 0;
+ -- SmallIcon
+ lvwSmallIcon : constant := 1;
+ -- List
+ lvwList : constant := 2;
+ -- Report
+ lvwReport : constant := 3;
+
+ -- ###### ListColumnAlignmentConstants{BDD1F046-858B-11D1-B16A-00C0F0283628} ######
+ -- Left
+ lvwColumnLeft : constant := 0;
+ -- Right
+ lvwColumnRight : constant := 1;
+ -- Center
+ lvwColumnCenter : constant := 2;
+
+ -- ###### ListFindItemWhereConstants{BDD1F047-858B-11D1-B16A-00C0F0283628} ######
+ -- Text
+ lvwText : constant := 0;
+ -- SubItem
+ lvwSubItem : constant := 1;
+ -- Tag
+ lvwTag : constant := 2;
+
+ -- ###### ListFindItemHowConstants{BDD1F048-858B-11D1-B16A-00C0F0283628} ######
+ -- Whole
+ lvwWhole : constant := 0;
+ -- Partial
+ lvwPartial : constant := 1;
+
+ -- ###### ImageDrawConstants{2C247F20-8591-11D1-B16A-00C0F0283628} ######
+ -- Normal
+ imlNormal : constant := 0;
+ -- Transparent
+ imlTransparent : constant := 1;
+ -- Selected
+ imlSelected : constant := 2;
+ -- Focus
+ imlFocus : constant := 3;
+
+ -- ###### TickStyleConstants{F08DF950-8592-11D1-B16A-00C0F0283628} ######
+ -- Bottom/Right
+ sldBottomRight : constant := 0;
+ -- Top/Left
+ sldTopLeft : constant := 1;
+ -- Both
+ sldBoth : constant := 2;
+ -- No Ticks
+ sldNoTicks : constant := 3;
+
+ -- ###### TextPositionConstants{F08DF951-8592-11D1-B16A-00C0F0283628} ######
+ -- Above/Left
+ sldAboveLeft : constant := 0;
+ -- Below/Right
+ sldBelowRight : constant := 1;
+
+ -- ###### Events ######
+ -- Click: Occurs when the user presses and then releases a mouse button over an object.
+ procedure Click_Proc;
+ type Click_Access is access procedure;
+
+ -- KeyDown: Occurs when the user presses a key while an object has the focus.
+ procedure KeyDown_Proc(KeyCode : gb.PSHORT; Shift : gb.SHORT);
+ type KeyDown_Access is access procedure (KeyCode : gb.PSHORT; Shift : gb.SHORT);
+
+ -- KeyPress: Occurs when the user presses and releases an ANSI key.
+ procedure KeyPress_Proc(KeyAscii : gb.PSHORT);
+ type KeyPress_Access is access procedure (KeyAscii : gb.PSHORT);
+
+ -- KeyUp: Occurs when the user releases a key while an object has the focus.
+ procedure KeyUp_Proc(KeyCode : gb.PSHORT; Shift : gb.SHORT);
+ type KeyUp_Access is access procedure (KeyCode : gb.PSHORT; Shift : gb.SHORT);
+
+ -- MouseDown: Occurs when the user presses the mouse button while an object has the focus.
+ procedure MouseDown_Proc(Button : gb.SHORT; Shift : gb.SHORT;
+ x : gb.LONG; y : gb.LONG);
+ type MouseDown_Access is access procedure (Button : gb.SHORT; Shift : gb.SHORT;
+ x : gb.LONG; y : gb.LONG);
+
+ -- MouseMove: Occurs when the user moves the mouse.
+ procedure MouseMove_Proc(Button : gb.SHORT; Shift : gb.SHORT;
+ x : gb.LONG; y : gb.LONG);
+ type MouseMove_Access is access procedure (Button : gb.SHORT; Shift : gb.SHORT;
+ x : gb.LONG; y : gb.LONG);
+
+ -- MouseUp: Occurs when the user releases the mouse button while an object has the focus.
+ procedure MouseUp_Proc(Button : gb.SHORT; Shift : gb.SHORT;
+ x : gb.LONG; y : gb.LONG);
+ type MouseUp_Access is access procedure (Button : gb.SHORT; Shift : gb.SHORT;
+ x : gb.LONG; y : gb.LONG);
+
+ -- Scroll: Slider scroll event
+ procedure Scroll_Proc;
+ type Scroll_Access is access procedure;
+
+ -- Change: Indicates that the contents of a control have changed.
+ procedure Change_Proc;
+ type Change_Access is access procedure;
+
+ -- OLEStartDrag: OLEStartDrag event
+ procedure OLEStartDrag_Proc(Data : gb.LPDISPATCH; AllowedEffects : gb.PLONG);
+ type OLEStartDrag_Access is access procedure (Data : gb.LPDISPATCH; AllowedEffects : gb.PLONG);
+
+ -- OLEGiveFeedback: OLEGiveFeedback event
+ procedure OLEGiveFeedback_Proc(Effect : gb.PLONG; DefaultCursors : gb.PVARIANT_BOOL);
+ type OLEGiveFeedback_Access is access procedure (Effect : gb.PLONG; DefaultCursors : gb.PVARIANT_BOOL);
+
+ -- OLESetData: OLESetData event
+ procedure OLESetData_Proc(Data : gb.LPDISPATCH; DataFormat : gb.PSHORT);
+ type OLESetData_Access is access procedure (Data : gb.LPDISPATCH; DataFormat : gb.PSHORT);
+
+ -- OLECompleteDrag: OLECompleteDrag event
+ procedure OLECompleteDrag_Proc(Effect : gb.PLONG);
+ type OLECompleteDrag_Access is access procedure (Effect : gb.PLONG);
+
+ -- OLEDragOver: OLEDragOver event
+ procedure OLEDragOver_Proc(Data : gb.LPDISPATCH; Effect : gb.PLONG;
+ Button : gb.PSHORT; Shift : gb.PSHORT; x : gb.PFLOAT;
+ y : gb.PFLOAT; State : gb.PSHORT);
+ type OLEDragOver_Access is access procedure (Data : gb.LPDISPATCH; Effect : gb.PLONG;
+ Button : gb.PSHORT; Shift : gb.PSHORT; x : gb.PFLOAT;
+ y : gb.PFLOAT; State : gb.PSHORT);
+
+ -- OLEDragDrop: OLEDragDrop event
+ procedure OLEDragDrop_Proc(Data : gb.LPDISPATCH; Effect : gb.PLONG;
+ Button : gb.PSHORT; Shift : gb.PSHORT; x : gb.PFLOAT;
+ y : gb.PFLOAT);
+ type OLEDragDrop_Access is access procedure (Data : gb.LPDISPATCH; Effect : gb.PLONG;
+ Button : gb.PSHORT; Shift : gb.PSHORT; x : gb.PFLOAT;
+ y : gb.PFLOAT);
+
+ -- ###### Object Declaration ######
+ type SliderCtrl(Parent : access gb.Object'class) is
+ new gb.OleControl(Parent) with
+ record
+ Click : Click_Access := Click_Proc'access;
+ KeyDown : KeyDown_Access := KeyDown_Proc'access;
+ KeyPress : KeyPress_Access := KeyPress_Proc'access;
+ KeyUp : KeyUp_Access := KeyUp_Proc'access;
+ MouseDown : MouseDown_Access := MouseDown_Proc'access;
+ MouseMove : MouseMove_Access := MouseMove_Proc'access;
+ MouseUp : MouseUp_Access := MouseUp_Proc'access;
+ Scroll : Scroll_Access := Scroll_Proc'access;
+ Change : Change_Access := Change_Proc'access;
+ OLEStartDrag : OLEStartDrag_Access := OLEStartDrag_Proc'access;
+ OLEGiveFeedback : OLEGiveFeedback_Access := OLEGiveFeedback_Proc'access;
+ OLESetData : OLESetData_Access := OLESetData_Proc'access;
+ OLECompleteDrag : OLECompleteDrag_Access := OLECompleteDrag_Proc'access;
+ OLEDragOver : OLEDragOver_Access := OLEDragOver_Proc'access;
+ OLEDragDrop : OLEDragDrop_Access := OLEDragDrop_Proc'access;
+ end record;
+ type SliderCtrlRef is access all SliderCtrl'class;
+
+ procedure Initialize(Obj : in out SliderCtrl);
+
+ -- ###### Methods ######
+ -- QueryInterface
+ procedure QueryInterface(Obj : SliderCtrl; riid : gb.LPDISPATCH; ppvObj : gb.PVOID);
+
+ -- AddRef
+ function AddRef(Obj : SliderCtrl) return gb.ULONG;
+
+ -- Release
+ function Release(Obj : SliderCtrl) return gb.ULONG;
+
+ -- GetTypeInfoCount
+ procedure GetTypeInfoCount(Obj : SliderCtrl; pctinfo : gb.PUINT);
+
+ -- GetTypeInfo
+ procedure GetTypeInfo(Obj : SliderCtrl; itinfo : gb.UINT; lcid : gb.ULONG;
+ pptinfo : gb.PVOID);
+
+ -- GetIDsOfNames
+ procedure GetIDsOfNames(Obj : SliderCtrl; riid : gb.LPDISPATCH; rgszNames : gb.PCHAR;
+ cNames : gb.UINT; lcid : gb.ULONG; rgdispid : gb.PLONG);
+
+ -- Invoke
+ procedure Invoke(Obj : SliderCtrl; dispidMember : gb.LONG; riid : gb.LPDISPATCH;
+ lcid : gb.ULONG; wFlags : gb.USHORT; pdispparams : gb.LPDISPATCH;
+ pvarResult : gb.LPVARIANT; pexcepinfo : gb.LPDISPATCH; puArgErr : gb.PUINT);
+
+ -- LargeChange: Returns/sets the increment value when the PageDown or PageUp
+ -- key is pressed.
+ function LargeChange(Obj : SliderCtrl) return gb.LONG;
+
+ -- LargeChange: Returns/sets the increment value when the PageDown or PageUp
+ -- key is pressed.
+ procedure LargeChange(Obj : SliderCtrl; Param1 : gb.LONG);
+
+ -- SmallChange: Returns/sets the increment value when the left or right arrow
+ -- key is pressed.
+ function SmallChange(Obj : SliderCtrl) return gb.LONG;
+
+ -- SmallChange: Returns/sets the increment value when the left or right arrow
+ -- key is pressed.
+ procedure SmallChange(Obj : SliderCtrl; Param1 : gb.LONG);
+
+ -- Max: Returns/sets the maximum value of a control.
+ function Max(Obj : SliderCtrl) return gb.LONG;
+
+ -- Max: Returns/sets the maximum value of a control.
+ procedure Max(Obj : SliderCtrl; Param1 : gb.LONG);
+
+ -- Min: Returns/sets the minimum value of a control.
+ function Min(Obj : SliderCtrl) return gb.LONG;
+
+ -- Min: Returns/sets the minimum value of a control.
+ procedure Min(Obj : SliderCtrl; Param1 : gb.LONG);
+
+ -- Orientation: Returns/sets the orientation of a Slider control, horizontal or vertical.
+ function Orientation(Obj : SliderCtrl) return gb.INT;
+
+ -- Orientation: Returns/sets the orientation of a Slider control, horizontal or vertical.
+ procedure Orientation(Obj : SliderCtrl; Param1 : gb.INT);
+
+ -- SelectRange: Returns/sets whether or not a Slider control can have a select range.
+ function SelectRange(Obj : SliderCtrl) return gb.BOOL;
+
+ -- SelectRange: Returns/sets whether or not a Slider control can have a select range.
+ procedure SelectRange(Obj : SliderCtrl; Param1 : gb.BOOL);
+
+ -- SelStart: Returns/sets the value where a selection starts.
+ function SelStart(Obj : SliderCtrl) return gb.LONG;
+
+ -- SelStart: Returns/sets the value where a selection starts.
+ procedure SelStart(Obj : SliderCtrl; Param1 : gb.LONG);
+
+ -- SelLength: Returns/sets the length of a selection.
+ function SelLength(Obj : SliderCtrl) return gb.LONG;
+
+ -- SelLength: Returns/sets the length of a selection.
+ procedure SelLength(Obj : SliderCtrl; Param1 : gb.LONG);
+
+ -- TickStyle: Returns/sets where ticks appear on a Slider control.
+ function TickStyle(Obj : SliderCtrl) return gb.INT;
+
+ -- TickStyle: Returns/sets where ticks appear on a Slider control.
+ procedure TickStyle(Obj : SliderCtrl; Param1 : gb.INT);
+
+ -- TickFrequency: Returns/sets the ratio of ticks on a Slider control; 1tick
+ -- every n increments.
+ function TickFrequency(Obj : SliderCtrl) return gb.LONG;
+
+ -- TickFrequency: Returns/sets the ratio of ticks on a Slider control; 1tick
+ -- every n increments.
+ procedure TickFrequency(Obj : SliderCtrl; Param1 : gb.LONG);
+
+ -- Value: Returns/sets the value of an object.
+ function Value(Obj : SliderCtrl) return gb.LONG;
+
+ -- Value: Returns/sets the value of an object.
+ procedure Value(Obj : SliderCtrl; Param1 : gb.LONG);
+
+ -- MouseIcon: Sets a custom mouse icon.
+ function MouseIcon(Obj : SliderCtrl) return gb.LPDISPATCH;
+
+ -- MouseIcon: Sets a custom mouse icon.
+ procedure MouseIcon(Obj : SliderCtrl; Param1 : gb.LPDISPATCH);
+
+ -- MousePointer: Returns/sets the type of mouse pointer displayed when over
+ -- part of an object.
+ function MousePointer(Obj : SliderCtrl) return gb.INT;
+
+ -- MousePointer: Returns/sets the type of mouse pointer displayed when over
+ -- part of an object.
+ procedure MousePointer(Obj : SliderCtrl; Param1 : gb.INT);
+
+ -- Enabled: Returns/sets a value that determines whether a form or control
+ -- can respond to user-generated events.
+ function Enabled(Obj : SliderCtrl) return gb.BOOL;
+
+ -- Enabled: Returns/sets a value that determines whether a form or control
+ -- can respond to user-generated events.
+ procedure Enabled(Obj : SliderCtrl; Param1 : gb.BOOL);
+
+ -- hWnd: Returns a handle to a form or control.
+ function hWnd(Obj : SliderCtrl) return gb.INT;
+
+ -- hWnd: Returns a handle to a form or control.
+ procedure hWnd(Obj : SliderCtrl; Param1 : gb.INT);
+
+ -- BorderStyle: Returns/sets the border style for an object.
+ function BorderStyle(Obj : SliderCtrl) return gb.INT;
+
+ -- BorderStyle: Returns/sets the border style for an object.
+ procedure BorderStyle(Obj : SliderCtrl; Param1 : gb.INT);
+
+ -- OLEDropMode: Returns/Sets whether this control can act as an OLE drop target.
+ function OLEDropMode(Obj : SliderCtrl) return gb.INT;
+
+ -- OLEDropMode: Returns/Sets whether this control can act as an OLE drop target.
+ procedure OLEDropMode(Obj : SliderCtrl; Param1 : gb.INT);
+
+ -- Refresh: Forces a complete repaint of a form or control.
+ procedure Refresh(Obj : SliderCtrl);
+
+ -- ClearSel: Sets the SelLength to 0.
+ procedure ClearSel(Obj : SliderCtrl);
+
+ -- DoClick: Hidden method that can be used to invoke the Click event
+ procedure DoClick(Obj : SliderCtrl);
+
+ -- GetNumTicks: Returns the number of visible ticks on a Slider control.
+ function GetNumTicks(Obj : SliderCtrl) return gb.LONG;
+
+ -- OLEDrag: Starts an OLE drag/drop event with the given control as the source.
+ procedure OLEDrag(Obj : SliderCtrl);
+
+ -- AboutBox
+ procedure AboutBox(Obj : SliderCtrl);
+
+ -- Text: Returns/sets the string displayed in the ToolTip as the slider's position changes.
+ function Text(Obj : SliderCtrl) return String;
+
+ -- Text: Returns/sets the string displayed in the ToolTip as the slider's position changes.
+ procedure Text(Obj : SliderCtrl; Param1 : String);
+
+ -- TextPosition: Returns/sets a value that determines where the tooltip displaying
+ -- the Slider's changing position is displayed.
+ function TextPosition(Obj : SliderCtrl) return gb.INT;
+
+ -- TextPosition: Returns/sets a value that determines where the tooltip displaying
+ -- the Slider's changing position is displayed.
+ procedure TextPosition(Obj : SliderCtrl; Param1 : gb.INT);
+
+end MSComctlLib_Slider;
+
+
+package body MSComctlLib_Slider is
+
+ pragma Suppress(Discriminant_Check);
+
+ use type gb.DISPID;
+ use type gb.VARTYPE;
+
+ -- ###### Methods ######
+ procedure QueryInterface(Obj : SliderCtrl; riid : gb.LPDISPATCH; ppvObj : gb.PVOID) is
+ myVariants : array (1..2) of gb.Variant;
+ begin
+ myVariants(2) := (gb.VT_DISPATCH, 0, 0, 0, (gb.VT_DISPATCH, riid));
+ myVariants(1) := (gb.VT_BYREF or gb.VT_VOID, 0, 0, 0, (gb.VT_BYREF or gb.VT_VOID, ppvObj));
+ gb.DoMethod(Obj, 1610612736, 1, 2, gb.Convert(myVariants'address));
+ end QueryInterface;
+
+ function AddRef(Obj : SliderCtrl) return gb.ULONG is
+ myResult : aliased gb.Variant;
+ begin
+ gb.DoMethod(Obj, 1610612737, 1, 0, null, myResult'unchecked_access);
+ return myResult.u.ulVal;
+ end AddRef;
+
+ function Release(Obj : SliderCtrl) return gb.ULONG is
+ myResult : aliased gb.Variant;
+ begin
+ gb.DoMethod(Obj, 1610612738, 1, 0, null, myResult'unchecked_access);
+ return myResult.u.ulVal;
+ end Release;
+
+ procedure GetTypeInfoCount(Obj : SliderCtrl; pctinfo : gb.PUINT) is
+ myVariants : array (1..1) of gb.Variant;
+ begin
+ myVariants(1) := (gb.VT_BYREF or gb.VT_UINT, 0, 0, 0, (gb.VT_BYREF or gb.VT_UINT, pctinfo));
+ gb.DoMethod(Obj, 1610678272, 1, 1, gb.Convert(myVariants'address));
+ end GetTypeInfoCount;
+
+ procedure GetTypeInfo(Obj : SliderCtrl; itinfo : gb.UINT; lcid : gb.ULONG;
+ pptinfo : gb.PVOID) is
+ myVariants : array (1..3) of gb.Variant;
+ begin
+ myVariants(3) := (gb.VT_UINT, 0, 0, 0, (gb.VT_UINT, itinfo));
+ myVariants(2) := (gb.VT_UI4, 0, 0, 0, (gb.VT_UI4, lcid));
+ myVariants(1) := (gb.VT_BYREF or gb.VT_VOID, 0, 0, 0, (gb.VT_BYREF or gb.VT_VOID, pptinfo));
+ gb.DoMethod(Obj, 1610678273, 1, 3, gb.Convert(myVariants'address));
+ end GetTypeInfo;
+
+ procedure GetIDsOfNames(Obj : SliderCtrl; riid : gb.LPDISPATCH; rgszNames : gb.PCHAR;
+ cNames : gb.UINT; lcid : gb.ULONG; rgdispid : gb.PLONG) is
+ myVariants : array (1..5) of gb.Variant;
+ begin
+ myVariants(5) := (gb.VT_DISPATCH, 0, 0, 0, (gb.VT_DISPATCH, riid));
+ myVariants(4) := (gb.VT_BYREF or gb.VT_I1, 0, 0, 0, (gb.VT_BYREF or gb.VT_I1, rgszNames));
+ myVariants(3) := (gb.VT_UINT, 0, 0, 0, (gb.VT_UINT, cNames));
+ myVariants(2) := (gb.VT_UI4, 0, 0, 0, (gb.VT_UI4, lcid));
+ myVariants(1) := (gb.VT_BYREF or gb.VT_I4, 0, 0, 0, (gb.VT_BYREF or gb.VT_I4, rgdispid));
+ gb.DoMethod(Obj, 1610678274, 1, 5, gb.Convert(myVariants'address));
+ end GetIDsOfNames;
+
+ procedure Invoke(Obj : SliderCtrl; dispidMember : gb.LONG; riid : gb.LPDISPATCH;
+ lcid : gb.ULONG; wFlags : gb.USHORT; pdispparams : gb.LPDISPATCH;
+ pvarResult : gb.LPVARIANT; pexcepinfo : gb.LPDISPATCH; puArgErr : gb.PUINT) is
+ myVariants : array (1..8) of gb.Variant;
+ begin
+ myVariants(8) := (gb.VT_I4, 0, 0, 0, (gb.VT_I4, dispidMember));
+ myVariants(7) := (gb.VT_DISPATCH, 0, 0, 0, (gb.VT_DISPATCH, riid));
+ myVariants(6) := (gb.VT_UI4, 0, 0, 0, (gb.VT_UI4, lcid));
+ myVariants(5) := (gb.VT_UI2, 0, 0, 0, (gb.VT_UI2, wFlags));
+ myVariants(4) := (gb.VT_DISPATCH, 0, 0, 0, (gb.VT_DISPATCH, pdispparams));
+ myVariants(3) := pvarResult.all;
+ myVariants(2) := (gb.VT_DISPATCH, 0, 0, 0, (gb.VT_DISPATCH, pexcepinfo));
+ myVariants(1) := (gb.VT_BYREF or gb.VT_UINT, 0, 0, 0, (gb.VT_BYREF or gb.VT_UINT, puArgErr));
+ gb.DoMethod(Obj, 1610678275, 1, 8, gb.Convert(myVariants'address));
+ end Invoke;
+
+ function LargeChange(Obj : SliderCtrl) return gb.LONG is
+ myResult : aliased gb.Variant;
+ begin
+ gb.DoMethod(Obj, 1, 2, 0, null, myResult'unchecked_access);
+ return myResult.u.lVal;
+ end LargeChange;
+
+ procedure LargeChange(Obj : SliderCtrl; Param1 : gb.LONG) is
+ myVariants : array (1..1) of gb.Variant;
+ begin
+ myVariants(1) := (gb.VT_I4, 0, 0, 0, (gb.VT_I4, Param1));
+ gb.DoMethod(Obj, 1, 4, 1, gb.Convert(myVariants'address));
+ end LargeChange;
+
+ function SmallChange(Obj : SliderCtrl) return gb.LONG is
+ myResult : aliased gb.Variant;
+ begin
+ gb.DoMethod(Obj, 2, 2, 0, null, myResult'unchecked_access);
+ return myResult.u.lVal;
+ end SmallChange;
+
+ procedure SmallChange(Obj : SliderCtrl; Param1 : gb.LONG) is
+ myVariants : array (1..1) of gb.Variant;
+ begin
+ myVariants(1) := (gb.VT_I4, 0, 0, 0, (gb.VT_I4, Param1));
+ gb.DoMethod(Obj, 2, 4, 1, gb.Convert(myVariants'address));
+ end SmallChange;
+
+ function Max(Obj : SliderCtrl) return gb.LONG is
+ myResult : aliased gb.Variant;
+ begin
+ gb.DoMethod(Obj, 3, 2, 0, null, myResult'unchecked_access);
+ return myResult.u.lVal;
+ end Max;
+
+ procedure Max(Obj : SliderCtrl; Param1 : gb.LONG) is
+ myVariants : array (1..1) of gb.Variant;
+ begin
+ myVariants(1) := (gb.VT_I4, 0, 0, 0, (gb.VT_I4, Param1));
+ gb.DoMethod(Obj, 3, 4, 1, gb.Convert(myVariants'address));
+ end Max;
+
+ function Min(Obj : SliderCtrl) return gb.LONG is
+ myResult : aliased gb.Variant;
+ begin
+ gb.DoMethod(Obj, 4, 2, 0, null, myResult'unchecked_access);
+ return myResult.u.lVal;
+ end Min;
+
+ procedure Min(Obj : SliderCtrl; Param1 : gb.LONG) is
+ myVariants : array (1..1) of gb.Variant;
+ begin
+ myVariants(1) := (gb.VT_I4, 0, 0, 0, (gb.VT_I4, Param1));
+ gb.DoMethod(Obj, 4, 4, 1, gb.Convert(myVariants'address));
+ end Min;
+
+ function Orientation(Obj : SliderCtrl) return gb.INT is
+ myResult : aliased gb.Variant;
+ begin
+ gb.DoMethod(Obj, 5, 2, 0, null, myResult'unchecked_access);
+ return myResult.u.intVal;
+ end Orientation;
+
+ procedure Orientation(Obj : SliderCtrl; Param1 : gb.INT) is
+ myVariants : array (1..1) of gb.Variant;
+ begin
+ myVariants(1) := (gb.VT_INT, 0, 0, 0, (gb.VT_INT, Param1));
+ gb.DoMethod(Obj, 5, 4, 1, gb.Convert(myVariants'address));
+ end Orientation;
+
+ function SelectRange(Obj : SliderCtrl) return gb.BOOL is
+ myResult : aliased gb.Variant;
+ begin
+ gb.DoMethod(Obj, 6, 2, 0, null, myResult'unchecked_access);
+ return gb.Convert(myResult.u.bool);
+ end SelectRange;
+
+ procedure SelectRange(Obj : SliderCtrl; Param1 : gb.BOOL) is
+ myVariants : array (1..1) of gb.Variant;
+ begin
+ myVariants(1) := (gb.VT_BOOL, 0, 0, 0, (gb.VT_BOOL, gb.Convert(Param1)));
+ gb.DoMethod(Obj, 6, 4, 1, gb.Convert(myVariants'address));
+ end SelectRange;
+
+ function SelStart(Obj : SliderCtrl) return gb.LONG is
+ myResult : aliased gb.Variant;
+ begin
+ gb.DoMethod(Obj, 7, 2, 0, null, myResult'unchecked_access);
+ return myResult.u.lVal;
+ end SelStart;
+
+ procedure SelStart(Obj : SliderCtrl; Param1 : gb.LONG) is
+ myVariants : array (1..1) of gb.Variant;
+ begin
+ myVariants(1) := (gb.VT_I4, 0, 0, 0, (gb.VT_I4, Param1));
+ gb.DoMethod(Obj, 7, 4, 1, gb.Convert(myVariants'address));
+ end SelStart;
+
+ function SelLength(Obj : SliderCtrl) return gb.LONG is
+ myResult : aliased gb.Variant;
+ begin
+ gb.DoMethod(Obj, 8, 2, 0, null, myResult'unchecked_access);
+ return myResult.u.lVal;
+ end SelLength;
+
+ procedure SelLength(Obj : SliderCtrl; Param1 : gb.LONG) is
+ myVariants : array (1..1) of gb.Variant;
+ begin
+ myVariants(1) := (gb.VT_I4, 0, 0, 0, (gb.VT_I4, Param1));
+ gb.DoMethod(Obj, 8, 4, 1, gb.Convert(myVariants'address));
+ end SelLength;
+
+ function TickStyle(Obj : SliderCtrl) return gb.INT is
+ myResult : aliased gb.Variant;
+ begin
+ gb.DoMethod(Obj, 9, 2, 0, null, myResult'unchecked_access);
+ return myResult.u.intVal;
+ end TickStyle;
+
+ procedure TickStyle(Obj : SliderCtrl; Param1 : gb.INT) is
+ myVariants : array (1..1) of gb.Variant;
+ begin
+ myVariants(1) := (gb.VT_INT, 0, 0, 0, (gb.VT_INT, Param1));
+ gb.DoMethod(Obj, 9, 4, 1, gb.Convert(myVariants'address));
+ end TickStyle;
+
+ function TickFrequency(Obj : SliderCtrl) return gb.LONG is
+ myResult : aliased gb.Variant;
+ begin
+ gb.DoMethod(Obj, 10, 2, 0, null, myResult'unchecked_access);
+ return myResult.u.lVal;
+ end TickFrequency;
+
+ procedure TickFrequency(Obj : SliderCtrl; Param1 : gb.LONG) is
+ myVariants : array (1..1) of gb.Variant;
+ begin
+ myVariants(1) := (gb.VT_I4, 0, 0, 0, (gb.VT_I4, Param1));
+ gb.DoMethod(Obj, 10, 4, 1, gb.Convert(myVariants'address));
+ end TickFrequency;
+
+ function Value(Obj : SliderCtrl) return gb.LONG is
+ myResult : aliased gb.Variant;
+ begin
+ gb.DoMethod(Obj, 11, 2, 0, null, myResult'unchecked_access);
+ return myResult.u.lVal;
+ end Value;
+
+ procedure Value(Obj : SliderCtrl; Param1 : gb.LONG) is
+ myVariants : array (1..1) of gb.Variant;
+ begin
+ myVariants(1) := (gb.VT_I4, 0, 0, 0, (gb.VT_I4, Param1));
+ gb.DoMethod(Obj, 11, 4, 1, gb.Convert(myVariants'address));
+ end Value;
+
+ function MouseIcon(Obj : SliderCtrl) return gb.LPDISPATCH is
+ myResult : aliased gb.Variant;
+ begin
+ gb.DoMethod(Obj, 12, 2, 0, null, myResult'unchecked_access);
+ return myResult.u.pdispVal;
+ end MouseIcon;
+
+ procedure MouseIcon(Obj : SliderCtrl; Param1 : gb.LPDISPATCH) is
+ myVariants : array (1..1) of gb.Variant;
+ begin
+ myVariants(1) := (gb.VT_DISPATCH, 0, 0, 0, (gb.VT_DISPATCH, Param1));
+ gb.DoMethod(Obj, 12, 4, 1, gb.Convert(myVariants'address));
+ end MouseIcon;
+
+ function MousePointer(Obj : SliderCtrl) return gb.INT is
+ myResult : aliased gb.Variant;
+ begin
+ gb.DoMethod(Obj, 13, 2, 0, null, myResult'unchecked_access);
+ return myResult.u.intVal;
+ end MousePointer;
+
+ procedure MousePointer(Obj : SliderCtrl; Param1 : gb.INT) is
+ myVariants : array (1..1) of gb.Variant;
+ begin
+ myVariants(1) := (gb.VT_INT, 0, 0, 0, (gb.VT_INT, Param1));
+ gb.DoMethod(Obj, 13, 4, 1, gb.Convert(myVariants'address));
+ end MousePointer;
+
+ function Enabled(Obj : SliderCtrl) return gb.BOOL is
+ myResult : aliased gb.Variant;
+ begin
+ gb.DoMethod(Obj, -514, 2, 0, null, myResult'unchecked_access);
+ return gb.Convert(myResult.u.bool);
+ end Enabled;
+
+ procedure Enabled(Obj : SliderCtrl; Param1 : gb.BOOL) is
+ myVariants : array (1..1) of gb.Variant;
+ begin
+ myVariants(1) := (gb.VT_BOOL, 0, 0, 0, (gb.VT_BOOL, gb.Convert(Param1)));
+ gb.DoMethod(Obj, -514, 4, 1, gb.Convert(myVariants'address));
+ end Enabled;
+
+ function hWnd(Obj : SliderCtrl) return gb.INT is
+ myResult : aliased gb.Variant;
+ begin
+ gb.DoMethod(Obj, -515, 2, 0, null, myResult'unchecked_access);
+ return myResult.u.intVal;
+ end hWnd;
+
+ procedure hWnd(Obj : SliderCtrl; Param1 : gb.INT) is
+ myVariants : array (1..1) of gb.Variant;
+ begin
+ myVariants(1) := (gb.VT_INT, 0, 0, 0, (gb.VT_INT, Param1));
+ gb.DoMethod(Obj, -515, 4, 1, gb.Convert(myVariants'address));
+ end hWnd;
+
+ function BorderStyle(Obj : SliderCtrl) return gb.INT is
+ myResult : aliased gb.Variant;
+ begin
+ gb.DoMethod(Obj, -504, 2, 0, null, myResult'unchecked_access);
+ return myResult.u.intVal;
+ end BorderStyle;
+
+ procedure BorderStyle(Obj : SliderCtrl; Param1 : gb.INT) is
+ myVariants : array (1..1) of gb.Variant;
+ begin
+ myVariants(1) := (gb.VT_INT, 0, 0, 0, (gb.VT_INT, Param1));
+ gb.DoMethod(Obj, -504, 4, 1, gb.Convert(myVariants'address));
+ end BorderStyle;
+
+ function OLEDropMode(Obj : SliderCtrl) return gb.INT is
+ myResult : aliased gb.Variant;
+ begin
+ gb.DoMethod(Obj, 1551, 2, 0, null, myResult'unchecked_access);
+ return myResult.u.intVal;
+ end OLEDropMode;
+
+ procedure OLEDropMode(Obj : SliderCtrl; Param1 : gb.INT) is
+ myVariants : array (1..1) of gb.Variant;
+ begin
+ myVariants(1) := (gb.VT_INT, 0, 0, 0, (gb.VT_INT, Param1));
+ gb.DoMethod(Obj, 1551, 4, 1, gb.Convert(myVariants'address));
+ end OLEDropMode;
+
+ procedure Refresh(Obj : SliderCtrl) is
+ begin
+ gb.DoMethod(Obj, -550, 1);
+ end Refresh;
+
+ procedure ClearSel(Obj : SliderCtrl) is
+ begin
+ gb.DoMethod(Obj, 14, 1);
+ end ClearSel;
+
+ procedure DoClick(Obj : SliderCtrl) is
+ begin
+ gb.DoMethod(Obj, -551, 1);
+ end DoClick;
+
+ function GetNumTicks(Obj : SliderCtrl) return gb.LONG is
+ myResult : aliased gb.Variant;
+ begin
+ gb.DoMethod(Obj, 15, 2, 0, null, myResult'unchecked_access);
+ return myResult.u.lVal;
+ end GetNumTicks;
+
+ procedure OLEDrag(Obj : SliderCtrl) is
+ begin
+ gb.DoMethod(Obj, 1552, 1);
+ end OLEDrag;
+
+ procedure AboutBox(Obj : SliderCtrl) is
+ begin
+ gb.DoMethod(Obj, -552, 1);
+ end AboutBox;
+
+ function Text(Obj : SliderCtrl) return String is
+ myResult : aliased gb.Variant;
+ begin
+ gb.DoMethod(Obj, 16, 2, 0, null, myResult'unchecked_access);
+ return gb.To_ASCII(myResult.u.bstrVal);
+ end Text;
+
+ procedure Text(Obj : SliderCtrl; Param1 : String) is
+ myBSTR1 : aliased gb.BSTR := gb.AllocBSTR(Param1);
+ myVariants : array (1..1) of gb.Variant;
+ begin
+ myVariants(1) := (gb.VT_BSTR, 0, 0, 0, (gb.VT_BSTR, myBSTR1));
+ gb.DoMethod(Obj, 16, 4, 1, gb.Convert(myVariants'address));
+ gb.FreeBSTR(myBSTR1);
+ end Text;
+
+ function TextPosition(Obj : SliderCtrl) return gb.INT is
+ myResult : aliased gb.Variant;
+ begin
+ gb.DoMethod(Obj, 17, 2, 0, null, myResult'unchecked_access);
+ return myResult.u.intVal;
+ end TextPosition;
+
+ procedure TextPosition(Obj : SliderCtrl; Param1 : gb.INT) is
+ myVariants : array (1..1) of gb.Variant;
+ begin
+ myVariants(1) := (gb.VT_INT, 0, 0, 0, (gb.VT_INT, Param1));
+ gb.DoMethod(Obj, 17, 4, 1, gb.Convert(myVariants'address));
+ end TextPosition;
+
+ -- ###### Event Dispatch ######
+ procedure DispatchEvent_Proc(Obj : gb.OleControlRef; dispidMember : gb.DISPID;
+ pdispparams : access gb.DISPPARAMS) is
+ hr : gb.HRESULT;
+ u : aliased gb.UINT;
+ myVariant1 : aliased gb.VARIANT;
+ myVariant2 : aliased gb.VARIANT;
+ myVariant3 : aliased gb.VARIANT;
+ myVariant4 : aliased gb.VARIANT;
+ myVariant5 : aliased gb.VARIANT;
+ myVariant6 : aliased gb.VARIANT;
+ myVariant7 : aliased gb.VARIANT;
+ begin
+ if dispidMember = -600 then
+ SliderCtrl(Obj.all).Click.all;
+ elsif dispidMember = -602 then
+ hr := gb.DispGetParam(pdispparams, 0, gb.VT_BYREF or gb.VT_I2, myVariant1'access, u'access);
+ hr := gb.DispGetParam(pdispparams, 1, gb.VT_I2, myVariant2'access, u'access);
+ SliderCtrl(Obj.all).KeyDown(myVariant1.u.iVal'unchecked_access, myVariant2.u.iVal);
+ hr := gb.VariantClear(myVariant1'access);
+ hr := gb.VariantClear(myVariant2'access);
+ elsif dispidMember = -603 then
+ hr := gb.DispGetParam(pdispparams, 0, gb.VT_BYREF or gb.VT_I2, myVariant1'access, u'access);
+ SliderCtrl(Obj.all).KeyPress(myVariant1.u.iVal'unchecked_access);
+ hr := gb.VariantClear(myVariant1'access);
+ elsif dispidMember = -604 then
+ hr := gb.DispGetParam(pdispparams, 0, gb.VT_BYREF or gb.VT_I2, myVariant1'access, u'access);
+ hr := gb.DispGetParam(pdispparams, 1, gb.VT_I2, myVariant2'access, u'access);
+ SliderCtrl(Obj.all).KeyUp(myVariant1.u.iVal'unchecked_access, myVariant2.u.iVal);
+ hr := gb.VariantClear(myVariant1'access);
+ hr := gb.VariantClear(myVariant2'access);
+ elsif dispidMember = -605 then
+ hr := gb.DispGetParam(pdispparams, 0, gb.VT_I2, myVariant1'access, u'access);
+ hr := gb.DispGetParam(pdispparams, 1, gb.VT_I2, myVariant2'access, u'access);
+ hr := gb.DispGetParam(pdispparams, 2, gb.VT_I4, myVariant3'access, u'access);
+ hr := gb.DispGetParam(pdispparams, 3, gb.VT_I4, myVariant4'access, u'access);
+ SliderCtrl(Obj.all).MouseDown(myVariant1.u.iVal, myVariant2.u.iVal,
+ myVariant3.u.lVal, myVariant4.u.lVal);
+ hr := gb.VariantClear(myVariant1'access);
+ hr := gb.VariantClear(myVariant2'access);
+ hr := gb.VariantClear(myVariant3'access);
+ hr := gb.VariantClear(myVariant4'access);
+ elsif dispidMember = -606 then
+ hr := gb.DispGetParam(pdispparams, 0, gb.VT_I2, myVariant1'access, u'access);
+ hr := gb.DispGetParam(pdispparams, 1, gb.VT_I2, myVariant2'access, u'access);
+ hr := gb.DispGetParam(pdispparams, 2, gb.VT_I4, myVariant3'access, u'access);
+ hr := gb.DispGetParam(pdispparams, 3, gb.VT_I4, myVariant4'access, u'access);
+ SliderCtrl(Obj.all).MouseMove(myVariant1.u.iVal, myVariant2.u.iVal,
+ myVariant3.u.lVal, myVariant4.u.lVal);
+ hr := gb.VariantClear(myVariant1'access);
+ hr := gb.VariantClear(myVariant2'access);
+ hr := gb.VariantClear(myVariant3'access);
+ hr := gb.VariantClear(myVariant4'access);
+ elsif dispidMember = -607 then
+ hr := gb.DispGetParam(pdispparams, 0, gb.VT_I2, myVariant1'access, u'access);
+ hr := gb.DispGetParam(pdispparams, 1, gb.VT_I2, myVariant2'access, u'access);
+ hr := gb.DispGetParam(pdispparams, 2, gb.VT_I4, myVariant3'access, u'access);
+ hr := gb.DispGetParam(pdispparams, 3, gb.VT_I4, myVariant4'access, u'access);
+ SliderCtrl(Obj.all).MouseUp(myVariant1.u.iVal, myVariant2.u.iVal,
+ myVariant3.u.lVal, myVariant4.u.lVal);
+ hr := gb.VariantClear(myVariant1'access);
+ hr := gb.VariantClear(myVariant2'access);
+ hr := gb.VariantClear(myVariant3'access);
+ hr := gb.VariantClear(myVariant4'access);
+ elsif dispidMember = 1 then
+ SliderCtrl(Obj.all).Scroll.all;
+ elsif dispidMember = 2 then
+ SliderCtrl(Obj.all).Change.all;
+ elsif dispidMember = 1550 then
+ hr := gb.DispGetParam(pdispparams, 0, gb.VT_DISPATCH, myVariant1'access, u'access);
+ hr := gb.DispGetParam(pdispparams, 1, gb.VT_BYREF or gb.VT_I4, myVariant2'access, u'access);
+ SliderCtrl(Obj.all).OLEStartDrag(myVariant1.u.pdispVal, myVariant2.u.lVal'unchecked_access);
+ hr := gb.VariantClear(myVariant1'access);
+ hr := gb.VariantClear(myVariant2'access);
+ elsif dispidMember = 1551 then
+ hr := gb.DispGetParam(pdispparams, 0, gb.VT_BYREF or gb.VT_I4, myVariant1'access, u'access);
+ hr := gb.DispGetParam(pdispparams, 1, gb.VT_BYREF or gb.VT_BOOL, myVariant2'access, u'access);
+ SliderCtrl(Obj.all).OLEGiveFeedback(myVariant1.u.lVal'unchecked_access, myVariant2.u.bool'unchecked_access);
+ hr := gb.VariantClear(myVariant1'access);
+ hr := gb.VariantClear(myVariant2'access);
+ elsif dispidMember = 1552 then
+ hr := gb.DispGetParam(pdispparams, 0, gb.VT_DISPATCH, myVariant1'access, u'access);
+ hr := gb.DispGetParam(pdispparams, 1, gb.VT_BYREF or gb.VT_I2, myVariant2'access, u'access);
+ SliderCtrl(Obj.all).OLESetData(myVariant1.u.pdispVal, myVariant2.u.iVal'unchecked_access);
+ hr := gb.VariantClear(myVariant1'access);
+ hr := gb.VariantClear(myVariant2'access);
+ elsif dispidMember = 1553 then
+ hr := gb.DispGetParam(pdispparams, 0, gb.VT_BYREF or gb.VT_I4, myVariant1'access, u'access);
+ SliderCtrl(Obj.all).OLECompleteDrag(myVariant1.u.lVal'unchecked_access);
+ hr := gb.VariantClear(myVariant1'access);
+ elsif dispidMember = 1554 then
+ hr := gb.DispGetParam(pdispparams, 0, gb.VT_DISPATCH, myVariant1'access, u'access);
+ hr := gb.DispGetParam(pdispparams, 1, gb.VT_BYREF or gb.VT_I4, myVariant2'access, u'access);
+ hr := gb.DispGetParam(pdispparams, 2, gb.VT_BYREF or gb.VT_I2, myVariant3'access, u'access);
+ hr := gb.DispGetParam(pdispparams, 3, gb.VT_BYREF or gb.VT_I2, myVariant4'access, u'access);
+ hr := gb.DispGetParam(pdispparams, 4, gb.VT_BYREF or gb.VT_R4, myVariant5'access, u'access);
+ hr := gb.DispGetParam(pdispparams, 5, gb.VT_BYREF or gb.VT_R4, myVariant6'access, u'access);
+ hr := gb.DispGetParam(pdispparams, 6, gb.VT_BYREF or gb.VT_I2, myVariant7'access, u'access);
+ SliderCtrl(Obj.all).OLEDragOver(myVariant1.u.pdispVal, myVariant2.u.lVal'unchecked_access,
+ myVariant3.u.iVal'unchecked_access, myVariant4.u.iVal'unchecked_access, myVariant5.u.fltVal'unchecked_access,
+ myVariant6.u.fltVal'unchecked_access, myVariant7.u.iVal'unchecked_access);
+ hr := gb.VariantClear(myVariant1'access);
+ hr := gb.VariantClear(myVariant2'access);
+ hr := gb.VariantClear(myVariant3'access);
+ hr := gb.VariantClear(myVariant4'access);
+ hr := gb.VariantClear(myVariant5'access);
+ hr := gb.VariantClear(myVariant6'access);
+ hr := gb.VariantClear(myVariant7'access);
+ elsif dispidMember = 1555 then
+ hr := gb.DispGetParam(pdispparams, 0, gb.VT_DISPATCH, myVariant1'access, u'access);
+ hr := gb.DispGetParam(pdispparams, 1, gb.VT_BYREF or gb.VT_I4, myVariant2'access, u'access);
+ hr := gb.DispGetParam(pdispparams, 2, gb.VT_BYREF or gb.VT_I2, myVariant3'access, u'access);
+ hr := gb.DispGetParam(pdispparams, 3, gb.VT_BYREF or gb.VT_I2, myVariant4'access, u'access);
+ hr := gb.DispGetParam(pdispparams, 4, gb.VT_BYREF or gb.VT_R4, myVariant5'access, u'access);
+ hr := gb.DispGetParam(pdispparams, 5, gb.VT_BYREF or gb.VT_R4, myVariant6'access, u'access);
+ SliderCtrl(Obj.all).OLEDragDrop(myVariant1.u.pdispVal, myVariant2.u.lVal'unchecked_access,
+ myVariant3.u.iVal'unchecked_access, myVariant4.u.iVal'unchecked_access, myVariant5.u.fltVal'unchecked_access,
+ myVariant6.u.fltVal'unchecked_access);
+ hr := gb.VariantClear(myVariant1'access);
+ hr := gb.VariantClear(myVariant2'access);
+ hr := gb.VariantClear(myVariant3'access);
+ hr := gb.VariantClear(myVariant4'access);
+ hr := gb.VariantClear(myVariant5'access);
+ hr := gb.VariantClear(myVariant6'access);
+ end if;
+ end DispatchEvent_Proc;
+
+ procedure Initialize(Obj : in out SliderCtrl) is
+ begin
+ Obj.i_DispatchEvent := DispatchEvent_Proc'access;
+ Obj.i_ProgID(1..21) := gb.To_OleChar("MSComctlLib.Slider.2");
+ Obj.i_EventDispatchIID(1..39) := gb.To_OleChar("{F08DF953-8592-11D1-B16A-00C0F0283628}");
+ end Initialize;
+
+ -- ###### Events ######
+ procedure Click_Proc is
+ begin
+ null;
+ end Click_Proc;
+
+ procedure KeyDown_Proc(KeyCode : gb.PSHORT; Shift : gb.SHORT) is
+ begin
+ null;
+ end KeyDown_Proc;
+
+ procedure KeyPress_Proc(KeyAscii : gb.PSHORT) is
+ begin
+ null;
+ end KeyPress_Proc;
+
+ procedure KeyUp_Proc(KeyCode : gb.PSHORT; Shift : gb.SHORT) is
+ begin
+ null;
+ end KeyUp_Proc;
+
+ procedure MouseDown_Proc(Button : gb.SHORT; Shift : gb.SHORT;
+ x : gb.LONG; y : gb.LONG) is
+ begin
+ null;
+ end MouseDown_Proc;
+
+ procedure MouseMove_Proc(Button : gb.SHORT; Shift : gb.SHORT;
+ x : gb.LONG; y : gb.LONG) is
+ begin
+ null;
+ end MouseMove_Proc;
+
+ procedure MouseUp_Proc(Button : gb.SHORT; Shift : gb.SHORT;
+ x : gb.LONG; y : gb.LONG) is
+ begin
+ null;
+ end MouseUp_Proc;
+
+ procedure Scroll_Proc is
+ begin
+ null;
+ end Scroll_Proc;
+
+ procedure Change_Proc is
+ begin
+ null;
+ end Change_Proc;
+
+ procedure OLEStartDrag_Proc(Data : gb.LPDISPATCH; AllowedEffects : gb.PLONG) is
+ begin
+ null;
+ end OLEStartDrag_Proc;
+
+ procedure OLEGiveFeedback_Proc(Effect : gb.PLONG; DefaultCursors : gb.PVARIANT_BOOL) is
+ begin
+ null;
+ end OLEGiveFeedback_Proc;
+
+ procedure OLESetData_Proc(Data : gb.LPDISPATCH; DataFormat : gb.PSHORT) is
+ begin
+ null;
+ end OLESetData_Proc;
+
+ procedure OLECompleteDrag_Proc(Effect : gb.PLONG) is
+ begin
+ null;
+ end OLECompleteDrag_Proc;
+
+ procedure OLEDragOver_Proc(Data : gb.LPDISPATCH; Effect : gb.PLONG;
+ Button : gb.PSHORT; Shift : gb.PSHORT; x : gb.PFLOAT;
+ y : gb.PFLOAT; State : gb.PSHORT) is
+ begin
+ null;
+ end OLEDragOver_Proc;
+
+ procedure OLEDragDrop_Proc(Data : gb.LPDISPATCH; Effect : gb.PLONG;
+ Button : gb.PSHORT; Shift : gb.PSHORT; x : gb.PFLOAT;
+ y : gb.PFLOAT) is
+ begin
+ null;
+ end OLEDragDrop_Proc;
+
+end MSComctlLib_Slider;
+
+