cxtrackbar.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 1,699 行 · 第 1/5 页

  private
    FSlideState: TcxTrackBarSlideState;
    FStartSelectionPosition: Integer;
    function GetStyle: TcxTrackBarStyle;
    procedure SetStyle(Value: TcxTrackBarStyle);
    procedure SetNewSelectionPosition(const ANewPosition: Integer);
    function GetPosition: Integer;
    procedure SetPosition(Value: Integer);
    function GetProperties: TcxCustomTrackBarProperties;
    function GetActiveProperties: TcxCustomTrackBarProperties;
    procedure GetOnGetThumbRect(out AValue: TcxGetThumbRectEvent);
    function GetViewInfo: TcxCustomTrackBarViewInfo;
    procedure SetProperties(Value: TcxCustomTrackBarProperties);
    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
  protected
    function DefaultParentColor: Boolean; override;
    procedure FillSizeProperties(var AEditSizeProperties: TcxEditSizeProperties); override;
    procedure Initialize; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseEnter(AControl: TControl); override;
    procedure MouseLeave(AControl: TControl); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure SynchronizeDisplayValue; override;
    function WantNavigationKeys: Boolean; override;
    procedure InternalSetPosition(Value: Integer);
    property ViewInfo: TcxCustomTrackBarViewInfo read GetViewInfo;
  public
    class function GetPropertiesClass: TcxCustomEditPropertiesClass; override;
    property ActiveProperties: TcxCustomTrackBarProperties
      read GetActiveProperties;
    property Position: Integer read GetPosition write SetPosition default 0;
    property Properties: TcxCustomTrackBarProperties read GetProperties
      write SetProperties;
    property Style: TcxTrackBarStyle read GetStyle write SetStyle;
    property Transparent;
  end;

  { TcxCustomTrackBar }
  
  TcxTrackBar = class(TcxCustomTrackBar)
  private
    function GetActiveProperties: TcxTrackBarProperties;
    function GetProperties: TcxTrackBarProperties;
    procedure SetProperties(Value: TcxTrackBarProperties);
  public
    class function GetPropertiesClass: TcxCustomEditPropertiesClass; override;
    property ActiveProperties: TcxTrackBarProperties read GetActiveProperties;
  published
    property Align;
    property Anchors;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property Position;
    property Properties: TcxTrackBarProperties read GetProperties
      write SetProperties;
    property ShowHint;
    property Style;
    property StyleDisabled;
    property StyleFocused;
    property StyleHot;
    property TabOrder;
    property TabStop;
    property Transparent;
    property Visible;
    property OnContextPopup;
    property OnDragDrop;
    property OnDragOver;
    property OnEditing;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
  end;

implementation

uses
  cxEditConsts, cxEditPaintUtils, cxEditUtils, cxExtEditUtils, cxSpinEdit,
  dxThemeConsts, dxThemeManager, dxUxTheme;

const
  BetweenTrackAndTick = 1;
  FromBorderIndent = 7;

type
  { TcxFilterTrackBarHelper }

  TcxFilterTrackBarHelper = class(TcxFilterSpinEditHelper)
  public
    class procedure InitializeProperties(AProperties,
      AEditProperties: TcxCustomEditProperties; AHasButtons: Boolean); override;
  end;

procedure CalculateCustomTrackBarViewInfo(ACanvas: TcxCanvas; AViewData: TcxCustomTrackBarViewData;
  AViewInfo: TcxCustomTrackBarViewInfo);

  procedure CheckFocusRectBounds;
  begin
    with AViewInfo do
    begin
      if FocusRect.Left < TextRect.Left - 1 then
        FocusRect.Left := TextRect.Left - 1;
      if FocusRect.Top < TextRect.Top - 1 then
        FocusRect.Top := TextRect.Top - 1;
      if FocusRect.Right > TextRect.Right + 1 then
        FocusRect.Right := TextRect.Right + 1;
      if FocusRect.Bottom > TextRect.Bottom + 1 then
        FocusRect.Bottom := TextRect.Bottom + 1;
    end;
  end;

