RxFPC: new component - TRxRangeSelector

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6019 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/rx/trunk/demos/RxDBVerticalGrid/project1.lps

@@ -3,7 +3,7 @@
   <ProjectSession>
     <Version Value="10"/>
     <BuildModes Active="Default"/>
-    <Units Count="73">
+    <Units Count="74">
       <Unit0>
         <Filename Value="project1.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -43,7 +43,7 @@
       <Unit4>
         <Filename Value="../../../../lcl/grids.pas"/>
         <UnitName Value="Grids"/>
-        <EditorIndex Value="4"/>
+        <EditorIndex Value="-1"/>
         <TopLine Value="985"/>
         <CursorPos X="15" Y="1001"/>
         <UsageCount Value="22"/>
@@ -176,7 +176,7 @@
       </Unit21>
       <Unit22>
         <Filename Value="../../rxdb/rxdbverticalgrid.pas"/>
-        <EditorIndex Value="5"/>
+        <EditorIndex Value="4"/>
         <TopLine Value="1289"/>
         <CursorPos X="26" Y="1290"/>
         <UsageCount Value="25"/>
@@ -542,6 +542,17 @@
         <CursorPos X="10" Y="331"/>
         <UsageCount Value="9"/>
       </Unit72>
+      <Unit73>
+        <Filename Value="unit1.lfm"/>
+        <EditorIndex Value="-1"/>
+        <CursorPos X="24" Y="23"/>
+        <ExtraEditorCount Value="1"/>
+        <ExtraEditor1>
+          <EditorIndex Value="-1"/>
+        </ExtraEditor1>
+        <UsageCount Value="10"/>
+        <DefaultSyntaxHighlighter Value="LFM"/>
+      </Unit73>
     </Units>
     <JumpHistory Count="28" HistoryIndex="27">
       <Position1>

components/rx/trunk/images/componet_img/all_component_res.sh

@@ -5,7 +5,9 @@ rm rxdbgrid.res
 rm pickdate.rex
 
 /usr/local/share/lazarus/tools/lazres rxdbgrid.res rx_markerdown.png rx_markerup.png rx_DropDown.png  rx_Ellipsis.png  rx_Glyph.png  rx_minus.png  rx_plus.png  rx_UpDown.png rx_menu_grid.png
-/usr/local/share/lazarus/tools/lazres rx_lcl.res picDateEdit.png rxbtn_downarrow.png
+
+/usr/local/share/lazarus/tools/lazres rx_lcl.res picDateEdit.png rxbtn_downarrow.png rx_range_h_back.png rx_range_h_sel.png rx_slader_bottom.png rx_slader_top.png
+
 /usr/local/share/lazarus/tools/lazres pickdate.res rx_next1.png rx_next2.png rx_prev1.png rx_prev2.png
 
 #../../../../tools\lazres.exe tooledit.lrs picDateEdit.bmp

components/rx/trunk/images/mk_res.sh

@@ -1,3 +1,3 @@
 rm rx.lrs
 rm rx.res
-/usr/local/share/lazarus/tools/lazres rx.res TRxDBDateEdit.png TRXLookUpEdit.xpm TRxDBCalcEdit.xpm TRxDBLookupCombo.xpm TRxDBGrid.xpm TDualListDialog.xpm TFolderLister.xpm TRxMemoryData.xpm TCURRENCYEDIT.xpm TRXSWITCH.xpm TRXDICE.xpm TRXDBCOMBOBOX.xpm ttoolpanel.xpm TPAGEMANAGER.xpm TRXAPPICON.xpm TSECRETPANEL.xpm TRXLABEL.xpm tautopanel.xpm TRxCalendarGrid.xpm TRxDateEdit.png TRxClock.png TRxSpeedButton.png TRxSpinButton.png TRxSpinEdit.png TRXDBSpinEdit.png TRxTimeEdit.png TRxDBTimeEdit.png TRxDBProgressBar.png TRxDBTrackBar.png TRxLoginDialog.png TRxVersionInfo.png TRxAboutDialog.png TRxDBCurrEdit.png TRxViewsPanel.png TRxDBColorBox.png TRxRadioGroup.png TRxDBRadioGroup.png TRxHistoryNavigator.png TRxCloseFormValidator.png TRxIniPropStorage.png TRxDBGridFooterTools.png TRxDateRangeEdit.png TRxMDICloseButton.png TRxMDIPanel.png TRxMDITasks.png TRxDBGridExportPDF.png TRxDBVerticalGrid.png
+/usr/local/share/lazarus/tools/lazres rx.res TRxDBDateEdit.png TRXLookUpEdit.xpm TRxDBCalcEdit.xpm TRxDBLookupCombo.xpm TRxDBGrid.xpm TDualListDialog.xpm TFolderLister.xpm TRxMemoryData.xpm TCURRENCYEDIT.xpm TRXSWITCH.xpm TRXDICE.xpm TRXDBCOMBOBOX.xpm ttoolpanel.xpm TPAGEMANAGER.xpm TRXAPPICON.xpm TSECRETPANEL.xpm TRXLABEL.xpm tautopanel.xpm TRxCalendarGrid.xpm TRxDateEdit.png TRxClock.png TRxSpeedButton.png TRxSpinButton.png TRxSpinEdit.png TRXDBSpinEdit.png TRxTimeEdit.png TRxDBTimeEdit.png TRxDBProgressBar.png TRxDBTrackBar.png TRxLoginDialog.png TRxVersionInfo.png TRxAboutDialog.png TRxDBCurrEdit.png TRxViewsPanel.png TRxDBColorBox.png TRxRadioGroup.png TRxDBRadioGroup.png TRxHistoryNavigator.png TRxCloseFormValidator.png TRxIniPropStorage.png TRxDBGridFooterTools.png TRxDateRangeEdit.png TRxMDICloseButton.png TRxMDIPanel.png TRxMDITasks.png TRxDBGridExportPDF.png TRxDBVerticalGrid.png TRxRangeSelector.png

