* some fixes

git-svn-id: https://svn.code.sf.net/p/kolmck/code@140 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07

Addons/KOLCCtrls.pas

@@ -1,8 +1,9 @@
 unit KOLCCtrls;
-{$UNDEF UNICODE}
 
 interface
 
+{$I KOLDEF.INC}
+
 uses
   Windows, Messages, ShellAPI, KOL;
 
@@ -90,7 +91,7 @@ type
   TTrackbarOption = ( trbAutoTicks, trbEnableSelRange, trbFixedLength,
                    trbNoThumb, trbNoTicks, trbTooltips, trbTopLeftMarks,
                    trbVertical, trbNoBorder );
-  TTrackbarOptions = set of TTrackbarOption;
+  TTrackbarOptions = Set Of TTrackbarOption;
 
   TOnScroll = procedure( Sender: PTrackbar; Code: Integer ) of object;
   {* Code:
@@ -114,18 +115,27 @@ type
     function GetVal( const Index: Integer ): Integer;
     procedure SetVal(const Index, Value: Integer);
     procedure SetThumbLen(const Index, Value: Integer);
+    procedure SetTickFreq(const Value: Integer);
+    procedure SetNumTicks(const Index, Value: Integer);
   protected
   public
     property OnScroll: TOnScroll read GetOnScroll write SetOnScroll;
     property RangeMin: Integer index $80010007 read GetVal write SetVal;
     property RangeMax: Integer index $80020008 read GetVal write SetVal;
     property PageSize: Integer index $00160015 read GetVal write SetVal;
+    {* to scroll with PgUp/PgDn }
     property LineSize: Integer index $00180017 read GetVal write SetVal;
+    {* to scroll with arrow keys }
     property Position: Integer index $80000005 read GetVal write SetVal;
-    property NumTicks: Integer index $00100000 read GetVal;
+    property NumTicks: Integer index $00100000 read GetVal write SetNumTicks;
+    {* set approximately via TickFreq, returns actual tick mark count }
+    property TickFreq: Integer                             write SetTickFreq;
+    {* 2 means that one tick will be drawn for 2 tick marks }
     property SelStart: Integer index $0011000B read GetVal write SetVal;
     property SelEnd  : Integer index $0012000C read GetVal write SetVal;
     property ThumbLen: Integer index $001B0000 read GetVal write SetThumbLen;
+    {* trbFixedLength should be on to have effect }
+    function ChannelRect: TRect;
   end;
 
   PTrackbarData = ^TTrackbarData;
@@ -469,7 +479,6 @@ type
   TSPCStatus = object(TControl)
   private
     { Private declarations }
-    fControl: PControl;
     function GetTop: Integer;
     procedure SetTop(Value: Integer);
     function GetLeft: Integer;
@@ -483,6 +492,7 @@ type
   protected
     { Protected declarations }
   public
+    fControl: PControl;
     destructor Destroy; virtual;
     function SetAlign(Value: TControlAlign): PSPCStatus; overload;
     function SetPosition(X, Y: integer): PSPCStatus; overload;
@@ -512,20 +522,21 @@ function NewTSPCStatusBar(AOwner: PControl): PSPCStatus;
 
 implementation
 
-function WndProcTrackbarParent(Sender: PControl; var Msg: TMsg; var Rslt: Integer): Boolean;
-var
-  D                 : PTrackbarData;
+function WndProcTrackbarParent( Sender: PControl; var Msg: TMsg; var Rslt: LRESULT ): Boolean;
+var D: PTrackbarData;
     Trackbar: PTrackbar;
 begin
-  Result := False;
+  Result := FALSE;
   if (Msg.message = WM_HSCROLL) or (Msg.message = WM_VSCROLL) then
-    if (Msg.lParam <> 0) then begin
-      Trackbar := Pointer({$IFDEF USE_PROP}
-        GetProp(Msg.lParam, ID_SELF)
+  if (Msg.lParam <> 0) then
+  begin
+    {$IFDEF USE_PROP}
+    Trackbar := Pointer( GetProp( Msg.lParam, ID_SELF ) );
     {$ELSE}
-        GetWindowLong(Msg.lParam, GWL_USERDATA)
-{$ENDIF});
-      if Assigned(Trackbar) then begin
+    Trackbar := Pointer( GetWindowLongPtr( Msg.lParam, GWLP_USERDATA ) );
+    {$ENDIF}
+    if Trackbar <> nil then
+    begin
       D := Trackbar.CustomData;
       if Assigned( D.FOnScroll ) then
         D.FOnScroll( Trackbar, Msg.wParam );
@@ -534,12 +545,10 @@ begin
 end;
 
 function NewTrackbar( AParent: PControl; Options: TTrackbarOptions; OnScroll: TOnScroll ): PTrackbar;
-const
-  TrackbarOptions   : array[TTrackbarOption] of Integer = (TBS_AUTOTICKS,
+const TrackbarOptions: array[ TTrackbarOption ] of Integer = ( TBS_AUTOTICKS,
       TBS_ENABLESELRANGE, TBS_FIXEDLENGTH, TBS_NOTHUMB, TBS_NOTICKS, TBS_TOOLTIPS,
       TBS_TOP, TBS_VERT, 0 );
-var
-  aStyle            : DWORD;
+var aStyle: DWORD;
     D: PTrackbarData;
     W, H: Integer;
 begin
@@ -549,7 +558,8 @@ begin
             not (trbNoBorder in Options), nil ) );
   W := 200;
   H := 40;
-  if (trbVertical in Options) then begin
+  if trbVertical in Options then
+  begin
     H := W;
     W := 40;
   end;
@@ -563,9 +573,13 @@ end;
 
 { TTrackbar }
 
+function TTrackbar.ChannelRect: TRect;
+begin
+  Perform( TBM_GETCHANNELRECT, 0, LPARAM( @ Result ) );
+end;
+
 function TTrackbar.GetOnScroll: TOnScroll;
-var
-  D                 : PTrackbarData;
+var D: PTrackbarData;
 begin
   D := CustomData;
   Result := D.FOnScroll;
@@ -576,9 +590,13 @@ begin
   Result := Perform( WM_USER + ( HiWord( Index ) and $7FFF ), 0, 0 );
 end;
 
+procedure TTrackbar.SetNumTicks(const Index, Value: Integer);
+begin
+  TickFreq := (RangeMax - RangeMin) div Value;
+end;
+
 procedure TTrackbar.SetOnScroll(const Value: TOnScroll);
-var
-  D                 : PTrackbarData;
+var D: PTrackbarData;
 begin
   D := CustomData;
   D.FOnScroll := Value;
@@ -589,6 +607,11 @@ begin
   Perform( TBM_SETTHUMBLENGTH, Value, 0 );
 end;
 
+procedure TTrackbar.SetTickFreq(const Value: Integer);
+begin
+  Perform( TBM_SETTICFREQ, Value, 0 );
+end;
+
 procedure TTrackbar.SetVal(const Index, Value: Integer);
 begin
   Perform( WM_USER + LoWord( Index ), Index shr 31, Value );
@@ -1770,4 +1793,3 @@ begin
 end;
 
 end.
-