cxscrollbar.pas

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

    begin
      if Position <> FSavePosition then
      begin
        Position := FSavePosition;
        DoScroll(sbpThumbnail);
      end; 
    end
    else
    begin
      if FKind = sbHorizontal then
      begin
        ADelta := X - FDownMousePos.X;
        if ADelta = 0 then Exit;
        if (ADelta < 0) and (FSaveThumbnailPos.X + ADelta < ViewInfo.TopLeftArrowRect.Right) then
          ADelta := ViewInfo.TopLeftArrowRect.Right - FSaveThumbnailPos.X
        else
          if (ADelta > 0) and (FSaveThumbnailPos.X + ASize + ADelta > ViewInfo.BottomRightArrowRect.Left) then
            ADelta := ViewInfo.BottomRightArrowRect.Left - (FSaveThumbnailPos.X + ASize);
        UpdateThumbnail(ADelta, 0);
      end
      else
      begin
        ADelta := Y - FDownMousePos.Y;
        if ADelta = 0 then Exit;
        if (ADelta < 0) and (FSaveThumbnailPos.Y + ADelta < ViewInfo.TopLeftArrowRect.Bottom) then
          ADelta := ViewInfo.TopLeftArrowRect.Bottom - FSaveThumbnailPos.Y
        else
          if (ADelta > 0) and (FSaveThumbnailPos.Y + ASize + ADelta > ViewInfo.BottomRightArrowRect.Top) then
            ADelta := ViewInfo.BottomRightArrowRect.Top - (FSaveThumbnailPos.Y + ASize);
        UpdateThumbnail(0, ADelta);
      end;
      ANewPos := GetPositionFromThumbnail;
      if ANewPos <> FPosition then
      begin
        FPosition := ANewPos;
        DoScroll(sbpThumbnail);
      end;
    end;
  end
  else
  begin
    if FState.PressedPart <> sbpNone then
      TcxTimer(FTimer).Enabled := FState.PressedPart = APart;
    if (FState.HotPart <> APart) and IsButtonHotTrack then
    begin
      FState.HotPart := APart;
      Repaint;
    end
    else
      FState.HotPart := APart;
  end;
end;

procedure TcxScrollBar.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited;
  begin
    CancelScroll;
    FState.HotPart := GetScrollBarPart(Point(X, Y));
  end;
end;

procedure TcxScrollBar.DoPaint(ACanvas: TcxCanvas);

  function GetButtonStateFromPartState(APart: TcxScrollBarPart): TcxButtonState;
  begin
    if not Enabled then
      Result := cxbsDisabled
    else
      if (APart <> sbpThumbnail) or ((APart = sbpThumbnail) and
        IsButtonHotTrack) then
      begin
        if FState.PressedPart <> sbpNone then
          if (APart = FState.PressedPart) and (APart = FState.HotPart) then
            Result := cxbsPressed
          else
            Result := cxbsNormal
        else
          if (APart = FState.HotPart) and not (csDesigning in ComponentState) then
            Result := cxbsHot
          else
            Result := cxbsNormal
      end
      else
        Result := cxbsNormal;
  end;

begin
  if not IsRectEmpty(ViewInfo.ThumbnailRect) then
    DrawScrollBarPart(ACanvas, ViewInfo.ThumbnailRect, sbpThumbnail,
      GetButtonStateFromPartState(sbpThumbnail))
  else
    DrawScrollBarPart(ACanvas, Bounds(0, 0, Width, Height), sbpPageUp, cxbsNormal);
  DrawScrollBarPart(ACanvas, ViewInfo.TopLeftArrowRect, sbpLineUp,
    GetButtonStateFromPartState(sbpLineUp));
  DrawScrollBarPart(ACanvas, ViewInfo.BottomRightArrowRect, sbpLineDown,
    GetButtonStateFromPartState(sbpLineDown));
  if not IsRectEmpty(ViewInfo.PageUpRect) then
    DrawScrollBarPart(ACanvas, ViewInfo.PageUpRect, sbpPageUp,
      GetButtonStateFromPartState(sbpPageUp));
  if not IsRectEmpty(ViewInfo.PageDownRect) then
    DrawScrollBarPart(ACanvas, ViewInfo.PageDownRect, sbpPageDown,
      GetButtonStateFromPartState(sbpPageDown));
