rxslider.pas

企业端数据申报系统：单位管理模块 单位查询. 业务申报模块 在线数据下载 在线数据上传 在线业务申核 申报业务查询 磁盘数据导出 磁盘数据导入 在线业务模块 在线业务

    TopColor := clBtnHighlight;
    if BevelStyle = bvLowered then TopColor := clBtnShadow;
    BottomColor := clBtnShadow;
    if BevelStyle = bvLowered then BottomColor := clBtnHighlight;
    Frame3D(Canvas, R, TopColor, BottomColor, FBevelWidth);
  end;
  if (csOpaque in ControlStyle) then
    with Canvas do begin
      Brush.Color := Color;
      FillRect(R);
    end;
  if FRuler.Width > 0 then begin
    if soRulerOpaque in Options then TransColor := clNone
    else TransColor := FRuler.TransparentColor;
    DrawBitmapTransparent(Canvas, FRulerOrg.X, FRulerOrg.Y, FRuler,
      TransColor);
  end;
  if (soShowFocus in Options) and FFocused and
    not (csDesigning in ComponentState) then
  begin
    R := SliderRect;
    InflateRect(R, -2, -2);
    Canvas.DrawFocusRect(R);
  end;
  if (soShowPoints in Options) then begin
    if Assigned(FOnDrawPoints) then FOnDrawPoints(Self)
    else InternalDrawPoints(Canvas, Increment, 3, 5);
  end;
{$IFDEF WIN32}
  if csPaintCopy in ControlState then
    HighlightThumb := not Enabled else
{$ENDIF}
  HighlightThumb := FThumbDown or not Enabled;
  DrawThumb(Canvas, P, HighlightThumb);
end;

function TRxCustomSlider.CanModify: Boolean;
begin
  Result := True;
end;

function TRxCustomSlider.GetSliderValue: Longint;
begin
  Result := FValue;
end;

function TRxCustomSlider.GetSliderRect: TRect;
begin
  Result := Bounds(0, 0, Width, Height);
  if BevelStyle <> bvNone then
    InflateRect(Result, -FBevelWidth, -FBevelWidth);
end;

procedure TRxCustomSlider.DrawThumb(Canvas: TCanvas; Origin: TPoint;
  Highlight: Boolean);
var
  R: TRect;
  Image: TBitmap;
  TransColor: TColor;
begin
  if Orientation = soHorizontal then Image := ImageHThumb
  else Image := ImageVThumb;
  R := Rect(0, 0, Image.Width, Image.Height);
  if NumThumbStates = 2 then begin
    if Highlight then R.Left := (R.Right - R.Left) div 2
    else R.Right := (R.Right - R.Left) div 2;
  end;
  if soThumbOpaque in Options then TransColor := clNone
  else TransColor := Image.TransparentColor;
  DrawBitmapRectTransparent(Canvas, Origin.X, Origin.Y, R, Image, TransColor);
end;

procedure TRxCustomSlider.InternalDrawPoints(ACanvas: TCanvas; PointsStep,
  PointsHeight, ExtremePointsHeight: Longint);
const
  MinInterval = 3;
var
  RulerLength: Integer;
  Interval, Scale, PointsCnt, I, Val: Longint;
  X, H, X1, X2, Y1, Y2: Integer;
  Range: Double;
begin
  RulerLength := GetRulerLength;
  ACanvas.Pen.Color := clWindowText;
  Scale := 0;
  Range := MaxValue - MinValue;
  repeat
    Inc(Scale);
    PointsCnt := Round(Range / (Scale * PointsStep)) + 1;
    if PointsCnt > 1 then
      Interval := RulerLength div (PointsCnt - 1)
    else Interval := RulerLength;
  until (Interval >= MinInterval + 1) or (Interval >= RulerLength);
  Val := MinValue;
  for I := 1 to PointsCnt do begin
    H := PointsHeight;
    if I = PointsCnt then Val := MaxValue;
    if (Val = MaxValue) or (Val = MinValue) then H := ExtremePointsHeight;
    X := GetOffsetByValue(Val);
    if Orientation = soHorizontal then begin
      X1 := X + (FImages[siHThumb].Width div NumThumbStates) div 2;
      Y1 := FPointsRect.Top;
      X2 := X1;
      Y2 := Y1 + H;
    end
    else begin
      X1 := FPointsRect.Left;
      Y1 := X + FImages[siVThumb].Height div 2;
      X2 := X1 + H;
      Y2 := Y1;
    end;
    with ACanvas do begin
      MoveTo(X1, Y1);
      LineTo(X2, Y2);
    end;
    Inc(Val, Scale * PointsStep);
  end;
end;

procedure TRxCustomSlider.DefaultDrawPoints(PointsStep, PointsHeight,
  ExtremePointsHeight: Longint);
begin
  InternalDrawPoints(Canvas, PointsStep, PointsHeight, ExtremePointsHeight);
end;

procedure TRxCustomSlider.CreateElements;
var
  I: TSliderImage;
begin
  FRuler := TBitmap.Create;
  for I := Low(FImages) to High(FImages) do SetImage(Ord(I), nil);
  AdjustElements;
end;

procedure TRxCustomSlider.BuildRuler(R: TRect);
var
  DstR, BmpR: TRect;
  I, L, B, N, C, Offs, Len, RulerWidth: Integer;
  TmpBmp: TBitmap;
  Index: TSliderImage;
begin
  TmpBmp := TBitmap.Create;
  try
    if Orientation = soHorizontal then Index := siHRuler
    else Index := siVRuler;
    if Orientation = soHorizontal then begin
      L := R.Right - R.Left - 2 * Indent;
      if L < 0 then L := 0;
      TmpBmp.Width := L;
      TmpBmp.Height := FImages[Index].Height;
      L := TmpBmp.Width - 2 * FEdgeSize;
      B := FImages[Index].Width - 2 * FEdgeSize;
      RulerWidth := FImages[Index].Width;
    end
    else begin
      TmpBmp.Width := FImages[Index].Width;
      TmpBmp.Height := R.Bottom - R.Top - 2 * Indent;
      L := TmpBmp.Height - 2 * FEdgeSize;
      B := FImages[Index].Height - 2 * FEdgeSize;
      RulerWidth := FImages[Index].Height;
    end;
    N := (L div B) + 1;
    C := L mod B;
    for I := 0 to N - 1 do begin
      if I = 0 then begin
        Offs := 0;
        Len := RulerWidth - FEdgeSize;
      end
      else begin
        Offs := FEdgeSize + I * B;
        if I = N - 1 then Len := C + FEdgeSize
        else Len := B;
      end;
      if Orientation = soHorizontal then
        DstR := Rect(Offs, 0, Offs + Len, TmpBmp.Height)
      else DstR := Rect(0, Offs, TmpBmp.Width, Offs + Len);
      if I = 0 then Offs := 0
      else
        if I = N - 1 then Offs := FEdgeSize + B - C
        else Offs := FEdgeSize;
      if Orientation = soHorizontal then
        BmpR := Rect(Offs, 0, Offs + DstR.Right - DstR.Left, TmpBmp.Height)
      else
        BmpR := Rect(0, Offs, TmpBmp.Width, Offs + DstR.Bottom - DstR.Top);
      TmpBmp.Canvas.CopyRect(DstR, FImages[Index].Canvas, BmpR);
    end;
    FRuler.Assign(TmpBmp);
  finally
    TmpBmp.Free;
  end;
end;

procedure TRxCustomSlider.AdjustElements;
var
  SaveValue: Longint;
  R: TRect;
begin
  SaveValue := Value;
  R := SliderRect;
  BuildRuler(R);
  if Orientation = soHorizontal then begin
    if FImages[siHThumb].Height > FRuler.Height then begin
      FThumbRect := Bounds(R.Left + Indent, R.Top + Indent,
        FImages[siHThumb].Width div NumThumbStates, FImages[siHThumb].Height);
      FRulerOrg := Point(R.Left + Indent, R.Top + Indent +
        (FImages[siHThumb].Height - FRuler.Height) div 2);
      FPointsRect := Rect(FRulerOrg.X, R.Top + Indent +
        FImages[siHThumb].Height + 1,
        FRulerOrg.X + FRuler.Width, R.Bottom - R.Top - 1);
    end
    else begin
      FThumbRect := Bounds(R.Left + Indent, R.Top + Indent +
        (FRuler.Height - FImages[siHThumb].Height) div 2,
        FImages[siHThumb].Width div NumThumbStates, FImages[siHThumb].Height);
      FRulerOrg := Point(R.Left + Indent, R.Top + Indent);
      FPointsRect := Rect(FRulerOrg.X, R.Top + Indent + FRuler.Height + 1,
        FRulerOrg.X + FRuler.Width, R.Bottom - R.Top - 1);
    end;
  end
  else begin { soVertical }
    if FImages[siVThumb].Width div NumThumbStates > FRuler.Width then
    begin
      FThumbRect := Bounds(R.Left + Indent, R.Top + Indent,
        FImages[siVThumb].Width div NumThumbStates, FImages[siVThumb].Height);
      FRulerOrg := Point(R.Left + Indent + (FImages[siVThumb].Width div NumThumbStates -
        FRuler.Width) div 2, R.Top + Indent);
      FPointsRect := Rect(R.Left + Indent + FImages[siVThumb].Width div NumThumbStates + 1,
        FRulerOrg.Y, R.Right - R.Left - 1, FRulerOrg.Y + FRuler.Height);
    end
    else begin
      FThumbRect := Bounds(R.Left + Indent + (FRuler.Width -
        FImages[siVThumb].Width div NumThumbStates) div 2, R.Top + Indent,
        FImages[siVThumb].Width div NumThumbStates, FImages[siVThumb].Height);
      FRulerOrg := Point(R.Left + Indent, R.Top + Indent);
      FPointsRect := Rect(R.Left + Indent + FRuler.Width + 1, FRulerOrg.Y,
        R.Right - R.Left - 1, FRulerOrg.Y + FRuler.Height);
    end;
  end;
  Value := SaveValue;
  Invalidate;