components/rx/trunk/registerrx.pas

@@ -56,7 +56,7 @@ uses
   RxAppIcon,
   {$ENDIF}
   Dialogs, ComponentEditors, DBPropEdits, rxctrls, RxAutoPanel, rxpickdate, rxtooledit, rxclock,
-  rxspin, RxTimeEdit, rxDateRangeEditUnit, RxAboutDialog, RxViewsPanel, RxMDI;
+  rxspin, RxTimeEdit, rxDateRangeEditUnit, RxAboutDialog, RxViewsPanel, RxMDI, RxRangeSel;
 
 {$R rx.res}
 
@@ -170,6 +170,11 @@ begin
   RegisterComponents(RxCtrllPageName,[TRxDateRangeEdit]);
 end;
 
+procedure RegisterRxRangeSelUnit;
+begin
+  RegisterComponents(RxCtrllPageName,[TRxRangeSelector]);
+end;
+
 procedure Register;
 begin
   //RX
@@ -198,6 +203,7 @@ begin
   RegisterUnit('RxHistoryNavigator', @RegisterRxHistoryNavigator);
   RegisterUnit('RxMDI', @RegisterRxMDI);
   RegisterUnit('rxDateRangeEditUnit', @RegisterrxDateRangeEditUnit);
+  RegisterUnit('RxRangeSel', @RegisterRxRangeSelUnit);
 
 end;
 

components/rx/trunk/rx.inc

@@ -58,3 +58,5 @@
 {$ENDIF}
 
 {.$DEFINE OLD_fpSPREADSHEET}
+
+{.$DEFINE DEVELOPER_RX}

components/rx/trunk/rxcontrols/rxrangesel.pas

