jvqscrollpanel.pas

East make Tray Icon in delphi

  if FDown then
    Flags := Flags or DFCS_PUSHED;

  if FFlat and not MouseOver then
    Flags := Flags or DFCS_FLAT;

  if MouseOver then
  begin
    if FKind in [sbUp, sbDown] then
      OffsetRect(R, 0, 1)
    else
      OffsetRect(R, 1, 0);
  end;

  DrawFrameControl(Canvas.Handle, R, DFC_SCROLL, Flags);
  Frame3D(Canvas, R, clBtnFace, clBtnFace, 1);
  if FDown then
    Frame3D(Canvas, R, clBtnShadow, clBtnHighLight, 1);
end;

procedure TJvScrollButton.Click;
begin
  if Enabled then
  begin
    inherited Click;
    ReleaseCapture;
  end;
end;

procedure TJvScrollButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FDown := True;
  inherited MouseDown(Button, Shift, X, Y);
  { AutoRepeat }
  if Parent is TJvCustomScrollPanel then
    FAutoRepeat := (Parent as TJvCustomScrollPanel).AutoRepeat;
  if FAutoRepeat then
  begin
    if not Assigned(FTimer) then
      FTimer := TTimer.Create(Self);
    with FTimer do
    begin
      OnTimer := OnTime;
      Interval := cInitTime;
      Enabled := True;
    end;
  end;
  Repaint;
end;

procedure TJvScrollButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  if not FRepeat then
    SetPosition;
  FRepeat := False;
  inherited MouseUp(Button, Shift, X, Y);
  FreeAndNil(FTimer);
  FDown := False;
  Repaint;
end;

procedure TJvScrollButton.SetPosition;
var
  AllowScroll: Boolean;
  Sp: TJvCustomScrollPanel;
begin
  if (Parent = nil) or not (Parent is TJvCustomScrollPanel) or not Parent.Visible then
    Exit;
  Sp := TJvCustomScrollPanel(Parent);
  AllowScroll := True;
  if Assigned(Sp.OnScrolling) then
    Sp.OnScrolling(Self, AllowScroll, FKind);
  if not AllowScroll then
    Exit;

  case FKind of
    sbUp:
      Sp.ScrollBy(0, FScrollAmount);
    sbDown:
      Sp.ScrollBy(0, -FScrollAmount);
    sbLeft:
      Sp.ScrollBy(FScrollAmount, 0);
    sbRight:
      Sp.ScrollBy(-FScrollAmount, 0);
  end;
  if Assigned(Sp.OnScrolled) then
    Sp.OnScrolled(Self, FKind);
  Sp.UpdateVisible;
end;

procedure TJvScrollButton.OnTime(Sender: TObject);
begin
  FTimer.Interval := cTimeDelay;
  if FDown and MouseCapture then
  begin
    SetPosition;
    FRepeat := True;
    if Parent <> nil then
      Parent.Invalidate;
  end;
end;

procedure TJvScrollButton.EnabledChanged;
begin
  inherited EnabledChanged;
  if Assigned(Parent) then
    Enabled := Parent.Enabled;
  Invalidate;
end;

//=== { TJvCustomScrollPanel } ===============================================

constructor TJvCustomScrollPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  // this is very strange: without it I get a "Control '' has no parent window" error
  // when dropping it in design-time. Never seen the need before
  // (rom) probably assigning Align causes it. That needs a parent.
//  if AOwner is TWinControl then
//    Parent := TWinControl(AOwner);
  ControlStyle := ControlStyle + [csAcceptsControls]; 
  FScrollDirection := sdHorizontal;
  FScrollAmount := 16;
  Align := alTop;
  Height := 35;
  SetupArrows;
end;

procedure TJvCustomScrollPanel.AlignArrows;
begin
  if FUpLeft = nil then
    Exit;
  case ScrollDirection of
    sdVertical:
      begin
        FUpLeft.Kind := sbUp;
        FUpLeft.SetBounds(0, 0, ClientWidth, 16);
//        FUpLeft.Anchors := [akTop, akLeft, akRight];
        FUpLeft.Align := alTop;

        FDownRight.Kind := sbDown;
        FDownRight.SetBounds(0, ClientHeight - 16, ClientWidth, 16);
//        FDownRight.Anchors := [akLeft, akRight, akBottom];
        FDownRight.Align := alBottom;
      end;
    sdHorizontal:
      begin
        FUpLeft.Kind := sbLeft;
        FUpLeft.SetBounds(0, 0, 16, ClientHeight);
//        FUpLeft.Anchors := [akTop, akLeft, akBottom];
        FUpLeft.Align := alLeft;

        FDownRight.Kind := sbRight;
        FDownRight.SetBounds(ClientWidth - 16, 0, 16, ClientHeight);
//        FDownRight.Anchors := [akTop, akRight, akBottom];
        FDownRight.Align := alRight;
      end;
  end;
  UpdateVisible;
end;

procedure TJvCustomScrollPanel.SetAutoArrange(Value: Boolean);
begin
  if FAutoArrange <> Value then
    FAutoArrange := Value;
