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;