sscrollmax.pas

Alpha Controls.v5.46b Source

procedure TsScrollMaxBand.Loaded;
begin
  inherited Loaded;
  SkinData.Loaded;
  Perform(CM_PARENTBEVELEDCHANGED, 0, 0);
  Perform(CM_PARENTBUTTONVISIBLECHANGED, 0, 0);
  TextChanged;
end;

procedure TsScrollMaxBand.BoundsChanged;
begin
  if FExpanded then ExpandedHeight := Height;
  if ScrollMax <> nil then ScrollMax.CorrectHeight;
end;

procedure TsScrollMaxBand.TextChanged;
begin
  FButton.Caption := Caption;
end;

procedure TsScrollMaxBand.SetExpanded(const Value: Boolean);
begin
  if FExpanded <> Value then begin
    FExpanded := Value;
    if FExpanded and Assigned(FOnExpand) then FOnExpand(Self);
    if not FExpanded and Assigned(FOnCollapse) then FOnCollapse(Self);
    RequestAlign;
    if ScrollMax <> nil then ScrollMax.CorrectHeight;
    if not FExpanded then FButton.SkinData.Invalidate
  end;
end;

procedure TsScrollMaxBand.SetExpandedHeight(const Value: Integer);
begin
  if FExpandedHeight <> Value then begin
    FExpandedHeight := Value;
    if FExpanded then Height := FExpandedHeight;
  end;
end;

function TsScrollMaxBand.GetOrder: Integer;
var
  I: Integer;
begin
  Result := FOrder;
  if (Parent = nil) or not (Parent is TsScrollMaxBands) then Exit;
  for I := 0 to Parent.ControlCount - 1 do if Parent.Controls[I] = Self then begin
    Result := I;
    Break;
  end;
end;

procedure TsScrollMaxBand.SetOrder(const Value: Integer);
begin
  if (Parent = nil) or not (Parent is TsScrollMaxBands) then Exit;
  if FOrder <> Value then begin
    TsScrollMaxBands(Parent).SetChildOrder(Self, Value);
    FOrder := GetOrder;
    RequestAlign;
  end;
end;

function TsScrollMaxBand.GetButtonVisible: Boolean;
begin
  Result := FButton.Visible;
end;

procedure TsScrollMaxBand.SetButtonVisible(const Value: Boolean);
begin
  if FButton.Visible <> Value then begin
    FParentButtonVisible := False;
    FButton.Visible := Value;
    UpdateSize(Top);
    Invalidate;
  end;
end;

function TsScrollMaxBand.IsButtonVisibleStored: Boolean;
begin
  Result := not ParentButtonVisible;
end;

procedure TsScrollMaxBand.SetParentButtonVisible(const Value: Boolean);
begin
  if FParentButtonVisible <> Value then begin
    FParentButtonVisible := Value;
    if Parent <> nil then Perform(CM_PARENTBUTTONVISIBLECHANGED, 0, 0);
  end;
end;

procedure TsScrollMaxBand.CMParentButtonVisibleChanged(var Msg: TMessage);
begin
  if FParentButtonVisible then begin
    if ScrollMax <> nil then SetButtonVisible(ScrollMax.FButtonVisible);
    FParentButtonVisible := True;
  end;
end;

procedure TsScrollMaxBand.SetBeveled(const Value: Boolean);
begin
  if FBeveled <> Value then begin
    FParentBeveled := False;
    FBeveled := Value;
    UpdateSize(Top);
    Invalidate;
  end;
end;

function TsScrollMaxBand.IsBeveledStored: Boolean;
begin
  Result := not ParentBeveled;
end;

procedure TsScrollMaxBand.SetParentBeveled(const Value: Boolean);
begin
  if FParentBeveled <> Value then begin
    FParentBeveled := Value;
    if Parent <> nil then Perform(CM_PARENTBEVELEDCHANGED, 0, 0);
  end;
end;

procedure TsScrollMaxBand.CMParentBeveledChanged(var Msg: TMessage);
begin
  if FParentBeveled then begin
    if ScrollMax <> nil then SetBeveled(ScrollMax.FBeveled);
    FParentBeveled := True;
  end;
end;