end;

procedure TJvCustomScrollPanel.SetAutoHide(Value: Boolean);
begin
  if FAutoHide <> Value then
  begin
    FAutoHide := Value;
    UpdateVisible;
    Invalidate;
  end;
end;

procedure TJvCustomScrollPanel.SetScrollDirection(Value: TJvScrollDirection);
begin
  if FScrollDirection <> Value then
  begin
    FScrollDirection := Value;
    if FAutoArrange then
      ArrangeChildren;
    Invalidate;
    //    AlignArrows;
    //    UpdateVisible;
  end;
end;

procedure TJvCustomScrollPanel.ArrangeChildren;
var
  i: Integer;
begin
  if FUpLeft = nil then
    Exit;
  DisableAlign;
  try
    for i := 0 to ControlCount - 1 do
    begin
      if (Controls[i] = FUpLeft) or (Controls[i] = FDownRight) then
        Continue;
      Controls[i].SetBounds(Controls[i].Top, Controls[i].Left, Controls[i].Height, Controls[i].Width);
    end;
    if not (csLoading in ComponentState) and (Align = alNone) then
      SetBounds(0, 0, Height, Width);
  finally
    EnableAlign;
  end;
end;

procedure TJvCustomScrollPanel.UpdateVisible;
var
  Less, More, i: Integer;
begin
  if FUpLeft = nil then
    Exit;
  DisableAlign;
  try
    if FAutoHide then
    begin
      if FScrollDirection = sdVertical then
      begin
        Less := ClientWidth;
        More := 0;
        for i := 0 to ControlCount - 1 do
        begin
          if (Controls[i] = FUpLeft) or (Controls[i] = FDownRight) then
            Continue;
          Less := Min(Controls[i].Top, Less);
          More := Max(Controls[i].Top + Controls[i].Height, More);
        end;
        FUpLeft.Visible := Less < 0;
        FDownRight.Visible := More > ClientHeight;
      end
      else
      if FScrollDirection = sdHorizontal then
      begin
        Less := ClientHeight;
        More := 0;
        for i := 0 to ControlCount - 1 do
        begin
          if (Controls[i] = FUpLeft) or (Controls[i] = FDownRight) then
            Continue;
          Less := Min(Controls[i].Left, Less);
          More := Max(Controls[i].Left + Controls[i].Width, More);
        end;
        FUpLeft.Visible := Less < 0;
        FDownRight.Visible := More > ClientWidth;
      end
    end
    else { always show }
    begin
      FUpLeft.Visible := True;
      FDownRight.Visible := True;
    end;
  finally
    EnableAlign;
  end;
end;

procedure TJvCustomScrollPanel.SetFlat(Value: Boolean);
begin
  if FFlat <> Value then
  begin
    FFlat := Value;
    if FUpLeft <> nil then
    begin
      FUpLeft.Flat := FFlat;
      FDownRight.Flat := FFlat;
    end;
    Invalidate;
  end;
end;

procedure TJvCustomScrollPanel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  AlignArrows;
  UpdateVisible;
end;

procedure TJvCustomScrollPanel.SetupArrows;
begin
  if FUpLeft <> nil then
    Exit;
  FUpLeft := TJvScrollButton.Create(Self);
  FUpLeft.FreeNotification(Self);
  FUpLeft.Kind := sbLeft;

  FDownRight := TJvScrollButton.Create(Self);
  FDownRight.FreeNotification(Self);
  FDownRight.Kind := sbRight;
end;

procedure TJvCustomScrollPanel.SetParent( const  AParent: TWinControl);
begin
  inherited SetParent(AParent);
  if FUpLeft = nil then
    Exit;
  FUpLeft.Parent := Self;
  FUpLeft.Visible := True;
  FDownRight.Parent := Self;
  FDownRight.Visible := True;
end;

procedure TJvCustomScrollPanel.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    if AComponent = FUpLeft then
      FUpLeft := nil;
    if AComponent = FDownRight then
      FDownRight := nil;
  end;
end;

procedure TJvCustomScrollPanel.EnabledChanged;
begin
  inherited EnabledChanged;
  if FUpLeft = nil then
    Exit;
  FUpLeft.Enabled := Enabled;
  FDownRight.Enabled := Enabled;
  if AutoHide then
    UpdateVisible
  else
    Invalidate;
end;

procedure TJvCustomScrollPanel.VisibleChanged;
begin
  inherited VisibleChanged;
  if FUpLeft = nil then
    Exit;
  FUpLeft.Visible := Visible;
  FDownRight.Visible := Visible;
end;

//=== { TJvScrollingWindow } =================================================

constructor TJvScrollingWindow.Create(AComponent: TComponent);
begin
  inherited Create(AComponent);
  AutoHide := True;
end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQScrollPanel.pas,v $';
    Revision: '$Revision: 1.22 $';
    Date: '$Date: 2004/12/01 22:53:20 $';
    LogPath: 'JVCL\run'
  );

initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.