@@ -0,0 +1,608 @@
+{ rxapputils unit
+
+  Copyright (C) 2005-2017 Lagunov Aleksey alexs75@yandex.ru and Lazarus team
+  original conception from rx library for Delphi (c)
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version with the following modification:
+
+  As a special exception, the copyright holders of this library give you
+  permission to link this library with independent modules to produce an
+  executable, regardless of the license terms of these independent modules,and
+  to copy and distribute the resulting executable under terms of your choice,
+  provided that you also meet, for each linked independent module, the terms
+  and conditions of the license of that module. An independent module is a
+  module which is not derived from or based on this library. If you modify
+  this library, you may extend this exception to your version of the library,
+  but you are not obligated to do so. If you do not wish to do so, delete this
+  exception statement from your version.
+
+  This program is distributed in the hope that it will be useful, but WITHOUT
+  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+
+unit RxRangeSel;
+
+{$I rx.inc}
+
+interface
+
+uses
+  Classes, SysUtils, Types, Controls, LMessages, Graphics;
+
+type
+  TRxRangeSelectorState =
+      (rssNormal, rssDisabled,
+       rssThumbTopHover, rssThumbTopDown,
+       rssThumbBottomHover, rssThumbBottomDown,
+       rssBlockHover, rssBlockDown);
+
+  TRxRangeSelectorStyle = (rxrsSimple, rxrsLazarus, rxrsNative);
+
+  { TRxCustomRangeSelector }
+
+  TRxCustomRangeSelector = class(TCustomControl)
+  private
+    FBackgroudGlyph: TBitmap;
+    FMax: Double;
+    FMin: Double;
+    FOnChange: TNotifyEvent;
+    FSelectedEnd: Double;
+    FSelectedGlyph: TBitmap;
+    FSelectedStart: Double;
+    FState: TRxRangeSelectorState;
+    FStyle: TRxRangeSelectorStyle;
+    FThumbTopGlyph:TBitmap;
+    FThumbBottomGlyph:TBitmap;
+    //
+    FThumbPosTop : TRect;
+    FThumbPosBottom : TRect;
+    FTracerPos : TRect;
+    FSelectedPos : TRect;
+    FThumbSize : TSize;
+
+    FDblClicked : Boolean;
+    FDown : boolean;
+    FPrevX : integer;
+    FPrevY : integer;
+    procedure DoChange;
+    function GetSelectedLength: Double;
+    function GetThumbBottomGlyph: TBitmap;
+    function GetThumbTopGlyph: TBitmap;
+    function IsThumbBottomGlyphStored: Boolean;
+    function IsThumbTopGlyphStored: Boolean;
+    procedure SetBackgroudGlyph(AValue: TBitmap);
+    procedure SetMax(AValue: Double);
+    procedure SetMin(AValue: Double);
+    procedure SetSelectedEnd(AValue: Double);
+    procedure SetSelectedGlyph(AValue: TBitmap);
+    procedure SetSelectedStart(AValue: Double);
+    procedure SetStyle(AValue: TRxRangeSelectorStyle);
+    procedure SetThumbBottomGlyph(AValue: TBitmap);
+    procedure SetThumbTopGlyph(AValue: TBitmap);
+    procedure InitSizes;
+    procedure UpdateData;
+    function LogicalToScreen(const LogicalPos: double): double;
+    function BarWidth: integer;
+    procedure SetState(AValue: TRxRangeSelectorState);
+    function DeduceState(const AX, AY: integer; const ADown: boolean): TRxRangeSelectorState;
+  protected
+    procedure Paint; override;
+    class function GetControlClassDefaultSize: TSize; override;
+    procedure Loaded; override;
+
+    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override;
+    procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
+    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override;
+    procedure MouseLeave; override ;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+
+    property SelectedGlyph: TBitmap read FSelectedGlyph write SetSelectedGlyph;
+    property BackgroudGlyph: TBitmap read FBackgroudGlyph write SetBackgroudGlyph;
+
+    procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); override;
+    property Min:Double read FMin write SetMin;
+    property Max:Double read FMax write SetMax;
+    property SelectedStart : Double read FSelectedStart write SetSelectedStart;
+    property SelectedEnd : Double read FSelectedEnd write SetSelectedEnd;
+    property SelectedLength : Double read GetSelectedLength;
+    property OnChange: TNotifyEvent read FOnChange write FOnChange;
+    property Style:TRxRangeSelectorStyle read FStyle write SetStyle;
+    property ThumbTopGlyph: TBitmap read GetThumbTopGlyph write SetThumbTopGlyph {stored IsThumbTopGlyphStored};
+    property ThumbBottomGlyph: TBitmap read GetThumbBottomGlyph write SetThumbBottomGlyph {stored IsThumbBottomGlyphStored};
+    property State:TRxRangeSelectorState read FState;
+  end;
+
+  { TRxRangeSelector }
+
+  TRxRangeSelector = class(TRxCustomRangeSelector)
+  published
+    property Anchors;
+    property Enabled;
+    property Visible;
+    property Color ;
+
+    property Min;
+    property Max;
+    property SelectedStart;
+    property SelectedEnd;
+    property Style;
+    property OnChange;
+    property ThumbTopGlyph;
+    property ThumbBottomGlyph;
+    property SelectedGlyph;
+  end;
+
+implementation
+uses rxlclutils, LCLType, LCLIntf, Themes;
+
+function IsIntInInterval(x, xmin, xmax: integer): boolean; inline;
+begin
+  IsIntInInterval := (xmin <= x) and (x <= xmax);
+end;
+
+function PointInRect(const X, Y: integer; const Rect: TRect): boolean; inline;
+begin
+  PointInRect := IsIntInInterval(X, Rect.Left, Rect.Right) and
+                 IsIntInInterval(Y, Rect.Top, Rect.Bottom);
+end;
+
+function IsRealInInterval(x, xmin, xmax: extended): boolean; inline;
+begin
+  IsRealInInterval := (xmin <= x) and (x <= xmax);
+end;
+
+{ TRxCustomRangeSelector }
+
+procedure TRxCustomRangeSelector.SetMax(AValue: Double);
+begin
+  if FMax=AValue then Exit;
+  FMax:=AValue;
+
+  if FSelectedEnd > FMax then
+    FSelectedEnd:=FMax;
+
+  UpdateData;
+  Invalidate;
+  DoChange;
+end;
+
+procedure TRxCustomRangeSelector.DoChange;
+begin
+  if Assigned(FOnChange) then
+    FOnChange(Self);
+end;
+
+function TRxCustomRangeSelector.GetSelectedLength: Double;
+begin
+  Result:=FSelectedEnd - FSelectedStart;
+end;
+
+function TRxCustomRangeSelector.GetThumbBottomGlyph: TBitmap;
+begin
+  Result:=FThumbBottomGlyph;
+end;
+
+function TRxCustomRangeSelector.GetThumbTopGlyph: TBitmap;
+begin
+  Result:=FThumbTopGlyph;
+end;
+
+function TRxCustomRangeSelector.IsThumbBottomGlyphStored: Boolean;
+begin
+
+end;
+
+function TRxCustomRangeSelector.IsThumbTopGlyphStored: Boolean;
+begin
+
+end;
+
+procedure TRxCustomRangeSelector.SetBackgroudGlyph(AValue: TBitmap);
+begin
+  InitSizes;
+  FBackgroudGlyph.Assign(AValue);
+end;
+
+procedure TRxCustomRangeSelector.SetMin(AValue: Double);
+begin
+  if FMin=AValue then Exit;
+  FMin:=AValue;
+
+  if FSelectedStart < FMin then
+    FSelectedStart:=FMin;
+
+  UpdateData;
+  Invalidate;
+  DoChange;
+end;
+
+procedure TRxCustomRangeSelector.SetSelectedEnd(AValue: Double);
+begin
+  if FSelectedEnd=AValue then Exit;
+  FSelectedEnd:=AValue;
+
+  if FSelectedEnd > FMax then
+    FSelectedEnd:=FMax
+  else
+  if FSelectedEnd < FSelectedStart then
+    FSelectedEnd:=FSelectedStart;
+
+  UpdateData;
+  Invalidate;
+  DoChange;
+end;
+
+procedure TRxCustomRangeSelector.SetSelectedGlyph(AValue: TBitmap);
+begin
+  InitSizes;
+  FSelectedGlyph.Assign(AValue);
+end;
+
+procedure TRxCustomRangeSelector.SetSelectedStart(AValue: Double);
+begin
+  if FSelectedStart=AValue then Exit;
+  FSelectedStart:=AValue;
+
+  if FSelectedStart < FMin then
+    FSelectedStart:=FMin
+  else
+  if FSelectedStart > FSelectedEnd then
+    FSelectedStart:=FSelectedEnd;
+
+  UpdateData;
+  Invalidate;
+  DoChange;
+end;
+
+procedure TRxCustomRangeSelector.SetStyle(AValue: TRxRangeSelectorStyle);
+begin
+  if FStyle=AValue then Exit;
+  FStyle:=AValue;
+  InitSizes;
+  UpdateData;
+  Invalidate;
+end;
+
+procedure TRxCustomRangeSelector.SetThumbBottomGlyph(AValue: TBitmap);
+begin
+  FThumbBottomGlyph.Assign(AValue);
+  InitSizes;
+  UpdateData;
+  Invalidate;
+end;
+
+procedure TRxCustomRangeSelector.SetThumbTopGlyph(AValue: TBitmap);
+begin
+  FThumbTopGlyph.Assign(AValue);
+  InitSizes;
+  UpdateData;
+  Invalidate;
+end;
+
+procedure TRxCustomRangeSelector.InitSizes;
+var
+  TD: TThemedElementDetails;
+begin
+  {$IFDEF WINDOWS}
+  if (FStyle = rxrsNative) and ThemeServices.ThemesEnabled then
+  begin
+    TD:=ThemeServices.GetElementDetails(ttbThumbBottomPressed);
+    FThumbSize:=ThemeServices.GetDetailSize(TD);
+  end
+  else
+  {$ENDIF WINDOWS}
+  if Assigned(FThumbTopGlyph) and (FThumbTopGlyph.Width > 0) then
+  begin
+    FThumbSize.CX:=FThumbTopGlyph.Width;
+    FThumbSize.CY:=FThumbTopGlyph.Height;
+  end
+  else
+  if Assigned(FThumbBottomGlyph) and (FThumbBottomGlyph.Width > 0) then
+  begin
+    FThumbSize.CX:=FThumbBottomGlyph.Width;
+    FThumbSize.CY:=FThumbBottomGlyph.Height;
+  end
+  else
+  begin
+    FThumbSize.CX:=6;
+    FThumbSize.CY:=10;
+  end;
+end;
+
+procedure TRxCustomRangeSelector.UpdateData;
+begin
+  FTracerPos.Left := FThumbSize.CX div 2;
+  FTracerPos.Right :=Width - FThumbSize.CX div 2;
+  FTracerPos.Top:=FThumbTopGlyph.Height + 1;
+  FTracerPos.Bottom:=FThumbPosBottom.Top - 1;
+
+  FSelectedPos.Left := round(LogicalToScreen(FSelectedStart)) - FThumbSize.CX div 2;
+  FSelectedPos.Top := FTracerPos.Top;
+  FSelectedPos.Right := round(LogicalToScreen(FSelectedEnd)) + FThumbSize.CX div 2;
+  FSelectedPos.Bottom := FTracerPos.Bottom;
+
+
+  FThumbPosTop.Top:=0;
+  FThumbPosTop.Left:=FSelectedPos.Left - FThumbSize.CX div 2;
+  FThumbPosTop.Bottom:=FThumbTopGlyph.Height;
+  FThumbPosTop.Right:=FThumbPosTop.Left + FThumbSize.CX;
+
+  FThumbPosBottom.Bottom:=Height;
+  FThumbPosBottom.Right:=FSelectedPos.Right + FThumbSize.CX div 2;
+  FThumbPosBottom.Top:=Height - FThumbBottomGlyph.Height;
+  FThumbPosBottom.Left:=FThumbPosBottom.Right - FThumbSize.CX;
+end;
+
+function TRxCustomRangeSelector.LogicalToScreen(const LogicalPos: double
+  ): double;
+begin
+  result := FThumbSize.CX + BarWidth * (LogicalPos - FMin) / (FMax - FMin)
+end;
+
+function TRxCustomRangeSelector.BarWidth: integer;
+begin
+  result := Width - 2 * FThumbSize.CX;
+end;
+
+procedure TRxCustomRangeSelector.SetState(AValue: TRxRangeSelectorState);
+begin
+  if AValue <> FState then
+  begin
+    FState := AValue;
+    Invalidate;
+  end;
+end;
+
+function TRxCustomRangeSelector.DeduceState(const AX, AY: integer;
+  const ADown: boolean): TRxRangeSelectorState;
+begin
+  Result := rssNormal;
+
+  if not Enabled then
+    Result := rssDisabled
+  else
+  begin
+    if PointInRect(AX, AY, FThumbPosTop) then
+    begin
+      if ADown then
+        Result := rssThumbTopDown
+      else
+        Result := rssThumbTopHover;
+    end
+    else
+    if PointInRect(AX, AY, FThumbPosBottom) then
+    begin
+      if ADown then
+        Result := rssThumbBottomDown
+      else
+        Result := rssThumbBottomHover;
+    end
+    else
+    if PointInRect(AX, AY, FSelectedPos) then
+    begin
+      if ADown then
+        Result := rssBlockDown
+      else
+        Result := rssBlockHover;
+    end;
+  end;
+end;
+
+procedure TRxCustomRangeSelector.Paint;
+var
+  DE: TThemedElementDetails;
+begin
+  inherited Paint;
+  Canvas.Brush.Color := Color;
+  Canvas.FillRect(ClientRect);
+
+  {$IFDEF WINDOWS}
+  if (FStyle = rxrsNative) and ThemeServices.ThemesEnabled then
+  begin
+    DE:=ThemeServices.GetElementDetails(ttbThumbBottomPressed);
+    ThemeServices.DrawElement( Canvas.Handle, DE, FThumbPosTop);
+
+    DE:=ThemeServices.GetElementDetails(ttbThumbTopPressed);
+    ThemeServices.DrawElement( Canvas.Handle, DE, FThumbPosBottom);
+
+    DE:=ThemeServices.GetElementDetails(ttbTrack);
+    ThemeServices.DrawElement( Canvas.Handle, DE, FTracerPos);
+
+    DE:=ThemeServices.GetElementDetails(ttbThumbNormal);
+    ThemeServices.DrawElement( Canvas.Handle, DE, FSelectedPos);
+  end
+  else
+  {$ENDIF WINDOWS}
+  if FStyle = rxrsSimple then
+  begin
+    Canvas.Brush.Color := Color;
+    Canvas.FillRect(ClientRect);
+
+    DrawEdge(Canvas.Handle, FTracerPos, EDGE_SUNKEN, BF_RECT);
+
+    Canvas.Brush.Color := clHighlight;
+    Canvas.FillRect(FSelectedPos);
+
+    case FState of
+        rssDisabled:
+          DrawEdge(Canvas.Handle, FSelectedPos, EDGE_BUMP, BF_RECT or BF_MONO);
+        rssBlockHover:
+          DrawEdge(Canvas.Handle, FSelectedPos, EDGE_RAISED, BF_RECT);
+        rssBlockDown:
+          DrawEdge(Canvas.Handle, FSelectedPos, EDGE_SUNKEN, BF_RECT);
+    else
+        DrawEdge(Canvas.Handle, FSelectedPos, EDGE_ETCHED, BF_RECT);
+    end;
+
+    case FState of
+        rssDisabled:
+          DrawEdge(Canvas.Handle, FThumbPosTop, EDGE_BUMP, BF_RECT or BF_MONO);
+        rssThumbTopHover:
+          DrawEdge(Canvas.Handle, FThumbPosTop, EDGE_RAISED, BF_RECT);
+        rssThumbTopDown:
+          DrawEdge(Canvas.Handle, FThumbPosTop, EDGE_SUNKEN, BF_RECT);
+    else
+        DrawEdge(Canvas.Handle, FThumbPosTop, EDGE_ETCHED, BF_RECT);
+    end;
+
+    case FState of
+        rssDisabled:
+          DrawEdge(Canvas.Handle, FThumbPosBottom, EDGE_BUMP, BF_RECT or BF_MONO);
+        rssThumbBottomHover:
+          DrawEdge(Canvas.Handle, FThumbPosBottom, EDGE_RAISED, BF_RECT);
+        rssThumbBottomDown:
+          DrawEdge(Canvas.Handle, FThumbPosBottom, EDGE_SUNKEN, BF_RECT);
+    else
+        DrawEdge(Canvas.Handle, FThumbPosBottom, EDGE_ETCHED, BF_RECT);
+    end;
+  end
+  else
+  begin
+    Canvas.Draw(FThumbPosTop.Left, FThumbPosTop.Top, FThumbTopGlyph);
+    Canvas.Draw(FThumbPosBottom.Left, FThumbPosBottom.Top, FThumbBottomGlyph);
+
+    if (FBackgroudGlyph.Width > 0) and (FBackgroudGlyph.Height>0) then
+    begin
+      Canvas.StretchDraw(FTracerPos, FBackgroudGlyph)
+    end;
+
+    if (FSelectedGlyph.Width > 0) and (FSelectedGlyph.Height > 0) then
+      Canvas.StretchDraw(FSelectedPos, FSelectedGlyph)
+    else
+    begin
+      Canvas.Brush.Color := clBlue;
+      Canvas.FillRect(FSelectedPos);
+    end;
+  end
+end;
+
+class function TRxCustomRangeSelector.GetControlClassDefaultSize: TSize;
+begin
+  Result.CX := 100;
+  Result.CY := 60;
+end;
+
+procedure TRxCustomRangeSelector.Loaded;
+begin
+  inherited Loaded;
+  UpdateData;
+end;
+
+procedure TRxCustomRangeSelector.MouseDown(Button: TMouseButton;
+  Shift: TShiftState; X: Integer; Y: Integer);
+begin
+  inherited MouseDown(Button, Shift, X, Y);
+
+  if FDblClicked then
+  begin
+    FDblClicked := false;
+    Exit;
+  end;
+
+  FDown := Button = mbLeft;
+  SetState(DeduceState(X, Y, FDown));
+end;
+
+procedure TRxCustomRangeSelector.MouseMove(Shift: TShiftState; X: Integer;
+  Y: Integer);
+begin
+  inherited MouseMove(Shift, X, Y);
+
+  if FState = rssThumbTopDown then
+    SetSelectedStart(FSelectedStart + (X - FPrevX) * (FMax - FMin) / BarWidth)
+  else
+  if FState = rssThumbBottomDown then
+    SetSelectedEnd(FSelectedEnd + (X - FPrevX) * (FMax - FMin) / BarWidth)
+  else
+  if FState = rssBlockDown then
+  begin
+    if IsRealInInterval(FSelectedStart + (X - FPrevX) * (FMax - FMin) / BarWidth, FMin, FMax) and
+       IsRealInInterval(FSelectedEnd + (X - FPrevX) * (FMax - FMin) / BarWidth, FMin, FMax) then
+    begin
+      SetSelectedStart(FSelectedStart + (X - FPrevX) * (FMax - FMin) / BarWidth);
+      SetSelectedEnd(FSelectedEnd + (X - FPrevX) * (FMax - FMin) / BarWidth);
+    end;
+  end
+  else
+    SetState(DeduceState(X, Y, FDown));
+
+  FPrevX := X;
+  FPrevY := Y;
+end;
+
+procedure TRxCustomRangeSelector.MouseUp(Button: TMouseButton;
+  Shift: TShiftState; X: Integer; Y: Integer);
+begin
+  inherited MouseUp(Button, Shift, X, Y);
+  FDown := false;
+  SetState(DeduceState(X, Y, FDown));
+end;
+
+procedure TRxCustomRangeSelector.MouseLeave;
+begin
+  inherited MouseLeave;
+  if Enabled then
+    SetState(rssNormal)
+  else
+    SetState(rssDisabled);
+end;
+
+procedure TRxCustomRangeSelector.SetBounds(aLeft, aTop, aWidth, aHeight: integer
+  );
+begin
+  inherited SetBounds(aLeft, aTop, aWidth, aHeight);
+  InitSizes;
+  UpdateData;
+  Invalidate;
+end;
+
+const
+  sRxRange_h_back = 'RX_RANGE_H_BACK';
+  sRxRange_h_sel = 'RX_RANGE_H_SEL';
+  sRX_SLADER_BOTTOM = 'RX_SLADER_BOTTOM';
+  sRX_SLADER_TOP = 'RX_SLADER_TOP';
+
+constructor TRxCustomRangeSelector.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+
+//  FThumbTopGlyph:=TBitmap.Create;
+//  FThumbBottomGlyph:=TBitmap.Create;
+
+//  FSelectedGlyph:=TBitmap.Create;
+//  FBackgroudGlyph:=TBitmap.Create;
+  FSelectedGlyph := CreateResBitmap(sRxRange_h_sel);
+  FBackgroudGlyph := CreateResBitmap(sRxRange_h_back);
+
+  FThumbTopGlyph:=CreateResBitmap(sRX_SLADER_TOP);
+  FThumbBottomGlyph:=CreateResBitmap(sRX_SLADER_BOTTOM);
+
+  with GetControlClassDefaultSize do
+    SetInitialBounds(0, 0, CX, CY);
+
+  FSelectedEnd:=50;
+  FMax:=100;
+end;
+
+destructor TRxCustomRangeSelector.Destroy;
+begin
+  FreeAndNil(FThumbTopGlyph);
+  FreeAndNil(FThumbBottomGlyph);
+  FreeAndNil(FSelectedGlyph);
+  FreeAndNil(FBackgroudGlyph);
+  inherited Destroy;
+end;
+
+end.
+