procedure TsScrollMaxBand.ButtonClick(Sender: TObject);
var
  E: Boolean;
begin
  E := True;
  if FExpanded then begin
    if Assigned(FOnCanCollapse) then FOnCanCollapse(Self, E);
  end
  else if Assigned(FOnCanExpand) then FOnCanExpand(Self, E);
  if E then Expanded := not FExpanded;
end;

procedure TsScrollMaxBand.SetParent(AParent: TWinControl);
begin
  inherited SetParent(AParent);
  if not (csLoading in ComponentState) then begin
    Perform(CM_PARENTBEVELEDCHANGED, 0, 0);
    Perform(CM_PARENTBUTTONVISIBLECHANGED, 0, 0);
  end;
end;

procedure TsScrollMaxBand.SetZOrder(TopMost: Boolean);
begin
  inherited SetZOrder(TopMost);
  RequestAlign;
end;

procedure TsScrollMaxBand.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if ScrollMax <> nil then ScrollMax.BandMouseDown(Self, Button, Shift, X, Y);
end;

procedure TsScrollMaxBand.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseMove(Shift, X, Y);
  if ScrollMax <> nil then ScrollMax.BandMouseMove(Self, Shift, X, Y);
end;

procedure TsScrollMaxBand.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  if ScrollMax <> nil then ScrollMax.BandMouseUp(Self, Button, Shift, X, Y);
end;

function TsScrollMaxBand.ScrollMax: TsScrollMax;
begin
  if (Parent <> nil) and (Parent is TsScrollMaxBands) and ((Parent as TsScrollMaxBands).Parent <> nil)
    then Result := Parent.Parent as TsScrollMax
    else Result := nil;
end;

function TsScrollMaxBand.CollapsedHeight: Integer;
begin
  Result := FButton.Height + FButton.Top;
end;

procedure TsScrollMaxBand.UpdateSize(ATop: Integer);
var
  W, H: Integer;
begin
  if (Parent <> nil) and not (Parent is TsScrollMaxBands) then Exit;
  if FExpanded then H := FExpandedHeight else H := CollapsedHeight;
  if ScrollMax <> nil then begin
    W := Parent.Width;
    if ScrollMax.ScrollBarVisible then W := W - 3;
  end
  else W := Width;
  SetBounds(0, ATop, W, H);
  FButton.Left := 0;
  FButton.Width := Width;
end;

procedure TsScrollMaxBand.Paint;
const
  Ex: array [Boolean] of Integer = (BF_TOP, BF_RECT);
var
  R: TRect;
begin
  if Canvas.Handle <> 0 then begin
    if csDesigning in ComponentState then;
    if FBeveled then begin
      R.Left := 0;
      if ButtonVisible then R.Top := FButton.Top + FButton.Height else R.Top := 0;
      R.Right := Width;
      R.Bottom := Height;
      Windows.DrawEdge(Canvas.Handle, R, EDGE_ETCHED, Ex[FExpanded]);
      if ButtonVisible then begin
        Canvas.Brush.Color := Color;
        Canvas.Brush.Style := bsSolid;
        if Expanded
          then Canvas.FillRect(Bounds(1, R.Top, Width - 3, 2))
          else Canvas.FillRect(Bounds(0, R.Top, Width, 2))
      end;
    end;
  end;
end;

procedure TsScrollMaxBand.AlignControls(AControl: TControl; var Rect: TRect);
var
  BevelSize: Integer;
begin
  BevelSize := FBorderWidth;
  if FBeveled then Inc(BevelSize, 3);
  InflateRect(Rect, -BevelSize, -BevelSize);
  if ButtonVisible then begin
    Inc(Rect.Top, FButton.Height);
    if FButton.Top > FBorderWidth then Inc(Rect.Top, FButton.Top);
  end;
  inherited AlignControls(AControl, Rect);
end;

procedure TsScrollMaxBand.SetBorderWidth(const Value: Integer);
begin
  if FBorderWidth <> Value then begin
    FBorderWidth := Value;
    Realign;
  end;
end;

procedure TsScrollMaxBand.ChangeScale(M, D : Integer);
begin
  inherited ChangeScale(M, D);
  ExpandedHeight := FExpandedHeight * M div D;
end;

procedure TsScrollMaxBands.AlignControls(AControl: TControl; var Rect: TRect);
var
  I: Integer;
  ScrollMax: TsScrollMax;
  T: Integer;
  SMax, SPage, SPos: Integer;
  procedure AdjustBottom;
  begin
    if (Controls[ControlCount - 1].BoundsRect.Bottom < Height) and (Controls[0].Top < 0) then begin
      if Height - (Controls[ControlCount - 1].BoundsRect.Bottom - Controls[0].Top) > 0
        then ScrollControls(-Controls[0].Top)
        else ScrollControls(Height - Controls[ControlCount - 1].BoundsRect.Bottom);
    end;
  end;
  procedure AdjustBand;
  var
    Band: TsScrollMaxBand;
  begin
    Band := AControl as TsScrollMaxBand;
    if (Band <> nil) and Band.FExpanded and (Band.BoundsRect.Bottom > Height) and (Band.Top > 0) and not (csLoading in Band.ComponentState) then begin
      ScrollControls(Height - Band.BoundsRect.Bottom);
    end;
  end;
begin
  if FScrolling then Exit;
  if (Parent <> nil) and (csLoading in Parent.ComponentState) then Exit;
  if (AControl <> nil) and not (AControl is TsScrollMaxBand) then begin
    raise Exception.Create('TsScrollMaxBand control only may be placed here');
  end;
  if Parent is TsScrollMax then ScrollMax := Parent as TsScrollMax else begin
    Exit
  end;
  if (AControl <> nil) and (AControl is TsScrollMaxBand) and (AControl as TsScrollMaxBand).FExpanded and ScrollMax.FOneExpanded then
    for I := 0 to ControlCount - 1 do
      if Controls[I] <> AControl then (Controls[I] as TsScrollMaxBand).Expanded := False;
  SPos := ScrollMax.FScrollPos;
  if ControlCount > 0 then begin
    for I := 0 to ControlCount - 1 do begin
      if I > 0 then T := Controls[I - 1].BoundsRect.Bottom else T := -ScrollMax.FScrollPos;
      if (Controls[I] is TsScrollMaxBand) then (Controls[I] as TsScrollMaxBand).UpdateSize(T);
    end;
    AdjustBottom;
    if (AControl is TsScrollMaxBand) then AdjustBand;
    SMax := Controls[ControlCount - 1].BoundsRect.Bottom - Controls[0].Top;
    SPos := -Controls[0].Top;
    ScrollMax.FScrollPos := SPos;
  end
  else SMax := Height;
  SPage := Height;
  ScrollMax.FScrollBar.SetParams(0, SMax, SPage, SPos);
end;

procedure TsScrollMaxBands.ScrollControls(const DeltaY: Integer);
begin
  FScrolling := True;
  try
    ScrollBy(0, DeltaY);
  finally
    FScrolling := False;
  end;
end;

procedure TsScrollMaxBands.FocusChanged(Control: TWinControl);
begin
  if (Control <> nil) and ContainsControl(Control) and (Parent <> nil) then (Parent as TsScrollMax).ScrollInView(Control);
end;

constructor TsScrollMax.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  SkinData.SkinSection := s_Bar;
  ControlStyle := ControlStyle - [csSetCaption, csAcceptsControls];
  Caption := '';
  Width := 250;
  Height := 150;
  Align := alLeft;
  BevelOuter := bvLowered;
  BorderWidth := 3;
  FExpandedHeight := -1;
  FButtonVisible := True;
  FBeveled := True;
  FPnlEdit := TsScrollMaxBands.Create(Self);
  with FPnlEdit do begin
    Align := alClient;
    Parent := Self;
    ControlStyle := ControlStyle + [csAcceptsControls];
    ParentColor := True;
  end;
  FScrollBar := TsPanelScrollBar.Create(Self);
  with FScrollBar do begin
    Inclusive := True;
    Parent := Self;
    Width := 7;
    Align := alRight;
    Max := FPnlEdit.Height;
    Page := Self.Height;
    OnScroll := ScrollBarScroll;
    Visible := True;
    DesignInteractive := True;
  end;
end;

destructor TsScrollMax.Destroy;
begin
  inherited Destroy;
end;