end;

procedure TcxScrollBar.DrawScrollBarPart(ACanvas: TcxCanvas; const R: TRect;
  APart: TcxScrollBarPart; AState: TcxButtonState);
begin
  Painter.DrawScrollBarPart(ACanvas, Kind = sbHorizontal, R, APart, AState);
end;

function TcxScrollBar.IsButtonHotTrack: Boolean;
begin
  Result := Painter.IsButtonHotTrack;
end;

procedure TcxScrollBar.Paint;
begin
  DoPaint(FCanvas);
  BitBlt(Canvas.Handle, 0, 0, FBitmap.Width, FBitmap.Height,
    FCanvas.Handle, 0, 0, SRCCOPY);
end;

procedure TcxScrollBar.Scroll(ScrollCode: TScrollCode; var ScrollPos: Integer);
begin
  if Assigned(FOnScroll) then FOnScroll(Self, ScrollCode, ScrollPos);
end;

function TcxScrollBar.ScrollBarMinimalThumbSize: Integer;
begin
  Result := Painter.ScrollBarMinimalThumbSize(Kind = sbVertical);
end;

procedure TcxScrollBar.CancelScroll;
begin
  if FState.PressedPart <> sbpNone then
  begin
    if FState.PressedPart = sbpThumbnail then
    begin
      FPosition := GetPositionFromThumbnail;
      InternalScroll(scPosition);
    end;
    TcxTimer(FTimer).Enabled := False;
    FState.PressedPart := sbpNone;
    FState.HotPart := sbpNone;
    InternalScroll(scEndScroll);
    ViewInfo.CalculateThumbnailRect;
    Invalidate;
  end;
end;

procedure TcxScrollBar.DoScroll(APart: TcxScrollBarPart);
begin
  case APart of
    sbpLineUp:  InternalScroll(scLineUp);
    sbpLineDown: InternalScroll(scLineDown);
    sbpPageUp: InternalScroll(scPageUp);
    sbpPageDown: InternalScroll(scPageDown);
    sbpThumbnail: InternalScroll(scTrack);
  end;
end;

function TcxScrollBar.GetCtr3D: Boolean;
begin
  Result := InternalCtl3D or FRealCtl3D;
end;

function TcxScrollBar.GetInternalCtl3D: Boolean;
begin
  Result := inherited Ctl3D;
end;

function TcxScrollBar.GetPositionFromThumbnail: Integer;
var
  ATotal, AThumbnailSize, ADistance: Integer;
begin
  ATotal := FMax - FMin;
  if FPageSize > 0 then Dec(ATotal, FPageSize - 1);
  if FKind = sbHorizontal then
  begin
    AThumbnailSize := ViewInfo.ThumbnailRect.Right - ViewInfo.ThumbnailRect.Left;
    ADistance := ViewInfo.BottomRightArrowRect.Left - ViewInfo.TopLeftArrowRect.Right - AThumbnailSize;
    Result := FMin + MulDiv(ATotal, ViewInfo.ThumbnailRect.Left - ViewInfo.TopLeftArrowRect.Right,
      ADistance);
  end
  else
  begin
    AThumbnailSize := ViewInfo.ThumbnailRect.Bottom - ViewInfo.ThumbnailRect.Top;
    ADistance := ViewInfo.BottomRightArrowRect.Top - ViewInfo.TopLeftArrowRect.Bottom - AThumbnailSize;
    Result := FMin + MulDiv(ATotal, ViewInfo.ThumbnailRect.Top - ViewInfo.TopLeftArrowRect.Bottom,
      ADistance);
  end;
end;

