⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 teelegendscrollbar.pas

📁 BCB第三方组件
💻 PAS
📖 第 1 页 / 共 2 页
字号:
          tmpItemSize:=tmpSize/Math.Max(1,(Num-CurrentCount+1));
        end;

        if Self.FHorizontal then
           ThumbBegin:=R.Left
        else
           ThumbBegin:=R.Top;

        Inc(ThumbBegin,FSize+Round(Position*tmpItemSize));

        ThumbEnd:=ThumbBegin+IThumbSize+1;

        // Thumb

        tmpR:=ThumbRectangle;

        tmp:=FThumb.Image.Filtered;

        if Assigned(tmp) then
        begin
          Dec(tmpR.Right);
          StretchDraw(tmpR,tmp);
          Inc(tmpR.Right);
        end
        else
        if FThumb.Gradient.Visible then
        begin
          Dec(tmpR.Right);
          FThumb.Gradient.Draw(ParentChart.Canvas,tmpR);
          Inc(tmpR.Right);
        end
        else
        begin
          AssignBrush(Self.ThumbBrush);
          Rectangle(tmpR);
        end;

        if Self.FBevel<>bvNone then
        begin
          Dec(tmpR.Right);
          DrawBevel(ParentChart.Canvas,Self.FBevel,tmpR,1);
        end;
      end;
    end;
  end;
end;

Procedure TTeeScrollBar.ApplyScroll(Delta:Double; ActivateTimer:Boolean);

  Procedure DoChange(const NewValue:Double);
  begin
    Position:=Round(NewValue);
    DoScroll;

    if ActivateTimer and FirstTime and FAutoRepeat then
    begin
      if not Assigned(FTimer) then
      begin
        FTimer:=TTimer.Create(Self);
        FTimer.OnTimer:=DoTimer;
      end;

      FTimer.Interval:=FInitial;
      FTimer.Enabled:=True;
    end;
  end;

begin
  if Delta<0 then
  begin
    Delta:=Math.Max(-Position,Delta);

    if Position>(Delta+1) then
       DoChange(Position+Delta);
  end
  else
  begin
    if (Position+Delta-1)<(TotalCount-CurrentCount) then
       DoChange(Position+Delta)
    else
       DoChange(TotalCount-CurrentCount); // <-- 7.04 scroll to bottom end
  end;
end;

function TTeeScrollBar.GetBackColor:TColor;
begin
  result:=Brush.BackColor;
end;

function TTeeScrollBar.GetThumbBrush:TChartBrush; // obsolete
begin
  result:=FThumb.Brush;
end;

function TTeeScrollBar.GetThumbSize:Integer; // obsolete
begin
  result:=FThumb.Size;
end;

Procedure TTeeScrollBar.HideDecOutline;
begin
  if FDecOutline then
  begin
    DrawDecOutline;
    FDecOutline:=False;
  end;
end;

Procedure TTeeScrollBar.HideIncOutline;
begin
  if FIncOutline then
  begin
    DrawIncOutline;
    FIncOutline:=False;
  end;
end;

Procedure TTeeScrollBar.ProcessClick(const P:TPoint);
var tmp : Integer;
begin
  OldPoint:=P;

  FInThumb:=False;
  FInDec:=False;
  FInInc:=False;

  if ClickedDec(P) then
  begin
    FInDec:=True;
    ApplyScroll(-1,True)
  end
  else
  if ClickedInc(P) then
  begin
    FInInc:=True;
    ApplyScroll(1,True)
  end
  else
  if ClickedThumb(P) then
     FInThumb:=True
  else
  if PointInRect(MainRectangle,P) then
  begin
    if Horizontal then tmp:=P.X
                  else tmp:=P.Y;

    if tmp<ThumbBegin then
       ApplyScroll(-DeltaMain,True)
    else
    if tmp>ThumbEnd then
       ApplyScroll(DeltaMain,True)
  end;
end;