components/rx/trunk/rxcontrols/rxspin.pas

@@ -758,8 +758,6 @@ begin
 end;
 
 procedure TRxSpinEdit.LMSize(var Message: TLMSize);
-var
-  MinHeight: Integer;
 begin
   inherited;
   ResizeButton;

components/rx/trunk/rxdb/rxdbgrid.pas

@@ -922,7 +922,9 @@ type
     function  GetDefaultEditor(Column: Integer): TWinControl; override;
 
     procedure PrepareCanvas(aCol, aRow: Integer; AState: TGridDrawState); override;
-
+{$IFDEF DEVELOPER_RX}
+    procedure InternalAdjustRowCount(var RecCount:integer); override;
+{$ENDIF}
     property Editor;
   public
     constructor Create(AOwner: TComponent); override;
@@ -5060,33 +5062,31 @@ begin
 end;
 
 procedure TRxDBGrid.KeyDown(var Key: word; Shift: TShiftState);
-//var
-//  FTmpReadOnly: boolean;
 
-  procedure DoShowFindDlg;
-  begin
-    if not (rdgAllowDialogFind in OptionsRx) then
-      exit;
-    if Length(QuickUTF8Search) > 0 then
-      QuickUTF8Search := '';
-    ShowFindDialog;
-  end;
+procedure DoShowFindDlg;
+begin
+  if not (rdgAllowDialogFind in OptionsRx) then
+    exit;
+  if Length(QuickUTF8Search) > 0 then
+    QuickUTF8Search := '';
+  ShowFindDialog;
+end;
 
