Стартовый пул
This commit is contained in:
@@ -0,0 +1,718 @@
|
||||
{ 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, ComCtrls;
|
||||
|
||||
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;
|
||||
FOrientation: TTrackBarOrientation;
|
||||
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 SetOrientation(AValue: TTrackBarOrientation);
|
||||
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;
|
||||
procedure InitImages(AOrient:TTrackBarOrientation);
|
||||
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;
|
||||
property Orientation:TTrackBarOrientation read FOrientation write SetOrientation default trHorizontal;
|
||||
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;
|
||||
property Orientation;
|
||||
end;
|
||||
|
||||
implementation
|
||||
uses rxlclutils, LCLType, LCLIntf, Themes;
|
||||
|
||||
const
|
||||
sRX_RANGE_H_BACK = 'RX_RANGE_H_BACK';
|
||||
sRX_RANGE_H_SEL = 'RX_RANGE_H_SEL';
|
||||
sRX_SLADER_BOTTOM = 'RX_SLADER_BOTTOM';
|
||||
sRX_SLADER_TOP = 'RX_SLADER_TOP';
|
||||
|
||||
sRX_RANGE_V_BACK = 'RX_RANGE_V_BACK';
|
||||
sRX_RANGE_V_SEL = 'RX_RANGE_V_SEL';
|
||||
sRX_SLADER_LEFT = 'RX_SLADER_LEFT';
|
||||
sRX_SLADER_RIGHT = 'RX_SLADER_RIGHT';
|
||||
|
||||
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.SetOrientation(AValue: TTrackBarOrientation);
|
||||
begin
|
||||
if FOrientation=AValue then Exit;
|
||||
FOrientation:=AValue;
|
||||
|
||||
InitImages(FOrientation);
|
||||
|
||||
UpdateData;
|
||||
Invalidate;
|
||||
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
|
||||
if FOrientation = trHorizontal then
|
||||
TD:=ThemeServices.GetElementDetails(ttbThumbBottomPressed)
|
||||
else
|
||||
TD:=ThemeServices.GetElementDetails(ttbThumbRightPressed);
|
||||
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
|
||||
if FOrientation = trHorizontal then
|
||||
begin
|
||||
FTracerPos.Left := FThumbSize.CX div 2;
|
||||
FTracerPos.Right :=Width - FThumbSize.CX div 2;
|
||||
FTracerPos.Top:=FThumbSize.CY + 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
|
||||
else
|
||||
begin
|
||||
FTracerPos.Top:= FThumbSize.CY div 2;
|
||||
FTracerPos.Bottom:=Height - FThumbSize.CY div 2;
|
||||
FTracerPos.Left := FThumbSize.CX + 1;
|
||||
FTracerPos.Right :=Width - FThumbSize.CX - 1;
|
||||
|
||||
FSelectedPos.Left := FTracerPos.Left;
|
||||
FSelectedPos.Top := round(LogicalToScreen(FSelectedStart)) - FThumbSize.CY div 2;
|
||||
FSelectedPos.Right := FTracerPos.Right;
|
||||
FSelectedPos.Bottom := round(LogicalToScreen(FSelectedEnd)) + FThumbSize.CY div 2;
|
||||
|
||||
FThumbPosTop.Left:=0;
|
||||
FThumbPosTop.Right:=FThumbTopGlyph.Width;
|
||||
FThumbPosTop.Top:=FSelectedPos.Top - FThumbSize.CY div 2;
|
||||
FThumbPosTop.Bottom:=FThumbPosTop.Top + FThumbSize.CY;
|
||||
|
||||
FThumbPosBottom.Right:=Width;
|
||||
FThumbPosBottom.Left:=Width - FThumbSize.CX - 1;
|
||||
FThumbPosBottom.Top:=FSelectedPos.Bottom - FThumbSize.CY div 2;
|
||||
FThumbPosBottom.Bottom:=FThumbPosBottom.Top + FThumbSize.CY;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TRxCustomRangeSelector.LogicalToScreen(const LogicalPos: double
|
||||
): double;
|
||||
begin
|
||||
if FOrientation = trHorizontal then
|
||||
Result := FThumbSize.CX
|
||||
else
|
||||
Result := FThumbSize.CY;
|
||||
|
||||
if (FMax - FMin) > 0 then
|
||||
Result := Result + BarWidth * (LogicalPos - FMin) / (FMax - FMin)
|
||||
end;
|
||||
|
||||
function TRxCustomRangeSelector.BarWidth: integer;
|
||||
begin
|
||||
if FOrientation = trHorizontal then
|
||||
result := Width - 2 * FThumbSize.CX
|
||||
else
|
||||
result := Height - 2 * FThumbSize.CY;
|
||||
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.InitImages(AOrient: TTrackBarOrientation);
|
||||
begin
|
||||
if AOrient = trHorizontal then
|
||||
begin
|
||||
FSelectedGlyph := CreateResBitmap(sRX_RANGE_H_SEL);
|
||||
FBackgroudGlyph := CreateResBitmap(sRX_RANGE_H_BACK);
|
||||
|
||||
FThumbTopGlyph:=CreateResBitmap(sRX_SLADER_TOP);
|
||||
FThumbBottomGlyph:=CreateResBitmap(sRX_SLADER_BOTTOM);
|
||||
end
|
||||
else
|
||||
begin
|
||||
FSelectedGlyph := CreateResBitmap(sRX_RANGE_V_SEL);
|
||||
FBackgroudGlyph := CreateResBitmap(sRX_RANGE_V_BACK);
|
||||
|
||||
FThumbTopGlyph:=CreateResBitmap(sRX_SLADER_LEFT);
|
||||
FThumbBottomGlyph:=CreateResBitmap(sRX_SLADER_RIGHT);
|
||||
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
|
||||
if FOrientation = trHorizontal then
|
||||
DE:=ThemeServices.GetElementDetails(ttbThumbBottomPressed)
|
||||
else
|
||||
DE:=ThemeServices.GetElementDetails(ttbThumbRightPressed);
|
||||
|
||||
ThemeServices.DrawElement( Canvas.Handle, DE, FThumbPosTop);
|
||||
|
||||
if FOrientation = trHorizontal then
|
||||
DE:=ThemeServices.GetElementDetails(ttbThumbTopPressed)
|
||||
else
|
||||
DE:=ThemeServices.GetElementDetails(ttbThumbLeftPressed);
|
||||
ThemeServices.DrawElement( Canvas.Handle, DE, FThumbPosBottom);
|
||||
|
||||
if FOrientation = trHorizontal then
|
||||
DE:=ThemeServices.GetElementDetails(ttbTrack)
|
||||
else
|
||||
DE:=ThemeServices.GetElementDetails(ttbTrackVert);
|
||||
ThemeServices.DrawElement( Canvas.Handle, DE, FTracerPos);
|
||||
|
||||
if FOrientation = trHorizontal then
|
||||
DE:=ThemeServices.GetElementDetails(ttbThumbNormal)
|
||||
else
|
||||
DE:=ThemeServices.GetElementDetails(ttbThumbVertNormal);
|
||||
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
|
||||
begin
|
||||
if FOrientation = trHorizontal then
|
||||
SetSelectedStart(FSelectedStart + (X - FPrevX) * (FMax - FMin) / BarWidth)
|
||||
else
|
||||
SetSelectedStart(FSelectedStart + (Y - FPrevY) * (FMax - FMin) / BarWidth)
|
||||
end
|
||||
else
|
||||
if FState = rssThumbBottomDown then
|
||||
begin
|
||||
if FOrientation = trHorizontal then
|
||||
SetSelectedEnd(FSelectedEnd + (X - FPrevX) * (FMax - FMin) / BarWidth)
|
||||
else
|
||||
SetSelectedEnd(FSelectedEnd + (Y - FPrevY) * (FMax - FMin) / BarWidth)
|
||||
end
|
||||
else
|
||||
if FState = rssBlockDown then
|
||||
begin
|
||||
if FOrientation = trHorizontal 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
|
||||
begin
|
||||
if IsRealInInterval(FSelectedStart + (Y - FPrevY) * (FMax - FMin) / BarWidth, FMin, FMax) and
|
||||
IsRealInInterval(FSelectedEnd + (Y - FPrevY) * (FMax - FMin) / BarWidth, FMin, FMax) then
|
||||
begin
|
||||
SetSelectedStart(FSelectedStart + (Y - FPrevY) * (FMax - FMin) / BarWidth);
|
||||
SetSelectedEnd(FSelectedEnd + (Y - FPrevY) * (FMax - FMin) / BarWidth);
|
||||
end;
|
||||
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;
|
||||
|
||||
constructor TRxCustomRangeSelector.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
|
||||
// FThumbTopGlyph:=TBitmap.Create;
|
||||
// FThumbBottomGlyph:=TBitmap.Create;
|
||||
|
||||
// FSelectedGlyph:=TBitmap.Create;
|
||||
// FBackgroudGlyph:=TBitmap.Create;
|
||||
InitImages(trHorizontal);
|
||||
|
||||
with GetControlClassDefaultSize do
|
||||
SetInitialBounds(0, 0, CX, CY);
|
||||
|
||||
FSelectedEnd:=50;
|
||||
FMax:=100;
|
||||
FOrientation:=trHorizontal;
|
||||
end;
|
||||
|
||||
destructor TRxCustomRangeSelector.Destroy;
|
||||
begin
|
||||
FreeAndNil(FThumbTopGlyph);
|
||||
FreeAndNil(FThumbBottomGlyph);
|
||||
FreeAndNil(FSelectedGlyph);
|
||||
FreeAndNil(FBackgroudGlyph);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user