Function TTeeScrollBar.CalcDelta(A,B:Integer):Double;
var tmpR : TRect;
begin
  if A=B then result:=0
  else
  begin
    tmpR:=ScrollRectangle;

    if Horizontal then
       result:=(TotalCount)/((tmpR.Right-tmpR.Left)/Abs(A-B))
    else
       result:=(TotalCount)/((tmpR.Bottom-tmpR.Top)/Abs(A-B));

    if A<B then result:=-result;
  end;
end;

procedure TTeeScrollBar.PrepareOutline;
begin
  with ParentChart.Canvas do
  begin
    Brush.Style:=bsClear;
    Pen.Style:=psSolid;
    Pen.Color:=clWhite;
    Pen.Width:=2;
    Pen.Mode:=pmXor;
  end;
end;

procedure TTeeScrollBar.DrawDecOutline;
begin
  PrepareOutline;
  DrawDecArrow;
end;

procedure TTeeScrollBar.DrawIncOutline;
begin
  PrepareOutline;
  DrawIncArrow;
end;

Procedure TTeeScrollBar.MouseMove(X,Y:Integer);
var tmp : Double;
begin
  if FInThumb then
  begin
    if Horizontal then tmp:=CalcDelta(X,OldPoint.X)
                  else tmp:=CalcDelta(Y,OldPoint.Y);

    if Abs(tmp)>=1 then
    begin
      ApplyScroll(tmp,False);
      OldPoint.X:=X;
      OldPoint.Y:=Y;
    end;
  end
  else
  if ClickedDec(TeePoint(X,Y)) then
  begin
    if (Position>0) and (not FDecOutline) then
    begin
      DrawDecOutline;
      FDecOutline:=True;
    end;
  end
  else
  begin
    HideDecOutline;

    if ClickedInc(TeePoint(X,Y)) then
    begin
      if (Position<(TotalCount-CurrentCount)) and (not FIncOutline) then
      begin
        DrawIncOutline;
        FIncOutline:=True;
      end;
    end
    else
      HideIncOutline;
  end;
end;

Procedure TTeeScrollBar.MouseUp;
begin
  FInThumb:=False;
  FInDec:=False;
  FInInc:=False;

  FirstTime:=True;
  if Assigned(FTimer) then
     FTimer.Enabled:=False;

  Repaint;
end;

Procedure TTeeScrollBar.DoScroll;
begin
  if Assigned(FOnScrolled) then FOnScrolled(Self);
end;

procedure TTeeScrollBar.SetThumb(const Value: TScrollBarThumb);
begin
  FThumb.Assign(Value);
end;

procedure TTeeScrollBar.SetThumbBrush(const Value: TChartBrush);
begin
  FThumb.Brush:=Value; // obsolete
end;

procedure TTeeScrollBar.SetThumbSize(const Value: Integer);
begin
  FThumb.Size:=Value; // obsolete
end;

procedure TTeeScrollBar.SetBevel(const Value: TPanelBevel);
begin
  if FBevel<>Value then
  begin
    FBevel:=Value;
    Repaint;
  end;
end;

procedure TTeeScrollBar.ChartEvent(AEvent:TChartToolEvent);
begin
  if AEvent=cteAfterDraw then
     Draw;
end;

procedure TTeeScrollBar.DoTimer(Sender: TObject);
begin
  ProcessClick(OldPoint);

  if FTimer.Interval>50 then
     FTimer.Interval:=50;
end;

procedure TTeeScrollBar.SetHorizontal(const Value: Boolean);
begin
  SetBooleanProperty(FHorizontal,Value);
end;