begin
  with AViewInfo do
  begin
    BackgroundColor := AViewData.Style.Color;
    if not IsInplace and Focused then
      if Length(Text) = 0 then
        FocusRect := cxEmptyRect
      else
      begin
        FocusRect := TextRect;
        InflateRect(FocusRect, 1, 1);
        CheckFocusRectBounds;
      end;
  end;
end;

procedure DrawBottomRightThumb(ACanvas: TcxCanvas; const AThumbRect: TRect;
  const AOrientation: TcxTrackBarOrientation; const AThumbSize: Integer;
  const AKind: TcxLookAndFeelKind; const AThumbColor: TColor);
var
  FX, FY: Integer;
  FLightPolyLine: array[0..3] of TPoint;
  FShadowPolyLine: array[0..2] of TPoint;
  FDarkPolyLine: array[0..2] of TPoint;
  FPolygon: array[0..5] of TPoint;
begin
  if AOrientation = tboVertical then
  begin
    FX := AThumbRect.Right - (AThumbSize div 2);

    FLightPolyLine[0] := Point(AThumbRect.Left, AThumbRect.Bottom);
    FLightPolyLine[1] := Point(AThumbRect.Left, AThumbRect.Top);
    FLightPolyLine[2] := Point(FX, AThumbRect.Top);
    FLightPolyLine[3] := Point(AThumbRect.Right, AThumbRect.Top + (AThumbSize div 2));

    FShadowPolyLine[0] := Point(AThumbRect.Left + 1, AThumbRect.Bottom);
    FShadowPolyLine[1] := Point(AThumbRect.Right - (AThumbSize div 2), AThumbRect.Bottom);
    FShadowPolyLine[2] := Point(AThumbRect.Right - 1, AThumbRect.Bottom - (AThumbSize div 2) + 1);

    FDarkPolyLine[0] := Point(AThumbRect.Left, AThumbRect.Bottom + 1);
    FDarkPolyLine[1] := Point(AThumbRect.Right - (AThumbSize div 2), AThumbRect.Bottom + 1);
    FDarkPolyLine[2] := Point(AThumbRect.Right, AThumbRect.Bottom - (AThumbSize div 2) + 1);

    FPolygon[0] := Point(AThumbRect.Left + 1, AThumbRect.Bottom);
    FPolygon[1] := Point(AThumbRect.Left + 1, AThumbRect.Top + 1);
    FPolygon[2] := Point(FX, AThumbRect.Top + 1);
    FPolygon[3] := Point(AThumbRect.Right - 1, AThumbRect.Top + (AThumbSize div 2));
    FPolygon[4] := Point(AThumbRect.Right - 1, AThumbRect.Top + (AThumbSize div 2) + 1);
    FPolygon[5] := Point(AThumbRect.Right - (AThumbSize div 2), AThumbRect.Bottom);
  end else
  begin
    FY := AThumbRect.Bottom - (AThumbSize div 2);

    FLightPolyLine[0] := Point(AThumbRect.Right, AThumbRect.Top);
    FLightPolyLine[1] := Point(AThumbRect.Left, AThumbRect.Top);
    FLightPolyLine[2] := Point(AThumbRect.Left, FY);
    FLightPolyLine[3] := Point(AThumbRect.Left + (AThumbSize div 2), AThumbRect.Bottom);

    FShadowPolyLine[0] := Point(AThumbRect.Left + (AThumbSize div 2), AThumbRect.Bottom - 1);
    FShadowPolyLine[1] := Point(AThumbRect.Right - 1, FY);
    FShadowPolyLine[2] := Point(AThumbRect.Right - 1, AThumbRect.Top + 1);

    FDarkPolyLine[0] := Point(AThumbRect.Left + (AThumbSize div 2), AThumbRect.Bottom);
    FDarkPolyLine[1] := Point(AThumbRect.Right, FY);
    FDarkPolyLine[2] := Point(AThumbRect.Right, AThumbRect.Top);

    FPolygon[0] := Point(AThumbRect.Right - 1, AThumbRect.Top + 1);
    FPolygon[1] := Point(AThumbRect.Left + 1, AThumbRect.Top + 1);
    FPolygon[2] := Point(AThumbRect.Left + 1, FY);
    FPolygon[3] := Point(AThumbRect.Left + (AThumbSize div 2) - 1, AThumbRect.Bottom - 1);
    FPolygon[4] := Point(AThumbRect.Left + (AThumbSize div 2), AThumbRect.Bottom - 1);
    FPolygon[5] := Point(AThumbRect.Right  - 1, FY);
  end;
  InternalPolyLine(ACanvas, FLightPolyLine, clWindow);
  InternalPolyLine(ACanvas, FShadowPolyLine, clBtnShadow);
  InternalPolyLine(ACanvas, FDarkPolyLine, clWindowText);
  ACanvas.Pen.Color := AThumbColor;
  ACanvas.Brush.Color := AThumbColor;
  ACanvas.Polygon(FPolygon);
  case AKind of
    lfStandard:
    begin
      InternalPolyLine(ACanvas, FLightPolyLine, clBtnHighlight);
      InternalPolyLine(ACanvas, FShadowPolyLine, clBtnShadow);
      InternalPolyLine(ACanvas, FDarkPolyLine, cl3DDkShadow);
    end;
    lfFlat:
    begin
      InternalPolyLine(ACanvas, FLightPolyLine, clBtnHighlight);
      InternalPolyLine(ACanvas, FDarkPolyLine, clBtnShadow);
    end;
    lfUltraFlat, lfOffice11:
    begin
      InternalPolyLine(ACanvas, FLightPolyLine, clWindowText);
      InternalPolyLine(ACanvas, FDarkPolyLine, clWindowText);
    end;
  end;