end;

procedure TRxCustomSlider.Sized;
begin
  AdjustElements;
end;

procedure TRxCustomSlider.Change;
begin
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TRxCustomSlider.Changed;
begin
  if Assigned(FOnChanged) then FOnChanged(Self);
end;

procedure TRxCustomSlider.RangeChanged;
begin
end;

procedure TRxCustomSlider.DefineProperties(Filer: TFiler);

{$IFDEF WIN32}
  function DoWrite: Boolean;
  begin
    if Assigned(Filer.Ancestor) then
      Result := FUserImages <> TRxCustomSlider(Filer.Ancestor).FUserImages
    else Result := FUserImages <> [];
  end;
{$ENDIF}

begin
  if Filer is TReader then inherited DefineProperties(Filer);
  Filer.DefineBinaryProperty('UserImages', ReadUserImages, WriteUserImages,
    {$IFDEF WIN32} DoWrite {$ELSE} FUserImages <> [] {$ENDIF});
end;

procedure TRxCustomSlider.ReadUserImages(Stream: TStream);
begin
  Stream.ReadBuffer(FUserImages, SizeOf(FUserImages));
end;

procedure TRxCustomSlider.WriteUserImages(Stream: TStream);
begin
  Stream.WriteBuffer(FUserImages, SizeOf(FUserImages));
end;

function TRxCustomSlider.StoreImage(Index: Integer): Boolean;
begin
  Result := TSliderImage(Index) in FUserImages;
end;

function TRxCustomSlider.GetImage(Index: Integer): TBitmap;
begin
  Result := FImages[TSliderImage(Index)];
end;

procedure TRxCustomSlider.SliderImageChanged(Sender: TObject);
begin
  if not (csCreating in ControlState) then Sized;
end;

procedure TRxCustomSlider.SetImage(Index: Integer; Value: TBitmap);
var
  Idx: TSliderImage;
begin
  Idx := TSliderImage(Index);
  if FImages[Idx] = nil then begin
    FImages[Idx] := TBitmap.Create;
    FImages[Idx].OnChange := SliderImageChanged;
  end;
  if Value = nil then begin
    FImages[Idx].Handle := LoadBitmap(HInstance, ImagesResNames[Idx]);
    Exclude(FUserImages, Idx);
    if not (csReading in ComponentState) then begin
      if Idx in [siHThumb, siVThumb] then Exclude(FOptions, soThumbOpaque)
      else Exclude(FOptions, soRulerOpaque);
      Invalidate;
    end;
  end
  else begin
    FImages[Idx].Assign(Value);
    Include(FUserImages, Idx);
  end;
end;

procedure TRxCustomSlider.SetEdgeSize(Value: Integer);
var
  MaxSize: Integer;
begin
  if Orientation = soHorizontal then MaxSize := FImages[siHRuler].Width
  else MaxSize := FImages[siVRuler].Height;
  if Value * 2 < MaxSize then
    if Value <> FEdgeSize then begin
      FEdgeSize := Value;
      Sized;
    end;
end;

function TRxCustomSlider.GetNumThumbStates: TNumThumbStates;
begin
  Result := FNumThumbStates;
end;

procedure TRxCustomSlider.SetNumThumbStates(Value: TNumThumbStates);
begin
  if FNumThumbStates <> Value then begin
    FNumThumbStates := Value;
    AdjustElements;
  end;
end;

procedure TRxCustomSlider.SetBevelStyle(Value: TPanelBevel);
begin
  if Value <> FBevelStyle then begin
    FBevelStyle := Value;
    Sized;
    Update;
  end;
end;

procedure TRxCustomSlider.SetOrientation(Value: TSliderOrientation);
begin
  if Orientation <> Value then begin
    FOrientation := Value;
    Sized;
    if ComponentState * [csLoading {$IFDEF WIN32}, csUpdating {$ENDIF}] = [] then
      SetBounds(Left, Top, Height, Width);
  end;
end;

procedure TRxCustomSlider.SetOptions(Value: TSliderOptions);
begin
  if Value <> FOptions then begin
    FOptions := Value;
    Invalidate;
  end;
end;

procedure TRxCustomSlider.SetRange(Min, Max: Longint);
begin
  if (Min < Max) or (csReading in ComponentState) then begin
    FMinValue := Min;
    FMaxValue := Max;
    if not (csReading in ComponentState) then
      if Min + Increment > Max then FIncrement := Max - Min;
    if (soShowPoints in Options) then Invalidate;
    Self.Value := FValue;
    RangeChanged;
  end;
end;

procedure TRxCustomSlider.SetMinValue(Value: Longint);
begin
  if FMinValue <> Value then SetRange(Value, MaxValue);
end;

procedure TRxCustomSlider.SetMaxValue(Value: Longint);
begin
  if FMaxValue <> Value then SetRange(MinValue, Value);
end;