{ fpGUI - Free Pascal GUI Library ScrollBox class declarations Copyright (C) 2000 - 2006 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, for details about redistributing fpGUI. 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 Assert(Canvas = Canvas); { 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}