procedure TTeeScrollBar.ChartMouseEvent(AEvent: TChartMouseEvent;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  case AEvent of
    cmeDown: ProcessClick(TeePoint(X,Y));
    cmeMove: MouseMove(X,Y);
      cmeUp: MouseUp;
  end;
end;

function TTeeScrollBar.CurrentCount: Integer;
begin
  result:=ThumbLength;
end;

function TTeeScrollBar.GetPosition: Integer;
begin
  result:=FPosition;
end;

procedure TTeeScrollBar.Assign(Source:TPersistent);
begin
  if Source is TTeeScrollBar then
  with TTeeScrollBar(Source) do
  begin
    Self.ArrowBrush:=ArrowBrush;
    Self.AutoRepeat:=AutoRepeat;
    Self.BackColor:=BackColor;
    Self.Bevel:=Bevel;
    Self.DrawStyle:=DrawStyle;
    Self.Gradient:=Gradient;
    Self.InitialDelay:=InitialDelay;
    Self.MinThumbSize:=MinThumbSize;
    Self.Size:=Size;
    Self.Thumb:=Thumb;
  end;

  inherited;
end;

class function TTeeScrollBar.Description: String;
begin
  result:=TeeMsg_TeeScrollBar;
end;

procedure TTeeScrollBar.SetBackColor(const Value: TColor);
begin
  Brush.BackColor:=Value;
end;

class function TTeeScrollBar.GetEditorClass: String;
begin
  result:='TScrollBarEditor'; // Do not localize
end;

procedure TTeeScrollBar.SetPosition(Value: Integer);
begin
  SetIntegerProperty(FPosition,Value);
  if Assigned(FOnSetPosition) then
     FOnSetPosition(Self,Value);
end;

procedure TTeeScrollBar.SetArrowBrush(const Value: TChartBrush);
begin
  FArrowBrush.Assign(Value);
end;

function TTeeScrollBar.DeltaMain: Integer;
begin
  result:=CurrentCount div 4;
end;

function TTeeScrollBar.ShouldDraw(var R: TRect): Boolean;
begin
  result:=TotalCount>0;
end;

function TTeeScrollBar.TotalCount: Integer;
begin
  result:=Max;
end;

procedure TTeeScrollBar.SetSize(const Value: Integer);
begin
  if FSize<>Value then
  begin
    SetIntegerProperty(FSize,Value);
    if Assigned(FOnChangeSize) then
       FOnChangeSize(Self);
  end;
end;

procedure TTeeScrollBar.SetParentChart(const Value: TCustomAxisPanel);
begin
  inherited;
  Repaint;
end;

procedure TTeeScrollBar.SetGradient(const Value: TTeeGradient);
begin
  FGradient.Assign(Value);
end;

procedure TTeeScrollBar.SetMinSize(const Value: Integer);
begin
  SetIntegerProperty(FMinSize,Value);
end;

{ TLegendScrollBar }

function TLegendScrollBar.ShouldDraw(var R:TRect):Boolean;
begin
  if Assigned(ParentChart) then
  begin
    L:=TCustomChart(ParentChart).Legend;

    // 8.0 This takes priority. TV52011438
    result:=L.ShouldDraw and (L.TotalLegendItems>0);

    if result then
       result:=(L.LastValue>-1) and
              ((DrawStyle=dsAlways) or (L.LastValue+1<L.TotalLegendItems)
                or (L.FirstValue>0));

    if result then
    begin
      FHorizontal:=not L.Vertical;
      R:=L.ShapeBounds;
    end;
  end
  else
    result:=False;
end;

function TLegendScrollBar.HasPaging:Boolean;
begin
  result:=ParentChart.MaxPointsPerPage>0;
end;

function TLegendScrollBar.TotalCount:Integer;
begin
  if HasPaging then
     result:=ParentChart.Pages.Count
  else
     result:=L.TotalLegendItems+L.FirstValue;
end;

function TLegendScrollBar.CurrentCount:Integer;
begin
  if HasPaging then
     result:=1
  else
     result:=L.LastValue-L.FirstValue+1;
end;

function TLegendScrollBar.GetPosition:Integer;
begin
  if HasPaging then
     result:=ParentChart.Pages.Current-1
  else
     result:=L.FirstValue;
end;

procedure TLegendScrollBar.SetPosition(Value:Integer);
begin
  if HasPaging then
     ParentChart.Pages.Current:=Value+1
  else
     L.FirstValue:=Value;
end;

procedure TLegendScrollBar.LegendCalcSize(Sender:TCustomChartLegend; var ASize:Integer);
begin
  if Active and ShouldDraw(R) then
     Inc(ASize,Size+1);
end;

procedure TLegendScrollBar.SetParentChart(const Value: TCustomAxisPanel);
begin
  SetLegendEvent(nil);
  inherited;
  SetLegendEvent(LegendCalcSize);
end;

class function TLegendScrollBar.Description: String;
begin
  result:=TeeMsg_LegendScrollbar;
end;

function TLegendScrollBar.DeltaMain: Integer;
begin
  if ParentChart.MaxPointsPerPage>0 then
     result:=1
  else
     result:=inherited DeltaMain;
end;

Destructor TLegendScrollBar.Destroy;
begin
  SetLegendEvent(nil);
  inherited;
end;

type
  TLegendAccess=class(TChartLegend);

procedure TLegendScrollBar.SetLegendEvent(Value:TLegendCalcSize);
begin
  if Assigned(ParentChart) and Assigned(TCustomChart(ParentChart).Legend) then
     TLegendAccess(TCustomChart(ParentChart).Legend).FOnCalcSize:=Value;
end;

class function TLegendScrollBar.LongDescription: String;
begin
  result:=TeeMsg_LegendScrollDesc;
end;

{ TScrollbarEditor }

procedure TScrollbarEditor.FormShow(Sender: TObject);
begin
  TeeScroll:=TTeeScrollBar(Tag);

  if Assigned(TeeScroll) then
  with TeeScroll do
  begin
    ButtonPen1.LinkPen(Pen);
    ComboBox1.ItemIndex:=Ord(Bevel);
    CBAuto.Checked:=AutoRepeat;
    UDSize.Position:=Size;
    UDDelay.Position:=InitialDelay;
    UDThumbSize.Position:=Thumb.Size;

    ButtonColor1.LinkProperty(TeeScroll,'BackColor'); // Do not localize

    BGradient.Gradient:=Gradient;
    BThumbGrad.Gradient:=Thumb.Gradient;
    CBStyle.ItemIndex:=Ord(Thumb.Style);

    EnableFilters;
  end;
end;

procedure TScrollbarEditor.Button1Click(Sender: TObject);
begin
  EditChartBrush(Self,TeeScroll.ThumbBrush)
end;

procedure TScrollbarEditor.Button2Click(Sender: TObject);
begin
  EditChartBrush(Self,TeeScroll.Brush)
end;

procedure TScrollbarEditor.ComboBox1Change(Sender: TObject);
begin
  TeeScroll.Bevel:=TPanelBevel(ComboBox1.ItemIndex);
end;

procedure TScrollbarEditor.CBAutoClick(Sender: TObject);
begin
  TeeScroll.AutoRepeat:=CBAuto.Checked;
end;

procedure TScrollbarEditor.Edit1Change(Sender: TObject);
begin
  if Showing and Assigned(TeeScroll) then
     TeeScroll.Size:=UDSize.Position;
end;

procedure TScrollbarEditor.Button3Click(Sender: TObject);
begin
  EditChartBrush(Self,TeeScroll.ArrowBrush)
end;

procedure TScrollbarEditor.Edit2Change(Sender: TObject);
begin
  if Showing and Assigned(TeeScroll) then
     TeeScroll.InitialDelay:=UDDelay.Position;
end;

procedure TScrollbarEditor.Edit3Change(Sender: TObject);
begin
  if Showing and Assigned(TeeScroll) then
     TeeScroll.ThumbSize:=UDThumbSize.Position;
end;

procedure TScrollbarEditor.BFiltersClick(Sender: TObject);
begin
  ShowFiltersEditor(Self, TeeScroll.Thumb.Image);
end;

procedure TScrollbarEditor.BBrowseClick(Sender: TObject);
begin
  TeeScroll.Thumb.Image.Assign(nil);
  TeeLoadClearImage(Self,TeeScroll.Thumb.Image);
  EnableFilters;
end;

procedure TScrollbarEditor.EnableFilters;
begin
  BFilters.Enabled:=TeeScroll.Thumb.Image.Graphic<>nil;
end;

procedure TScrollbarEditor.CBStyleChange(Sender: TObject);
begin
  TeeScroll.Thumb.Style:=TScrollThumbStyle(CBStyle.ItemIndex);
  EnableFilters;
end;

initialization
  RegisterClass(TScrollbarEditor);
  RegisterTeeTools([TLegendScrollBar]);
finalization
  UnRegisterTeeTools([TLegendScrollBar]);
end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -