jvqscrollmax.pas

East make Tray Icon in delphi

        T := Controls[I - 1].BoundsRect.Bottom
      else
        T := -ScrollMax.FScrollPos;
      (Controls[I] as TJvScrollMaxBand).UpdateSize(T);
    end;
    AdjustBottom;
    AdjustBand;
    SMax := Controls[ControlCount - 1].BoundsRect.Bottom - Controls[0].Top;
    SPos := -Controls[0].Top;
    ScrollMax.FScrollPos := SPos;
    SetCursor;
  end
  else
    SMax := Height;
  SPage := Height;
  ScrollMax.FScrollBar.SetParams(0, SMax, SPage, SPos);
end;

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

procedure TJvScrollMaxBands.FocusChanged;
var
  Control: TWinControl;
begin
  inherited FocusChanged;
  Control := GetFocusedControl(self);
  if (Control <> nil) and
    ContainsControl(Control) and
    (Parent <> nil) then
    (Parent as TJvScrollMax).ScrollInView(Control);
end;

procedure TJvScrollMaxBands.Paint;
var
  R: TRect;
  S1: string;
begin
  if (csDesigning in ComponentState) and
    (ControlCount = 0) and
    (Canvas.Handle <> NullHandle) then
  begin
    R := ClientRect;
    Canvas.Font.Color := clAppWorkSpace;
    S1 := RsRightClickAndChooseAddBand;
    DrawText(Canvas.Handle, S1, -1, R, DT_WORDBREAK {or DT_CENTER or DT_VCENTER});
  end;
end;

//=== { TJvScrollMax } =======================================================

constructor TJvScrollMax.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csSetCaption, csAcceptsControls];
  Caption := '';
  Width := 250;
  Height := 150;
  BorderWidth := 3;
  FExpandedHeight := -1;
  FButtonFont := TFont.Create;
  FButtonFont.Name := 'Small Fonts';
  FButtonFont.Size := 7;
  FButtonFont.OnChange := ButtonFontChanged;
  FButtonVisible := True;
  FBeveled := True;
  ParentColor := True;
  FPnlEdit := TJvScrollMaxBands.Create(Self);
  with FPnlEdit do
  begin
    Align := alClient;
    Parent := Self;
    ControlStyle := ControlStyle + [csAcceptsControls];
    ParentColor := True;
  end;
  FScrollBar := TJvPanelScrollBar.Create(Self);
  with FScrollBar do
  begin
    Inclusive := True;
    Parent := Self;
    Width := 7;
    Align := alRight;
    Max := FPnlEdit.Height;
    Page := Self.Height;
    OnScroll := ScrollBarScroll;
    ParentColor := True;
    Visible := True;
    DesignInteractive := True;
  end; 
end;

destructor TJvScrollMax.Destroy;
begin
  FButtonFont.Free;
  inherited Destroy;
end;





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

procedure TJvScrollMax.SetButtonFont(Value: TFont);
begin
  FButtonFont.Assign(Value);
end;

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

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

procedure TJvScrollMax.ButtonFontChanged(Sender: TObject);
begin
  FPnlEdit.NotifyControls(CM_PARENTBUTTONFONTCHANGED);
end;

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

procedure TJvScrollMax.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
          TJvScrollMax(Bands[iB].Controls[iC]).OnMouseDown := BandMouseDown;
          TJvScrollMax(Bands[iB].Controls[iC]).OnMouseMove := BandMouseMove;
          TJvScrollMax(Bands[iB].Controls[iC]).OnMouseUp := BandMouseUp;
        end;
end;

procedure TJvScrollMax.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 TJvScrollMax.BandMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  CH: Integer;
begin
  if (Button = mbLeft) and (BandCount > 0) then
  begin
    FY := (Sender as TControl).ClientToScreen(Point(0, Y)).Y;
    CH := FPnlEdit.Height;
    if (Bands[BandCount - 1].BoundsRect.Bottom > CH) or
      (Bands[0].Top < 0) then
      Screen.Cursor := crRAHandMove
    else
      Screen.Cursor := crDefault;
  end;
end;

procedure TJvScrollMax.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 {Up}
    begin
      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 {Down}
    begin
      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 TJvScrollMax.BandMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Screen.Cursor := crDefault;
end;

function TJvScrollMax.GetBand(Index: Integer): TJvScrollMaxBand;
begin
  Result := TJvScrollMaxBand(FPnlEdit.Controls[Index]);
end;

function TJvScrollMax.GetBandCount: Integer;
begin
  Result := FPnlEdit.ControlCount;
end;

procedure TJvScrollMax.GetChildren(Proc: TGetChildProc; Root: TComponent);
begin
  FPnlEdit.GetChildren(Proc, Root);
end;

function TJvScrollMax.GetChildParent: TComponent;
begin
  Result := FPnlEdit;
end;

procedure TJvScrollMax.SetScrollPos(const Value: Integer);
begin
  if FScrollPos <> Value then
  begin
    FScrollPos := Value;
    if not (csLoading in ComponentState) then
    begin
      if FScrollPos > FScrollBar.Max - FScrollBar.Page then
        FScrollPos := FScrollBar.Max - FScrollBar.Page;
      if FScrollPos < 0 then
        FScrollPos := 0;
      DesignerModified(Self);
      FPnlEdit.Realign;
    end;
  end;