-  procedure DoShowColumnsDlg;
-  begin
-    if not (rdgAllowColumnsForm in OptionsRx) then
-      exit;
-    if Length(QuickUTF8Search) > 0 then
-      QuickUTF8Search := '';
-    ShowColumnsDialog;
-  end;
+procedure DoShowColumnsDlg;
+begin
+  if not (rdgAllowColumnsForm in OptionsRx) then
+    exit;
+  if Length(QuickUTF8Search) > 0 then
+    QuickUTF8Search := '';
+  ShowColumnsDialog;
+end;
 
-  procedure DoShowQuickFilter;
-  begin
-    if not (rdgAllowQuickFilter in FOptionsRx) then
-      exit;
-    OnFilter(Self);
-  end;
+procedure DoShowQuickFilter;
+begin
+  if not (rdgAllowQuickFilter in FOptionsRx) then
+    exit;
+  OnFilter(Self);
+end;
 
 begin
   if (Key in CCancelQuickSearchKeys) then
@@ -5230,6 +5230,10 @@ begin
       H:=H - GetDefaultRowHeight * FFooterOptions.RowCount;
 
     Result := H div GetDefaultRowHeight;
+
+    if rdgFilter in OptionsRx then
+      Dec(Result, 1);
+
     if dgTitles in Options then
       Dec(Result, 1);
   end