procedure TsScrollMax.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do begin
    Style := Style or WS_CLIPCHILDREN;
    ExStyle := ExStyle or WS_EX_CONTROLPARENT;
  end;
end;

procedure TsScrollMax.Loaded;
begin
  inherited Loaded;
  Resize;
  FPnlEdit.Realign;
end;

procedure TsScrollMax.SetButtonVisible(const Value: Boolean);
begin
  if FButtonVisible <> Value then begin
    FButtonVisible := Value;
    FPnlEdit.NotifyControls(CM_PARENTBUTTONVISIBLECHANGED);
  end;
end;

procedure TsScrollMax.SetBeveled(const Value: Boolean);
begin
  if FBeveled <> Value then begin
    FBeveled := Value;
    FPnlEdit.NotifyControls(CM_PARENTBEVELEDCHANGED);
  end;
end;

procedure TsScrollMax.MouseControls(AControls: array of TControl);
var
  I: Integer;
begin
  for I := Low(AControls) to High(AControls) do begin
    TsScrollMax(AControls[I]).OnMouseDown := BandMouseDown;
    TsScrollMax(AControls[I]).OnMouseMove := BandMouseMove;
    TsScrollMax(AControls[I]).OnMouseUp := BandMouseUp;
  end;
end;

procedure TsScrollMax.MouseClasses(AControlClasses: array of TControlClass);
var
  I, iB, iC: Integer;
begin
  for I := Low(AControlClasses) to High(AControlClasses) do
    for iB := 0 to BandCount - 1 do
      for iC := 0 to Bands[iB].ControlCount - 1 do if Bands[iB].Controls[iC] is AControlClasses[I] then begin
        TsScrollMax(Bands[iB].Controls[iC]).OnMouseDown := BandMouseDown;
        TsScrollMax(Bands[iB].Controls[iC]).OnMouseMove := BandMouseMove;
        TsScrollMax(Bands[iB].Controls[iC]).OnMouseUp := BandMouseUp;
      end;
end;

procedure TsScrollMax.Correct;
var
  Sm: Integer;
  CH: Integer;
begin
  if BandCount > 0 then begin
    Sm := 0;
    CH := FPnlEdit.Height;
    if (Bands[BandCount - 1].BoundsRect.Bottom < CH) and (Bands[0].Top < 0) then Sm := (CH - Bands[BandCount - 1].BoundsRect.Bottom);
    if Bands[0].Top + Sm > 0 then Sm := -Bands[0].Top;
    if Sm <> 0 then begin
      FPnlEdit.ScrollControls(Sm);
      FScrollBar.Pos := -Bands[0].Top;
      FScrollPos := FScrollBar.Pos;
    end;
  end;
end;

procedure TsScrollMax.BandMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (Button = mbLeft) and (BandCount > 0) then begin
    FY := (Sender as TControl).ClientToScreen(Point(0, Y)).Y;
  end;
end;

procedure TsScrollMax.BandMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  Sm: Integer;
  CH: Integer;
begin
  if (ssLeft in Shift) and (BandCount > 0) then begin
    Y := (Sender as TControl).ClientToScreen(Point(0, Y)).Y;
    CH := FPnlEdit.Height;
    if not (Sender = FScrollBar.Scroller) then Sm := Y - FY else Sm := FY - Y;
    if Sm < 0 then begin // Up
      if not (Bands[BandCount - 1].BoundsRect.Bottom > CH)
        then Sm := 0
        else if Bands[BandCount - 1].BoundsRect.Bottom + Sm < CH then Sm := CH - Bands[BandCount - 1].BoundsRect.Bottom;
    end
    else
    if Sm > 0 then begin // Down
      if not (Bands[0].Top < 0)
        then Sm := 0
        else if Bands[0].Top + Sm > 0 then Sm := -Bands[0].Top;
    end;
    if Sm <> 0 then begin
      FPnlEdit.ScrollControls(Sm);
      FScrollBar.Pos := -Bands[0].Top;
      FScrollPos := FScrollBar.Pos;
    end;
    FY := Y;
    Correct;
  end;
end;

procedure TsScrollMax.BandMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Screen.Cursor := crDefault;
end;

function TsScrollMax.GetBand(Index: Integer): TsScrollMaxBand;
begin