cxscrollbar.pas

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

    ADelta := FBottomRightArrowRect.Top - FTopLeftArrowRect.Bottom;
    if ScrollBar.PageSize = 0 then
    begin
      ASize := GetSystemMetrics(SM_CYVTHUMB);
      if ASize > ADelta then
        Exit;
      Dec(ADelta, ASize);
      if (ADelta <= 0) or (ScrollBar.Max = ScrollBar.Min) then
        FThumbnailRect := Bounds(0, FTopLeftArrowRect.Bottom, ScrollBar.Width, ASize)
      else
        FThumbnailRect := Bounds(0, FTopLeftArrowRect.Bottom +
          MulDiv(ADelta, ScrollBar.Position - ScrollBar.Min, ScrollBar.Max - ScrollBar.Min), ScrollBar.Width, ASize);
    end
    else
    begin
      ASize := MinInt(ADelta, MulDiv(ScrollBar.PageSize, ADelta, ScrollBar.Max - ScrollBar.Min + 1));
      if (ADelta < FThumbnailSize) or (ScrollBar.Max = ScrollBar.Min) then
        Exit;
      if ASize < FThumbnailSize then
        ASize := FThumbnailSize;
      Dec(ADelta, ASize);
      FThumbnailRect := Bounds(0, FTopLeftArrowRect.Bottom, ScrollBar.Width, ASize);
      ASize := (ScrollBar.Max - ScrollBar.Min) - (ScrollBar.PageSize - 1);
      OffsetRect(FThumbnailRect, 0, MulDiv(ADelta, MinInt(ScrollBar.Position - ScrollBar.Min, ASize), ASize));
    end;
  end;
  AdjustPageRects;
end;

procedure TcxScrollBarViewInfo.SetThumbnailPos(APos: Integer);
begin
  if ScrollBar.Kind = sbHorizontal then
    OffsetRect(FThumbnailRect, -FThumbnailRect.Left + APos, 0)
  else
    OffsetRect(FThumbnailRect, 0, -FThumbnailRect.Top + APos);
end;

procedure TcxScrollBarViewInfo.CalculateRects;
var
  ASize, H, W: Integer;
begin
  if ScrollBar.Kind = sbHorizontal then
  begin
    ASize := GetScrollBarSize.cy;
    if ScrollBar.Width div 2 < ASize then
      W := ScrollBar.Width div 2
    else
      W := ASize;
    FTopLeftArrowRect := Bounds(0, 0, W, ScrollBar.Height);
    FBottomRightArrowRect := Bounds(ScrollBar.Width - W, 0, W, ScrollBar.Height);
  end
  else
  begin
    ASize := GetScrollBarSize.cx;
    if ScrollBar.Height div 2 < ASize then
      H := ScrollBar.Height div 2
    else
      H := ASize;
    FTopLeftArrowRect := Bounds(0, 0, ScrollBar.Width, H);
    FBottomRightArrowRect := Bounds(0, ScrollBar.Height - H, ScrollBar.Width, H);
  end;
  CalculateThumbnailRect;
end;

{ TcxScrollBar }

constructor TcxScrollBar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FBitmap := TBitmap.Create;
  FBitmap.PixelFormat := pfDevice;
  FCanvas := TcxCanvas.Create(FBitmap.Canvas);
  FLookAndFeel := TcxLookAndFeel.Create(Self);
  FLookAndFeel.OnChanged := LookAndFeelChanged;
  FViewInfo := GetViewInfoClass.Create(Self);
  Width := 121;
  ControlStyle := [csFramed, csOpaque, csCaptureMouse];
  FKind := sbHorizontal;
  Height := GetScrollBarSize.cy;
  FThemeChangedNotificator := TdxThemeChangedNotificator.Create;
  FThemeChangedNotificator.OnThemeChanged := ThemeChanged;
  FPosition := 0;
  FMin := 0;
  FMax := 100;
  FSmallChange := 1;
  FLargeChange := 1;

  FTimer := TcxTimer.Create(nil);
  TcxTimer(FTimer).Enabled := False;
  TcxTimer(FTimer).Interval:= cxScrollInitialInterval;
  TcxTimer(FTimer).OnTimer := OnTimer;
  ViewInfo.CalculateMinThumnailSize;
  ViewInfo.Calculate;
end;

destructor TcxScrollBar.Destroy;
begin
  FreeAndNil(FTimer);
  FreeAndNil(FThemeChangedNotificator);
  FreeAndNil(FViewInfo);
  FreeAndNil(FLookAndFeel);
  FreeAndNil(FCanvas);
  FreeAndNil(FBitmap);
  inherited Destroy;
end;

procedure TcxScrollBar.SetCtl3D(Value: Boolean);
begin
  FRealCtl3D := Value;
  InternalCtl3D := Value;
end;

procedure TcxScrollBar.SetInternalCtl3D(Value: Boolean);
begin
  if InternalCtl3D <> Value then
    inherited Ctl3D := Value;
end;

function TcxScrollBar.IsCtl3DStored: Boolean;
begin
  Result := not ParentCtl3D;
end;

procedure TcxScrollBar.OnTimer(Sender: TObject);

  function CheckHotPart: Boolean;
  var
    P: TPoint;
  begin
    GetCursorPos(P);
    Result := GetScrollBarPart(ScreenToClient(P)) = FState.PressedPart;
  end;

begin
  if (GetCaptureControl = Self) and (FState.PressedPart in cxTimerParts) then
  begin
    if TcxTimer(FTimer).Interval = cxScrollInitialInterval then
      TcxTimer(FTimer).Interval := cxScrollInterval;
    DoScroll(FState.PressedPart);
    TcxTimer(FTimer).Enabled := CheckHotPart;
  end
  else
    CancelScroll;
end;

procedure TcxScrollBar.SetKind(Value: TScrollBarKind);
begin
  if FKind <> Value then
  begin
    FKind := Value;
    if not (csLoading in ComponentState) then
      SetBounds(Left, Top, Height, Width)
    else
      ViewInfo.Calculate;
    Invalidate;
  end;
end;

procedure TcxScrollBar.SetLookAndFeel(Value: TcxLookAndFeel);
begin
  FLookAndFeel.Assign(Value);
end;

procedure TcxScrollBar.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
  ABoundsChanged: Boolean;
begin
  ABoundsChanged := (ALeft <> Left) or (ATop <> Top) or
    (AWidth <> Width) or (AHeight <> Height);
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  if ABoundsChanged and (AWidth > 0) and (AHeight > 0) then
  begin
    FBitmap.Width := AWidth;
    FBitmap.Height := AHeight;
    ViewInfo.Calculate;
  end;
end;

procedure TcxScrollBar.SetScrollParams(AMin, AMax, APosition,
  APageSize: Integer; ARedraw: Boolean = True);
begin
  if (AMax < AMin) or (AMax < APageSize) then
    raise EInvalidOperation.Create(SScrollBarRange);
  ARedraw := ARedraw and HandleAllocated;

  if APosition < AMin then APosition := AMin;
  if APosition > AMax then APosition := AMax;

    if (Min <> AMin) or (Max <> AMax) or (FPageSize <> APageSize) or
      (Position <> APosition) then
    begin
      FMin := AMin;
      FMax := AMax;
      FPageSize := APageSize;
    end                                          
    else
      ARedraw := False;
    if Position <> APosition then
    begin
      Enabled := True;
      FPosition := APosition;
      ViewInfo.CalculateThumbnailRect;
      if ARedraw then Repaint;
      Change;
    end
    else
    begin
      ViewInfo.CalculateThumbnailRect;
      if ARedraw then Repaint;
    end;
end;

procedure TcxScrollBar.SetParams(APosition, AMin, AMax: Integer);
begin
  SetScrollParams(AMin, AMax, APosition, FPageSize);
end;

procedure TcxScrollBar.SetMax(Value: Integer);
begin
  SetScrollParams(FMin, Value, FPosition, FPageSize);
end;

procedure TcxScrollBar.SetMin(Value: Integer);
begin
  SetScrollParams(Value, FMax, FPosition, FPageSize);
end;