@@ -6343,6 +6347,109 @@ begin
   inherited PrepareCanvas(aCol, aRow, AState);
 end;
 
+{$IFDEF DEVELOPER_RX}
+type
+  THackDataLink = class(TDataLink)
+
+  end;
+
+procedure TRxDBGrid.InternalAdjustRowCount(var RecCount: integer);
+var
+  CurActiveRecord, j, H1, FRec, H, H2: Integer;
+  i: LongInt;
+  R: TRxColumn;
+  F: TField;
+  S: String;
+begin
+  inherited InternalAdjustRowCount(RecCount);
+
+  if (not (Assigned(DataLink) and DataLink.Active)) or ((GCache.VisibleGrid.Top=0) and (GCache.VisibleGrid.Bottom=0)) then
+    exit;
+
+  CurActiveRecord:=DataLink.ActiveRecord;
+
+  if dgTitles in Options then
+  begin
+    FRec:=1;
+    H2:=1;
+  end
+  else
+  begin
+    FRec:=0;
+    H2:=0;
+  end;
+
+  for i:=GCache.VisibleGrid.Top to GCache.VisibleGrid.Bottom do
+  begin
+    DataLink.ActiveRecord:=i - FixedRows;
+//    P:=PtrInt(DataSource.DataSet.ActiveBuffer);
+    H:=1;
+    for j:=0 to Columns.Count-1 do
+    begin
+      R:=Columns[j] as TRxColumn;
+      if R.WordWrap then
+      begin
+        F:=R.Field;
+        if Assigned(F) then
+          S:=F.DisplayText
+        else
+          S:='';
+
+        H1 := Max((Canvas.TextWidth(S) + 2) div R.Width + 1, H);
+        if H1 > WordCount(S, [' ']) then
+          H1 := WordCount(S, [' ']);
+      end
+      else
+        H1:=1;
+      H:=Max(H, H1);
+    end;
+
+
+{
+
+    if FGroupItems.Active and DatalinkActive then
+      if Assigned(FGroupItems.FindGroupItem(DataSource.DataSet.Bookmark)) then
+        Inc(H);
+
+
+    if i<RowCount then
+    begin
+      if Assigned(FOnCalcRowHeight) then
+        FOnCalcRowHeight(Self, H);
+      RowHeights[i] := GetDefaultRowHeight * H;
+      H2:=H2 + RowHeights[i];
+      if H2<=ClientHeight  then
+        Inc(Result);
+    end;}
+
+    if H2 + H > RecCount then
+    begin
+//      RecCount:=FRec;
+      if (FRec < FixedRows + CurActiveRecord) {and (CurActiveRecord = DataLink.ActiveRecord)} then
+      begin
+        TopRow:=1;
+//        THackDataLink(DataLink).FirstRecord:=THackDataLink(DataLink).FirstRecord + 1;
+{        H:=CurActiveRecord - DataLink.ActiveRecord;
+        THackDataLink(DataLink).FirstRecord:=THackDataLink(DataLink).FirstRecord + 1;
+        THackDataSet(DataLink.DataSet).RecalcBufListSize;}
+//        THackDataLink(DataLink).BufferCount:=FRec;
+        H:=0;
+      end;
+//      DataLink.BufferCount:=FRec;
+//      break;
+    end
+    else
+    begin
+      FRec:=FRec + 1;
+      H2:=H2 + H;
+    end;
+  end;
+
+  DataLink.ActiveRecord:=CurActiveRecord;
+
+end;
+{$ENDIF}
+
 procedure TRxDBGrid.GetOnCreateLookup;
 begin
   if Assigned(F_CreateLookup) then

