PoFGui/MSComctlLib_Slider.ada

   1
   2 with gb;
   3
   4 package MSComctlLib_Slider is
   5
   6
   7   -- ######  BorderStyleConstants{76B523C0-8579-11D1-B16A-00C0F0283628}  ######
   8   -- None
   9   ccNone : constant := 0;
  10   -- Fixed Single
  11   ccFixedSingle : constant := 1;
  12
  13   -- ######  MousePointerConstants{76B523C1-8579-11D1-B16A-00C0F0283628}  ######
  14   -- Default
  15   ccDefault : constant := 0;
  16   -- Arrow mouse pointer
  17   ccArrow : constant := 1;
  18   -- Cross mouse pointer
  19   ccCross : constant := 2;
  20   -- I-Beam mouse pointer
  21   ccIBeam : constant := 3;
  22   -- Icon mouse pointer
  23   ccIcon : constant := 4;
  24   -- Size mouse pointer
  25   ccSize : constant := 5;
  26   -- Size NE SW mouse pointer
  27   ccSizeNESW : constant := 6;
  28   -- Size N S mouse pointer
  29   ccSizeNS : constant := 7;
  30   -- Size NW SE mouse pointer
  31   ccSizeNWSE : constant := 8;
  32   -- Size W E mouse pointer
  33   ccSizeEW : constant := 9;
  34   -- Up arrow mouse pointer
  35   ccUpArrow : constant := 10;
  36   -- Hourglass mouse pointer
  37   ccHourglass : constant := 11;
  38   -- No drop mouse pointer
  39   ccNoDrop : constant := 12;
  40   -- Arrow and Hourglass mouse pointer
  41   ccArrowHourglass : constant := 13;
  42   -- Arrow and Question mark mouse pointer
  43   ccArrowQuestion : constant := 14;
  44   -- Size all mouse pointer
  45   ccSizeAll : constant := 15;
  46   -- Custom mouse pointer icon specified by the MouseIcon property
  47   ccCustom : constant := 99;
  48
  49   -- ######  AppearanceConstants{76B523C2-8579-11D1-B16A-00C0F0283628}  ######
  50   -- Flat
  51   ccFlat : constant := 0;
  52   -- 3D
  53   cc3D : constant := 1;
  54
  55   -- ######  VB4AppearanceConstants{00000000-0000-0000-0000-000000000000}  ######
  56   -- Flat
  57   vbFlat : constant := 0;
  58   -- 3D
  59   vb3D : constant := 1;
  60
  61   -- ######  ScrollingConstants{76B523C3-8579-11D1-B16A-00C0F0283628}  ######
  62   -- Standard Scrolling
  63   ccScrollingStandard : constant := 0;
  64   -- Smooth Scrolling
  65   ccScrollingSmooth : constant := 1;
  66
  67   -- ######  OrientationConstants{76B523C4-8579-11D1-B16A-00C0F0283628}  ######
  68   -- Horizontal
  69   ccOrientationHorizontal : constant := 0;
  70   -- Vertical
  71   ccOrientationVertical : constant := 1;
  72
  73   -- ######  OLEDragConstants{D8898460-742F-11CF-8AEA-00AA00C00905}  ######
  74   -- OLE drag/drop will be initialized only under programmatic control.
  75   ccOLEDragManual : constant := 0;
  76   -- OLE drag/drop will be initialized when the user drags 'out' of the control,
  77   -- or under programmatic control.
  78   ccOLEDragAutomatic : constant := 1;
  79
  80   -- ######  OLEDropConstants{D8898461-742F-11CF-8AEA-00AA00C00905}  ######
  81   -- Accepts no OLE drag/drop operations.
  82   ccOLEDropNone : constant := 0;
  83   -- Accepts an OLE drag/drop under programmatic control only.
  84   ccOLEDropManual : constant := 1;
  85
  86   -- ######  DragOverConstants{D8898464-742F-11CF-8AEA-00AA00C00905}  ######
  87   -- Source control dragged into target.
  88   ccEnter : constant := 0;
  89   -- Source control dragged out of target.
  90   ccLeave : constant := 1;
  91   -- Source control dragged from one position in target to another.
  92   ccOver : constant := 2;
  93
  94   -- ######  ClipBoardConstants{D8898462-742F-11CF-8AEA-00AA00C00905}  ######
  95   -- Text (.txt file).
  96   ccCFText : constant := 1;
  97   -- Bitmap (.bmp file).
  98   ccCFBitmap : constant := 2;
  99   -- Metafile (.wmf file).
 100   ccCFMetafile : constant := 3;
 101   -- Device-independent bitmap.
 102   ccCFDIB : constant := 8;
 103   -- Color palette.
 104   ccCFPalette : constant := 9;
 105   -- Enhanced metafile (.emf file).
 106   ccCFEMetafile : constant := 14;
 107   -- Filename list (Microsoft Windows Explorer)
 108   ccCFFiles : constant := 15;
 109   -- Rich Text Format (.rtf file).
 110   ccCFRTF : constant := -16639;
 111
 112   -- ######  OLEDropEffectConstants{D8898463-742F-11CF-8AEA-00AA00C00905}  ######
 113   -- No OLE drag/drop operation has taken place/would take place.
 114   ccOLEDropEffectNone : constant := 0;
 115   -- A mask to indicate that a copy has taken place/would take place.
 116   ccOLEDropEffectCopy : constant := 1;
 117   -- A mask to indicate that a move has taken place/would take place.
 118   ccOLEDropEffectMove : constant := 2;
 119   -- A mask to indicate that the drop target window has scrolled/would scroll.
 120   ccOLEDropEffectScroll : constant := -2147483648;
 121
 122   -- ######  ErrorConstants{76B523C5-8579-11D1-B16A-00C0F0283628}  ######
 123   -- Invalid procedure call
 124   ccInvalidProcedureCall : constant := 5;
 125   -- Out of memory
 126   ccOutOfMemory : constant := 7;
 127   -- Type mismatch
 128   ccTypeMismatch : constant := 13;
 129   -- Object variable or With block variable not set
 130   ccObjectVariableNotSet : constant := 91;
 131   -- Invalid property value
 132   ccInvalidPropertyValue : constant := 380;
 133   -- Property cannot be set at runtime
 134   ccSetNotSupportedAtRuntime : constant := 382;
 135   -- Property is read-only
 136   ccSetNotSupported : constant := 383;
 137   -- Property can't be set on this control
 138   ccSetNotPermitted : constant := 387;
 139   -- Property is write-only
 140   ccGetNotSupported : constant := 394;
 141   -- Invalid picture
 142   ccInvalidPicture : constant := 481;
 143   -- Invalid object use
 144   ccInvalidObjectUse : constant := 425;
 145   -- Specified format doesn't match format of data
 146   ccWrongClipboardFormat : constant := 461;
 147   -- DataObject formats list may not be cleared or expanded outside of the OLEStartDrag event
 148   ccDataObjectLocked : constant := 672;
 149   -- Expected at least one argument.
 150   ccExpectedAnArgument : constant := 673;
 151   -- Illegal recursive invocation of OLE drag and drop
 152   ccRecursiveOleDrag : constant := 674;
 153   -- Non-intrinsic OLE drag and drop formats used with SetData require Byte
 154   -- array data.  GetData may return more bytes than were given to SetData.
 155   ccFormatNotByteArray : constant := 675;
 156   -- Requested data was not supplied to the DataObject during the OLESetData event.
 157   ccDataNotSetForFormat : constant := 676;
 158   -- Index out of bounds
 159   ccIndexOutOfBounds : constant := 35600;
 160   -- Element not found
 161   ccElemNotFound : constant := 35601;
 162   -- Key is not unique in collection
 163   ccNonUniqueKey : constant := 35602;
 164   -- Invalid key
 165   ccInvalidKey : constant := 35603;
 166   -- This item's control has been deleted
 167   ccElemNotPartOfCollection : constant := 35605;
 168   -- Control's collection has been modified
 169   ccCollectionChangedDuringEnum : constant := 35606;
 170   -- This would introduce a cycle
 171   ccWouldIntroduceCycle : constant := 35614;
 172   -- Required argument is missing
 173   ccMissingRequiredArg : constant := 35607;
 174   -- Invalid object
 175   ccBadObjectReference : constant := 35610;
 176   -- Circular object referencing is not allowed
 177   ccCircularReference : constant := 35700;
 178   -- The first column in a ListView control must be left aligned
 179   ccCol1MustBeLeftAligned : constant := 35604;
 180   -- Property is read-only if image list contains images
 181   ccReadOnlyIfHasImages : constant := 35611;
 182   -- ImageList must be initialized before it can be used
 183   ccImageListMustBeInitialized : constant := 35613;
 184   -- All images in list must be same size
 185   ccNotSameSize : constant := 35615;
 186   -- ImageList cannot be modified while another control is bound to it
 187   ccImageListLocked : constant := 35617;
 188   -- Maximum Panels Exceeded
 189   ccMaxPanelsExceeded : constant := 35616;
 190   -- Maximum Buttons Exceeded
 191   ccMaxButtonsExceeded : constant := 35619;
 192   -- Invalid procedure call in safe mode
 193   ccInvalidSafeModeProcCall : constant := 680;
 194
 195   -- ######  TabWidthStyleConstants{1EFB6590-857C-11D1-B16A-00C0F0283628}  ######
 196   -- Justified
 197   tabJustified : constant := 0;
 198   -- Non-Justified
 199   tabNonJustified : constant := 1;
 200   -- Fixed
 201   tabFixed : constant := 2;
 202
 203   -- ######  TabStyleConstants{1EFB6591-857C-11D1-B16A-00C0F0283628}  ######
 204   -- Tabs
 205   tabTabs : constant := 0;
 206   -- Buttons
 207   tabButtons : constant := 1;
 208   -- Flat Buttons
 209   tabFlatButtons : constant := 2;
 210
 211   -- ######  PlacementConstants{1EFB6592-857C-11D1-B16A-00C0F0283628}  ######
 212   -- Top
 213   tabPlacementTop : constant := 0;
 214   -- Bottom
 215   tabPlacementBottom : constant := 1;
 216   -- Left
 217   tabPlacementLeft : constant := 2;
 218   -- Right
 219   tabPlacementRight : constant := 3;
 220
 221   -- ######  TabSelStyleConstants{1EFB6593-857C-11D1-B16A-00C0F0283628}  ######
 222   -- Standard
 223   tabTabStandard : constant := 0;
 224   -- Opposite
 225   tabTabOpposite : constant := 1;
 226
 227   -- ######  ButtonStyleConstants{66833FE0-8583-11D1-B16A-00C0F0283628}  ######
 228   -- Default
 229   tbrDefault : constant := 0;
 230   -- Check
 231   tbrCheck : constant := 1;
 232   -- ButtonGroup
 233   tbrButtonGroup : constant := 2;
 234   -- Separator
 235   tbrSeparator : constant := 3;
 236   -- Placeholder
 237   tbrPlaceholder : constant := 4;
 238   -- Dropdown
 239   tbrDropdown : constant := 5;
 240
 241   -- ######  ValueConstants{66833FE1-8583-11D1-B16A-00C0F0283628}  ######
 242   -- Unpressed
 243   tbrUnpressed : constant := 0;
 244   -- Pressed
 245   tbrPressed : constant := 1;
 246
 247   -- ######  ToolbarStyleConstants{66833FE2-8583-11D1-B16A-00C0F0283628}  ######
 248   -- Standard
 249   tbrStandard : constant := 0;
 250   -- Transparent
 251   tbrFlat : constant := 1;
 252
 253   -- ######  ToolbarTextAlignConstants{66833FE3-8583-11D1-B16A-00C0F0283628}  ######
 254   -- Bottom
 255   tbrTextAlignBottom : constant := 0;
 256   -- Right
 257   tbrTextAlignRight : constant := 1;
 258
 259   -- ######  SbarStyleConstants{8E3867A0-8586-11D1-B16A-00C0F0283628}  ######
 260   -- Multiple panels
 261   sbrNormal : constant := 0;
 262   -- Single panel simple text
 263   sbrSimple : constant := 1;
 264
 265   -- ######  PanelAlignmentConstants{8E3867A6-8586-11D1-B16A-00C0F0283628}  ######
 266   -- Left
 267   sbrLeft : constant := 0;
 268   -- Center
 269   sbrCenter : constant := 1;
 270   -- Right
 271   sbrRight : constant := 2;
 272
 273   -- ######  PanelAutoSizeConstants{8E3867A7-8586-11D1-B16A-00C0F0283628}  ######
 274   -- None
 275   sbrNoAutoSize : constant := 0;
 276   -- Spring
 277   sbrSpring : constant := 1;
 278   -- Contents
 279   sbrContents : constant := 2;
 280
 281   -- ######  PanelBevelConstants{8E3867A8-8586-11D1-B16A-00C0F0283628}  ######
 282   -- None
 283   sbrNoBevel : constant := 0;
 284   -- Inset
 285   sbrInset : constant := 1;
 286   -- Raised
 287   sbrRaised : constant := 2;
 288
 289   -- ######  PanelStyleConstants{8E3867A9-8586-11D1-B16A-00C0F0283628}  ######
 290   -- Text
 291   sbrText : constant := 0;
 292   -- Caps
 293   sbrCaps : constant := 1;
 294   -- Num
 295   sbrNum : constant := 2;
 296   -- Ins
 297   sbrIns : constant := 3;
 298   -- Scrl
 299   sbrScrl : constant := 4;
 300   -- Time
 301   sbrTime : constant := 5;
 302   -- Date
 303   sbrDate : constant := 6;
 304   -- Kana
 305   sbrKana : constant := 7;
 306
 307   -- ######  LabelEditConstants{C74190B0-8589-11D1-B16A-00C0F0283628}  ######
 308   -- Automatic
 309   tvwAutomatic : constant := 0;
 310   -- Manual
 311   tvwManual : constant := 1;
 312
 313   -- ######  TreeLineStyleConstants{C74190B1-8589-11D1-B16A-00C0F0283628}  ######
 314   -- TreeLines
 315   tvwTreeLines : constant := 0;
 316   -- RootLines
 317   tvwRootLines : constant := 1;
 318
 319   -- ######  TreeStyleConstants{C74190B2-8589-11D1-B16A-00C0F0283628}  ######
 320   -- Text Only
 321   tvwTextOnly : constant := 0;
 322   -- Picture and Text
 323   tvwPictureText : constant := 1;
 324   -- Plus/Minus and Text
 325   tvwPlusMinusText : constant := 2;
 326   -- Plus/Minus, Picture and Text
 327   tvwPlusPictureText : constant := 3;
 328   -- Treelines and Text
 329   tvwTreelinesText : constant := 4;
 330   -- Treelines, Picture and Text
 331   tvwTreelinesPictureText : constant := 5;
 332   -- Treelines, Plus/Minus and Text
 333   tvwTreelinesPlusMinusText : constant := 6;
 334   -- Treelines, Plus/Minus, Picture and Text
 335   tvwTreelinesPlusMinusPictureText : constant := 7;
 336
 337   -- ######  TreeRelationshipConstants{C74190B3-8589-11D1-B16A-00C0F0283628}  ######
 338   -- First sibling
 339   tvwFirst : constant := 0;
 340   -- Last sibling
 341   tvwLast : constant := 1;
 342   -- Next sibling
 343   tvwNext : constant := 2;
 344   -- Previous sibling
 345   tvwPrevious : constant := 3;
 346   -- Child
 347   tvwChild : constant := 4;
 348
 349   -- ######  ListTextBackgroundConstants{BDD1F040-858B-11D1-B16A-00C0F0283628}  ######
 350   -- Draws ListItem text with transparent background
 351   lvwTransparent : constant := 0;
 352   -- Draws ListItem text with opaque background using Background color property
 353   lvwOpaque : constant := 1;
 354
 355   -- ######  ListArrangeConstants{BDD1F041-858B-11D1-B16A-00C0F0283628}  ######
 356   -- None
 357   lvwNone : constant := 0;
 358   -- Left
 359   lvwAutoLeft : constant := 1;
 360   -- Top
 361   lvwAutoTop : constant := 2;
 362
 363   -- ######  ListPictureAlignmentConstants{BDD1F042-858B-11D1-B16A-00C0F0283628}  ######
 364   -- Aligns background picture to the upper left.
 365   lvwTopLeft : constant := 0;
 366   -- Aligns background picture to the upper right.
 367   lvwTopRight : constant := 1;
 368   -- Aligns background picture to the lower left.
 369   lvwBottomLeft : constant := 2;
 370   -- Aligns background picture to the lower right.
 371   lvwBottomRight : constant := 3;
 372   -- Aligns background picture to the center.
 373   lvwCenter : constant := 4;
 374   -- Tiles the picture to fill the ListView background.
 375   lvwTile : constant := 5;
 376
 377   -- ######  ListLabelEditConstants{BDD1F043-858B-11D1-B16A-00C0F0283628}  ######
 378   -- Automatic
 379   lvwAutomatic : constant := 0;
 380   -- Manual
 381   lvwManual : constant := 1;
 382
 383   -- ######  ListSortOrderConstants{BDD1F044-858B-11D1-B16A-00C0F0283628}  ######
 384   -- Ascending
 385   lvwAscending : constant := 0;
 386   -- Descending
 387   lvwDescending : constant := 1;
 388
 389   -- ######  ListViewConstants{BDD1F045-858B-11D1-B16A-00C0F0283628}  ######
 390   -- Icon
 391   lvwIcon : constant := 0;
 392   -- SmallIcon
 393   lvwSmallIcon : constant := 1;
 394   -- List
 395   lvwList : constant := 2;
 396   -- Report
 397   lvwReport : constant := 3;
 398
 399   -- ######  ListColumnAlignmentConstants{BDD1F046-858B-11D1-B16A-00C0F0283628}  ######
 400   -- Left
 401   lvwColumnLeft : constant := 0;
 402   -- Right
 403   lvwColumnRight : constant := 1;
 404   -- Center
 405   lvwColumnCenter : constant := 2;
 406
 407   -- ######  ListFindItemWhereConstants{BDD1F047-858B-11D1-B16A-00C0F0283628}  ######
 408   -- Text
 409   lvwText : constant := 0;
 410   -- SubItem
 411   lvwSubItem : constant := 1;
 412   -- Tag
 413   lvwTag : constant := 2;
 414
 415   -- ######  ListFindItemHowConstants{BDD1F048-858B-11D1-B16A-00C0F0283628}  ######
 416   -- Whole
 417   lvwWhole : constant := 0;
 418   -- Partial
 419   lvwPartial : constant := 1;
 420
 421   -- ######  ImageDrawConstants{2C247F20-8591-11D1-B16A-00C0F0283628}  ######
 422   -- Normal
 423   imlNormal : constant := 0;
 424   -- Transparent
 425   imlTransparent : constant := 1;
 426   -- Selected
 427   imlSelected : constant := 2;
 428   -- Focus
 429   imlFocus : constant := 3;
 430
 431   -- ######  TickStyleConstants{F08DF950-8592-11D1-B16A-00C0F0283628}  ######
 432   -- Bottom/Right
 433   sldBottomRight : constant := 0;
 434   -- Top/Left
 435   sldTopLeft : constant := 1;
 436   -- Both
 437   sldBoth : constant := 2;
 438   -- No Ticks
 439   sldNoTicks : constant := 3;
 440
 441   -- ######  TextPositionConstants{F08DF951-8592-11D1-B16A-00C0F0283628}  ######
 442   -- Above/Left
 443   sldAboveLeft : constant := 0;
 444   -- Below/Right
 445   sldBelowRight : constant := 1;
 446
 447   -- ######  Events  ######
 448   -- Click:  Occurs when the user presses and then releases a mouse button over an object.
 449   procedure Click_Proc;
 450   type Click_Access is access procedure;
 451
 452   -- KeyDown:  Occurs when the user presses a key while an object has the focus.
 453   procedure KeyDown_Proc(KeyCode : gb.PSHORT; Shift : gb.SHORT);
 454   type KeyDown_Access is access procedure (KeyCode : gb.PSHORT; Shift : gb.SHORT);
 455
 456   -- KeyPress:  Occurs when the user presses and releases an ANSI key.
 457   procedure KeyPress_Proc(KeyAscii : gb.PSHORT);
 458   type KeyPress_Access is access procedure (KeyAscii : gb.PSHORT);
 459
 460   -- KeyUp:  Occurs when the user releases a key while an object has the focus.
 461   procedure KeyUp_Proc(KeyCode : gb.PSHORT; Shift : gb.SHORT);
 462   type KeyUp_Access is access procedure (KeyCode : gb.PSHORT; Shift : gb.SHORT);
 463
 464   -- MouseDown:  Occurs when the user presses the mouse button while an object has the focus.
 465   procedure MouseDown_Proc(Button : gb.SHORT; Shift : gb.SHORT;
 466         x : gb.LONG; y : gb.LONG);
 467   type MouseDown_Access is access procedure (Button : gb.SHORT; Shift : gb.SHORT;
 468         x : gb.LONG; y : gb.LONG);
 469
 470   -- MouseMove:  Occurs when the user moves the mouse.
 471   procedure MouseMove_Proc(Button : gb.SHORT; Shift : gb.SHORT;
 472         x : gb.LONG; y : gb.LONG);
 473   type MouseMove_Access is access procedure (Button : gb.SHORT; Shift : gb.SHORT;
 474         x : gb.LONG; y : gb.LONG);
 475
 476   -- MouseUp:  Occurs when the user releases the mouse button while an object has the focus.
 477   procedure MouseUp_Proc(Button : gb.SHORT; Shift : gb.SHORT;
 478         x : gb.LONG; y : gb.LONG);
 479   type MouseUp_Access is access procedure (Button : gb.SHORT; Shift : gb.SHORT;
 480         x : gb.LONG; y : gb.LONG);
 481
 482   -- Scroll:  Slider scroll event
 483   procedure Scroll_Proc;
 484   type Scroll_Access is access procedure;
 485
 486   -- Change:  Indicates that the contents of a control have changed.
 487   procedure Change_Proc;
 488   type Change_Access is access procedure;
 489
 490   -- OLEStartDrag:  OLEStartDrag event
 491   procedure OLEStartDrag_Proc(Data : gb.LPDISPATCH; AllowedEffects : gb.PLONG);
 492   type OLEStartDrag_Access is access procedure (Data : gb.LPDISPATCH; AllowedEffects : gb.PLONG);
 493
 494   -- OLEGiveFeedback:  OLEGiveFeedback event
 495   procedure OLEGiveFeedback_Proc(Effect : gb.PLONG; DefaultCursors : gb.PVARIANT_BOOL);
 496   type OLEGiveFeedback_Access is access procedure (Effect : gb.PLONG; DefaultCursors : gb.PVARIANT_BOOL);
 497
 498   -- OLESetData:  OLESetData event
 499   procedure OLESetData_Proc(Data : gb.LPDISPATCH; DataFormat : gb.PSHORT);
 500   type OLESetData_Access is access procedure (Data : gb.LPDISPATCH; DataFormat : gb.PSHORT);
 501
 502   -- OLECompleteDrag:  OLECompleteDrag event
 503   procedure OLECompleteDrag_Proc(Effect : gb.PLONG);
 504   type OLECompleteDrag_Access is access procedure (Effect : gb.PLONG);
 505
 506   -- OLEDragOver:  OLEDragOver event
 507   procedure OLEDragOver_Proc(Data : gb.LPDISPATCH; Effect : gb.PLONG;
 508         Button : gb.PSHORT; Shift : gb.PSHORT; x : gb.PFLOAT;
 509         y : gb.PFLOAT; State : gb.PSHORT);
 510   type OLEDragOver_Access is access procedure (Data : gb.LPDISPATCH; Effect : gb.PLONG;
 511         Button : gb.PSHORT; Shift : gb.PSHORT; x : gb.PFLOAT;
 512         y : gb.PFLOAT; State : gb.PSHORT);
 513
 514   -- OLEDragDrop:  OLEDragDrop event
 515   procedure OLEDragDrop_Proc(Data : gb.LPDISPATCH; Effect : gb.PLONG;
 516         Button : gb.PSHORT; Shift : gb.PSHORT; x : gb.PFLOAT;
 517         y : gb.PFLOAT);
 518   type OLEDragDrop_Access is access procedure (Data : gb.LPDISPATCH; Effect : gb.PLONG;
 519         Button : gb.PSHORT; Shift : gb.PSHORT; x : gb.PFLOAT;
 520         y : gb.PFLOAT);
 521
 522   -- ######  Object Declaration  ######
 523   type SliderCtrl(Parent : access gb.Object'class) is
 524     new gb.OleControl(Parent) with
 525   record
 526     Click : Click_Access := Click_Proc'access;
 527     KeyDown : KeyDown_Access := KeyDown_Proc'access;
 528     KeyPress : KeyPress_Access := KeyPress_Proc'access;
 529     KeyUp : KeyUp_Access := KeyUp_Proc'access;
 530     MouseDown : MouseDown_Access := MouseDown_Proc'access;
 531     MouseMove : MouseMove_Access := MouseMove_Proc'access;
 532     MouseUp : MouseUp_Access := MouseUp_Proc'access;
 533     Scroll : Scroll_Access := Scroll_Proc'access;
 534     Change : Change_Access := Change_Proc'access;
 535     OLEStartDrag : OLEStartDrag_Access := OLEStartDrag_Proc'access;
 536     OLEGiveFeedback : OLEGiveFeedback_Access := OLEGiveFeedback_Proc'access;
 537     OLESetData : OLESetData_Access := OLESetData_Proc'access;
 538     OLECompleteDrag : OLECompleteDrag_Access := OLECompleteDrag_Proc'access;
 539     OLEDragOver : OLEDragOver_Access := OLEDragOver_Proc'access;
 540     OLEDragDrop : OLEDragDrop_Access := OLEDragDrop_Proc'access;
 541   end record;
 542   type SliderCtrlRef is access all SliderCtrl'class;
 543
 544   procedure Initialize(Obj : in out SliderCtrl);
 545
 546   -- ######  Methods  ######
 547   -- QueryInterface
 548   procedure QueryInterface(Obj : SliderCtrl; riid : gb.LPDISPATCH; ppvObj : gb.PVOID);
 549
 550   -- AddRef
 551   function AddRef(Obj : SliderCtrl) return gb.ULONG;
 552
 553   -- Release
 554   function Release(Obj : SliderCtrl) return gb.ULONG;
 555
 556   -- GetTypeInfoCount
 557   procedure GetTypeInfoCount(Obj : SliderCtrl; pctinfo : gb.PUINT);
 558
 559   -- GetTypeInfo
 560   procedure GetTypeInfo(Obj : SliderCtrl; itinfo : gb.UINT; lcid : gb.ULONG;
 561       pptinfo : gb.PVOID);
 562
 563   -- GetIDsOfNames
 564   procedure GetIDsOfNames(Obj : SliderCtrl; riid : gb.LPDISPATCH; rgszNames : gb.PCHAR;
 565       cNames : gb.UINT; lcid : gb.ULONG; rgdispid : gb.PLONG);
 566
 567   -- Invoke
 568   procedure Invoke(Obj : SliderCtrl; dispidMember : gb.LONG; riid : gb.LPDISPATCH;
 569       lcid : gb.ULONG; wFlags : gb.USHORT; pdispparams : gb.LPDISPATCH;
 570       pvarResult : gb.LPVARIANT; pexcepinfo : gb.LPDISPATCH; puArgErr : gb.PUINT);
 571
 572   -- LargeChange:  Returns/sets the increment value when the PageDown or PageUp
 573   -- key is pressed.
 574   function LargeChange(Obj : SliderCtrl) return gb.LONG;
 575
 576   -- LargeChange:  Returns/sets the increment value when the PageDown or PageUp
 577   -- key is pressed.
 578   procedure LargeChange(Obj : SliderCtrl; Param1 : gb.LONG);
 579
 580   -- SmallChange:  Returns/sets the increment value when the left or right arrow
 581   -- key is pressed.
 582   function SmallChange(Obj : SliderCtrl) return gb.LONG;
 583
 584   -- SmallChange:  Returns/sets the increment value when the left or right arrow
 585   -- key is pressed.
 586   procedure SmallChange(Obj : SliderCtrl; Param1 : gb.LONG);
 587
 588   -- Max:  Returns/sets the maximum value of a control.
 589   function Max(Obj : SliderCtrl) return gb.LONG;
 590
 591   -- Max:  Returns/sets the maximum value of a control.
 592   procedure Max(Obj : SliderCtrl; Param1 : gb.LONG);
 593
 594   -- Min:  Returns/sets the minimum value of a control.
 595   function Min(Obj : SliderCtrl) return gb.LONG;
 596
 597   -- Min:  Returns/sets the minimum value of a control.
 598   procedure Min(Obj : SliderCtrl; Param1 : gb.LONG);
 599
 600   -- Orientation:  Returns/sets the orientation of a Slider control, horizontal or vertical.
 601   function Orientation(Obj : SliderCtrl) return gb.INT;
 602
 603   -- Orientation:  Returns/sets the orientation of a Slider control, horizontal or vertical.
 604   procedure Orientation(Obj : SliderCtrl; Param1 : gb.INT);
 605
 606   -- SelectRange:  Returns/sets whether or not a Slider control can have a select range.
 607   function SelectRange(Obj : SliderCtrl) return gb.BOOL;
 608
 609   -- SelectRange:  Returns/sets whether or not a Slider control can have a select range.
 610   procedure SelectRange(Obj : SliderCtrl; Param1 : gb.BOOL);
 611
 612   -- SelStart:  Returns/sets the value where a selection starts.
 613   function SelStart(Obj : SliderCtrl) return gb.LONG;
 614
 615   -- SelStart:  Returns/sets the value where a selection starts.
 616   procedure SelStart(Obj : SliderCtrl; Param1 : gb.LONG);
 617
 618   -- SelLength:  Returns/sets the length of a selection.
 619   function SelLength(Obj : SliderCtrl) return gb.LONG;
 620
 621   -- SelLength:  Returns/sets the length of a selection.
 622   procedure SelLength(Obj : SliderCtrl; Param1 : gb.LONG);
 623
 624   -- TickStyle:  Returns/sets where ticks appear on a Slider control.
 625   function TickStyle(Obj : SliderCtrl) return gb.INT;
 626
 627   -- TickStyle:  Returns/sets where ticks appear on a Slider control.
 628   procedure TickStyle(Obj : SliderCtrl; Param1 : gb.INT);
 629
 630   -- TickFrequency:  Returns/sets the ratio of ticks on a Slider control; 1tick
 631   -- every n increments.
 632   function TickFrequency(Obj : SliderCtrl) return gb.LONG;
 633
 634   -- TickFrequency:  Returns/sets the ratio of ticks on a Slider control; 1tick
 635   -- every n increments.
 636   procedure TickFrequency(Obj : SliderCtrl; Param1 : gb.LONG);
 637
 638   -- Value:  Returns/sets the value of an object.
 639   function Value(Obj : SliderCtrl) return gb.LONG;
 640
 641   -- Value:  Returns/sets the value of an object.
 642   procedure Value(Obj : SliderCtrl; Param1 : gb.LONG);
 643
 644   -- MouseIcon:  Sets a custom mouse icon.
 645   function MouseIcon(Obj : SliderCtrl) return gb.LPDISPATCH;
 646
 647   -- MouseIcon:  Sets a custom mouse icon.
 648   procedure MouseIcon(Obj : SliderCtrl; Param1 : gb.LPDISPATCH);
 649
 650   -- MousePointer:  Returns/sets the type of mouse pointer displayed when over
 651   -- part of an object.
 652   function MousePointer(Obj : SliderCtrl) return gb.INT;
 653
 654   -- MousePointer:  Returns/sets the type of mouse pointer displayed when over
 655   -- part of an object.
 656   procedure MousePointer(Obj : SliderCtrl; Param1 : gb.INT);
 657
 658   -- Enabled:  Returns/sets a value that determines whether a form or control
 659   -- can respond to user-generated events.
 660   function Enabled(Obj : SliderCtrl) return gb.BOOL;
 661
 662   -- Enabled:  Returns/sets a value that determines whether a form or control
 663   -- can respond to user-generated events.
 664   procedure Enabled(Obj : SliderCtrl; Param1 : gb.BOOL);
 665
 666   -- hWnd:  Returns a handle to a form or control.
 667   function hWnd(Obj : SliderCtrl) return gb.INT;
 668
 669   -- hWnd:  Returns a handle to a form or control.
 670   procedure hWnd(Obj : SliderCtrl; Param1 : gb.INT);
 671
 672   -- BorderStyle:  Returns/sets the border style for an object.
 673   function BorderStyle(Obj : SliderCtrl) return gb.INT;
 674
 675   -- BorderStyle:  Returns/sets the border style for an object.
 676   procedure BorderStyle(Obj : SliderCtrl; Param1 : gb.INT);
 677
 678   -- OLEDropMode:  Returns/Sets whether this control can act as an OLE drop target.
 679   function OLEDropMode(Obj : SliderCtrl) return gb.INT;
 680
 681   -- OLEDropMode:  Returns/Sets whether this control can act as an OLE drop target.
 682   procedure OLEDropMode(Obj : SliderCtrl; Param1 : gb.INT);
 683
 684   -- Refresh:  Forces a complete repaint of a form or control.
 685   procedure Refresh(Obj : SliderCtrl);
 686
 687   -- ClearSel:  Sets the SelLength to 0.
 688   procedure ClearSel(Obj : SliderCtrl);
 689
 690   -- DoClick:  Hidden method that can be used to invoke the Click event
 691   procedure DoClick(Obj : SliderCtrl);
 692
 693   -- GetNumTicks:  Returns the number of visible ticks on a Slider control.
 694   function GetNumTicks(Obj : SliderCtrl) return gb.LONG;
 695
 696   -- OLEDrag:  Starts an OLE drag/drop event with the given control as the source.
 697   procedure OLEDrag(Obj : SliderCtrl);
 698
 699   -- AboutBox
 700   procedure AboutBox(Obj : SliderCtrl);
 701
 702   -- Text:  Returns/sets the string displayed in the ToolTip as the slider's position changes.
 703   function Text(Obj : SliderCtrl) return String;
 704
 705   -- Text:  Returns/sets the string displayed in the ToolTip as the slider's position changes.
 706   procedure Text(Obj : SliderCtrl; Param1 : String);
 707
 708   -- TextPosition:  Returns/sets a value that determines where the tooltip displaying
 709   -- the Slider's changing position is displayed.
 710   function TextPosition(Obj : SliderCtrl) return gb.INT;
 711
 712   -- TextPosition:  Returns/sets a value that determines where the tooltip displaying
 713   -- the Slider's changing position is displayed.
 714   procedure TextPosition(Obj : SliderCtrl; Param1 : gb.INT);
 715
 716 end MSComctlLib_Slider;
 717
 718
 719 package body MSComctlLib_Slider is
 720
 721   pragma Suppress(Discriminant_Check);
 722
 723   use type gb.DISPID;
 724   use type gb.VARTYPE;
 725
 726   -- ######  Methods  ######
 727   procedure QueryInterface(Obj : SliderCtrl; riid : gb.LPDISPATCH; ppvObj : gb.PVOID) is
 728     myVariants : array (1..2) of gb.Variant;
 729   begin
 730     myVariants(2) := (gb.VT_DISPATCH, 0, 0, 0, (gb.VT_DISPATCH, riid));
 731     myVariants(1) := (gb.VT_BYREF or gb.VT_VOID, 0, 0, 0, (gb.VT_BYREF or gb.VT_VOID, ppvObj));
 732     gb.DoMethod(Obj, 1610612736, 1, 2, gb.Convert(myVariants'address));
 733   end QueryInterface;
 734
 735   function AddRef(Obj : SliderCtrl) return gb.ULONG is
 736     myResult   : aliased gb.Variant;
 737   begin
 738     gb.DoMethod(Obj, 1610612737, 1, 0, null, myResult'unchecked_access);
 739     return myResult.u.ulVal;
 740   end AddRef;
 741
 742   function Release(Obj : SliderCtrl) return gb.ULONG is
 743     myResult   : aliased gb.Variant;
 744   begin
 745     gb.DoMethod(Obj, 1610612738, 1, 0, null, myResult'unchecked_access);
 746     return myResult.u.ulVal;
 747   end Release;
 748
 749   procedure GetTypeInfoCount(Obj : SliderCtrl; pctinfo : gb.PUINT) is
 750     myVariants : array (1..1) of gb.Variant;
 751   begin
 752     myVariants(1) := (gb.VT_BYREF or gb.VT_UINT, 0, 0, 0, (gb.VT_BYREF or gb.VT_UINT, pctinfo));
 753     gb.DoMethod(Obj, 1610678272, 1, 1, gb.Convert(myVariants'address));
 754   end GetTypeInfoCount;
 755
 756   procedure GetTypeInfo(Obj : SliderCtrl; itinfo : gb.UINT; lcid : gb.ULONG;
 757       pptinfo : gb.PVOID) is
 758     myVariants : array (1..3) of gb.Variant;
 759   begin
 760     myVariants(3) := (gb.VT_UINT, 0, 0, 0, (gb.VT_UINT, itinfo));
 761     myVariants(2) := (gb.VT_UI4, 0, 0, 0, (gb.VT_UI4, lcid));
 762     myVariants(1) := (gb.VT_BYREF or gb.VT_VOID, 0, 0, 0, (gb.VT_BYREF or gb.VT_VOID, pptinfo));
 763     gb.DoMethod(Obj, 1610678273, 1, 3, gb.Convert(myVariants'address));
 764   end GetTypeInfo;
 765
 766   procedure GetIDsOfNames(Obj : SliderCtrl; riid : gb.LPDISPATCH; rgszNames : gb.PCHAR;
 767       cNames : gb.UINT; lcid : gb.ULONG; rgdispid : gb.PLONG) is
 768     myVariants : array (1..5) of gb.Variant;
 769   begin
 770     myVariants(5) := (gb.VT_DISPATCH, 0, 0, 0, (gb.VT_DISPATCH, riid));
 771     myVariants(4) := (gb.VT_BYREF or gb.VT_I1, 0, 0, 0, (gb.VT_BYREF or gb.VT_I1, rgszNames));
 772     myVariants(3) := (gb.VT_UINT, 0, 0, 0, (gb.VT_UINT, cNames));
 773     myVariants(2) := (gb.VT_UI4, 0, 0, 0, (gb.VT_UI4, lcid));
 774     myVariants(1) := (gb.VT_BYREF or gb.VT_I4, 0, 0, 0, (gb.VT_BYREF or gb.VT_I4, rgdispid));
 775     gb.DoMethod(Obj, 1610678274, 1, 5, gb.Convert(myVariants'address));
 776   end GetIDsOfNames;
 777
 778   procedure Invoke(Obj : SliderCtrl; dispidMember : gb.LONG; riid : gb.LPDISPATCH;
 779       lcid : gb.ULONG; wFlags : gb.USHORT; pdispparams : gb.LPDISPATCH;
 780       pvarResult : gb.LPVARIANT; pexcepinfo : gb.LPDISPATCH; puArgErr : gb.PUINT) is
 781     myVariants : array (1..8) of gb.Variant;
 782   begin
 783     myVariants(8) := (gb.VT_I4, 0, 0, 0, (gb.VT_I4, dispidMember));
 784     myVariants(7) := (gb.VT_DISPATCH, 0, 0, 0, (gb.VT_DISPATCH, riid));
 785     myVariants(6) := (gb.VT_UI4, 0, 0, 0, (gb.VT_UI4, lcid));
 786     myVariants(5) := (gb.VT_UI2, 0, 0, 0, (gb.VT_UI2, wFlags));
 787     myVariants(4) := (gb.VT_DISPATCH, 0, 0, 0, (gb.VT_DISPATCH, pdispparams));
 788     myVariants(3) := pvarResult.all;
 789     myVariants(2) := (gb.VT_DISPATCH, 0, 0, 0, (gb.VT_DISPATCH, pexcepinfo));
 790     myVariants(1) := (gb.VT_BYREF or gb.VT_UINT, 0, 0, 0, (gb.VT_BYREF or gb.VT_UINT, puArgErr));
 791     gb.DoMethod(Obj, 1610678275, 1, 8, gb.Convert(myVariants'address));
 792   end Invoke;
 793
 794   function LargeChange(Obj : SliderCtrl) return gb.LONG is
 795     myResult   : aliased gb.Variant;
 796   begin
 797     gb.DoMethod(Obj, 1, 2, 0, null, myResult'unchecked_access);
 798     return myResult.u.lVal;
 799   end LargeChange;
 800
 801   procedure LargeChange(Obj : SliderCtrl; Param1 : gb.LONG) is
 802     myVariants : array (1..1) of gb.Variant;
 803   begin
 804     myVariants(1) := (gb.VT_I4, 0, 0, 0, (gb.VT_I4, Param1));
 805     gb.DoMethod(Obj, 1, 4, 1, gb.Convert(myVariants'address));
 806   end LargeChange;
 807
 808   function SmallChange(Obj : SliderCtrl) return gb.LONG is
 809     myResult   : aliased gb.Variant;
 810   begin
 811     gb.DoMethod(Obj, 2, 2, 0, null, myResult'unchecked_access);
 812     return myResult.u.lVal;
 813   end SmallChange;
 814
 815   procedure SmallChange(Obj : SliderCtrl; Param1 : gb.LONG) is
 816     myVariants : array (1..1) of gb.Variant;
 817   begin
 818     myVariants(1) := (gb.VT_I4, 0, 0, 0, (gb.VT_I4, Param1));
 819     gb.DoMethod(Obj, 2, 4, 1, gb.Convert(myVariants'address));
 820   end SmallChange;
 821
 822   function Max(Obj : SliderCtrl) return gb.LONG is
 823     myResult   : aliased gb.Variant;
 824   begin
 825     gb.DoMethod(Obj, 3, 2, 0, null, myResult'unchecked_access);
 826     return myResult.u.lVal;
 827   end Max;
 828
 829   procedure Max(Obj : SliderCtrl; Param1 : gb.LONG) is
 830     myVariants : array (1..1) of gb.Variant;
 831   begin
 832     myVariants(1) := (gb.VT_I4, 0, 0, 0, (gb.VT_I4, Param1));
 833     gb.DoMethod(Obj, 3, 4, 1, gb.Convert(myVariants'address));
 834   end Max;
 835
 836   function Min(Obj : SliderCtrl) return gb.LONG is
 837     myResult   : aliased gb.Variant;
 838   begin
 839     gb.DoMethod(Obj, 4, 2, 0, null, myResult'unchecked_access);
 840     return myResult.u.lVal;
 841   end Min;
 842
 843   procedure Min(Obj : SliderCtrl; Param1 : gb.LONG) is
 844     myVariants : array (1..1) of gb.Variant;
 845   begin
 846     myVariants(1) := (gb.VT_I4, 0, 0, 0, (gb.VT_I4, Param1));
 847     gb.DoMethod(Obj, 4, 4, 1, gb.Convert(myVariants'address));
 848   end Min;
 849
 850   function Orientation(Obj : SliderCtrl) return gb.INT is
 851     myResult   : aliased gb.Variant;
 852   begin
 853     gb.DoMethod(Obj, 5, 2, 0, null, myResult'unchecked_access);
 854     return myResult.u.intVal;
 855   end Orientation;
 856
 857   procedure Orientation(Obj : SliderCtrl; Param1 : gb.INT) is
 858     myVariants : array (1..1) of gb.Variant;
 859   begin
 860     myVariants(1) := (gb.VT_INT, 0, 0, 0, (gb.VT_INT, Param1));
 861     gb.DoMethod(Obj, 5, 4, 1, gb.Convert(myVariants'address));
 862   end Orientation;
 863
 864   function SelectRange(Obj : SliderCtrl) return gb.BOOL is
 865     myResult   : aliased gb.Variant;
 866   begin
 867     gb.DoMethod(Obj, 6, 2, 0, null, myResult'unchecked_access);
 868     return gb.Convert(myResult.u.bool);
 869   end SelectRange;
 870
 871   procedure SelectRange(Obj : SliderCtrl; Param1 : gb.BOOL) is
 872     myVariants : array (1..1) of gb.Variant;
 873   begin
 874     myVariants(1) := (gb.VT_BOOL, 0, 0, 0, (gb.VT_BOOL, gb.Convert(Param1)));
 875     gb.DoMethod(Obj, 6, 4, 1, gb.Convert(myVariants'address));
 876   end SelectRange;
 877
 878   function SelStart(Obj : SliderCtrl) return gb.LONG is
 879     myResult   : aliased gb.Variant;
 880   begin
 881     gb.DoMethod(Obj, 7, 2, 0, null, myResult'unchecked_access);
 882     return myResult.u.lVal;
 883   end SelStart;
 884
 885   procedure SelStart(Obj : SliderCtrl; Param1 : gb.LONG) is
 886     myVariants : array (1..1) of gb.Variant;
 887   begin
 888     myVariants(1) := (gb.VT_I4, 0, 0, 0, (gb.VT_I4, Param1));
 889     gb.DoMethod(Obj, 7, 4, 1, gb.Convert(myVariants'address));
 890   end SelStart;
 891
 892   function SelLength(Obj : SliderCtrl) return gb.LONG is
 893     myResult   : aliased gb.Variant;
 894   begin
 895     gb.DoMethod(Obj, 8, 2, 0, null, myResult'unchecked_access);
 896     return myResult.u.lVal;
 897   end SelLength;
 898
 899   procedure SelLength(Obj : SliderCtrl; Param1 : gb.LONG) is
 900     myVariants : array (1..1) of gb.Variant;
 901   begin
 902     myVariants(1) := (gb.VT_I4, 0, 0, 0, (gb.VT_I4, Param1));
 903     gb.DoMethod(Obj, 8, 4, 1, gb.Convert(myVariants'address));
 904   end SelLength;
 905
 906   function TickStyle(Obj : SliderCtrl) return gb.INT is
 907     myResult   : aliased gb.Variant;
 908   begin
 909     gb.DoMethod(Obj, 9, 2, 0, null, myResult'unchecked_access);
 910     return myResult.u.intVal;
 911   end TickStyle;
 912
 913   procedure TickStyle(Obj : SliderCtrl; Param1 : gb.INT) is
 914     myVariants : array (1..1) of gb.Variant;
 915   begin
 916     myVariants(1) := (gb.VT_INT, 0, 0, 0, (gb.VT_INT, Param1));
 917     gb.DoMethod(Obj, 9, 4, 1, gb.Convert(myVariants'address));
 918   end TickStyle;
 919
 920   function TickFrequency(Obj : SliderCtrl) return gb.LONG is
 921     myResult   : aliased gb.Variant;
 922   begin
 923     gb.DoMethod(Obj, 10, 2, 0, null, myResult'unchecked_access);
 924     return myResult.u.lVal;
 925   end TickFrequency;
 926
 927   procedure TickFrequency(Obj : SliderCtrl; Param1 : gb.LONG) is
 928     myVariants : array (1..1) of gb.Variant;
 929   begin
 930     myVariants(1) := (gb.VT_I4, 0, 0, 0, (gb.VT_I4, Param1));
 931     gb.DoMethod(Obj, 10, 4, 1, gb.Convert(myVariants'address));
 932   end TickFrequency;
 933
 934   function Value(Obj : SliderCtrl) return gb.LONG is
 935     myResult   : aliased gb.Variant;
 936   begin
 937     gb.DoMethod(Obj, 11, 2, 0, null, myResult'unchecked_access);
 938     return myResult.u.lVal;
 939   end Value;
 940
 941   procedure Value(Obj : SliderCtrl; Param1 : gb.LONG) is
 942     myVariants : array (1..1) of gb.Variant;
 943   begin
 944     myVariants(1) := (gb.VT_I4, 0, 0, 0, (gb.VT_I4, Param1));
 945     gb.DoMethod(Obj, 11, 4, 1, gb.Convert(myVariants'address));
 946   end Value;
 947
 948   function MouseIcon(Obj : SliderCtrl) return gb.LPDISPATCH is
 949     myResult   : aliased gb.Variant;
 950   begin
 951     gb.DoMethod(Obj, 12, 2, 0, null, myResult'unchecked_access);
 952     return myResult.u.pdispVal;
 953   end MouseIcon;
 954
 955   procedure MouseIcon(Obj : SliderCtrl; Param1 : gb.LPDISPATCH) is
 956     myVariants : array (1..1) of gb.Variant;
 957   begin
 958     myVariants(1) := (gb.VT_DISPATCH, 0, 0, 0, (gb.VT_DISPATCH, Param1));
 959     gb.DoMethod(Obj, 12, 4, 1, gb.Convert(myVariants'address));
 960   end MouseIcon;
 961
 962   function MousePointer(Obj : SliderCtrl) return gb.INT is
 963     myResult   : aliased gb.Variant;
 964   begin
 965     gb.DoMethod(Obj, 13, 2, 0, null, myResult'unchecked_access);
 966     return myResult.u.intVal;
 967   end MousePointer;
 968
 969   procedure MousePointer(Obj : SliderCtrl; Param1 : gb.INT) is
 970     myVariants : array (1..1) of gb.Variant;
 971   begin
 972     myVariants(1) := (gb.VT_INT, 0, 0, 0, (gb.VT_INT, Param1));
 973     gb.DoMethod(Obj, 13, 4, 1, gb.Convert(myVariants'address));
 974   end MousePointer;
 975
 976   function Enabled(Obj : SliderCtrl) return gb.BOOL is
 977     myResult   : aliased gb.Variant;
 978   begin
 979     gb.DoMethod(Obj, -514, 2, 0, null, myResult'unchecked_access);
 980     return gb.Convert(myResult.u.bool);
 981   end Enabled;
 982
 983   procedure Enabled(Obj : SliderCtrl; Param1 : gb.BOOL) is
 984     myVariants : array (1..1) of gb.Variant;
 985   begin
 986     myVariants(1) := (gb.VT_BOOL, 0, 0, 0, (gb.VT_BOOL, gb.Convert(Param1)));
 987     gb.DoMethod(Obj, -514, 4, 1, gb.Convert(myVariants'address));
 988   end Enabled;
 989
 990   function hWnd(Obj : SliderCtrl) return gb.INT is
 991     myResult   : aliased gb.Variant;
 992   begin
 993     gb.DoMethod(Obj, -515, 2, 0, null, myResult'unchecked_access);
 994     return myResult.u.intVal;
 995   end hWnd;
 996
 997   procedure hWnd(Obj : SliderCtrl; Param1 : gb.INT) is
 998     myVariants : array (1..1) of gb.Variant;
 999   begin
1000     myVariants(1) := (gb.VT_INT, 0, 0, 0, (gb.VT_INT, Param1));
1001     gb.DoMethod(Obj, -515, 4, 1, gb.Convert(myVariants'address));
1002   end hWnd;
1003
1004   function BorderStyle(Obj : SliderCtrl) return gb.INT is
1005     myResult   : aliased gb.Variant;
1006   begin
1007     gb.DoMethod(Obj, -504, 2, 0, null, myResult'unchecked_access);
1008     return myResult.u.intVal;
1009   end BorderStyle;
1010
1011   procedure BorderStyle(Obj : SliderCtrl; Param1 : gb.INT) is
1012     myVariants : array (1..1) of gb.Variant;
1013   begin
1014     myVariants(1) := (gb.VT_INT, 0, 0, 0, (gb.VT_INT, Param1));
1015     gb.DoMethod(Obj, -504, 4, 1, gb.Convert(myVariants'address));
1016   end BorderStyle;
1017
1018   function OLEDropMode(Obj : SliderCtrl) return gb.INT is
1019     myResult   : aliased gb.Variant;
1020   begin
1021     gb.DoMethod(Obj, 1551, 2, 0, null, myResult'unchecked_access);
1022     return myResult.u.intVal;
1023   end OLEDropMode;
1024
1025   procedure OLEDropMode(Obj : SliderCtrl; Param1 : gb.INT) is
1026     myVariants : array (1..1) of gb.Variant;
1027   begin
1028     myVariants(1) := (gb.VT_INT, 0, 0, 0, (gb.VT_INT, Param1));
1029     gb.DoMethod(Obj, 1551, 4, 1, gb.Convert(myVariants'address));
1030   end OLEDropMode;
1031
1032   procedure Refresh(Obj : SliderCtrl) is
1033   begin
1034     gb.DoMethod(Obj, -550, 1);
1035   end Refresh;
1036
1037   procedure ClearSel(Obj : SliderCtrl) is
1038   begin
1039     gb.DoMethod(Obj, 14, 1);
1040   end ClearSel;
1041
1042   procedure DoClick(Obj : SliderCtrl) is
1043   begin
1044     gb.DoMethod(Obj, -551, 1);
1045   end DoClick;
1046
1047   function GetNumTicks(Obj : SliderCtrl) return gb.LONG is
1048     myResult   : aliased gb.Variant;
1049   begin
1050     gb.DoMethod(Obj, 15, 2, 0, null, myResult'unchecked_access);
1051     return myResult.u.lVal;
1052   end GetNumTicks;
1053
1054   procedure OLEDrag(Obj : SliderCtrl) is
1055   begin
1056     gb.DoMethod(Obj, 1552, 1);
1057   end OLEDrag;
1058
1059   procedure AboutBox(Obj : SliderCtrl) is
1060   begin
1061     gb.DoMethod(Obj, -552, 1);
1062   end AboutBox;
1063
1064   function Text(Obj : SliderCtrl) return String is
1065     myResult   : aliased gb.Variant;
1066   begin
1067     gb.DoMethod(Obj, 16, 2, 0, null, myResult'unchecked_access);
1068     return gb.To_ASCII(myResult.u.bstrVal);
1069   end Text;
1070
1071   procedure Text(Obj : SliderCtrl; Param1 : String) is
1072     myBSTR1 : aliased gb.BSTR := gb.AllocBSTR(Param1);
1073     myVariants : array (1..1) of gb.Variant;
1074   begin
1075     myVariants(1) := (gb.VT_BSTR, 0, 0, 0, (gb.VT_BSTR, myBSTR1));
1076     gb.DoMethod(Obj, 16, 4, 1, gb.Convert(myVariants'address));
1077     gb.FreeBSTR(myBSTR1);
1078   end Text;
1079
1080   function TextPosition(Obj : SliderCtrl) return gb.INT is
1081     myResult   : aliased gb.Variant;
1082   begin
1083     gb.DoMethod(Obj, 17, 2, 0, null, myResult'unchecked_access);
1084     return myResult.u.intVal;
1085   end TextPosition;
1086
1087   procedure TextPosition(Obj : SliderCtrl; Param1 : gb.INT) is
1088     myVariants : array (1..1) of gb.Variant;
1089   begin
1090     myVariants(1) := (gb.VT_INT, 0, 0, 0, (gb.VT_INT, Param1));
1091     gb.DoMethod(Obj, 17, 4, 1, gb.Convert(myVariants'address));
1092   end TextPosition;
1093
1094   -- ######  Event Dispatch  ######
1095   procedure DispatchEvent_Proc(Obj : gb.OleControlRef; dispidMember : gb.DISPID;
1096       pdispparams : access gb.DISPPARAMS) is
1097     hr         : gb.HRESULT;
1098     u          : aliased gb.UINT;
1099     myVariant1 : aliased gb.VARIANT;
1100     myVariant2 : aliased gb.VARIANT;
1101     myVariant3 : aliased gb.VARIANT;
1102     myVariant4 : aliased gb.VARIANT;
1103     myVariant5 : aliased gb.VARIANT;
1104     myVariant6 : aliased gb.VARIANT;
1105     myVariant7 : aliased gb.VARIANT;
1106   begin
1107     if dispidMember = -600 then
1108       SliderCtrl(Obj.all).Click.all;
1109     elsif dispidMember = -602 then
1110       hr := gb.DispGetParam(pdispparams, 0, gb.VT_BYREF or gb.VT_I2, myVariant1'access, u'access);
1111       hr := gb.DispGetParam(pdispparams, 1, gb.VT_I2, myVariant2'access, u'access);
1112       SliderCtrl(Obj.all).KeyDown(myVariant1.u.iVal'unchecked_access, myVariant2.u.iVal);
1113       hr := gb.VariantClear(myVariant1'access);
1114       hr := gb.VariantClear(myVariant2'access);
1115     elsif dispidMember = -603 then
1116       hr := gb.DispGetParam(pdispparams, 0, gb.VT_BYREF or gb.VT_I2, myVariant1'access, u'access);
1117       SliderCtrl(Obj.all).KeyPress(myVariant1.u.iVal'unchecked_access);
1118       hr := gb.VariantClear(myVariant1'access);
1119     elsif dispidMember = -604 then
1120       hr := gb.DispGetParam(pdispparams, 0, gb.VT_BYREF or gb.VT_I2, myVariant1'access, u'access);
1121       hr := gb.DispGetParam(pdispparams, 1, gb.VT_I2, myVariant2'access, u'access);
1122       SliderCtrl(Obj.all).KeyUp(myVariant1.u.iVal'unchecked_access, myVariant2.u.iVal);
1123       hr := gb.VariantClear(myVariant1'access);
1124       hr := gb.VariantClear(myVariant2'access);
1125     elsif dispidMember = -605 then
1126       hr := gb.DispGetParam(pdispparams, 0, gb.VT_I2, myVariant1'access, u'access);
1127       hr := gb.DispGetParam(pdispparams, 1, gb.VT_I2, myVariant2'access, u'access);
1128       hr := gb.DispGetParam(pdispparams, 2, gb.VT_I4, myVariant3'access, u'access);
1129       hr := gb.DispGetParam(pdispparams, 3, gb.VT_I4, myVariant4'access, u'access);
1130       SliderCtrl(Obj.all).MouseDown(myVariant1.u.iVal, myVariant2.u.iVal,
1131         myVariant3.u.lVal, myVariant4.u.lVal);
1132       hr := gb.VariantClear(myVariant1'access);
1133       hr := gb.VariantClear(myVariant2'access);
1134       hr := gb.VariantClear(myVariant3'access);
1135       hr := gb.VariantClear(myVariant4'access);
1136     elsif dispidMember = -606 then
1137       hr := gb.DispGetParam(pdispparams, 0, gb.VT_I2, myVariant1'access, u'access);
1138       hr := gb.DispGetParam(pdispparams, 1, gb.VT_I2, myVariant2'access, u'access);
1139       hr := gb.DispGetParam(pdispparams, 2, gb.VT_I4, myVariant3'access, u'access);
1140       hr := gb.DispGetParam(pdispparams, 3, gb.VT_I4, myVariant4'access, u'access);
1141       SliderCtrl(Obj.all).MouseMove(myVariant1.u.iVal, myVariant2.u.iVal,
1142         myVariant3.u.lVal, myVariant4.u.lVal);
1143       hr := gb.VariantClear(myVariant1'access);
1144       hr := gb.VariantClear(myVariant2'access);
1145       hr := gb.VariantClear(myVariant3'access);
1146       hr := gb.VariantClear(myVariant4'access);
1147     elsif dispidMember = -607 then
1148       hr := gb.DispGetParam(pdispparams, 0, gb.VT_I2, myVariant1'access, u'access);
1149       hr := gb.DispGetParam(pdispparams, 1, gb.VT_I2, myVariant2'access, u'access);
1150       hr := gb.DispGetParam(pdispparams, 2, gb.VT_I4, myVariant3'access, u'access);
1151       hr := gb.DispGetParam(pdispparams, 3, gb.VT_I4, myVariant4'access, u'access);
1152       SliderCtrl(Obj.all).MouseUp(myVariant1.u.iVal, myVariant2.u.iVal,
1153         myVariant3.u.lVal, myVariant4.u.lVal);
1154       hr := gb.VariantClear(myVariant1'access);
1155       hr := gb.VariantClear(myVariant2'access);
1156       hr := gb.VariantClear(myVariant3'access);
1157       hr := gb.VariantClear(myVariant4'access);
1158     elsif dispidMember = 1 then
1159       SliderCtrl(Obj.all).Scroll.all;
1160     elsif dispidMember = 2 then
1161       SliderCtrl(Obj.all).Change.all;
1162     elsif dispidMember = 1550 then
1163       hr := gb.DispGetParam(pdispparams, 0, gb.VT_DISPATCH, myVariant1'access, u'access);
1164       hr := gb.DispGetParam(pdispparams, 1, gb.VT_BYREF or gb.VT_I4, myVariant2'access, u'access);
1165       SliderCtrl(Obj.all).OLEStartDrag(myVariant1.u.pdispVal, myVariant2.u.lVal'unchecked_access);
1166       hr := gb.VariantClear(myVariant1'access);
1167       hr := gb.VariantClear(myVariant2'access);
1168     elsif dispidMember = 1551 then
1169       hr := gb.DispGetParam(pdispparams, 0, gb.VT_BYREF or gb.VT_I4, myVariant1'access, u'access);
1170       hr := gb.DispGetParam(pdispparams, 1, gb.VT_BYREF or gb.VT_BOOL, myVariant2'access, u'access);
1171       SliderCtrl(Obj.all).OLEGiveFeedback(myVariant1.u.lVal'unchecked_access, myVariant2.u.bool'unchecked_access);
1172       hr := gb.VariantClear(myVariant1'access);
1173       hr := gb.VariantClear(myVariant2'access);
1174     elsif dispidMember = 1552 then
1175       hr := gb.DispGetParam(pdispparams, 0, gb.VT_DISPATCH, myVariant1'access, u'access);
1176       hr := gb.DispGetParam(pdispparams, 1, gb.VT_BYREF or gb.VT_I2, myVariant2'access, u'access);
1177       SliderCtrl(Obj.all).OLESetData(myVariant1.u.pdispVal, myVariant2.u.iVal'unchecked_access);
1178       hr := gb.VariantClear(myVariant1'access);
1179       hr := gb.VariantClear(myVariant2'access);
1180     elsif dispidMember = 1553 then
1181       hr := gb.DispGetParam(pdispparams, 0, gb.VT_BYREF or gb.VT_I4, myVariant1'access, u'access);
1182       SliderCtrl(Obj.all).OLECompleteDrag(myVariant1.u.lVal'unchecked_access);
1183       hr := gb.VariantClear(myVariant1'access);
1184     elsif dispidMember = 1554 then
1185       hr := gb.DispGetParam(pdispparams, 0, gb.VT_DISPATCH, myVariant1'access, u'access);
1186       hr := gb.DispGetParam(pdispparams, 1, gb.VT_BYREF or gb.VT_I4, myVariant2'access, u'access);
1187       hr := gb.DispGetParam(pdispparams, 2, gb.VT_BYREF or gb.VT_I2, myVariant3'access, u'access);
1188       hr := gb.DispGetParam(pdispparams, 3, gb.VT_BYREF or gb.VT_I2, myVariant4'access, u'access);
1189       hr := gb.DispGetParam(pdispparams, 4, gb.VT_BYREF or gb.VT_R4, myVariant5'access, u'access);
1190       hr := gb.DispGetParam(pdispparams, 5, gb.VT_BYREF or gb.VT_R4, myVariant6'access, u'access);
1191       hr := gb.DispGetParam(pdispparams, 6, gb.VT_BYREF or gb.VT_I2, myVariant7'access, u'access);
1192       SliderCtrl(Obj.all).OLEDragOver(myVariant1.u.pdispVal, myVariant2.u.lVal'unchecked_access,
1193         myVariant3.u.iVal'unchecked_access, myVariant4.u.iVal'unchecked_access, myVariant5.u.fltVal'unchecked_access,
1194         myVariant6.u.fltVal'unchecked_access, myVariant7.u.iVal'unchecked_access);
1195       hr := gb.VariantClear(myVariant1'access);
1196       hr := gb.VariantClear(myVariant2'access);
1197       hr := gb.VariantClear(myVariant3'access);
1198       hr := gb.VariantClear(myVariant4'access);
1199       hr := gb.VariantClear(myVariant5'access);
1200       hr := gb.VariantClear(myVariant6'access);
1201       hr := gb.VariantClear(myVariant7'access);
1202     elsif dispidMember = 1555 then
1203       hr := gb.DispGetParam(pdispparams, 0, gb.VT_DISPATCH, myVariant1'access, u'access);
1204       hr := gb.DispGetParam(pdispparams, 1, gb.VT_BYREF or gb.VT_I4, myVariant2'access, u'access);
1205       hr := gb.DispGetParam(pdispparams, 2, gb.VT_BYREF or gb.VT_I2, myVariant3'access, u'access);
1206       hr := gb.DispGetParam(pdispparams, 3, gb.VT_BYREF or gb.VT_I2, myVariant4'access, u'access);
1207       hr := gb.DispGetParam(pdispparams, 4, gb.VT_BYREF or gb.VT_R4, myVariant5'access, u'access);
1208       hr := gb.DispGetParam(pdispparams, 5, gb.VT_BYREF or gb.VT_R4, myVariant6'access, u'access);
1209       SliderCtrl(Obj.all).OLEDragDrop(myVariant1.u.pdispVal, myVariant2.u.lVal'unchecked_access,
1210         myVariant3.u.iVal'unchecked_access, myVariant4.u.iVal'unchecked_access, myVariant5.u.fltVal'unchecked_access,
1211         myVariant6.u.fltVal'unchecked_access);
1212       hr := gb.VariantClear(myVariant1'access);
1213       hr := gb.VariantClear(myVariant2'access);
1214       hr := gb.VariantClear(myVariant3'access);
1215       hr := gb.VariantClear(myVariant4'access);
1216       hr := gb.VariantClear(myVariant5'access);
1217       hr := gb.VariantClear(myVariant6'access);
1218     end if;
1219   end DispatchEvent_Proc;
1220
1221   procedure Initialize(Obj : in out SliderCtrl) is
1222   begin
1223     Obj.i_DispatchEvent := DispatchEvent_Proc'access;
1224     Obj.i_ProgID(1..21) := gb.To_OleChar("MSComctlLib.Slider.2");
1225     Obj.i_EventDispatchIID(1..39) := gb.To_OleChar("{F08DF953-8592-11D1-B16A-00C0F0283628}");
1226   end Initialize;
1227
1228   -- ######  Events  ######
1229   procedure Click_Proc is
1230   begin
1231     null;
1232   end Click_Proc;
1233
1234   procedure KeyDown_Proc(KeyCode : gb.PSHORT; Shift : gb.SHORT) is
1235   begin
1236     null;
1237   end KeyDown_Proc;
1238
1239   procedure KeyPress_Proc(KeyAscii : gb.PSHORT) is
1240   begin
1241     null;
1242   end KeyPress_Proc;
1243
1244   procedure KeyUp_Proc(KeyCode : gb.PSHORT; Shift : gb.SHORT) is
1245   begin
1246     null;
1247   end KeyUp_Proc;
1248
1249   procedure MouseDown_Proc(Button : gb.SHORT; Shift : gb.SHORT;
1250         x : gb.LONG; y : gb.LONG) is
1251   begin
1252     null;
1253   end MouseDown_Proc;
1254
1255   procedure MouseMove_Proc(Button : gb.SHORT; Shift : gb.SHORT;
1256         x : gb.LONG; y : gb.LONG) is
1257   begin
1258     null;
1259   end MouseMove_Proc;
1260
1261   procedure MouseUp_Proc(Button : gb.SHORT; Shift : gb.SHORT;
1262         x : gb.LONG; y : gb.LONG) is
1263   begin
1264     null;
1265   end MouseUp_Proc;
1266
1267   procedure Scroll_Proc is
1268   begin
1269     null;
1270   end Scroll_Proc;
1271
1272   procedure Change_Proc is
1273   begin
1274     null;
1275   end Change_Proc;
1276
1277   procedure OLEStartDrag_Proc(Data : gb.LPDISPATCH; AllowedEffects : gb.PLONG) is
1278   begin
1279     null;
1280   end OLEStartDrag_Proc;
1281
1282   procedure OLEGiveFeedback_Proc(Effect : gb.PLONG; DefaultCursors : gb.PVARIANT_BOOL) is
1283   begin
1284     null;
1285   end OLEGiveFeedback_Proc;
1286
1287   procedure OLESetData_Proc(Data : gb.LPDISPATCH; DataFormat : gb.PSHORT) is
1288   begin
1289     null;
1290   end OLESetData_Proc;
1291
1292   procedure OLECompleteDrag_Proc(Effect : gb.PLONG) is
1293   begin
1294     null;
1295   end OLECompleteDrag_Proc;
1296
1297   procedure OLEDragOver_Proc(Data : gb.LPDISPATCH; Effect : gb.PLONG;
1298         Button : gb.PSHORT; Shift : gb.PSHORT; x : gb.PFLOAT;
1299         y : gb.PFLOAT; State : gb.PSHORT) is
1300   begin
1301     null;
1302   end OLEDragOver_Proc;
1303
1304   procedure OLEDragDrop_Proc(Data : gb.LPDISPATCH; Effect : gb.PLONG;
1305         Button : gb.PSHORT; Shift : gb.PSHORT; x : gb.PFLOAT;
1306         y : gb.PFLOAT) is
1307   begin
1308     null;
1309   end OLEDragDrop_Proc;
1310
1311 end MSComctlLib_Slider;
1312
1313