controls/updown/KOLMHUpDown.pas

   1 unit KOLMHUpDown;
   2 {* TKOLMHUpDown object}
   3 //  MHUpDown Êîìïîíåíò (MHUpDown Component)
   4 //  Àâòîð (Author): Æàðîâ Äìèòðèé (Zharov Dmitry) aka Ãýíäàëüô (Gandalf)
   5 //  Äàòà ñîçäàíèÿ (Create date): 26-àïð(apr)-2002
   6 //  Äàòà êîððåêöèè (Last correction Date): 5-àâã(aug)-2003
   7 //  Âåðñèÿ (Version): 1.31
   8 //  EMail: Gandalf@kol.mastak.ru
   9 //  WWW: http://kol.mastak.ru
  10 //  Áëàãîäàðíîñòè (Thanks):
  11 //    Alexander Pravdin
  12 //    Bogus³aw Brandys
  13 //    dominiko-m
  14 //  Íîâîå â (New in):
  15 //
  16 //  V1.31
  17 //  [!] Èñïðàâëåíî "îòúåäàíèå" Buddy (Buddy "eating" FIX) <Great Thanks to dominiko-m> [MCK]
  18 //
  19 //  V1.3
  20 //  [*] Ïîääåðæêà KOLWrapper âèçóàëèçàöèè (KOLWrapper visualition support) [MCK]
  21 //
  22 //  V1.22
  23 //  [!] Ñîâìåñòèìîñòü ñ Õèíòàìè (ToolTips compatability) [KOL]
  24 //
  25 //  V1.21
  26 //  [!] Ïîääåðæêà D7 (D7 Support) [KOLnMCK]
  27 //
  28 //  V1.2
  29 //  [!] Èñïðàâëåíà îøèáêà BuddySize (Fix BuddySize) [MCK]
  30 //
  31 //  V1.1
  32 //  [!] Èñïðàâëåíèÿ Buddy (Fixed Buddy) <Great Thanks to Alexander Pravdin> [MCK]
  33 //  [!] Èñïðàâëåíà îøèáêà Increment=0 (Increment=0 bug fixed) <Great Thanks to Alexander Pravdin> [MCK]
  34 //  [-] Íàéäåíà îøèáêà BuddySize (Bug BuddySize found) [MCK]
  35 //
  36 //  V1.0
  37 //  [+~] Ñîáûòèå OnChangingEx (OnChangingEx event) <Thanks to Bogus³aw Brandys> [KOLnMCK]
  38 //  [+~] Ñâîéñòâî Increment (Increment property) <Thanks to Bogus³aw Brandys> [KOLnMCK]
  39 //  [*] Òåïåðü ïîääåðæèâàþòñÿ 32áèò çíà÷åíèÿ Position (32bit position support now) [KOLnMCK]
  40 //
  41 //  V0.9
  42 //  [+] Ïîääåðæêà D6 (D6 Support) <Thanks to Alexander Pravdin> [KOLnMCK]
  43 //  [+++] Î÷åíü ìíîãî (Very much) [KOLnMCK]
  44 //
  45 //  V0.4
  46 //  +Add Recreate
  47 //  +Optimize Visible (may usefull for all KOL)
  48 //  +Fix Double (KOL)
  49 //  +Add HotTrack
  50 //  +Add BuddyInteger
  51 //  +Add ButtonAlign
  52 //  +Add AutoBuddy
  53 //  +Add Wrap Better
  54 //  +Add Thousands Better
  55 //  +Add ArrowKeys
  56 //  +Add Orient Better
  57 //  -Some Bug Buddy (Buddy Object Become smaller, and YourSelf can't be Buddy)
  58 //  V0.21
  59 //  +Add Updata Paint (for KOLnMCK 1.30)
  60 //  +Add Improve Paint
  61 //  V0.20
  62 //  +Add Enabled
  63 //  +Add EraseBgr
  64 //  +Add Tag
  65 //  V0.19
  66 //  +Add HexBase
  67 //  +Add OnMove
  68 //  +Add OnFileDrop
  69 //  +Add OnPaint
  70 //  V0.18
  71 //  +Add OnMouseMove
  72 //  +Add OnMouseUp
  73 //  +Add OnMouseDown
  74 //  +Add OnMouseLeave
  75 //  +Add OnMouseEnter
  76 //  +Add OnResize
  77 //  +Add OnHide
  78 //  +Add OnShow
  79 //  V0.17
  80 //  +Add Buddy
  81 //  +Add Default Values
  82 //  V0.15
  83 //  +Add Better Paint
  84 //  V0.1
  85 //  +Add OnScroll
  86 //  +Add so-so Paint (MCK)
  87 //  +Add Min/Max/Position/Wrap/Orientation/Thousands
  88 //  +Add Cursor
  89 //  +Add Visible
  90 //
  91 //  Ñïèñîê äåë (To-Do list):
  92 //  1. Àññåìáëåð (Asm)
  93 //  2. Îïòèìèçèðîâàòü (Optimize)
  94 //  3. Îøèáêè (Errors)
  95 //  4. Ñîáûòèÿ (Events)
  96 //  5. Ñïðàâêà (Help)
  97
  98 interface
  99 uses
 100   KOL, Windows, Messages {, KOLMHToolTip};
 101
 102 const
 103   REFRESH_PERIOD: Cardinal = 1;
 104   {* Amount of elapsed time, in seconds, before the position
 105   change increment is used.}
 106
 107 type
 108   TUpDownAlignButton = (udLeft, udRight);
 109   {*}
 110   TUpDownOrientation = (udHorizontal, udVertical);
 111   {*}
 112   TUpDownDirection = (updNone, updUp, updDown);
 113   {*}
 114   TOnChangingEx = procedure(Sender: PObj; var Allow: Boolean; NewValue:
 115     SmallInt; Direction: TUpDownDirection) of object;
 116   {*}
 117
 118 type
 119   NM_UPDOWN = packed record
 120     hdr: TNMHDR;
 121     iPos: Integer;
 122     iDelta: Integer;
 123   end;
 124   TNMUpDown = NM_UPDOWN;
 125   PNMUpDown = ^TNMUpDown;
 126
 127 type
 128   UDACCEL = packed record
 129     nSec: UINT;
 130     nInc: UINT;
 131   end;
 132   TUDAccel = UDACCEL;
 133   PUDAccel = ^TUDAccel;
 134
 135   PMHUpDown = ^TMHUpDown;
 136   TKOLMHUpDown = PMHUpDown;
 137   TMHUpDown = object(TControl)
 138     {*}
 139   private
 140     function GetHexBase: Boolean;
 141     procedure SetHexBase(const Value: Boolean);
 142
 143     function GetBuddy: HWnd;
 144     procedure SetBuddy(const Value: HWnd);
 145
 146     procedure SetMin(const Value: Integer);
 147     function GetMin: Integer;
 148
 149     procedure SetMax(const Value: Integer);
 150     function GetMax: Integer;
 151
 152     procedure SetPosition(const Value: Integer);
 153     function GetPosition: Integer;
 154
 155     procedure SetIncrement(const Value: Integer);
 156     function GetIncrement: Integer;
 157
 158     procedure SetOnChangingEx(const Value: TOnChangingEx);
 159     function GetOnChangingEx: TOnChangingEx;
 160
 161     function GetOrientation: TUpDownOrientation;
 162
 163     function GetArrowKeys: Boolean;
 164
 165     function GetAlignButton: TUpDownAlignButton;
 166
 167     function GetAutoBuddy: Boolean;
 168
 169     function GetThousands: Boolean;
 170
 171     function GetWrap: Boolean;
 172
 173     function GetHotTrack: Boolean;
 174
 175   public
 176     property Min: Integer read GetMin write SetMin;
 177     {* Specifies the minimum value of the Position property.}
 178     property Max: Integer read GetMax write SetMax;
 179     {* Specifies the maximum value of the Position property.}
 180     property Position: Integer read GetPosition write SetPosition;
 181     {* Current updown value}
 182     property Increment: Integer read GetIncrement write SetIncrement;
 183     {* Specifies the amount the Position value changes each time the up or down button is pressed.}
 184     property Buddy: HWnd read GetBuddy write SetBuddy;
 185     {* Companion control for updown}
 186     property Orientation: TUpDownOrientation read GetOrientation;
 187     {* Orientation of updown arrows}
 188     property ArrowKeys: Boolean read GetArrowKeys;
 189     {* The updown control receives input from the Up arrow and Down arrow keys.}
 190     property AlignButton: TUpDownAlignButton read GetAlignButton;
 191     {* The position of the up-down control can be relative to its companion (buddy) control.
 192     Updown button can be placed on right or left side of buddy control}
 193     property AutoBuddy: Boolean read GetAutoBuddy;
 194     {* Automatically arrange to last control in Z-Order}
 195     property Thousands: Boolean read GetThousands;
 196     {* Determines whether a thousands separator appears between every three digits of a decimal string.}
 197     property Wrap: Boolean read GetWrap;
 198     {* Use Wrap to specify whether the up-down control treats the range determined
 199      by the Max and Min properties as a continuous loop.}
 200     property HexBase: Boolean read GetHexBase write SetHexBase;
 201     {* Hexadecimal units}
 202     property HotTrack: Boolean read GetHotTrack;
 203     {*}
 204     property OnChangingEx: TOnChangingEx read GetOnChangingEx write
 205       SetOnChangingEx;
 206     {* Event fired when position is about to change.Could be used to disallow change
 207      of Position property.}
 208   end;
 209
 210 const
 211   UPDOWN_CLASS = 'msctls_updown32';
 212
 213   UDN_FIRST = 0 - 721;
 214
 215   UD_MAXVAL = $7FFF;
 216   UD_MINVAL = -UD_MAXVAL;
 217
 218   UDS_WRAP = $0001;
 219   UDS_SETBUDDYINT = $0002;
 220   UDS_ALIGNRIGHT = $0004;
 221   UDS_ALIGNLEFT = $0008;
 222   UDS_AUTOBUDDY = $0010;
 223   UDS_ARROWKEYS = $0020;
 224   UDS_HORZ = $0040;
 225   UDS_NOTHOUSANDS = $0080;
 226   UDS_HOTTRACK = $0100;
 227
 228   UDM_SETRANGE = WM_USER + 101;
 229   UDM_GETRANGE = WM_USER + 102;
 230   UDM_SETPOS = WM_USER + 103;
 231   UDM_GETPOS = WM_USER + 104;
 232   UDM_SETBUDDY = WM_USER + 105;
 233   UDM_GETBUDDY = WM_USER + 106;
 234   UDM_SETACCEL = WM_USER + 107;
 235   UDM_GETACCEL = WM_USER + 108;
 236   UDM_SETBASE = WM_USER + 109;
 237   UDM_GETBASE = WM_USER + 110;
 238   UDM_SETRANGE32 = WM_USER + 111;
 239   UDM_GETRANGE32 = WM_USER + 112;
 240   UDM_SETPOS32 = WM_USER + 113;
 241   UDM_GETPOS32 = WM_USER + 114;
 242   UDN_DELTAPOS = UDN_FIRST - 1;
 243
 244   Thousands2Style: array[Boolean] of DWord = (UDS_NOTHOUSANDS, $0);
 245   Wrap2Style: array[Boolean] of DWord = ($0, UDS_WRAP);
 246   ArrowKeys2Style: array[Boolean] of DWord = ($0, UDS_ARROWKEYS);
 247   Orientation2Style: array[TUpDownOrientation] of DWord = (UDS_HORZ, $0);
 248   AlignButton2Style: array[TUpDownAlignButton] of DWord = (UDS_ALIGNLEFT,
 249     UDS_ALIGNRIGHT);
 250   AutoBuddy2Style: array[Boolean] of DWord = ($0, UDS_AUTOBUDDY);
 251   HotTrack2Style: array[Boolean] of DWord = ($0, UDS_HOTTRACK);
 252   Visible2Style: array[Boolean] of DWord = ($0, WS_VISIBLE);
 253
 254 function NewMHUpDown(AParent: PControl; Orientation: TUpDownOrientation; Wrap,
 255   Thousands, ArrowKeys, AutoBuddy, HotTrack, BuddyInteger: Boolean; AlignButton:
 256   TUpDownAlignButton): PControl;
 257
 258 implementation
 259
 260 type
 261   PUpDownData = ^TUpDownData;
 262   TUpDownData = packed record
 263     FOrientation: TUpDownOrientation;
 264     FArrowKeys: Boolean;
 265     FHotTrack: Boolean;
 266     FAutoBuddy: Boolean;
 267     FThousands: Boolean;
 268     FWrap: Boolean;
 269     FAlignButton: TUpDownAlignButton;
 270     FOnChangingEx: TOnChangingEx;
 271     FMin: Integer;
 272     FMax: Integer;
 273   end;
 274
 275 function WndProcUpDown(Sender: PControl; var Msg: TMsg; var Rslt: Integer):
 276   Boolean;
 277 var
 278   UpDownNow: PMHUpDown;
 279   NMUpDown: PNMUpDown;
 280   Allow: Boolean;
 281   Direction: TUpDownDirection;
 282   NewValue: Integer;
 283   Data: PUpDownData;
 284 begin
 285   Result := FALSE;
 286   Allow := True;
 287   if (Msg.message = WM_NOTIFY) and (Msg.lParam <> 0) then
 288   begin
 289     NMUpDown := PNMUpDown(Msg.lParam);
 290     UpDownNow := PMHUpDown(Sender);
 291     Data := UpDownNow.CustomData;
 292     if NMUpDown.hdr.code = UDN_DELTAPOS then
 293     begin
 294       if Assigned(UpDownNow) then
 295       begin
 296         if Assigned(Data^.FOnChangingEx) then
 297         begin
 298           if NMUpDown.iDelta = 0 then
 299             Direction := updNone
 300           else
 301           begin
 302             if NMUpDown.iDelta < 0 then
 303               Direction := updDown
 304             else
 305               Direction := updUp;
 306           end;
 307           NewValue := NMUpDown.iPos + NMUpDown.iDelta;
 308           if NewValue > Data^.FMax then
 309             NewValue := Data^.FMax;
 310           if NewValue < Data^.FMin then
 311             NewValue := Data^.FMin;
 312           Data^.FOnChangingEx(PObj(UpDownNow), Allow, NewValue, Direction);
 313           Result := true;
 314           if not Allow then
 315             Rslt := 1
 316           else
 317             Rslt := 0;
 318         end;
 319       end;
 320     end;
 321   end;
 322 end;
 323
 324 function WndProcUpDownParent(Sender: PControl; var Msg: TMsg; var Rslt:
 325   Integer): Boolean;
 326 var
 327   UpDownNow: PMHUpDown;
 328   Bar: TScrollerBar;
 329 begin
 330   Result := False;
 331
 332   if ((Msg.message = WM_HSCROLL) or (Msg.message = WM_VSCROLL)) and (Msg.lParam
 333     <> 0) then
 334   begin
 335     UpDownNow := Pointer(GetProp(Msg.lParam, ID_SELF));
 336     if UpDownNow <> nil then
 337     begin
 338       if Assigned(UpDownNow.OnScroll) then
 339       begin
 340         if Msg.message = WM_VSCROLL then
 341           Bar := sbVertical
 342         else
 343           Bar := sbHorizontal;
 344         UpDownNow.OnScroll(UpDownNow, Bar, LoWord(Msg.wParam),
 345           HiWord(Msg.wParam));
 346       end;
 347     end;
 348   end;
 349 end;
 350
 351 function NewMHUpDown(AParent: PControl; Orientation: TUpDownOrientation; Wrap,
 352   Thousands, ArrowKeys, AutoBuddy, HotTrack, BuddyInteger: Boolean; AlignButton:
 353   TUpDownAlignButton): PControl;
 354 var
 355   D: PUpDownData;
 356 begin
 357   DoInitCommonControls(ICC_UPDOWN_CLASS);
 358   Result := PMHUpDown(_NewCommonControl(AParent, UPDOWN_CLASS, WS_CHILD or
 359     WS_VISIBLE or Thousands2Style[Thousands] or Wrap2Style[Wrap] or
 360     ArrowKeys2Style[ArrowKeys] or Orientation2Style[Orientation] or
 361     AlignButton2Style[AlignButton] or AutoBuddy2Style[AutoBuddy] or UDS_SETBUDDYINT
 362     or HotTrack2Style[HotTrack], False, nil));
 363   GetMem(D, Sizeof(D^));
 364   FillChar(D^, SizeOf(D^), 0);
 365   Result.CustomData := D;
 366   D.FMin := 0;
 367   D.FMax := 100;
 368   D.FOrientation := Orientation;
 369   D.FHotTrack := HotTrack;
 370   D.FWrap := Wrap;
 371   D.FThousands := Thousands;
 372   D.FArrowKeys := ArrowKeys;
 373   D.FAutoBuddy := AutoBuddy;
 374   D.FAlignButton := AlignButton;
 375   Result.AttachProc(WndProcUpDown);
 376   AParent.AttachProc(WndProcUpDownParent);
 377 end;
 378
 379 { Buddy }
 380 //----------------------------------------------------------------------------//
 381
 382 procedure TMHUpDown.SetBuddy(const Value: HWnd);
 383 begin
 384   Perform(UDM_SETBUDDY, Value, 0);
 385 end;
 386
 387 function TMHUpDown.GetBuddy: HWnd;
 388 begin
 389   Result := Perform(UDM_GETBUDDY, 0, 0);
 390 end;
 391
 392 { Min }
 393 //----------------------------------------------------------------------------//
 394
 395 procedure TMHUpDown.SetMin(const Value: Integer);
 396 var
 397   TMP: Integer;
 398 begin
 399   Perform(UDM_GETRANGE32, 0, DWord(@TMP));
 400   Perform(UDM_SETRANGE32, Value, TMP);
 401   PUpDownData(CustomData)^.FMin := Value;
 402 end;
 403
 404 function TMHUpDown.GetMin: Integer;
 405 begin
 406   Perform(UDM_GETRANGE, DWord(@Result), 0);
 407 end;
 408
 409 { Max }
 410 //----------------------------------------------------------------------------//
 411
 412 procedure TMHUpDown.SetMax(const Value: Integer);
 413 var
 414   TMP: Integer;
 415 begin
 416   Perform(UDM_GETRANGE, DWord(@TMP), 0);
 417   Perform(UDM_SETRANGE, TMP, Value);
 418   PUpDownData(CustomData)^.FMax := Value;
 419 end;
 420
 421 function TMHUpDown.GetMax: Integer;
 422 begin
 423   Perform(UDM_GETRANGE32, 0, DWord(@Result));
 424 end;
 425
 426 { Position }
 427 //----------------------------------------------------------------------------//
 428
 429 procedure TMHUpDown.SetPosition(const Value: Integer);
 430 begin
 431   Perform(UDM_SETPOS32, 0, Value);
 432 end;
 433
 434 function TMHUpDown.GetPosition: Integer;
 435 begin
 436   Result := Perform(UDM_GETPOS32, 0, 0);
 437 end;
 438
 439 { HexBase }
 440 //----------------------------------------------------------------------------//
 441
 442 procedure TMHUpDown.SetHexBase(const Value: Boolean);
 443 begin
 444   if Value then
 445     Perform(UDM_SETBASE, 16, 0)
 446   else
 447     Perform(UDM_SETBASE, 10, 0);
 448 end;
 449
 450 function TMHUpDown.GetHexBase: Boolean;
 451 begin
 452   if Perform(UDM_GETBASE, 0, 0) = 16 then
 453     Result := True
 454   else
 455     Result := False;
 456 end;
 457
 458 { Increment }
 459 //----------------------------------------------------------------------------//
 460
 461 procedure TMHUpDown.SetIncrement(const Value: Integer);
 462 var
 463   acc: TUDAccel;
 464 begin
 465   acc.nSec := REFRESH_PERIOD;
 466   acc.nInc := Cardinal(Value);
 467   Perform(UDM_SETACCEL, 1, LongInt(@acc));
 468 end;
 469
 470 function TMHUpDown.GetIncrement: Integer;
 471 var
 472   tmp: LongInt;
 473   acc: TUDAccel;
 474 begin
 475   Perform(UDM_GETACCEL, LongInt(@tmp), LongInt(@acc));
 476   Result := acc.nInc;
 477 end;
 478
 479 { Orientation }
 480 //----------------------------------------------------------------------------//
 481
 482 function TMHUpDown.GetOrientation: TUpDownOrientation;
 483 begin
 484   Result := PUpDownData(CustomData)^.FOrientation;
 485 end;
 486
 487 { ArrowKeys }
 488 //----------------------------------------------------------------------------//
 489
 490 function TMHUpDown.GetArrowKeys: Boolean;
 491 begin
 492   Result := PUpDownData(CustomData)^.FArrowKeys;
 493 end;
 494
 495 { AlignButton }
 496 //----------------------------------------------------------------------------//
 497
 498 function TMHUpDown.GetAlignButton: TUpDownAlignButton;
 499 begin
 500   Result := PUpDownData(CustomData)^.FAlignButton;
 501 end;
 502
 503 { AutoBuddy }
 504 //----------------------------------------------------------------------------//
 505
 506 function TMHUpDown.GetAutoBuddy: Boolean;
 507 begin
 508   Result := PUpDownData(CustomData)^.FAutoBuddy;
 509 end;
 510
 511 { Thousands }
 512 //----------------------------------------------------------------------------//
 513
 514 function TMHUpDown.GetThousands: Boolean;
 515 begin
 516   Result := PUpDownData(CustomData)^.FThousands;
 517 end;
 518
 519 { Wrap }
 520 //----------------------------------------------------------------------------//
 521
 522 function TMHUpDown.GetWrap: Boolean;
 523 begin
 524   Result := PUpDownData(CustomData)^.FWrap;
 525 end;
 526
 527 { HotTrack }
 528 //----------------------------------------------------------------------------//
 529
 530 function TMHUpDown.GetHotTrack: Boolean;
 531 begin
 532   Result := PUpDownData(CustomData)^.FHotTrack;
 533 end;
 534
 535 { OnChangingEx }
 536 //----------------------------------------------------------------------------//
 537
 538 procedure TMHUpDown.SetOnChangingEx(const Value: TOnChangingEx);
 539 begin
 540   PUpDownData(CustomData)^.FOnChangingEx := Value;
 541 end;
 542
 543 function TMHUpDown.GetOnChangingEx: TOnChangingEx;
 544 begin
 545   Result := PUpDownData(CustomData)^.FOnChangingEx;
 546 end;
 547
 548 end.
 549