diff options
Diffstat (limited to 'gui/scrollbox.inc')
| -rw-r--r-- | gui/scrollbox.inc | 429 |
1 files changed, 429 insertions, 0 deletions
diff --git a/gui/scrollbox.inc b/gui/scrollbox.inc new file mode 100644 index 00000000..123060db --- /dev/null +++ b/gui/scrollbox.inc @@ -0,0 +1,429 @@ +{ + 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. + + Scrollbox 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} + +{ Scrolling support implementation } + +{$IFDEF read_interface} + + TScrollingSupport = class + private + Parent: TWidget; + FBorders: TRect; + FClientRect: TRect; + FVirtualSize: TSize; + FHorzScrollBar, FVertScrollBar: TScrollBar; + FOnClientRectChange: TNotifyEvent; + function EvMouseWheel(Event: TMouseWheelEventObj): Boolean; + public + constructor Create(AParent: TWidget); + destructor Destroy; override; + function ProcessEvent(Event: TEventObj): Boolean; + function DistributeEvent(Event: TEventObj): Boolean; + function SendToChild(AChild: TWidget; Event: TEventObj): Boolean; + procedure CalcSizes; + procedure Resized; + function CalcClientSize(AHorzBarVisible, AVertBarVisible: Boolean): TSize; + procedure SetVirtualSize(const ASize: TSize); + function ScrollPos: TPoint; + procedure DefHorzScrollHandler(Sender: TObject; var APosition: Integer); + procedure DefVertScrollHandler(Sender: TObject; var APosition: Integer); + property Borders: TRect read FBorders; + property ClientRect: TRect read FClientRect; + property HorzScrollBar: TScrollBar read FHorzScrollBar; + property VertScrollBar: TScrollBar read FVertScrollBar; + property OnClientRectChange: TNotifyEvent read FOnClientRectChange write FOnClientRectChange; + end; + + + TCustomScrollBox = class(TWidget) + protected + ScrollingSupport: TScrollingSupport; + procedure Paint(Canvas: TFCanvas); override; + function ProcessEvent(Event: TEventObj): Boolean; override; + function DistributeEvent(Event: TEventObj): Boolean; override; +// procedure EvKeyPressed(Key: Word; Shift: TShiftState); override; + procedure CalcSizes; override; + procedure Resized; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + end; + + + TScrollBox = class(TCustomScrollBox) + end; + +{$ENDIF read_interface} + + + +{$IFDEF read_implementation} + +// =================================================================== +// TScrollingSupport +// =================================================================== + +constructor TScrollingSupport.Create(AParent: TWidget); +begin + Parent := AParent; + + FHorzScrollBar := TScrollBar.Create(Parent); + HorzScrollBar.Name := '#Scrolling_HorzBar'; + HorzScrollBar.Embedded := True; + HorzScrollBar.SetEmbeddedParent(Parent); + + FVertScrollBar := TScrollBar.Create(Parent); + VertScrollBar.Name := '#Scrolling_VertBar'; + VertScrollBar.Orientation := Vertical; + VertScrollBar.Embedded := True; + VertScrollBar.SetEmbeddedParent(Parent); +end; + +destructor TScrollingSupport.Destroy; +begin + inherited Destroy; +end; + +function TScrollingSupport.ProcessEvent(Event: TEventObj): Boolean; +var + HorzScrollBarHeight, VertScrollBarWidth: Integer; + Canvas: TFCanvas; +begin + if Event.InheritsFrom(TPaintEventObj) then + begin + if HorzScrollBar.Visible then + HorzScrollBarHeight := HorzScrollBar.MinSize.cy + else + HorzScrollBarHeight := 0; + + if VertScrollBar.Visible then + VertScrollBarWidth := VertScrollBar.MinSize.cx + else + VertScrollBarWidth := 0; + + Canvas := TPaintEventObj(Event).Canvas; + Parent.Style.DrawScrollBoxBorder(Canvas, + Rect(0, 0, Parent.Width, Parent.Height)); + Parent.Style.DrawWindowBackground(Canvas, Rect(VertScrollBar.Left, + HorzScrollBar.Top, VertScrollBar.Left + VertScrollBarWidth, + HorzScrollBar.Top + HorzScrollBarHeight)); + Result := False; + end else if Event.InheritsFrom(TMouseWheelEventObj) then + Result := EvMouseWheel(TMouseWheelEventObj(Event)) + else + Result := False; +end; + +function TScrollingSupport.DistributeEvent(Event: TEventObj): Boolean; +begin + Result := Event.SendToChild(HorzScrollBar) or + Event.SendToChild(VertScrollBar); +end; + +function TScrollingSupport.SendToChild(AChild: TWidget; + Event: TEventObj): Boolean; +var + Canvas: TFCanvas; + OldMatrix: TGfxMatrix; +begin + if Event.InheritsFrom(TPreparePaintEventObj) then + begin + Canvas := TPaintEventObj(Event).Canvas; + OldMatrix := Canvas.Matrix; + Canvas.AppendTranslation(Point(ClientRect.Left - HorzScrollBar.Position, + ClientRect.Top - VertScrollBar.Position)); + Result := Event.SendToChild(AChild); + Canvas.Matrix := OldMatrix; + end else if Event.InheritsFrom(TPaintEventObj) then + begin + Canvas := TPaintEventObj(Event).Canvas; + Canvas.SaveState; + try + Canvas.AppendTranslation(Point(-HorzScrollBar.Position, + -VertScrollBar.Position)); + if Canvas.IntersectClipRect(ClientRect) {and Canvas.IntersectClipRect( + Rect(AChild.Left + ClientRect.Left, AChild.Top + ClientRect.Top, + AChild.Left + AChild.Width + ClientRect.Left, + AChild.Top + AChild.Height + ClientRect.Top))} then + begin + {Canvas.AppendTranslation(AChild.Left + ClientRect.Left, + AChild.Top + ClientRect.Top); + Inc(Event.RefCount); + Result := AChild.SendEvent(Event);} + Canvas.AppendTranslation(ClientRect.TopLeft); + Result := Event.SendToChild(AChild); + end else + Result := False; + finally + Canvas.RestoreState; + end; + end else + Result := Event.SendToChild(AChild); +end; + +procedure TScrollingSupport.CalcSizes; +begin + FBorders := Parent.Style.GetScrollBoxBorders; + with Parent, Borders do + begin + FMinSize := HorzScrollBar.MinSize + VertScrollBar.MinSize + + TopLeft + BottomRight; + FDefSize := HorzScrollBar.DefSize + VertScrollBar.DefSize + + TopLeft + BottomRight; + end; +end; + +procedure TScrollingSupport.Resized; +var + HorzScrollBarHeight, VertScrollBarWidth: Integer; + + procedure CalcScrollBarSizes; + begin + if HorzScrollBar.Visible then + HorzScrollBarHeight := HorzScrollBar.MinSize.cy + else + HorzScrollBarHeight := 0; + + if VertScrollBar.Visible then + VertScrollBarWidth := VertScrollBar.MinSize.cx + else + VertScrollBarWidth := 0; + end; + +var + Canvas: TFCanvas; + HorzBarVisible, VertBarVisible, + LastHorzBarVisible, LastVertBarVisible: Boolean; +begin + HorzBarVisible := HorzScrollBar.Visible; + VertBarVisible := VertScrollBar.Visible; + LastHorzBarVisible := not HorzBarVisible; + + if FVirtualSize <> gfxbase.Size(0, 0) then + with gfxbase.Size(ClientRect) do + begin + HorzScrollBar.PageSize := cx; + VertScrollBar.PageSize := cy; + end; + + FBorders := Parent.Style.GetScrollBoxBorders; + with FBorders do + begin + while (HorzBarVisible <> LastHorzBarVisible) or + (VertBarVisible <> LastVertBarVisible) do + begin + LastHorzBarVisible := HorzBarVisible; + LastVertBarVisible := VertBarVisible; + CalcScrollBarSizes; + HorzScrollBar.SetBounds( + Point(Left, Parent.Height - HorzScrollBar.MinSize.cy - Bottom), + gfxbase.Size(Parent.Width - VertScrollBarWidth - Left - Right, + HorzScrollBar.MinSize.cy)); + VertScrollBar.SetBounds( + Point(Parent.Width - VertScrollBar.MinSize.cx - Right, Top), + gfxbase.Size(VertScrollBar.MinSize.cx, + Parent.Height - HorzScrollBarHeight - Top - Bottom)); + + ClientRect.Left := Left; + ClientRect.Top := Top; + ClientRect.Right := Parent.Width - Right - VertScrollBarWidth; + ClientRect.Bottom := Parent.Height - Bottom - HorzScrollBarHeight; + if Assigned(OnClientRectChange) then + OnClientRectChange(Self); + + HorzBarVisible := HorzScrollBar.Visible; + VertBarVisible := VertScrollBar.Visible; + end; + end; +end; + +function TScrollingSupport.CalcClientSize(AHorzBarVisible, + AVertBarVisible: Boolean): TSize; +begin + FBorders := Parent.Style.GetScrollBoxBorders; + Result := Parent.BoundsSize - Borders.TopLeft - Borders.BottomRight; + if AVertBarVisible then + Dec(Result.cx, VertScrollBar.MinSize.cx); + if AHorzBarVisible then + Dec(Result.cy, HorzScrollBar.MinSize.cy); +end; + +procedure TScrollingSupport.SetVirtualSize(const ASize: TSize); +begin + FVirtualSize := ASize; + HorzScrollBar.Max := FVirtualSize.cx; + VertScrollBar.Max := FVirtualSize.cy; +end; + +function TScrollingSupport.ScrollPos: TPoint; +begin + Result.x := HorzScrollBar.Position; + Result.y := VertScrollBar.Position; +end; + +procedure TScrollingSupport.DefHorzScrollHandler(Sender: TObject; + var APosition: Integer); +var + Delta: Integer; + r: TRect; +begin + Delta := HorzScrollBar.Position - APosition; + r := ClientRect; + if Delta < 0 then // Scrolling to the right side + Dec(r.Left, Delta) + else // Scrolling to the left side + Dec(r.Right, Delta); + Parent.Scroll(r, Delta, 0); +end; + +procedure TScrollingSupport.DefVertScrollHandler(Sender: TObject; + var APosition: Integer); +var + Delta: Integer; + r: TRect; +begin + Delta := VertScrollBar.Position - APosition; + r := ClientRect; + if Delta < 0 then // Scrolling downwards + Dec(r.Top, Delta) + else // Scrolling upwards + Dec(r.Bottom, Delta); + Parent.Scroll(r, 0, Delta); +end; + +function TScrollingSupport.EvMouseWheel(Event: TMouseWheelEventObj): Boolean; +var + mshift: TShiftState; +begin + if Parent.DistributeEvent(Event) then + exit; + + mshift := Event.Shift * [ssShift, ssAlt, ssCtrl, ssMeta, + ssSuper, ssHyper, ssAltGr]; + + if not VertScrollBar.Visible then + Include(mshift, ssShift); + + if mshift = [] then + VertScrollBar.Position := VertScrollBar.Position + + Round(Event.WheelDelta * VertScrollBar.SmallChange) + else if mshift = [ssShift] then + HorzScrollBar.Position := HorzScrollBar.Position + + Round(Event.WheelDelta * VertScrollBar.SmallChange); + Result := True; +end; + + +// =================================================================== +// TCustomScrollBox +// =================================================================== + +constructor TCustomScrollBox.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + WidgetStyle := WidgetStyle + [wsClickable, wsOpaque]; + FCanExpandWidth := True; + FCanExpandHeight := True; + ScrollingSupport := TScrollingSupport.Create(Self); +end; + +destructor TCustomScrollBox.Destroy; +begin + ScrollingSupport.Free; + inherited Destroy; +end; + + +// Protected methods + +procedure TCustomScrollBox.Paint(Canvas: TFCanvas); +begin +{ + Style.DrawWindowBackground(Canvas, Rect(HorzScrollBar.Left, + VertScrollBar.Top, HorzScrollBar.Left + HorzScrollBar.Width, + VertScrollBar.Top + VertScrollBar.Height));} +end; + +function TCustomScrollBox.ProcessEvent(Event: TEventObj): Boolean; +begin + Result := ScrollingSupport.ProcessEvent(Event) or + inherited ProcessEvent(Event); +end; + +function TCustomScrollBox.DistributeEvent(Event: TEventObj): Boolean; +begin + Result := ScrollingSupport.DistributeEvent(Event) or + inherited DistributeEvent(Event); +end; + +procedure TCustomScrollBox.CalcSizes; +begin + ScrollingSupport.CalcSizes; +end; + +procedure TCustomScrollBox.Resized; +begin + ScrollingSupport.Resized; +end; + +{ !!!: Move to TScrollingSupport as soon as this is a real event +procedure TCustomScrollBox.EvKeyPressed(Key: Word; Shift: TShiftState); +var + mshift: TShiftState; +begin + mshift := Shift * [ssShift, ssAlt, ssCtrl, ssMeta, ssSuper, ssHyper, ssAltGr]; + if mshift = [] then + case Key of + keyLeft: + HorzScrollBar.ButtonUpClick(nil); + keyRight: + HorzScrollBar.ButtonDownClick(nil); + keyUp: + VertScrollBar.ButtonUpClick(nil); + keyDown: + VertScrollBar.ButtonDownClick(nil); + keyPageUp: + VertScrollBar.PageUp; + keyPageDown: + VertScrollBar.PageDown; + keyHome: + VertScrollBar.Position := 0; + keyEnd: + VertScrollBar.Position := VertScrollBar.Max - VertScrollBar.PageSize; + end + else if mshift = [ssShift] then + case Key of + keyPageUp: + HorzScrollBar.PageUp; + keyPageDown: + HorzScrollBar.PageDown; + keyHome: + HorzScrollBar.Position := 0; + keyEnd: + HorzScrollBar.Position := HorzScrollBar.Max - HorzScrollBar.PageSize; + end + else + inherited EvKeyPressed(Key, Shift); +end;} + + +{$ENDIF read_implementation} + |