diff options
Diffstat (limited to 'gui/scrollbar.inc')
| -rw-r--r-- | gui/scrollbar.inc | 730 |
1 files changed, 730 insertions, 0 deletions
diff --git a/gui/scrollbar.inc b/gui/scrollbar.inc new file mode 100644 index 00000000..8a24584b --- /dev/null +++ b/gui/scrollbar.inc @@ -0,0 +1,730 @@ +{ + fpGUI - Free Pascal Graphical User Interface + Copyright (C) 2000 - 2001 by + Areca Systems GmbH / Sebastian Guenther + Copyright (C) 2006 by Graeme Geldenhuys + member of the fpGUI development team. + + Scrollbar class declarations + + See the file COPYING.fpGUI, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + + +{%mainunit fpgui.pp} + +{$IFDEF read_interface} + + // !!!: Add argument which indicates the type of scrolling + TScrollEvent = procedure(Sender: TObject; var APosition: Integer) of object; + + + TCustomScrollBar = class(TWidget) + private + FOrientation: TOrientation; + FMin: Integer; + FMax: Integer; + FPageSize: Integer; + FPosition: Integer; + FSmallChange: Integer; + FLargeChange: Integer; + FOnChange: TNotifyEvent; + FOnScroll: TScrollEvent; + ButtonUp: TGenericButton; + ButtonDown: TGenericButton; + Slider: TWidget; + Embedded: Boolean; // for internal embedded usage! + + // Event handling + procedure ButtonUpClick(Sender: TObject); + procedure ButtonDownClick(Sender: TObject); + // Property access + procedure SetOrientation(AOrientation: TOrientation); + procedure SetMin(AMin: Integer); + procedure SetMax(AMax: Integer); + procedure SetPageSize(APageSize: Integer); + procedure SetPosition(APosition: Integer); + // Helpers + function GetButtonSize: Integer; + function ClipPosition(APosition: Integer): Integer; + procedure UpdateBar; + protected + function DistributeEvent(Event: TEventObj): Boolean; override; + procedure Paint(Canvas: TFCanvas); override; + procedure CalcSizes; override; + procedure Resized; override; + property Orientation: TOrientation read FOrientation write SetOrientation; + property Min: Integer read FMin write SetMin default 0; + property Max: Integer read FMax write SetMax default 100; + property PageSize: Integer read FPageSize write SetPageSize; + property Position: Integer read FPosition write SetPosition default 0; + property SmallChange: Integer read FSmallChange write FSmallChange default 1; + property LargeChange: Integer read FLargeChange write FLargeChange default 0; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + property OnScroll: TScrollEvent read FOnScroll write FOnScroll; + public + constructor Create(AOwner: TComponent); override; + procedure LineUp; + procedure LineDown; + procedure PageUp; + procedure PageDown; + end; + + + TScrollBar = class(TCustomScrollBar) + published + property Enabled; + property Orientation; + property Min; + property Max; + property PageSize; + property Position; + property SmallChange; + property LargeChange; + property OnChange; + property OnScroll; + end; + + +{$ENDIF read_interface} + + + +{$IFDEF read_implementation} + + + +// =================================================================== +// TCustomScrollBar and helper classes +// =================================================================== + +// ------------------------------------------------------------------- +// TScrollBarButton +// ------------------------------------------------------------------- + +type + { Private button type only used for scrollbars. } + TScrollBarButton = class(TGenericButton) + protected + procedure Paint(Canvas: TFCanvas); override; + procedure CalcSizes; override; + public + Direction: TArrowDirection; + end; + + +procedure TScrollBarButton.Paint(Canvas: TFCanvas); +begin + inherited Paint(Canvas); + Style.DrawScrollBarButton(Canvas, Rect(0, 0, BoundsSize.cx, BoundsSize.cy), + Direction, (wsClicked in WidgetState) and (wsMouseInside in WidgetState), + wsEnabled in WidgetState); +end; + + +procedure TScrollBarButton.CalcSizes; +begin + ASSERT(Owner is TCustomScrollBar); + FMinSize := Style.GetScrollBarBtnSize(TCustomScrollBar(Owner).Orientation); +end; + + +// ------------------------------------------------------------------- +// TScrollBarSlider +// ------------------------------------------------------------------- + +type + TScrollBarSlider = class(TWidget) + private + function EvMousePressed(Event: TMousePressedEventObj): Boolean; + function EvMouseReleased(Event: TMouseReleasedEventObj): Boolean; + function EvMouseMove(Event: TMouseMoveEventObj): Boolean; + protected + ButtonPos: Integer; + ButtonSize: Integer; + IsDraggingButton: Boolean; + PrevAreaPressed: Boolean; + NextAreaPressed: Boolean; + DragStartMousePos: Integer; + DragStartButtonPos: Integer; +// ButtonMoveSavedPosition: Integer; + procedure Paint(Canvas: TFCanvas); override; + function ProcessEvent(Event: TEventObj): Boolean; override; + procedure CalcSizes; override; + function CalcPosition: Integer; + public + constructor Create(AOwner: TComponent); override; + procedure UpdateBar; + end; + + +constructor TScrollBarSlider.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + WidgetStyle := WidgetStyle + [wsCaptureMouse, wsClickable, wsOpaque]; +end; + + +procedure TScrollBarSlider.UpdateBar; +var + Size: Integer; +begin + ASSERT(Owner is TCustomScrollBar); + + if Visible then + begin + with TCustomScrollBar(Owner) do + begin + if (Min = Max) or (Max - Min = PageSize - 1) then + ButtonPos := 0 + else + begin + if Orientation = Horizontal then + Size := Self.BoundsSize.cx + else + Size := Self.BoundsSize.cy; + + if PageSize = 0 then + ButtonPos := (Position - Min) * (Size - ButtonSize) div (Max - Min) + else + ButtonPos := (Position - Min) * + (Size - ButtonSize) div (Max - Min - PageSize + 1); + end; + ButtonSize := GetButtonSize; + end; + Redraw; + end; +end; + + +procedure TScrollBarSlider.Paint(Canvas: TFCanvas); +var + Size: Integer; + r: TRect; + StartPos, EndPos: PInteger; + Color2: TColor; +begin + ASSERT(Owner is TCustomScrollBar); + inherited Paint(Canvas); + + if TCustomScrollBar(Owner).Orientation = Horizontal then + begin + r.Top := 0; + r.Bottom := Height; + StartPos := @r.Left; + EndPos := @r.Right; + Size := Width; + end else + begin + r.Left := 0; + r.Right := Width; + StartPos := @r.Top; + EndPos := @r.Bottom; + Size := Height; + end; + + if ButtonPos > 0 then + begin + if PrevAreaPressed then + Color2 := cl3DDkShadow + else + Color2 := cl3DLight; + Canvas.SetColor(GetAvgColor(Style.GetUIColor(clScrollBar), + Style.GetUIColor(Color2))); + StartPos^ := 0; + EndPos^ := ButtonPos; + Canvas.FillRect(r); + end; + if ButtonPos + ButtonSize < Size then + begin + if NextAreaPressed then + Color2 := cl3DDkShadow + else + Color2 := cl3DLight; + Canvas.SetColor(GetAvgColor(Style.GetUIColor(clScrollBar), + Style.GetUIColor(Color2))); + StartPos^ := ButtonPos + ButtonSize; + EndPos^ := Size; + Canvas.FillRect(r); + end; + + StartPos^ := ButtonPos; + EndPos^ := ButtonPos + ButtonSize; + Style.DrawButtonFace(Canvas, r, [btnIsEmbedded]); +end; + + +function TScrollBarSlider.ProcessEvent(Event: TEventObj): Boolean; +begin + Result := False; + if Event.InheritsFrom(TMousePressedEventObj) then + Result := EvMousePressed(TMousePressedEventObj(Event)) + else if Event.InheritsFrom(TMouseReleasedEventObj) then + Result := EvMouseReleased(TMouseReleasedEventObj(Event)) + else if Event.InheritsFrom(TMouseMoveEventObj) then + Result := EvMouseMove(TMouseMoveEventObj(Event)); + + if not Result then + Result := inherited ProcessEvent(Event); + + if Event.InheritsFrom(TVisibilityChangeEventObj) and Visible then + UpdateBar; +end; + + +function TScrollBarSlider.EvMousePressed(Event: TMousePressedEventObj): Boolean; +var + Pos: Integer; +begin + Result := inherited ProcessEvent(Event); // For mouse grabbing support + + if Event.Button <> mbLeft then + exit; + + if TCustomScrollBar(Owner).Orientation = Horizontal then + Pos := Event.Position.x + else + Pos := Event.Position.y; + + if Pos < ButtonPos then + begin + PrevAreaPressed := True; + TCustomScrollBar(Owner).PageUp + end + else if Pos > ButtonPos + ButtonSize then + begin + NextAreaPressed := True; + TCustomScrollBar(Owner).PageDown + end + else + begin + IsDraggingButton := True; + DragStartMousePos := Pos; + DragStartButtonPos := ButtonPos; + end; + + Result := True; +end; + + +function TScrollBarSlider.EvMouseReleased( + Event: TMouseReleasedEventObj): Boolean; +var + NewPosition: Integer; +begin + Result := inherited ProcessEvent(Event); // For mouse grabbing support + + if Event.Button <> mbLeft then + exit; + + if IsDraggingButton then + begin + IsDraggingButton := False; + NewPosition := CalcPosition; + if NewPosition <> TCustomScrollBar(Owner).Position then + begin + if Assigned(TCustomScrollBar(Owner).OnScroll) then + TCustomScrollBar(Owner).OnScroll(Owner, NewPosition); + TCustomScrollBar(Owner).FPosition := NewPosition; + end; + if (NewPosition <> DragStartMousePos) and + Assigned(TCustomScrollBar(Owner).OnChange) then + TCustomScrollBar(Owner).OnChange(Self); + UpdateBar; + end + else if PrevAreaPressed then + begin + PrevAreaPressed := False; + Redraw; + end + else if NextAreaPressed then + begin + NextAreaPressed := False; + Redraw; + end; + Result := True; +end; + + +function TScrollBarSlider.EvMouseMove(Event: TMouseMoveEventObj): Boolean; +var + Pos, Size, VirtualPos: Integer; +begin + if IsDraggingButton then + begin + if wsMouseInside in WidgetState then + if TCustomScrollBar(Owner).Orientation = Horizontal then + begin + Pos := Event.Position.x; + Size := Width; + end else + begin + Pos := Event.Position.y; + Size := Height; + end + else + begin + Pos := DragStartMousePos; + if TCustomScrollBar(Owner).Orientation = Horizontal then + Size := Width + else + Size := Height; + end; + + ButtonPos := ClipMinMax(DragStartButtonPos + Pos - DragStartMousePos, + 0, Size - ButtonSize); + VirtualPos := CalcPosition; + + if VirtualPos <> TCustomScrollBar(Owner).Position then + begin + if Assigned(TCustomScrollBar(Owner).OnScroll) then + TCustomScrollBar(Owner).OnScroll(Owner, VirtualPos); + TCustomScrollBar(Owner).FPosition := VirtualPos; + end; + + Redraw; + Result := True + end else + Result := False; +end; + + +procedure TScrollBarSlider.CalcSizes; +begin + if TCustomScrollBar(Owner).Orientation = Horizontal then + FDefSize.cx := Style.GetScrollBarBtnSize(Horizontal).cy * 5 + else + FDefSize.cy := Style.GetScrollBarBtnSize(Vertical).cx * 5; +end; + + +function TScrollBarSlider.CalcPosition: Integer; +var + Size: Integer; +begin + with TCustomScrollBar(Owner) do + begin + if Orientation = Horizontal then + Size := Self.Width + else + Size := Self.Height; + + if Size = ButtonSize then + Position := 0 + else + begin + if PageSize = 0 then + Result := ButtonPos * (Max - Min + 1) + else + Result := ButtonPos * (Max - Min - PageSize + 2); + Result := Result div (Size - ButtonSize); + Result := Result + Min; + end; + Result := ClipPosition(Result); + end; +end; + + +// ------------------------------------------------------------------- +// TCustomScrollBar +// ------------------------------------------------------------------- + +constructor TCustomScrollBar.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + Include(WidgetStyle, wsOpaque); + Embedded := False; + + FMax := 100; + FSmallChange := 1; + + ButtonUp := TScrollBarButton.Create(Self); + ButtonUp.Name := '#ScrollBarButtonUp'; + TScrollBarButton(ButtonUp).Direction := arrowLeft; + ButtonUp.Embedded := True; + ButtonUp.CanExpandWidth := False; + ButtonUp.CanExpandHeight := False; + ButtonUp.OnClick := @ButtonUpClick; + ButtonUp.SetEmbeddedParent(Self); + + Slider := TScrollBarSlider.Create(Self); + Slider.Name := '#ScrollBarSlider'; + Slider.SetEmbeddedParent(Self); + + ButtonDown := TScrollBarButton.Create(Self); + ButtonDown.Name := '#ScrollBarButtonDown'; + TScrollBarButton(ButtonDown).Direction := arrowRight; + ButtonDown.Embedded := True; + ButtonDown.CanExpandWidth := False; + ButtonDown.CanExpandHeight := False; + ButtonDown.OnClick := @ButtonDownClick; + ButtonDown.SetEmbeddedParent(Self); +end; + + +procedure TCustomScrollBar.LineUp; +begin + Position := Position - SmallChange; +end; + + +procedure TCustomScrollBar.LineDown; +begin + Position := Position + SmallChange; +end; + + +procedure TCustomScrollBar.PageUp; +var + Diff: Integer; +begin + if LargeChange = 0 then + begin + Diff := (Max - Min + 6) div 10; + if Diff = 0 then + Inc(Diff); + Position := Position - Diff; + end else + Position := Position - LargeChange; +end; + + +procedure TCustomScrollBar.PageDown; +var + Diff: Integer; +begin + if LargeChange = 0 then + begin + Diff := (Max - Min + 6) div 10; + if Diff = 0 then + Inc(Diff); + Position := Position + Diff; + end else + Position := Position + LargeChange; +end; + + +function TCustomScrollBar.DistributeEvent(Event: TEventObj): Boolean; +begin + Result := Event.SendToChild(Slider) or Event.SendToChild(ButtonUp) or + Event.SendToChild(ButtonDown); +end; + + +procedure TCustomScrollBar.Paint(Canvas: TFCanvas); +begin + if not Embedded then + Style.DrawScrollBarBorder(Canvas, Rect(0, 0, Width, Height)); +end; + + +procedure TCustomScrollBar.CalcSizes; +begin + if Orientation = Horizontal then + begin + FMinSize.cx := ButtonUp.DefSize.cx + Slider.MinSize.cx + ButtonDown.DefSize.cx; + FMinSize.cy := ButtonUp.DefSize.cy; + FDefSize.cx := ButtonUp.DefSize.cx + Slider.DefSize.cx + ButtonDown.DefSize.cx; + FDefSize.cy := ButtonUp.DefSize.cy; + FMaxSize.cx := InfiniteSize; + FMaxSize.cy := ButtonUp.DefSize.cy; + end else + begin + FMinSize.cx := ButtonUp.DefSize.cx; + FMinSize.cy := ButtonUp.DefSize.cy + Slider.MinSize.cy + ButtonDown.DefSize.cy; + FDefSize.cx := ButtonUp.DefSize.cx; + FDefSize.cy := ButtonUp.DefSize.cy + Slider.DefSize.cy + ButtonDown.DefSize.cy; + FMaxSize.cx := ButtonUp.DefSize.cx; + FMaxSize.cy := InfiniteSize; + end; + + if not Embedded then + with Style.GetScrollBarBorders(Orientation) do + begin + Inc(FMinSize.cx, Left + Right); + Inc(FMinSize.cy, Top + Bottom); + FDefSize.cx := fpGUI.Min(DefSize.cx + Left + Right, InfiniteSize); + FDefSize.cy := fpGUI.Min(DefSize.cy + Top + Bottom, InfiniteSize); + FMaxSize.cx := fpGUI.Min(MaxSize.cx + Left + Right, InfiniteSize); + FMaxSize.cy := fpGUI.Min(MaxSize.cy + Top + Bottom, InfiniteSize); + end; +end; + + +procedure TCustomScrollBar.Resized; +var + r: TRect; +begin + if not Embedded then + with Style.GetScrollBarBorders(Orientation) do + begin + r.Left := Left; + r.Top := Top; + r.Right := Width - Right; + r.Bottom := Height - Bottom; + end + else + begin + r.Left := 0; + r.Top := 0; + r.Right := Width; + r.Bottom := Height; + end; + + with r do + if Orientation = Horizontal then + begin + ButtonUp.SetBounds(TopLeft, Size(ButtonUp.DefSize.cx, Bottom - Top)); + ButtonDown.SetBounds(Point(Right - ButtonDown.DefSize.cx, Top), + Size(ButtonDown.DefSize.cx, Bottom - Top)); + Slider.SetBounds(Point(Left + ButtonUp.DefSize.cx, Top), + Size(Right - Left - ButtonUp.DefSize.cx - ButtonDown.DefSize.cx, + Bottom - Top)); + end + else + begin + ButtonUp.SetBounds(TopLeft, Size(Right - Left, ButtonDown.DefSize.cy)); + ButtonDown.SetBounds(Point(Left, Bottom - ButtonDown.DefSize.cy), + Size(Right - Left, ButtonDown.DefSize.cy)); + Slider.SetBounds(Point(Left, Top + ButtonUp.DefSize.cy), + Size(Right - Left, + Bottom - Top - ButtonUp.DefSize.cy - ButtonDown.DefSize.cy)); + end; + + UpdateBar; +end; + + +procedure TCustomScrollBar.ButtonUpClick(Sender: TObject); +begin + LineUp; +end; + + +procedure TCustomScrollBar.ButtonDownClick(Sender: TObject); +begin + LineDown; +end; + + +procedure TCustomScrollBar.SetOrientation(AOrientation: TOrientation); +begin + if AOrientation <> Orientation then + begin + FOrientation := AOrientation; + if Orientation = Horizontal then + begin + TScrollBarButton(ButtonUp).Direction := arrowLeft; + TScrollBarButton(ButtonDown).Direction := arrowRight; + end else + begin + TScrollBarButton(ButtonUp).Direction := arrowUp; + TScrollBarButton(ButtonDown).Direction := arrowDown; + end; + end; +end; + + +procedure TCustomScrollBar.SetMin(AMin: Integer); +begin + if AMin <> FMin then + begin + FMin := AMin; + Position := Position; // Do range clipping + UpdateBar; + end; +end; + + +procedure TCustomScrollBar.SetMax(AMax: Integer); +begin + if AMax <> FMax then + begin + FMax := AMax; + Position := Position; // Do range clipping + UpdateBar; + end; +end; + + +procedure TCustomScrollBar.SetPageSize(APageSize: Integer); +begin + if FPageSize <> APageSize then + begin + FPageSize := APageSize; + Position := Position; // Do range clipping + UpdateBar; + end; +end; + + +procedure TCustomScrollBar.SetPosition(APosition: Integer); +begin + APosition := ClipPosition(APosition); + + if (APosition <> Position) and Assigned(OnScroll) then + OnScroll(Self, APosition); + + if APosition <> Position then + begin + FPosition := APosition; + UpdateBar; + if Assigned(OnChange) then + OnChange(Self); + end; +end; + + +function TCustomScrollBar.GetButtonSize: Integer; +var + Size: Integer; +begin + if PageSize = 0 then + if Orientation = Horizontal then + Result := Height + else + Result := Width + else + begin + if Orientation = Horizontal then + Size := Slider.Width + else + Size := Slider.Height; + Result := fpGUI.Max(Style.GetScrollBarBtnMinSize, + PageSize * Size div fpGUI.Max(1, Max - Min + 1)); + if Result > Size then + Result := Size; + end; +end; + + +function TCustomScrollBar.ClipPosition(APosition: Integer): Integer; +begin + if APosition > Max - PageSize then + if PageSize = 0 then + Result := Max + else + Result := Max - PageSize + 1 + else + Result := APosition; + if Result < Min then + Result := Min; +end; + + +procedure TCustomScrollBar.UpdateBar; +begin + if Embedded then + Visible := (Max > Min) and ((PageSize = 0) or (PageSize <= Max - Min)); + TScrollBarSlider(Slider).UpdateBar; +end; + + +{$ENDIF read_implementation} + |