procedure TcxScrollBar.SetPageSize(Value: Integer);
begin
  SetScrollParams(FMin, FMax, FPosition, Value);
end;

procedure TcxScrollBar.SetPosition(Value: Integer);
begin
  SetScrollParams(FMin, FMax, Value, FPageSize);
end;

procedure TcxScrollBar.Change;
begin
  inherited Changed;
  if Assigned(FOnChange) then FOnChange(Self);
end;

function TcxScrollBar.GetPainter: TcxCustomLookAndFeelPainterClass;
begin
  Result := LookAndFeel.GetAvailablePainter(totScrollBar);
end;

function TcxScrollBar.GetViewInfoClass: TcxScrollBarViewInfoClass;
begin
  Result := TcxScrollBarViewInfo;
end;

procedure TcxScrollBar.LookAndFeelChanged(Sender: TcxLookAndFeel;
  AChangedValues: TcxLookAndFeelValues);
var
  ASaveValue: Boolean;
begin
  if (LookAndFeel.SkinPainter <> nil) and Ctl3D then
  begin
    ASaveValue := Ctl3D;
    InternalCtl3D := False;
    FRealCtl3D := ASaveValue;
  end
  else
    InternalCtl3D := FRealCtl3D;
  ViewInfo.CalculateMinThumnailSize;
  ViewInfo.Calculate;
  Invalidate;
end;

procedure TcxScrollBar.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  APart: TcxScrollBarPart;
begin
  inherited;
  if (Button <> mbLeft) then Exit;
  APart := GetScrollBarPart(Point(X, Y));
  if APart <> sbpNone then
  begin
    if APart = sbpThumbnail then
    begin
      FDownMousePos := Point(X, Y);
      FSavePosition := FPosition;
      FSaveThumbnailPos := ViewInfo.ThumbnailRect.TopLeft;
      InternalScroll(scTrack);
    end;
    FState.PressedPart := APart;
    FState.HotPart := APart;
    if APart in cxTimerParts then
    begin
      DoScroll(APart);
      TcxTimer(FTimer).Interval := cxScrollInitialInterval;
      TcxTimer(FTimer).Enabled := True;
    end;
    Repaint;
  end;
end;

procedure TcxScrollBar.MouseEnter(AControl: TControl);
begin
  if IsButtonHotTrack or (FState.PressedPart in cxTimerParts) then
    Repaint;
end;

procedure TcxScrollBar.MouseLeave(AControl: TControl);
begin
  if FState.PressedPart <> sbpThumbnail then
    FState.HotPart := sbpNone;
  if IsButtonHotTrack or (FState.PressedPart in cxTimerParts) then
    Invalidate;
end;

procedure TcxScrollBar.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  APart: TcxScrollBarPart;
  R: TRect;
  ADelta, ANewPos, ASize: Integer;

  procedure UpdateThumbnail(ADeltaX, ADeltaY: Integer);
  begin
    if FKind = sbHorizontal then
      ViewInfo.SetThumbnailPos(FSaveThumbnailPos.X + ADeltaX)
    else
      ViewInfo.SetThumbnailPos(FSaveThumbnailPos.Y + ADeltaY);
    ViewInfo.AdjustPageRects;
    Repaint;
  end;

begin
  inherited MouseMove(Shift, X, Y);
  APart := GetScrollBarPart(Point(X, Y));
  if FState.PressedPart = sbpThumbnail then
  begin
    if FKind = sbHorizontal then
    begin
      ASize := ViewInfo.ThumbnailRect.Right - ViewInfo.ThumbnailRect.Left;
      R := Rect(-cxScrollMinDistance, -cxScrollMaxDistance,
        Width + cxScrollMinDistance, Height + cxScrollMaxDistance);
    end
    else
    begin
      ASize := ViewInfo.ThumbnailRect.Bottom - ViewInfo.ThumbnailRect.Top;
      R := Rect(-cxScrollMaxDistance, -cxScrollMinDistance,
        Width + cxScrollMaxDistance, Height + cxScrollMinDistance);
    end;
    if not (FUnlimitedTracking or PtInRect(R, Point(X, Y))) then