end;

procedure TJvScrollMax.ScrollBarScroll(Sender: TObject);
begin
  ScrollPos := FScrollBar.Pos;
  if Assigned(FOnScroll) then
    FOnScroll(Self);
end;

procedure TJvScrollMax.ScrollInView(AControl: TControl);
var
  I: Integer;
  Band: TJvScrollMaxBand;
  Rect: TRect;
begin
  Band := nil;
  for I := 0 to FPnlEdit.ControlCount - 1 do
    if (FPnlEdit.Controls[I] as TJvScrollMaxBand).ContainsControl(AControl) then
    begin
      Band := FPnlEdit.Controls[I] as TJvScrollMaxBand;
      Break;
    end;
  if Band = nil then
    raise EJvScrollMaxError.CreateResFmt(@RsEControlsNotAChildOfs, [AControl.Name, Parent.Name]);
  Band.Expanded := True;
  Rect := AControl.ClientRect;
  Dec(Rect.Top, BevelWidth + BorderWidth + 4);
  Inc(Rect.Bottom, BevelWidth + BorderWidth + 4);
  Rect.TopLeft := ScreenToClient(AControl.ClientToScreen(Rect.TopLeft));
  Rect.BottomRight := ScreenToClient(AControl.ClientToScreen(Rect.BottomRight));
  if Rect.Top < 0 then
    ScrollPos := ScrollPos + Rect.Top
  else
  if Rect.Bottom > ClientHeight then
  begin
    if Rect.Bottom - Rect.Top > ClientHeight then
      Rect.Bottom := Rect.Top + ClientHeight;
    ScrollPos := ScrollPos + Rect.Bottom - ClientHeight;
  end;
end;

procedure TJvScrollMax.SetAutoHeight(const Value: Boolean);
begin
  if FAutoHeight <> Value then
  begin
    FAutoHeight := Value;
    if FAutoHeight then
      CorrectHeight;
  end;
end;

procedure TJvScrollMax.SetExpandedHeight(const Value: Integer);
begin
  if FExpandedHeight <> Value then
  begin
    FExpandedHeight := Value;
    if FAutoHeight then
      CorrectHeight;
  end;
end;

procedure TJvScrollMax.Resize;
begin
  inherited Resize;
  if FAutoHeight and (BandCount > 0) and
    not AllCollapsed and (FExpandedHeight > -1) then
    FExpandedHeight := Height;
  if FAutoHeight then
    CorrectHeight;
end;

procedure TJvScrollMax.CorrectHeight;
var
  I, H: Integer;
  Band: TJvScrollMaxBand;
begin
  if not FAutoHeight or (BandCount = 0) then
    Exit;
  if AllCollapsed then
  begin
    H := 0;
    for I := 0 to BandCount - 1 do
      Inc(H, Bands[I].Height);
    ClientHeight := H + 2 * PanelBorder(Self);
  end
  else
  if FExpandedHeight <> -1 then
    Height := FExpandedHeight
  else
  begin
    H := 0;
    Band := nil;
    for I := 0 to BandCount - 1 do
      if Bands[I].Height > H then
      begin
        Band := Bands[I];
        H := Band.Height;
      end;
    H := 0;
    for I := 0 to BandCount - 1 do
      if Bands[I] = Band then
        Inc(H, Bands[I].Height)
      else
        Inc(H, Bands[I].CollapsedHeight);
    ClientHeight := H + 2 * PanelBorder(Self);
  end;
end;

function TJvScrollMax.AllCollapsed: Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := 0 to BandCount - 1 do
    if Bands[I].Expanded then
      Exit;
  Result := True;
end;

function TJvScrollMax.AllExpanded: Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := 0 to BandCount - 1 do
    if not Bands[I].Expanded then
      Exit;
  Result := True;
end;

procedure TJvScrollMax.AddBand(Band: TJvScrollMaxBand);
begin
  Band.Parent := GetChildParent as TWinControl;
end;

function TJvScrollMax.GetScrollBarWidth: Cardinal;
begin
  Result := FScrollBar.Width;
end;

procedure TJvScrollMax.SetScrollBarWidth(const Value: Cardinal);
begin
  if Value >= 4 then
    FScrollBar.Width := Value;
end;

function TJvScrollMax.GetScrollBarVisible: Boolean;
begin
  Result := FScrollBar.Visible;
end;

procedure TJvScrollMax.SetScrollBarVisible(const Value: Boolean);
begin
  FScrollBar.Visible := Value;
  if csDesigning in ComponentState then
    if not Value then
      FScrollBar.Parent := nil
    else
      FScrollBar.Parent := Self;
end;

procedure TJvScrollMax.SetOneExpanded(const Value: Boolean);
begin
  if FOneExpanded <> Value then
  begin
    FOneExpanded := Value;
    { .. }
  end;
end;

{ (rom) deactivated  can cause problems
initialization
  crRAHand := DefineCursor('JvHANDCURSOR');
  crRAHandMove := DefineCursor('JvHANDMOVECURSOR');
}

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQScrollMax.pas,v $';
    Revision: '$Revision: 1.21 $';
    Date: '$Date: 2005/02/11 10:11:57 $';
    LogPath: 'JVCL\run'
  );

initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.