PoFGui/MSComCtl2_FlatScrollBar.ada

   1
   2 with gb;
   3
   4 package MSComCtl2_FlatScrollBar is
   5
   6
   7   -- ######  OLEDropConstants{D8898461-742F-11CF-8AEA-00AA00C00905}  ######
   8   -- Accepts no OLE drag/drop operations.
   9   cc2OLEDropNone : constant := 0;
  10   -- Accepts an OLE drag/drop under programmatic control only.
  11   cc2OLEDropManual : constant := 1;
  12
  13   -- ######  DragOverConstants{D8898464-742F-11CF-8AEA-00AA00C00905}  ######
  14   -- Source control dragged into target.
  15   cc2Enter : constant := 0;
  16   -- Source control dragged out of target.
  17   cc2Leave : constant := 1;
  18   -- Source control dragged from one position in target to another.
  19   cc2Over : constant := 2;
  20
  21   -- ######  ClipBoardConstants{D8898462-742F-11CF-8AEA-00AA00C00905}  ######
  22   -- Text (.txt file).
  23   cc2CFText : constant := 1;
  24   -- Bitmap (.bmp file).
  25   cc2CFBitmap : constant := 2;
  26   -- Metafile (.wmf file).
  27   cc2CFMetafile : constant := 3;
  28   -- Device-independent bitmap.
  29   cc2CFDIB : constant := 8;
  30   -- Color palette.
  31   cc2CFPalette : constant := 9;
  32   -- Enhanced metafile (.emf file).
  33   cc2CFEMetafile : constant := 14;
  34   -- Filename list (Microsoft Windows Explorer)
  35   cc2CFFiles : constant := 15;
  36   -- Rich Text Format (.rtf file).
  37   cc2CFRTF : constant := -16639;
  38
  39   -- ######  OLEDropEffectConstants{D8898463-742F-11CF-8AEA-00AA00C00905}  ######
  40   -- No OLE drag/drop operation has taken place/would take place.
  41   cc2OLEDropEffectNone : constant := 0;
  42   -- A mask to indicate that a copy has taken place/would take place.
  43   cc2OLEDropEffectCopy : constant := 1;
  44   -- A mask to indicate that a move has take place/would take place.
  45   cc2OLEDropEffectMove : constant := 2;
  46   -- A mask to indicate that the drop target window has scrolled/would scroll.
  47   cc2OLEDropEffectScroll : constant := -2147483648;
  48
  49   -- ######  ErrorConstants{79311D2C-87C0-11D1-8BE3-0000F8754DA1}  ######
  50   -- Bad file name or number
  51   cc2BadFileNameOrNumber : constant := 52;
  52   -- File not found
  53   cc2FileNotFound : constant := 53;
  54   -- Invalid property value
  55   cc2InvalidPropertyValue : constant := 380;
  56   -- Property cannot be set at run time
  57   cc2SetNotSupportedAtRuntime : constant := 382;
  58   -- Property is read-only
  59   cc2SetNotSupported : constant := 383;
  60   -- Property is write-only
  61   cc2GetNotSupported : constant := 394;
  62   -- DataObject formats list may not be cleared or expanded outside of the OLEStartDrag event
  63   cc2DataObjectLocked : constant := 672;
  64   -- Expected at least one argument.
  65   cc2ExpectedAnArgument : constant := 673;
  66   -- Invalid procedure call
  67   cc2InvalidProcedureCall : constant := 5;
  68   -- Invalid object use
  69   cc2InvalidObjectUse : constant := 425;
  70   -- Specified format doesn't match format of data
  71   cc2WrongClipboardFormat : constant := 461;
  72   -- Illegal recursive invocation of OLE drag and drop
  73   cc2RecursiveOleDrag : constant := 674;
  74   -- Non-intrinsic OLE drag and drop formats used with SetData require Byte
  75   -- array data.  GetData may return more bytes than were given to SetData.
  76   cc2FormatNotByteArray : constant := 675;
  77   -- Requested data was not supplied to the DataObject during the OLESetData event.
  78   cc2DataNotSetForFormat : constant := 676;
  79   -- Internal state of the control has become corrupted
  80   cc2InconsistentObject : constant := 35750;
  81   -- Unable to set property
  82   cc2ErrorDuringSet : constant := 35751;
  83   -- Unable to open AVI file
  84   cc2ErrorOpeningVideo : constant := 35752;
  85   -- Unable to play AVI file
  86   cc2ErrorPlayingVideo : constant := 35753;
  87   -- Must open AVI file first
  88   cc2VideoNotOpen : constant := 35755;
  89   -- Error trying to stop playing AVI file
  90   cc2ErrorStoppingVideo : constant := 35757;
  91   -- Error closing open AVI file
  92   cc2ErrorClosingVideo : constant := 35758;
  93   -- Stop method does not effect AutoPlay property
  94   cc2CantStopAutoPlay : constant := 35759;
  95   -- BuddyControl property must be set first
  96   cc2NoValidBuddyCtl : constant := 35754;
  97   -- AutoBuddy not set, no potential buddy controls found
  98   cc2AutoBuddyNotSet : constant := 35756;
  99   -- BuddyControl must be a separate control within the same container
 100   cc2BuddyNotASibling : constant := 35760;
 101   -- An UpDown control cannot be buddied with another UpDown control
 102   cc2NoUpDownAsBuddy : constant := 35761;
 103   -- An invalid date range was specified.
 104   cc2InvalidRange : constant := 35770;
 105   -- An invalid date was specified for the MaxDate property.
 106   cc2InvalidMaxDate : constant := 35771;
 107   -- An invalid date was specified for the MinDate property.
 108   cc2InvalidMinDate : constant := 35772;
 109   -- A date was specified that does not fall within the MinDate and MaxDate properties.
 110   cc2DateOutOfRange : constant := 35773;
 111   -- A value was specified for the MaxDate property that is lower than the current
 112   -- value of MinDate.
 113   cc2InvalidMaxDateMin : constant := 35774;
 114   -- A value was specified for the MinDate property that is higher than the
 115   -- current value of MaxDate.
 116   cc2InvalidMinDateMax : constant := 35775;
 117   -- A value was specified for MonthRows or MonthColumns that is not between 1 and 12.
 118   cc2InvalidRowColValue : constant := 35776;
 119   -- A value was specified for MonthRows or MonthColumns that would cause the
 120   -- total number of months (i.e. MonthRows * MonthCols) to be greater than 12.
 121   cc2InvalidRowColTotal : constant := 35777;
 122   -- An error occurred in a call to the Windows MonthView control.
 123   cc2MonthViewError : constant := 35778;
 124   -- Can't set Day property when MultiSelect = True.
 125   cc2SetDayMultiSelectOn : constant := 35779;
 126   -- Can't set DayOfWeek property when MultiSelect = True.
 127   cc2SetDayOfWeekMultiSelectOn : constant := 35780;
 128   -- Can't set Month property when MultiSelect = True.
 129   cc2SetMonthMultiSelectOn : constant := 35781;
 130   -- Can't set Week property when MultiSelect = True.
 131   cc2SetWeekMultiSelectOn : constant := 35782;
 132   -- Can't set Year property when MultiSelect = True.
 133   cc2SetYearMultiSelectOn : constant := 35783;
 134   -- Can't set MaxSelCount property when MultiSelect = False.
 135   cc2SetMaxSelCountMultiSelectOff : constant := 35784;
 136   -- Can't set SelEnd property when MultiSelect = False.
 137   cc2SetSelEndMultiSelectOff : constant := 35785;
 138   -- Can't set SelStart property when MultiSelect = False.
 139   cc2SetSelStartMultiSelectOff : constant := 35786;
 140   -- Can't set Value to NULL when CheckBox property = FALSE.
 141   cc2NullValueNotAllowed : constant := 35787;
 142   -- An error occurred in a call to the Windows Date and Time Picker control.
 143   cc2DTPickerError : constant := 35788;
 144   -- Scroll value is out of range.
 145   cc2ScrollValueOutOfRange : constant := 35789;
 146
 147   -- ######  AppearanceConstants{79311D2D-87C0-11D1-8BE3-0000F8754DA1}  ######
 148   -- Flat
 149   cc2Flat : constant := 0;
 150   -- 3D
 151   cc23D : constant := 1;
 152
 153   -- ######  BorderStyleConstants{79311D2E-87C0-11D1-8BE3-0000F8754DA1}  ######
 154   -- None
 155   cc2None : constant := 0;
 156   -- Fixed Single
 157   cc2FixedSingle : constant := 1;
 158
 159   -- ######  MousePointerConstants{79311D2F-87C0-11D1-8BE3-0000F8754DA1}  ######
 160   -- Default
 161   cc2Default : constant := 0;
 162   -- Arrow mouse pointer
 163   cc2Arrow : constant := 1;
 164   -- Cross mouse pointer
 165   cc2Cross : constant := 2;
 166   -- I-Beam mouse pointer
 167   cc2IBeam : constant := 3;
 168   -- Icon mouse pointer
 169   cc2Icon : constant := 4;
 170   -- Size mouse pointer
 171   cc2Size : constant := 5;
 172   -- Size NE SW mouse pointer
 173   cc2SizeNESW : constant := 6;
 174   -- Size N S mouse pointer
 175   cc2SizeNS : constant := 7;
 176   -- Size NW SE mouse pointer
 177   cc2SizeNWSE : constant := 8;
 178   -- Size W E mouse pointer
 179   cc2SizeEW : constant := 9;
 180   -- Up arrow mouse pointer
 181   cc2UpArrow : constant := 10;
 182   -- Hourglass mouse pointer
 183   cc2Hourglass : constant := 11;
 184   -- No drop mouse pointer
 185   cc2NoDrop : constant := 12;
 186   -- Arrow and Hourglass mouse pointer
 187   cc2ArrowHourglass : constant := 13;
 188   -- Arrow and Question mark mouse pointer
 189   cc2ArrowQuestion : constant := 14;
 190   -- Size all mouse pointer
 191   cc2SizeAll : constant := 15;
 192   -- Custom mouse pointer icon specified by the MouseIcon property
 193   cc2Custom : constant := 99;
 194
 195   -- ######  OrientationConstants{603C7E7D-87C2-11D1-8BE3-0000F8754DA1}  ######
 196   -- Vertical
 197   cc2OrientationVertical : constant := 0;
 198   -- Horizontal
 199   cc2OrientationHorizontal : constant := 1;
 200
 201   -- ######  BackStyleConstants{B09DE712-87C1-11D1-8BE3-0000F8754DA1}  ######
 202   -- Transparent
 203   cc2BackstyleTransparent : constant := 0;
 204   -- Opaque
 205   cc2BackstyleOpaque : constant := 1;
 206
 207   -- ######  AlignmentConstants{603C7E7C-87C2-11D1-8BE3-0000F8754DA1}  ######
 208   -- Left Align
 209   cc2AlignmentLeft : constant := 0;
 210   -- Right Align
 211   cc2AlignmentRight : constant := 1;
 212
 213   -- ######  DayConstants{232E4566-87C3-11D1-8BE3-0000F8754DA1}  ######
 214   -- Sunday
 215   mvwSunday : constant := 1;
 216   -- Monday
 217   mvwMonday : constant := 2;
 218   -- Tuesday
 219   mvwTuesday : constant := 3;
 220   -- Wednesday
 221   mvwWednesday : constant := 4;
 222   -- Thursday
 223   mvwThursday : constant := 5;
 224   -- Friday
 225   mvwFriday : constant := 6;
 226   -- Saturday
 227   mvwSaturday : constant := 7;
 228
 229   -- ######  MonthConstants{232E4567-87C3-11D1-8BE3-0000F8754DA1}  ######
 230   -- January
 231   mvwJanuary : constant := 1;
 232   -- February
 233   mvwFebruary : constant := 2;
 234   -- March
 235   mvwMarch : constant := 3;
 236   -- April
 237   mvwApril : constant := 4;
 238   -- May
 239   mvwMay : constant := 5;
 240   -- June
 241   mvwJune : constant := 6;
 242   -- July
 243   mvwJuly : constant := 7;
 244   -- August
 245   mvwAugust : constant := 8;
 246   -- September
 247   mvwSeptember : constant := 9;
 248   -- October
 249   mvwOctober : constant := 10;
 250   -- November
 251   mvwNovember : constant := 11;
 252   -- December
 253   mvwDecember : constant := 12;
 254
 255   -- ######  MonthViewHitTestAreas{232E4568-87C3-11D1-8BE3-0000F8754DA1}  ######
 256   -- Calendar Background
 257   mvwCalendarBack : constant := 0;
 258   -- Calendar Date
 259   mvwCalendarDate : constant := 1;
 260   -- Calendar Date Next Month
 261   mvwCalendarDateNext : constant := 2;
 262   -- Calendar Date Previous Month
 263   mvwCalendarDatePrev : constant := 3;
 264   -- Calendar Day
 265   mvwCalendarDay : constant := 4;
 266   -- Calendar Week Number
 267   mvwCalendarWeekNum : constant := 5;
 268   -- Nowhere
 269   mvwNoWhere : constant := 6;
 270   -- Title Background
 271   mvwTitleBack : constant := 7;
 272   -- Title Button Next
 273   mvwTitleBtnNext : constant := 8;
 274   -- Title Button Previous
 275   mvwTitleBtnPrev : constant := 9;
 276   -- Title Month
 277   mvwTitleMonth : constant := 10;
 278   -- Title Year
 279   mvwTitleYear : constant := 11;
 280   -- Today Link
 281   mvwTodayLink : constant := 12;
 282
 283   -- ######  FormatConstants{20DD1B9C-87C4-11D1-8BE3-0000F8754DA1}  ######
 284   -- Display date in long format, e.g. 'Friday, Sept 2, 1974'.
 285   dtpLongDate : constant := 0;
 286   -- Display date in short format, e.g. '9/2/74'.
 287   dtpShortDate : constant := 1;
 288   -- Display time in standard format, e.g. '5:31:42 PM'.
 289   dtpTime : constant := 2;
 290   -- Display date and time using the format string specified in the 'CustomFormat' property.
 291   dtpCustom : constant := 3;
 292
 293   -- ######  FlatScrollBarAppearanceConstants{FE387535-44A3-11D1-B5B7-0000C09000C4}  ######
 294   -- A normal, non-flat scrollbar is displayed.  No special visual effects are applied.
 295   fsb3D : constant := 0;
 296   -- A standard flat scrollbar is displayed.  When the mouse moves over a direction
 297   -- button or the thumb, that portion of the scrollbar will be displayed in
 298   -- inverted colors.
 299   fsbFlat : constant := 1;
 300   -- A flat scrollbar is displayed.  When the mouse moves over a direction button
 301   -- or the thumb, that portion of the scrollbar will be displayed in 3D.
 302   fsbTrack3D : constant := 2;
 303
 304   -- ######  ArrowsConstants{FE387536-44A3-11D1-B5B7-0000C09000C4}  ######
 305   -- Enables both direction buttons.
 306   cc2Both : constant := 0;
 307   -- Enables only the left or up button, depending on whether the orientation
 308   -- is vertical or horizontal.
 309   cc2LeftUp : constant := 1;
 310   -- Enables only the right or down button, depending on whether the orientation
 311   -- is vertical or horizontal.
 312   cc2RightDown : constant := 2;
 313
 314   -- ######  Events  ######
 315   -- Change:  Occurs when the user causes the Value property of the scroll bar to change.
 316   procedure Change_Proc;
 317   type Change_Access is access procedure;
 318
 319   -- Scroll:  Occurs when the scroll box is being dragged by the user.
 320   procedure Scroll_Proc;
 321   type Scroll_Access is access procedure;
 322
 323   -- ######  Object Declaration  ######
 324   type FlatScrollBarCtrl(Parent : access gb.Object'class) is
 325     new gb.OleControl(Parent) with
 326   record
 327     Change : Change_Access := Change_Proc'access;
 328     Scroll : Scroll_Access := Scroll_Proc'access;
 329   end record;
 330   type FlatScrollBarCtrlRef is access all FlatScrollBarCtrl'class;
 331
 332   procedure Initialize(Obj : in out FlatScrollBarCtrl);
 333
 334   -- ######  Methods  ######
 335   -- QueryInterface
 336   procedure QueryInterface(Obj : FlatScrollBarCtrl; riid : gb.LPDISPATCH; ppvObj : gb.PVOID);
 337
 338   -- AddRef
 339   function AddRef(Obj : FlatScrollBarCtrl) return gb.ULONG;
 340
 341   -- Release
 342   function Release(Obj : FlatScrollBarCtrl) return gb.ULONG;
 343
 344   -- GetTypeInfoCount
 345   procedure GetTypeInfoCount(Obj : FlatScrollBarCtrl; pctinfo : gb.PUINT);
 346
 347   -- GetTypeInfo
 348   procedure GetTypeInfo(Obj : FlatScrollBarCtrl; itinfo : gb.UINT; lcid : gb.ULONG;
 349       pptinfo : gb.PVOID);
 350
 351   -- GetIDsOfNames
 352   procedure GetIDsOfNames(Obj : FlatScrollBarCtrl; riid : gb.LPDISPATCH; rgszNames : gb.PCHAR;
 353       cNames : gb.UINT; lcid : gb.ULONG; rgdispid : gb.PLONG);
 354
 355   -- Invoke
 356   procedure Invoke(Obj : FlatScrollBarCtrl; dispidMember : gb.LONG; riid : gb.LPDISPATCH;
 357       lcid : gb.ULONG; wFlags : gb.USHORT; pdispparams : gb.LPDISPATCH;
 358       pvarResult : gb.LPVARIANT; pexcepinfo : gb.LPDISPATCH; puArgErr : gb.PUINT);
 359
 360   -- Appearance:  Returns/sets whether or not controls, Forms or an MDIForm
 361   -- are painted at run time with 3-D effects.
 362   function Appearance(Obj : FlatScrollBarCtrl) return gb.INT;
 363
 364   -- Appearance:  Returns/sets whether or not controls, Forms or an MDIForm
 365   -- are painted at run time with 3-D effects.
 366   procedure Appearance(Obj : FlatScrollBarCtrl; Param1 : gb.INT);
 367
 368   -- Arrows:  Returns/sets which direction buttons will be enabled.
 369   function Arrows(Obj : FlatScrollBarCtrl) return gb.INT;
 370
 371   -- Arrows:  Returns/sets which direction buttons will be enabled.
 372   procedure Arrows(Obj : FlatScrollBarCtrl; Param1 : gb.INT);
 373
 374   -- Enabled:  Returns/sets a value that determines whether a form or control
 375   -- can respond to user-generated events.
 376   function Enabled(Obj : FlatScrollBarCtrl) return gb.BOOL;
 377
 378   -- Enabled:  Returns/sets a value that determines whether a form or control
 379   -- can respond to user-generated events.
 380   procedure Enabled(Obj : FlatScrollBarCtrl; Param1 : gb.BOOL);
 381
 382   -- hWnd:  Returns a handle to a form or control.
 383   function hWnd(Obj : FlatScrollBarCtrl) return gb.INT;
 384
 385   -- hWnd:  Returns a handle to a form or control.
 386   procedure hWnd(Obj : FlatScrollBarCtrl; Param1 : gb.INT);
 387
 388   -- LargeChange:  Returns/sets a value that determines the amount of change
 389   -- to the Value property when the user clicks the area between the scroll
 390   -- box and the scroll arrow.
 391   function LargeChange(Obj : FlatScrollBarCtrl) return gb.SHORT;
 392
 393   -- LargeChange:  Returns/sets a value that determines the amount of change
 394   -- to the Value property when the user clicks the area between the scroll
 395   -- box and the scroll arrow.
 396   procedure LargeChange(Obj : FlatScrollBarCtrl; Param1 : gb.SHORT);
 397
 398   -- Min:  Returns/sets the scrollbar's minimum Value property setting.
 399   function Min(Obj : FlatScrollBarCtrl) return gb.SHORT;
 400
 401   -- Min:  Returns/sets the scrollbar's minimum Value property setting.
 402   procedure Min(Obj : FlatScrollBarCtrl; Param1 : gb.SHORT);
 403
 404   -- Max:  Returns/sets the scrollbar's maximum Value property setting.
 405   function Max(Obj : FlatScrollBarCtrl) return gb.SHORT;
 406
 407   -- Max:  Returns/sets the scrollbar's maximum Value property setting.
 408   procedure Max(Obj : FlatScrollBarCtrl; Param1 : gb.SHORT);
 409
 410   -- MouseIcon:  Sets a custom mouse icon.
 411   function MouseIcon(Obj : FlatScrollBarCtrl) return gb.LPDISPATCH;
 412
 413   -- MouseIcon:  Sets a custom mouse icon.
 414   procedure MouseIcon(Obj : FlatScrollBarCtrl; Param1 : gb.LPDISPATCH);
 415
 416   -- MousePointer:  Returns/sets the type of mouse pointer displayed when over
 417   -- part of an object.
 418   function MousePointer(Obj : FlatScrollBarCtrl) return gb.INT;
 419
 420   -- MousePointer:  Returns/sets the type of mouse pointer displayed when over
 421   -- part of an object.
 422   procedure MousePointer(Obj : FlatScrollBarCtrl; Param1 : gb.INT);
 423
 424   -- Orientation:  Returns/sets a value that determines whether the scrollbar
 425   -- is vertical or horizontal.
 426   function Orientation(Obj : FlatScrollBarCtrl) return gb.INT;
 427
 428   -- Orientation:  Returns/sets a value that determines whether the scrollbar
 429   -- is vertical or horizontal.
 430   procedure Orientation(Obj : FlatScrollBarCtrl; Param1 : gb.INT);
 431
 432   -- SmallChange:  Returns/sets a value that determines the amount of change
 433   -- to the Value property when the user clicks a scroll arrow.
 434   function SmallChange(Obj : FlatScrollBarCtrl) return gb.SHORT;
 435
 436   -- SmallChange:  Returns/sets a value that determines the amount of change
 437   -- to the Value property when the user clicks a scroll arrow.
 438   procedure SmallChange(Obj : FlatScrollBarCtrl; Param1 : gb.SHORT);
 439
 440   -- Value:  Returns/sets the current position of the scroll bar.
 441   function Value(Obj : FlatScrollBarCtrl) return gb.SHORT;
 442
 443   -- Value:  Returns/sets the current position of the scroll bar.
 444   procedure Value(Obj : FlatScrollBarCtrl; Param1 : gb.SHORT);
 445
 446   -- AboutBox
 447   procedure AboutBox(Obj : FlatScrollBarCtrl);
 448
 449   -- Refresh:  Forces a complete repaint of a form or control.
 450   procedure Refresh(Obj : FlatScrollBarCtrl);
 451
 452 end MSComCtl2_FlatScrollBar;
 453
 454
 455 package body MSComCtl2_FlatScrollBar is
 456
 457   pragma Suppress(Discriminant_Check);
 458
 459   use type gb.DISPID;
 460   use type gb.VARTYPE;
 461
 462   -- ######  Methods  ######
 463   procedure QueryInterface(Obj : FlatScrollBarCtrl; riid : gb.LPDISPATCH; ppvObj : gb.PVOID) is
 464     myVariants : array (1..2) of gb.Variant;
 465   begin
 466     myVariants(2) := (gb.VT_DISPATCH, 0, 0, 0, (gb.VT_DISPATCH, riid));
 467     myVariants(1) := (gb.VT_BYREF or gb.VT_VOID, 0, 0, 0, (gb.VT_BYREF or gb.VT_VOID, ppvObj));
 468     gb.DoMethod(Obj, 1610612736, 1, 2, gb.Convert(myVariants'address));
 469   end QueryInterface;
 470
 471   function AddRef(Obj : FlatScrollBarCtrl) return gb.ULONG is
 472     myResult   : aliased gb.Variant;
 473   begin
 474     gb.DoMethod(Obj, 1610612737, 1, 0, null, myResult'unchecked_access);
 475     return myResult.u.ulVal;
 476   end AddRef;
 477
 478   function Release(Obj : FlatScrollBarCtrl) return gb.ULONG is
 479     myResult   : aliased gb.Variant;
 480   begin
 481     gb.DoMethod(Obj, 1610612738, 1, 0, null, myResult'unchecked_access);
 482     return myResult.u.ulVal;
 483   end Release;
 484
 485   procedure GetTypeInfoCount(Obj : FlatScrollBarCtrl; pctinfo : gb.PUINT) is
 486     myVariants : array (1..1) of gb.Variant;
 487   begin
 488     myVariants(1) := (gb.VT_BYREF or gb.VT_UINT, 0, 0, 0, (gb.VT_BYREF or gb.VT_UINT, pctinfo));
 489     gb.DoMethod(Obj, 1610678272, 1, 1, gb.Convert(myVariants'address));
 490   end GetTypeInfoCount;
 491
 492   procedure GetTypeInfo(Obj : FlatScrollBarCtrl; itinfo : gb.UINT; lcid : gb.ULONG;
 493       pptinfo : gb.PVOID) is
 494     myVariants : array (1..3) of gb.Variant;
 495   begin
 496     myVariants(3) := (gb.VT_UINT, 0, 0, 0, (gb.VT_UINT, itinfo));
 497     myVariants(2) := (gb.VT_UI4, 0, 0, 0, (gb.VT_UI4, lcid));
 498     myVariants(1) := (gb.VT_BYREF or gb.VT_VOID, 0, 0, 0, (gb.VT_BYREF or gb.VT_VOID, pptinfo));
 499     gb.DoMethod(Obj, 1610678273, 1, 3, gb.Convert(myVariants'address));
 500   end GetTypeInfo;
 501
 502   procedure GetIDsOfNames(Obj : FlatScrollBarCtrl; riid : gb.LPDISPATCH; rgszNames : gb.PCHAR;
 503       cNames : gb.UINT; lcid : gb.ULONG; rgdispid : gb.PLONG) is
 504     myVariants : array (1..5) of gb.Variant;
 505   begin
 506     myVariants(5) := (gb.VT_DISPATCH, 0, 0, 0, (gb.VT_DISPATCH, riid));
 507     myVariants(4) := (gb.VT_BYREF or gb.VT_I1, 0, 0, 0, (gb.VT_BYREF or gb.VT_I1, rgszNames));
 508     myVariants(3) := (gb.VT_UINT, 0, 0, 0, (gb.VT_UINT, cNames));
 509     myVariants(2) := (gb.VT_UI4, 0, 0, 0, (gb.VT_UI4, lcid));
 510     myVariants(1) := (gb.VT_BYREF or gb.VT_I4, 0, 0, 0, (gb.VT_BYREF or gb.VT_I4, rgdispid));
 511     gb.DoMethod(Obj, 1610678274, 1, 5, gb.Convert(myVariants'address));
 512   end GetIDsOfNames;
 513
 514   procedure Invoke(Obj : FlatScrollBarCtrl; dispidMember : gb.LONG; riid : gb.LPDISPATCH;
 515       lcid : gb.ULONG; wFlags : gb.USHORT; pdispparams : gb.LPDISPATCH;
 516       pvarResult : gb.LPVARIANT; pexcepinfo : gb.LPDISPATCH; puArgErr : gb.PUINT) is
 517     myVariants : array (1..8) of gb.Variant;
 518   begin
 519     myVariants(8) := (gb.VT_I4, 0, 0, 0, (gb.VT_I4, dispidMember));
 520     myVariants(7) := (gb.VT_DISPATCH, 0, 0, 0, (gb.VT_DISPATCH, riid));
 521     myVariants(6) := (gb.VT_UI4, 0, 0, 0, (gb.VT_UI4, lcid));
 522     myVariants(5) := (gb.VT_UI2, 0, 0, 0, (gb.VT_UI2, wFlags));
 523     myVariants(4) := (gb.VT_DISPATCH, 0, 0, 0, (gb.VT_DISPATCH, pdispparams));
 524     myVariants(3) := pvarResult.all;
 525     myVariants(2) := (gb.VT_DISPATCH, 0, 0, 0, (gb.VT_DISPATCH, pexcepinfo));
 526     myVariants(1) := (gb.VT_BYREF or gb.VT_UINT, 0, 0, 0, (gb.VT_BYREF or gb.VT_UINT, puArgErr));
 527     gb.DoMethod(Obj, 1610678275, 1, 8, gb.Convert(myVariants'address));
 528   end Invoke;
 529
 530   function Appearance(Obj : FlatScrollBarCtrl) return gb.INT is
 531     myResult   : aliased gb.Variant;
 532   begin
 533     gb.DoMethod(Obj, 1, 2, 0, null, myResult'unchecked_access);
 534     return myResult.u.intVal;
 535   end Appearance;
 536
 537   procedure Appearance(Obj : FlatScrollBarCtrl; Param1 : gb.INT) is
 538     myVariants : array (1..1) of gb.Variant;
 539   begin
 540     myVariants(1) := (gb.VT_INT, 0, 0, 0, (gb.VT_INT, Param1));
 541     gb.DoMethod(Obj, 1, 4, 1, gb.Convert(myVariants'address));
 542   end Appearance;
 543
 544   function Arrows(Obj : FlatScrollBarCtrl) return gb.INT is
 545     myResult   : aliased gb.Variant;
 546   begin
 547     gb.DoMethod(Obj, 2, 2, 0, null, myResult'unchecked_access);
 548     return myResult.u.intVal;
 549   end Arrows;
 550
 551   procedure Arrows(Obj : FlatScrollBarCtrl; Param1 : gb.INT) is
 552     myVariants : array (1..1) of gb.Variant;
 553   begin
 554     myVariants(1) := (gb.VT_INT, 0, 0, 0, (gb.VT_INT, Param1));
 555     gb.DoMethod(Obj, 2, 4, 1, gb.Convert(myVariants'address));
 556   end Arrows;
 557
 558   function Enabled(Obj : FlatScrollBarCtrl) return gb.BOOL is
 559     myResult   : aliased gb.Variant;
 560   begin
 561     gb.DoMethod(Obj, -514, 2, 0, null, myResult'unchecked_access);
 562     return gb.Convert(myResult.u.bool);
 563   end Enabled;
 564
 565   procedure Enabled(Obj : FlatScrollBarCtrl; Param1 : gb.BOOL) is
 566     myVariants : array (1..1) of gb.Variant;
 567   begin
 568     myVariants(1) := (gb.VT_BOOL, 0, 0, 0, (gb.VT_BOOL, gb.Convert(Param1)));
 569     gb.DoMethod(Obj, -514, 4, 1, gb.Convert(myVariants'address));
 570   end Enabled;
 571
 572   function hWnd(Obj : FlatScrollBarCtrl) return gb.INT is
 573     myResult   : aliased gb.Variant;
 574   begin
 575     gb.DoMethod(Obj, -515, 2, 0, null, myResult'unchecked_access);
 576     return myResult.u.intVal;
 577   end hWnd;
 578
 579   procedure hWnd(Obj : FlatScrollBarCtrl; Param1 : gb.INT) is
 580     myVariants : array (1..1) of gb.Variant;
 581   begin
 582     myVariants(1) := (gb.VT_INT, 0, 0, 0, (gb.VT_INT, Param1));
 583     gb.DoMethod(Obj, -515, 4, 1, gb.Convert(myVariants'address));
 584   end hWnd;
 585
 586   function LargeChange(Obj : FlatScrollBarCtrl) return gb.SHORT is
 587     myResult   : aliased gb.Variant;
 588   begin
 589     gb.DoMethod(Obj, 3, 2, 0, null, myResult'unchecked_access);
 590     return myResult.u.iVal;
 591   end LargeChange;
 592
 593   procedure LargeChange(Obj : FlatScrollBarCtrl; Param1 : gb.SHORT) is
 594     myVariants : array (1..1) of gb.Variant;
 595   begin
 596     myVariants(1) := (gb.VT_I2, 0, 0, 0, (gb.VT_I2, Param1));
 597     gb.DoMethod(Obj, 3, 4, 1, gb.Convert(myVariants'address));
 598   end LargeChange;
 599
 600   function Min(Obj : FlatScrollBarCtrl) return gb.SHORT is
 601     myResult   : aliased gb.Variant;
 602   begin
 603     gb.DoMethod(Obj, 4, 2, 0, null, myResult'unchecked_access);
 604     return myResult.u.iVal;
 605   end Min;
 606
 607   procedure Min(Obj : FlatScrollBarCtrl; Param1 : gb.SHORT) is
 608     myVariants : array (1..1) of gb.Variant;
 609   begin
 610     myVariants(1) := (gb.VT_I2, 0, 0, 0, (gb.VT_I2, Param1));
 611     gb.DoMethod(Obj, 4, 4, 1, gb.Convert(myVariants'address));
 612   end Min;
 613
 614   function Max(Obj : FlatScrollBarCtrl) return gb.SHORT is
 615     myResult   : aliased gb.Variant;
 616   begin
 617     gb.DoMethod(Obj, 5, 2, 0, null, myResult'unchecked_access);
 618     return myResult.u.iVal;
 619   end Max;
 620
 621   procedure Max(Obj : FlatScrollBarCtrl; Param1 : gb.SHORT) is
 622     myVariants : array (1..1) of gb.Variant;
 623   begin
 624     myVariants(1) := (gb.VT_I2, 0, 0, 0, (gb.VT_I2, Param1));
 625     gb.DoMethod(Obj, 5, 4, 1, gb.Convert(myVariants'address));
 626   end Max;
 627
 628   function MouseIcon(Obj : FlatScrollBarCtrl) return gb.LPDISPATCH is
 629     myResult   : aliased gb.Variant;
 630   begin
 631     gb.DoMethod(Obj, 6, 2, 0, null, myResult'unchecked_access);
 632     return myResult.u.pdispVal;
 633   end MouseIcon;
 634
 635   procedure MouseIcon(Obj : FlatScrollBarCtrl; Param1 : gb.LPDISPATCH) is
 636     myVariants : array (1..1) of gb.Variant;
 637   begin
 638     myVariants(1) := (gb.VT_DISPATCH, 0, 0, 0, (gb.VT_DISPATCH, Param1));
 639     gb.DoMethod(Obj, 6, 4, 1, gb.Convert(myVariants'address));
 640   end MouseIcon;
 641
 642   function MousePointer(Obj : FlatScrollBarCtrl) return gb.INT is
 643     myResult   : aliased gb.Variant;
 644   begin
 645     gb.DoMethod(Obj, 7, 2, 0, null, myResult'unchecked_access);
 646     return myResult.u.intVal;
 647   end MousePointer;
 648
 649   procedure MousePointer(Obj : FlatScrollBarCtrl; Param1 : gb.INT) is
 650     myVariants : array (1..1) of gb.Variant;
 651   begin
 652     myVariants(1) := (gb.VT_INT, 0, 0, 0, (gb.VT_INT, Param1));
 653     gb.DoMethod(Obj, 7, 4, 1, gb.Convert(myVariants'address));
 654   end MousePointer;
 655
 656   function Orientation(Obj : FlatScrollBarCtrl) return gb.INT is
 657     myResult   : aliased gb.Variant;
 658   begin
 659     gb.DoMethod(Obj, 8, 2, 0, null, myResult'unchecked_access);
 660     return myResult.u.intVal;
 661   end Orientation;
 662
 663   procedure Orientation(Obj : FlatScrollBarCtrl; Param1 : gb.INT) is
 664     myVariants : array (1..1) of gb.Variant;
 665   begin
 666     myVariants(1) := (gb.VT_INT, 0, 0, 0, (gb.VT_INT, Param1));
 667     gb.DoMethod(Obj, 8, 4, 1, gb.Convert(myVariants'address));
 668   end Orientation;
 669
 670   function SmallChange(Obj : FlatScrollBarCtrl) return gb.SHORT is
 671     myResult   : aliased gb.Variant;
 672   begin
 673     gb.DoMethod(Obj, 9, 2, 0, null, myResult'unchecked_access);
 674     return myResult.u.iVal;
 675   end SmallChange;
 676
 677   procedure SmallChange(Obj : FlatScrollBarCtrl; Param1 : gb.SHORT) is
 678     myVariants : array (1..1) of gb.Variant;
 679   begin
 680     myVariants(1) := (gb.VT_I2, 0, 0, 0, (gb.VT_I2, Param1));
 681     gb.DoMethod(Obj, 9, 4, 1, gb.Convert(myVariants'address));
 682   end SmallChange;
 683
 684   function Value(Obj : FlatScrollBarCtrl) return gb.SHORT is
 685     myResult   : aliased gb.Variant;
 686   begin
 687     gb.DoMethod(Obj, 10, 2, 0, null, myResult'unchecked_access);
 688     return myResult.u.iVal;
 689   end Value;
 690
 691   procedure Value(Obj : FlatScrollBarCtrl; Param1 : gb.SHORT) is
 692     myVariants : array (1..1) of gb.Variant;
 693   begin
 694     myVariants(1) := (gb.VT_I2, 0, 0, 0, (gb.VT_I2, Param1));
 695     gb.DoMethod(Obj, 10, 4, 1, gb.Convert(myVariants'address));
 696   end Value;
 697
 698   procedure AboutBox(Obj : FlatScrollBarCtrl) is
 699   begin
 700     gb.DoMethod(Obj, -552, 1);
 701   end AboutBox;
 702
 703   procedure Refresh(Obj : FlatScrollBarCtrl) is
 704   begin
 705     gb.DoMethod(Obj, -550, 1);
 706   end Refresh;
 707
 708   -- ######  Event Dispatch  ######
 709   procedure DispatchEvent_Proc(Obj : gb.OleControlRef; dispidMember : gb.DISPID;
 710       pdispparams : access gb.DISPPARAMS) is
 711     hr         : gb.HRESULT;
 712     u          : aliased gb.UINT;
 713   begin
 714     if dispidMember = 1 then
 715       FlatScrollBarCtrl(Obj.all).Change.all;
 716     elsif dispidMember = 2 then
 717       FlatScrollBarCtrl(Obj.all).Scroll.all;
 718     end if;
 719   end DispatchEvent_Proc;
 720
 721   procedure Initialize(Obj : in out FlatScrollBarCtrl) is
 722   begin
 723     Obj.i_DispatchEvent := DispatchEvent_Proc'access;
 724     Obj.i_ProgID(1..26) := gb.To_OleChar("MSComCtl2.FlatScrollBar.2");
 725     Obj.i_EventDispatchIID(1..39) := gb.To_OleChar("{FE387539-44A3-11D1-B5B7-0000C09000C4}");
 726   end Initialize;
 727
 728   -- ######  Events  ######
 729   procedure Change_Proc is
 730   begin
 731     null;
 732   end Change_Proc;
 733
 734   procedure Scroll_Proc is
 735   begin
 736     null;
 737   end Scroll_Proc;
 738
 739 end MSComCtl2_FlatScrollBar;
 740
 741