paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-30 17:02:36 +02:00
Code Issues Packages Projects Releases Wiki Activity

fix scrolling (win32)

Browse Source 
git-svn-id: trunk@6601 -
This commit is contained in:
micha 2005-01-15 13:25:29 +00:00
parent b1cb0e902c
commit 32c65f7004
4 changed files with 49 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
lcl/include/scrollingwincontrol.inc
View File

@ -133,7 +133,21 @@ begin
end;
procedure TScrollingWinControl.ScrollBy(DeltaX, DeltaY: Integer);
var
Control: TControl;
I: integer;
begin
TWSScrollingWinControlClass(WidgetSetClass).ScrollBy(Self, DeltaX, DeltaY);
for I := 0 to ControlCount - 1 do
begin
Control := Controls[I];
if not (Control is TWinControl) or not TWinControl(Control).HandleAllocated then
begin
// widgetset does not know about this control
Control.SetBounds(Control.Left+DeltaX, Control.Top+DeltaY,
Control.Width, Control.Height);
end;
end;
Invalidate;
end;

11
lcl/interfaces/gtk/gtkwsforms.pp
View File

@ -40,6 +40,8 @@ type
private
protected
public
class procedure ScrollBy(const AWinControl: TScrollingWinControl;
const DeltaX, DeltaY: integer); override;
end;
{ TGtkWSScrollBox }
@ -115,6 +117,13 @@ implementation
{ TGtkWSCustomForm }
procedure TGtkWSScrollingWinControl.ScrollBy(const AWinControl: TScrollingWinControl;
const DeltaX, DeltaY: integer);
begin
end;
{ TGtkWSCustomForm }
procedure TGtkWSCustomForm.SetFormBorderStyle(const AForm: TCustomForm;
const AFormBorderStyle: TFormBorderStyle);
begin
@ -168,7 +177,7 @@ initialization
// To improve speed, register only classes
// which actually implement something
////////////////////////////////////////////////////
// RegisterWSComponent(TScrollingWinControl, TGtkWSScrollingWinControl);
RegisterWSComponent(TScrollingWinControl, TGtkWSScrollingWinControl);
// RegisterWSComponent(TScrollBox, TGtkWSScrollBox);
// RegisterWSComponent(TCustomFrame, TGtkWSCustomFrame);
// RegisterWSComponent(TFrame, TGtkWSFrame);

16
lcl/interfaces/win32/win32wsforms.pp
View File

@ -46,6 +46,8 @@ type
private
protected
public
class procedure ScrollBy(const AWinControl: TScrollingWinControl;
const DeltaX, DeltaY: integer); override;
end;
{ TWin32WSScrollBox }
@ -186,7 +188,19 @@ begin
Result := Params.Window;
end;
{ TWin32WSScrollingWinControl }
function ScrollWindowPtr(hWnd:HWND; XAmount:longint; YAmount:longint; lpRect: pointer; lpClipRect: pointer):WINBOOL; stdcall; external 'user32' name 'ScrollWindow';
procedure TWin32WSScrollingWinControl.ScrollBy(const AWinControl: TScrollingWinControl;
const DeltaX, DeltaY: integer);
var
lVisible: boolean;
begin
lVisible := AWinControl.HandleAllocated and Windows.IsWindowVisible(AWinControl.Handle);
if lVisible then
ScrollWindowPtr(AWinControl.Handle, DeltaX, DeltaY, nil, nil);
end;
{ TWin32WSCustomForm }
@ -340,7 +354,7 @@ initialization
// To improve speed, register only classes
// which actually implement something
////////////////////////////////////////////////////
// RegisterWSComponent(TScrollingWinControl, TWin32WSScrollingWinControl);
RegisterWSComponent(TScrollingWinControl, TWin32WSScrollingWinControl);
RegisterWSComponent(TScrollBox, TWin32WSScrollBox);
// RegisterWSComponent(TCustomFrame, TWin32WSCustomFrame);
// RegisterWSComponent(TFrame, TWin32WSFrame);

10
lcl/widgetset/wsforms.pp
View File

@ -51,7 +51,10 @@ uses
type
{ TWSScrollingWinControl }
TWSScrollingWinControlClass = class of TWSScrollingWinControl;
TWSScrollingWinControl = class(TWSWinControl)
class procedure ScrollBy(const AWinControl: TScrollingWinControl;
const DeltaX, DeltaY: integer); virtual;
end;
{ TWSScrollBox }
@ -105,6 +108,13 @@ type
implementation
{ TWSScrollingWinControl }
procedure TWSScrollingWinControl.ScrollBy(const AWinControl: TScrollingWinControl;
const DeltaX, DeltaY: integer);
begin
end;
{ TWSCustomForm }
procedure TWSCustomForm.CloseModal(const ACustomForm: TCustomForm);