end;

procedure DrawTopLeftThumb(ACanvas: TcxCanvas; const AThumbRect: TRect;
  const AOrientation: TcxTrackBarOrientation; const AThumbSize: Integer;
  const AKind: TcxLookAndFeelKind; const AThumbColor: TColor);
var
  FX, FY: Integer;
  FLightPolyLine: array[0..2] of TPoint;
  FShadowPolyLine: array[0..3] of TPoint;
  FDarkPolyLine: array[0..3] of TPoint;
  FPolygon: array[0..5] of TPoint;
begin
  if AOrientation = tboVertical then
  begin
    FX := AThumbRect.Left + (AThumbSize div 2);

    FLightPolyLine[0] := Point(AThumbRect.Right, AThumbRect.Top);
    FLightPolyLine[1] := Point(FX, AThumbRect.Top);
    FLightPolyLine[2] := Point(AThumbRect.Left, AThumbRect.Top + (AThumbSize div 2));

    FShadowPolyLine[0] := Point(AThumbRect.Right - 1, AThumbRect.Top + 1);
    FShadowPolyLine[1] := Point(AThumbRect.Right - 1, AThumbRect.Bottom);
    FShadowPolyLine[2] := Point(AThumbRect.Left + (AThumbSize div 2), AThumbRect.Bottom);
    FShadowPolyLine[3] := Point(AThumbRect.Left + 1, AThumbRect.Bottom - (AThumbSize div 2) + 1);

    FDarkPolyLine[0] := Point(AThumbRect.Right, AThumbRect.Top);
    FDarkPolyLine[1] := Point(AThumbRect.Right, AThumbRect.Bottom + 1);
    FDarkPolyLine[2] := Point(AThumbRect.Left + (AThumbSize div 2), AThumbRect.Bottom + 1);
    FDarkPolyLine[3] := Point(AThumbRect.Left, AThumbRect.Bottom - (AThumbSize div 2) + 1);

    FPolygon[0] := Point(AThumbRect.Right - 2, AThumbRect.Bottom);
    FPolygon[1] := Point(AThumbRect.Right - 2, AThumbRect.Top + 1);
    FPolygon[2] := Point(FX, AThumbRect.Top + 1);
    FPolygon[3] := Point(AThumbRect.Left + 1, AThumbRect.Top + (AThumbSize div 2));
    FPolygon[4] := Point(AThumbRect.Left + 1, AThumbRect.Top + (AThumbSize div 2) + 1);
    FPolygon[5] := Point(AThumbRect.Left + (AThumbSize div 2), AThumbRect.Bottom);
  end else
  begin
    FY := AThumbRect.Top + (AThumbSize div 2);

    FLightPolyLine[0] := Point(AThumbRect.Left, AThumbRect.Bottom);
    FLightPolyLine[1] := Point(AThumbRect.Left, FY);
    FLightPolyLine[2] := Point(AThumbRect.Left + (AThumbSize div 2), AThumbRect.Top);

    FShadowPolyLine[0] := Point(AThumbRect.Left + (AThumbSize div 2), AThumbRect.Top + 1);
    FShadowPolyLine[1] := Point(AThumbRect.Right - 1, FY);
    FShadowPolyLine[2] := Point(AThumbRect.Right - 1, AThumbRect.Bottom - 1);
    FShadowPolyLine[3] := Point(AThumbRect.Left, AThumbRect.Bottom - 1);

    FDarkPolyLine[0] := Point(AThumbRect.Left + (AThumbSize div 2), AThumbRect.Top);
    FDarkPolyLine[1] := Point(AThumbRect.Right, FY);
    FDarkPolyLine[2] := Point(AThumbRect.Right, AThumbRect.Bottom);
    FDarkPolyLine[3] := Point(AThumbRect.Left, AThumbRect.Bottom);

    FPolygon[0] := Point(AThumbRect.Right - 1, AThumbRect.Bottom - 2);
    FPolygon[1] := Point(AThumbRect.Left + 1, AThumbRect.Bottom - 2);
    FPolygon[2] := Point(AThumbRect.Left + 1, FY);
    FPolygon[3] := Point(AThumbRect.Left + (AThumbSize div 2) - 1, AThumbRect.Top + 2);
    FPolygon[4] := Point(AThumbRect.Left + (AThumbSize div 2), AThumbRect.Top + 2);
    FPolygon[5] := Point(AThumbRect.Right  - 1, FY);
  end;
  ACanvas.Pen.Color := AThumbColor;
  ACanvas.Brush.Color := AThumbColor;
  ACanvas.Polygon(FPolygon);
  case AKind of
    lfStandard:
    begin
      InternalPolyLine(ACanvas, FLightPolyLine, clBtnHighlight);
      InternalPolyLine(ACanvas, FShadowPolyLine, clBtnShadow);
      InternalPolyLine(ACanvas, FDarkPolyLine, cl3DDkShadow);
    end;
    lfFlat:
    begin
      InternalPolyLine(ACanvas, FLightPolyLine, clBtnHighlight);
      InternalPolyLine(ACanvas, FDarkPolyLine, clBtnShadow);
    end;
    lfUltraFlat, lfOffice11:
    begin
      InternalPolyLine(ACanvas, FLightPolyLine, clWindowText);
      InternalPolyLine(ACanvas, FDarkPolyLine, clWindowText);
    end;
  end;
end;

{ TcxTrackBarStyle }

function TcxTrackBarStyle.DefaultBorderStyle: TcxContainerBorderStyle;
begin
  if IsBaseStyle then
    Result := cbsNone
  else
    Result := inherited DefaultBorderStyle;
end;

function TcxTrackBarStyle.DefaultHotTrack: Boolean;
begin
  Result := False;
end;

{ TcxCustomTrackBarViewInfo }

constructor TcxCustomTrackBarViewInfo.Create;
begin
  inherited Create;
  FLookAndFeel := TcxLookAndFeel.Create(nil);
  FTBBitmap := TBitmap.Create;
  FTBBitmap.PixelFormat := pfDevice;
  FTBCanvas := TcxCanvas.Create(FTBBitmap.Canvas);
  MouseStates := [];
end;