function TcxScrollBar.GetScrollBarPart(P: TPoint): TcxScrollBarPart;
begin
  Result := sbpNone;
  if not PtInRect(ClientRect, P) then
    Exit;
  if PtInRect(ViewInfo.TopLeftArrowRect, P) then
    Result := sbpLineUp
  else if PtInRect(ViewInfo.BottomRightArrowRect, P) then
    Result := sbpLineDown
  else if IsRectEmpty(ViewInfo.ThumbnailRect) then
    Exit
  else if PtInRect(ViewInfo.ThumbnailRect, P) then
    Result := sbpThumbnail
  else if PtInRect(ViewInfo.PageUpRect, P) then
    Result := sbpPageUp
  else if PtInRect(ViewInfo.PageDownRect, P) then
    Result := sbpPageDown
end;

procedure TcxScrollBar.InternalScroll(AScrollCode: TScrollCode);
var
  ScrollPos: Integer;
  NewPos: Longint;

  procedure CorrectPos(var APos: Integer);
  begin
    if APos < Min then APos := Min;
    if APos > Max then APos := Max;
  end;

begin
  NewPos := Position;
  case AScrollCode of
    scLineUp:
      Dec(NewPos, SmallChange);
    scLineDown:
      Inc(NewPos, SmallChange);
    scPageUp:
      Dec(NewPos, LargeChange);
    scPageDown:
      Inc(NewPos, LargeChange);
    scTop:
        NewPos := FMin;
    scBottom:
        NewPos := FMax;
  end;
  CorrectPos(NewPos);
  ScrollPos := NewPos;
  Scroll(AScrollCode, ScrollPos);
  begin
    CorrectPos(ScrollPos);
    if ScrollPos <> FPosition then
    begin
      if AScrollCode <> scTrack then
        SetPosition(ScrollPos)
      else
      begin
        FPosition := ScrollPos;
        Repaint;
      end;
    end;
  end;
end;

procedure TcxScrollBar.ThemeChanged;
begin
  ViewInfo.CalculateMinThumnailSize;
  ViewInfo.Calculate;
  UpdateScrollBarBitmaps;
  Invalidate;
  if Parent <> nil then
    Parent.Realign;
end;

procedure TcxScrollBar.CMCtl3DChanged(
  var Message: TMessage);
begin
  inherited;
  FRealCtl3D := InternalCtl3D;
  LookAndFeelChanged(LookAndFeel, []);
end;

procedure TcxScrollBar.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  ViewInfo.Calculate;
  if not Enabled then
    CancelScroll;
  Invalidate;
end;

procedure TcxScrollBar.CNHScroll(var Message: TWMHScroll);
begin
  InternalScroll(TScrollCode(Message.ScrollCode));
end;

procedure TcxScrollBar.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if Message.lParam = 0 then
    MouseEnter(Self)
  else
    MouseEnter(TControl(Message.lParam));
end;

procedure TcxScrollBar.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  if Message.lParam = 0 then
    MouseLeave(Self)
  else
    MouseLeave(TControl(Message.lParam));
end;

procedure TcxScrollBar.CMSysColorChange(var Message: TMessage);
begin
  UpdateScrollBarBitmaps;
  inherited;
end;

procedure TcxScrollBar.CMVisibleChanged(var Message: TMessage);
begin
  if not Visible then CancelScroll;
  inherited;
end;

procedure TcxScrollBar.CNVScroll(var Message: TWMVScroll);
begin
  InternalScroll(TScrollCode(Message.ScrollCode));
end;

procedure TcxScrollBar.CNCtlColorScrollBar(var Message: TMessage);
begin
  UpdateScrollBarBitmaps;
  with Message do
    CallWindowProc(DefWndProc, Handle, Msg, WParam, LParam);
end;

procedure TcxScrollBar.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  Message.Result := 1;
end;

procedure TcxScrollBar.WMCancelMode(var Message: TWMCancelMode);
begin
  CancelScroll;
  inherited;
end;

end.