components/rx/trunk/rxnew.lpk

@@ -26,7 +26,7 @@ Copyright (c) 1998 Master-Bank
 translate to Lazarus by alexs in 2005 - 2017"/>
     <License Value="LGPL"/>
     <Version Major="3" Minor="1" Release="1" Build="210"/>
-    <Files Count="71">
+    <Files Count="72">
       <Item1>
         <Filename Value="registerrx.pas"/>
         <HasRegisterProc Value="True"/>
@@ -314,6 +314,10 @@ translate to Lazarus by alexs in 2005 - 2017"/>
         <Filename Value="rxcontrols\rxlclutils.pas"/>
         <UnitName Value="rxlclutils"/>
       </Item71>
+      <Item72>
+        <Filename Value="rxcontrols\rxrangesel.pas"/>
+        <UnitName Value="rxrangesel"/>
+      </Item72>
     </Files>
     <LazDoc Paths="docs;\usr\local\share\lazarus\components\rxnew\docs"/>
     <i18n>

components/rx/trunk/rxnew.pas

@@ -21,7 +21,7 @@ uses
   RxIniPropStorage, rxlclconst, rxlogin, RxMDI, rxpagemngr, rxpickdate, 
   rxShortCutUnit, rxspin, rxswitch, RxSystemServices, rxtbrsetup, RxTimeEdit, 
   rxtoolbar, rxtooledit, RxDBGrid_PopUpFilterUnit, rxdbverticalgrid, 
-  rxlclutils, LazarusPackageIntf;
+  rxlclutils, RxRangeSel, LazarusPackageIntf;
 
 implementation