paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-12 09:16:13 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: Implement TCustomMemo.ScrollBy. Refactor widgetset ScrollBy from ScrollingWinControl to WinControl. Solves issue #29067.

Browse Source 
git-svn-id: trunk@50523 -
This commit is contained in:
juha 2015-11-29 18:45:53 +00:00
parent 0ef4cb9fff
commit 6bb18f6fbd
31 changed files with 205 additions and 286 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/controls.pp
View File

@ -2163,6 +2163,7 @@ type
procedure DisableAlign;
procedure EnableAlign;
procedure ReAlign; // realign all children
procedure ScrollBy_WS(DeltaX, DeltaY: Integer);
procedure ScrollBy(DeltaX, DeltaY: Integer); virtual;
procedure WriteLayoutDebugReport(const Prefix: string); override;
procedure AutoAdjustLayout(AMode: TLayoutAdjustmentPolicy;

8
lcl/forms.pp
View File

@ -92,7 +92,7 @@ type
FOldScrollInfoValid: Boolean;
protected
FControl: TWinControl;
FPosition, FPrevPosition: Integer;
FPosition: Integer;
function ControlHandle: HWnd; virtual;
function GetAutoScroll: boolean; virtual;
function GetIncrement: TScrollBarInc; virtual;
@ -109,7 +109,6 @@ type
procedure SetIncrement(const AValue: TScrollBarInc); virtual;
procedure SetPage(const AValue: TScrollBarInc); virtual;
procedure SetPosition(const Value: Integer);
procedure SetControlPosition; virtual;
procedure SetRange(const AValue: Integer); virtual;
procedure SetSmooth(const AValue: Boolean); virtual;
procedure SetTracking(const AValue: Boolean);
@ -168,8 +167,7 @@ type
procedure WMHScroll(var Message : TLMHScroll); message LM_HScroll;
procedure WMVScroll(var Message : TLMVScroll); message LM_VScroll;
procedure ComputeScrollbars; virtual;
procedure ScrollbarHandler(ScrollKind: TScrollBarKind;
OldPosition: Integer); virtual;
//procedure ScrollbarHandler(ScrollKind: TScrollBarKind; OldPosition: Integer); virtual;
procedure SetAutoScroll(Value: Boolean); virtual;
procedure Loaded; override;
procedure Resizing(State: TWindowState); virtual;
@ -1798,7 +1796,7 @@ implementation
{$endif}
uses
WSForms; // Widgetset uses circle is allowed
WSControls, WSForms; // Widgetset uses circle is allowed
var
HandlingException: Boolean = False;

17
lcl/include/controlscrollbar.inc
View File

@ -70,11 +70,14 @@ begin
if Value = FPosition then
exit;
// now actually set the position
FPrevPosition := FPosition;
FPosition := Value;
// scroll logical client area of FControl
SetControlPosition;
if Kind = sbVertical then
FControl.ScrollBy(0, FPosition - Value)
else
FControl.ScrollBy(FPosition - Value, 0);
// now actually set the position
FPosition := Value;
// check that the new position is also set on the scrollbar
if HandleAllocated and (GetScrollPos(ControlHandle, IntfBarKind[Kind]) <> FPosition) then
@ -94,12 +97,6 @@ begin
end;
end;
procedure TControlScrollBar.SetControlPosition;
begin
if FControl is TScrollingWinControl then
TScrollingWinControl(FControl).ScrollbarHandler(Kind, FPrevPosition);
end;
function TControlScrollBar.GetIncrement: TScrollBarInc;
begin
Result := FIncrement;

49
lcl/include/custommemo.inc
View File

@ -15,13 +15,6 @@
{off $DEFINE DEBUG_MEMO}
{------------------------------------------------------------------------------
Method: TCustomMemo.Create
Params:
Returns:
Constructor for the class
------------------------------------------------------------------------------}
constructor TCustomMemo.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
@ -36,13 +29,6 @@ begin
AutoSize := False;
end;
{------------------------------------------------------------------------------
Method: TCustomMemo.Destroy
Params: None
Returns: Nothing
Destructor for the class.
------------------------------------------------------------------------------}
destructor TCustomMemo.Destroy;
begin
FreeThenNil(FLines);
@ -51,20 +37,16 @@ begin
inherited Destroy;
end;
{------------------------------------------------------------------------------
Method: TCustomMemo.Append
Params:
Returns:
------------------------------------------------------------------------------}
procedure TCustomMemo.Append(const Value: String);
begin
Lines.Add(Value);
end;
{------------------------------------------------------------------------------
procedure TCustomMemo.SetHorzScrollBar(const AValue: TMemoScrollBar);
------------------------------------------------------------------------------}
procedure TCustomMemo.ScrollBy(DeltaX, DeltaY: Integer);
begin
ScrollBy_WS(DeltaX, DeltaY);
end;
procedure TCustomMemo.SetHorzScrollBar(const AValue: TMemoScrollBar);
begin
if FHorzScrollBar=AValue then exit;
@ -79,9 +61,6 @@ begin
TWSCustomMemoClass(WidgetSetClass).SetCaretPos(Self, Value);
end;
{------------------------------------------------------------------------------
procedure TCustomMemo.SetVertScrollBar(const AValue: TMemoScrollBar);
------------------------------------------------------------------------------}
procedure TCustomMemo.SetVertScrollBar(const AValue: TMemoScrollBar);
begin
if FVertScrollBar=AValue then exit;
@ -213,12 +192,6 @@ begin
inherited;
end;
{------------------------------------------------------------------------------
Method: TCustomMemo.SetLines
Params:
Returns:
------------------------------------------------------------------------------}
procedure TCustomMemo.SetLines(const Value: TStrings);
begin
if (Value <> nil) then
@ -235,9 +208,6 @@ begin
end;
end;
{------------------------------------------------------------------------------
procedure TCustomMemo.SetScrollbars(const Value : TScrollStyle);
------------------------------------------------------------------------------}
procedure TCustomMemo.SetScrollBars(const Value: TScrollStyle);
begin
if Value <> FScrollbars then begin
@ -247,9 +217,6 @@ begin
end;
end;
{------------------------------------------------------------------------------
procedure TCustomMemo.Loaded;
------------------------------------------------------------------------------}
procedure TCustomMemo.Loaded;
begin
inherited Loaded;
@ -302,12 +269,6 @@ begin
TWSCustomMemoClass(WidgetSetClass).SetWantTabs(Self, NewWantTabs);
end;
{------------------------------------------------------------------------------
Method: TCustomMemo.SetWordWrap
Params:
Returns:
------------------------------------------------------------------------------}
procedure TCustomMemo.SetWordWrap(const Value: boolean);
begin
if Value <> FWordWrap then

5
lcl/include/memoscrollbar.inc
View File

@ -11,11 +11,6 @@
{ TMemoScrollbar }
procedure TMemoScrollbar.SetControlPosition;
begin
//TCustomMemo(FControl).ScrollBy(FPosition - FPrevPosition); No good!
end;
function TMemoScrollbar.GetHorzScrollBar: TControlScrollBar;
begin
Result:=TCustomMemo(FControl).HorzScrollBar;

17
lcl/include/scrollingwincontrol.inc
View File

@ -248,13 +248,7 @@ end;
procedure TScrollingWinControl.ScrollBy(DeltaX, DeltaY: Integer);
begin
if HandleAllocated and IsWindowVisible(Handle) then
begin
TWSScrollingWinControlClass(WidgetSetClass).ScrollBy(Self, DeltaX, DeltaY);
//Invalidate;
end
else
inherited ScrollBy(DeltaX, DeltaY);
ScrollBy_WS(DeltaX, DeltaY);
end;
procedure TScrollingWinControl.ScrollInView(AControl: TControl);
@ -283,15 +277,6 @@ begin
end;
end;
procedure TScrollingWinControl.ScrollbarHandler(ScrollKind: TScrollBarKind;
OldPosition: Integer);
begin
if ScrollKind = sbVertical then
ScrollBy(0, OldPosition - FVertScrollBar.Position)
else
ScrollBy(OldPosition - FHorzScrollBar.Position, 0);
end;
procedure TScrollingWinControl.Loaded;
begin
inherited Loaded;

8
lcl/include/wincontrol.inc
View File

@ -6131,6 +6131,14 @@ begin
AdjustSize;
end;
procedure TWinControl.ScrollBy_WS(DeltaX, DeltaY: Integer);
begin
if HandleAllocated and IsWindowVisible(Handle) then
TWSWinControlClass(WidgetSetClass).ScrollBy(Self, DeltaX, DeltaY)
else
ScrollBy(DeltaX, DeltaY);
end;
procedure TWinControl.ScrollBy(DeltaX, DeltaY: Integer);
var
i: Integer;

18
lcl/interfaces/carbon/carbonwscontrols.pp
View File

@ -85,6 +85,7 @@ type
class procedure SetText(const AWinControl: TWinControl; const AText: String); override;
class procedure Invalidate(const AWinControl: TWinControl); override;
class procedure ShowHide(const AWinControl: TWinControl); override;
class procedure ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY: integer); override;
end;
{ TCarbonWSGraphicControl }
@ -379,6 +380,15 @@ begin
TCarbonWidget(AWinControl.Handle).ShowHide(AWinControl.HandleObjectShouldBeVisible);
end;
class procedure TCarbonWSWinControl.ScrollBy(const AWinControl: TWinControl;
DeltaX, DeltaY: integer);
begin
if not CheckHandle(AWinControl, Self, 'ScrollBy') then Exit;
TCarbonWidget(AWinControl.Handle).ScrollBy(DeltaX, DeltaY);
AWinControl.Invalidate;
end;
{------------------------------------------------------------------------------
Method: TCarbonWSWinControl.CreateHandle
Params: AWinControl - LCL control
@ -457,8 +467,8 @@ end;
Retrieves the client bounding rect of control in Carbon interface
------------------------------------------------------------------------------}
class function TCarbonWSWinControl.GetClientBounds(const AWinControl: TWinControl;
var ARect: TRect): Boolean;
class function TCarbonWSWinControl.GetClientBounds(
const AWincontrol: TWinControl; var ARect: TRect): Boolean;
begin
Result := False;
if not CheckHandle(AWinControl, Self, 'GetClientBounds') then Exit;
@ -473,8 +483,8 @@ end;
Retrieves the client rect of control in Carbon interface
------------------------------------------------------------------------------}
class function TCarbonWSWinControl.GetClientRect(const AWinControl: TWinControl;
var ARect: TRect): Boolean;
class function TCarbonWSWinControl.GetClientRect(
const AWincontrol: TWinControl; var ARect: TRect): Boolean;
begin
Result := False;
if not CheckHandle(AWinControl, Self, 'GetClientRect') then Exit;

16
lcl/interfaces/carbon/carbonwsforms.pp
View File

@ -39,7 +39,6 @@ type
TCarbonWSScrollingWinControl = class(TWSScrollingWinControl)
published
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure ScrollBy(const AWinControl: TScrollingWinControl; const DeltaX, DeltaY: integer); override;
end;
{ TCarbonWSScrollBox }
@ -130,21 +129,6 @@ begin
Result := TLCLIntfHandle(TCarbonScrollingWinControl.Create(AWinControl, AParams));
end;
{------------------------------------------------------------------------------
Method: TCarbonWSScrollingWinControl.ScrollBy
Params: AWinControl - LCL scrolling win control
DX, DY -
Scrolls the content of the passed window
------------------------------------------------------------------------------}
class procedure TCarbonWSScrollingWinControl.ScrollBy(const AWinControl: TScrollingWinControl; const DeltaX, DeltaY: integer);
begin
if not CheckHandle(AWinControl, Self, 'ScrollBy') then Exit;
TCarbonWidget(AWinControl.Handle).ScrollBy(DeltaX, DeltaY);
AWinControl.Invalidate;
end;
{ TCarbonWSCustomForm }
{------------------------------------------------------------------------------

1
lcl/interfaces/cocoa/cocoawscommon.pas
View File

@ -100,6 +100,7 @@ type
class procedure SetColor(const AWinControl: TWinControl); override;
class procedure ShowHide(const AWinControl: TWinControl); override;
class procedure Invalidate(const AWinControl: TWinControl); override;
// class procedure ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY: integer); override;
end;

1
lcl/interfaces/cocoa/cocoawsforms.pp
View File

@ -62,7 +62,6 @@ type
protected
public
// class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
// class procedure ScrollBy(const AWinControl: TScrollingWinControl; const DeltaX, DeltaY: integer); override;
end;
{ TCocoaWSScrollBox }

8
lcl/interfaces/customdrawn/customdrawnwsforms.pp
View File

@ -52,16 +52,16 @@ type
TCDWSScrollBox = class(TWSScrollBox)
published
// class procedure ScrollBy(const AWinControl: TScrollingWinControl;
// const DeltaX, DeltaY: integer); override;
// class procedure ScrollBy(const AWinControl: TWinControl;
// DeltaX, DeltaY: integer); override;
end;
{ TCDWSCustomFrame }
TCDWSCustomFrame = class(TWSCustomFrame)
published
// class procedure ScrollBy(const AWinControl: TScrollingWinControl;
// const DeltaX, DeltaY: integer); override;
// class procedure ScrollBy(const AWinControl: TWinControl;
// DeltaX, DeltaY: integer); override;
end;
{ TCDWSFrame }

2
lcl/interfaces/gtk/gtkwscontrols.pp
View File

@ -88,8 +88,8 @@ type
class procedure SetPos(const AWinControl: TWinControl; const ALeft, ATop: Integer); override;
class procedure SetText(const AWinControl: TWinControl; const AText: string); override;
class procedure SetShape(const AWinControl: TWinControl; const AShape: HBITMAP); override;
class procedure PaintTo(const AWinControl: TWinControl; ADC: HDC; X, Y: Integer); override;
class procedure PaintTo(const AWinControl: TWinControl; ADC: HDC; X, Y: Integer); override;
class procedure ShowHide(const AWinControl: TWinControl); override;
end;

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

@ -40,7 +40,6 @@ type
class procedure SetCallbacks(const AWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
published
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure ScrollBy(const AWinControl: TScrollingWinControl; const DeltaX, DeltaY: integer); override;
class procedure SetColor(const AWinControl: TWinControl); override;
end;
@ -185,13 +184,6 @@ begin
SetCallBacks(PGtkWidget(Frame), WidgetInfo);
end;
class procedure TGtkWSScrollingWinControl.ScrollBy(const AWinControl: TScrollingWinControl;
const DeltaX, DeltaY: integer);
begin
{$IFDEF VerboseGtkToDos}{$note implement me}{$ENDIF}
AWinControl.Invalidate;
end;
class procedure TGtkWSScrollingWinControl.SetColor(
const AWinControl: TWinControl);
begin

41
lcl/interfaces/gtk2/gtk2wscontrols.pp
View File

@ -91,11 +91,11 @@ type
class procedure SetPos(const AWinControl: TWinControl; const ALeft, ATop: Integer); override;
class procedure SetText(const AWinControl: TWinControl; const AText: string); override;
class procedure SetShape(const AWinControl: TWinControl; const AShape: HBITMAP); override;
class procedure PaintTo(const AWinControl: TWinControl; ADC: HDC; X, Y: Integer); override;
class procedure ShowHide(const AWinControl: TWinControl); override;
class procedure SetBiDiMode(const AWinControl: TWinControl; UseRightToLeftAlign, {%H-}UseRightToLeftReading, {%H-}UseRightToLeftScrollBar : Boolean); override;
class procedure PaintTo(const AWinControl: TWinControl; ADC: HDC; X, Y: Integer); override;
class procedure ShowHide(const AWinControl: TWinControl); override;
class procedure ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY: integer); override;
end;
{ TGtk2WSGraphicControl }
@ -625,6 +625,39 @@ begin
InvalidateLastWFPResult(AWinControl, AWinControl.BoundsRect);
end;
class procedure TGtk2WSWinControl.ScrollBy(const AWinControl: TWinControl;
DeltaX, DeltaY: integer);
var
Scrolled: PGtkScrolledWindow;
Adjustment: PGtkAdjustment;
h, v: Double;
NewPos: Double;
begin
if not AWinControl.HandleAllocated then exit;
Scrolled := GTK_SCROLLED_WINDOW({%H-}Pointer(AWinControl.Handle));
if not GTK_IS_SCROLLED_WINDOW(Scrolled) then
exit;
Adjustment := gtk_scrolled_window_get_hadjustment(Scrolled);
if Adjustment <> nil then
begin
h := gtk_adjustment_get_value(Adjustment);
NewPos := Adjustment^.upper - Adjustment^.page_size;
if h - DeltaX <= NewPos then
NewPos := h - DeltaX;
gtk_adjustment_set_value(Adjustment, NewPos);
end;
Adjustment := gtk_scrolled_window_get_vadjustment(Scrolled);
if Adjustment <> nil then
begin
v := gtk_adjustment_get_value(Adjustment);
NewPos := Adjustment^.upper - Adjustment^.page_size;
if v - DeltaY <= NewPos then
NewPos := v - DeltaY;
gtk_adjustment_set_value(Adjustment, NewPos);
end;
AWinControl.Invalidate;
end;
class procedure TGtk2WSWinControl.SetBounds(const AWinControl: TWinControl;
const ALeft, ATop, AWidth, AHeight: Integer);
var

45
lcl/interfaces/gtk2/gtk2wsforms.pp
View File

@ -39,9 +39,8 @@ type
protected
class procedure SetCallbacks(const AWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
published
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure SetColor(const AWinControl: TWinControl); override;
class procedure ScrollBy(const AWinControl: TScrollingWinControl; const DeltaX, DeltaY: integer); override;
end;
{ TGtk2WSScrollBox }
@ -68,9 +67,9 @@ type
protected
class procedure SetCallbacks(const AWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
published
class function CanFocus(const AWinControl: TWinControl): Boolean; override;
class function CanFocus(const AWinControl: TWinControl): Boolean; override;
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure ScrollBy(const AWinControl: TScrollingWinControl; const DeltaX, DeltaY: integer); override;
class procedure ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY: integer); override;
class procedure SetIcon(const AForm: TCustomForm; const Small, Big: HICON); override;
class procedure SetAlphaBlend(const ACustomForm: TCustomForm;
const AlphaBlend: Boolean; const Alpha: Byte); override;
@ -459,7 +458,7 @@ begin
g_idle_remove_by_data(Data);
end;
class procedure TGtk2WSCustomForm.ScrollBy(const AWinControl: TScrollingWinControl; const DeltaX, DeltaY: integer);
class procedure TGtk2WSCustomForm.ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY: integer);
var
Layout: PGtkLayout;
WidgetInfo: PWidgetInfo;
@ -959,8 +958,7 @@ begin
end;
end;
class procedure TGtk2WSScrollingWinControl.SetColor(
const AWinControl: TWinControl);
class procedure TGtk2WSScrollingWinControl.SetColor(const AWinControl: TWinControl);
begin
if not WSCheckHandleAllocated(AWinControl, 'SetColor')
then Exit;
@ -971,39 +969,6 @@ begin
GTK_STATE_PRELIGHT, GTK_STATE_SELECTED]);
end;
class procedure TGtk2WSScrollingWinControl.ScrollBy(
const AWinControl: TScrollingWinControl; const DeltaX, DeltaY: integer);
var
Scrolled: PGtkScrolledWindow;
Adjustment: PGtkAdjustment;
h, v: Double;
NewPos: Double;
begin
if not AWinControl.HandleAllocated then exit;
Scrolled := GTK_SCROLLED_WINDOW({%H-}Pointer(AWinControl.Handle));
if not GTK_IS_SCROLLED_WINDOW(Scrolled) then
exit;
Adjustment := gtk_scrolled_window_get_hadjustment(Scrolled);
if Adjustment <> nil then
begin
h := gtk_adjustment_get_value(Adjustment);
NewPos := Adjustment^.upper - Adjustment^.page_size;
if h - DeltaX <= NewPos then
NewPos := h - DeltaX;
gtk_adjustment_set_value(Adjustment, NewPos);
end;
Adjustment := gtk_scrolled_window_get_vadjustment(Scrolled);
if Adjustment <> nil then
begin
v := gtk_adjustment_get_value(Adjustment);
NewPos := Adjustment^.upper - Adjustment^.page_size;
if v - DeltaY <= NewPos then
NewPos := v - DeltaY;
gtk_adjustment_set_value(Adjustment, NewPos);
end;
AWinControl.Invalidate;
end;
{ TGtk2WSHintWindow }
class procedure TGtk2WSHintWindow.SetCallbacks(const AWidget: PGtkWidget;

49
lcl/interfaces/gtk3/gtk3wscontrols.pp
View File

@ -110,6 +110,7 @@ type
class procedure Invalidate(const AWinControl: TWinControl); override;
class procedure PaintTo(const AWinControl: TWinControl; ADC: HDC; X, Y: Integer); override;
class procedure ShowHide(const AWinControl: TWinControl); override; //TODO: rename to SetVisible(control, visible)
class procedure ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY: integer); override;
end;
TGtk3WSWinControlClass = class of TGtk3WSWinControl;
@ -542,6 +543,54 @@ begin
end;
end;
class procedure TGtk3WSWinControl.ScrollBy(const AWinControl: TWinControl;
DeltaX, DeltaY: integer);
var
Scrolled: PGtkScrolledWindow;
Adjustment: PGtkAdjustment;
h, v: Double;
NewPos: Double;
begin
{.$IFDEF GTK3DEBUGCORE}
// DebugLn('TGtk3WSWinControl.ScrollBy not implemented ');
{.$ENDIF}
if not AWinControl.HandleAllocated then exit;
Scrolled := TGtk3ScrollingWinControl(AWinControl.Handle).GetScrolledWindow;
if not Gtk3IsScrolledWindow(Scrolled) then
exit;
{$note below is old gtk2 implementation}
TGtk3ScrollingWinControl(AWinControl.Handle).ScrollX := TGtk3ScrollingWinControl(AWinControl.Handle).ScrollX + DeltaX;
TGtk3ScrollingWinControl(AWinControl.Handle).ScrollY := TGtk3ScrollingWinControl(AWinControl.Handle).ScrollY + DeltaY;
//TODO: change this part like in Qt using ScrollX and ScrollY variables
//GtkAdjustment calculation isn't good here (can go below 0 or over max)
// DebugLn('TGtk3WSWinControl.ScrollBy DeltaX=',dbgs(DeltaX),' DeltaY=',dbgs(DeltaY));
exit;
Adjustment := gtk_scrolled_window_get_hadjustment(Scrolled);
if Adjustment <> nil then
begin
h := gtk_adjustment_get_value(Adjustment);
NewPos := Adjustment^.upper - Adjustment^.page_size;
if h - DeltaX <= NewPos then
NewPos := h - DeltaX;
if NewPos < 0 then
NewPos := 0;
gtk_adjustment_set_value(Adjustment, NewPos);
end;
Adjustment := gtk_scrolled_window_get_vadjustment(Scrolled);
if Adjustment <> nil then
begin
v := gtk_adjustment_get_value(Adjustment);
NewPos := Adjustment^.upper - Adjustment^.page_size;
if v - DeltaY <= NewPos then
NewPos := v - DeltaY;
if NewPos < 0 then
NewPos := 0;
// writeln('OldValue ',dbgs(V),' NewValue ',dbgs(NewPos),' upper=',dbgs(Adjustment^.upper - Adjustment^.page_size));
gtk_adjustment_set_value(Adjustment, NewPos);
end;
AWinControl.Invalidate;
end;
{ TGtk3WSCustomControl }
class function TGtk3WSCustomControl.CreateHandle(

52
lcl/interfaces/gtk3/gtk3wsforms.pp
View File

@ -51,10 +51,8 @@ type
TGtk3WSScrollingWinControl = class(TWSScrollingWinControl)
published
class function CreateHandle(const AWinControl: TWinControl;
class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure ScrollBy(const AWinControl: TScrollingWinControl;
const DeltaX, DeltaY: integer); override;
end;
{ TWSScrollBox }
@ -155,54 +153,6 @@ begin
Result := TLCLIntfHandle(TGtk3ScrollingWinControl.Create(AWinControl, AParams));
end;
class procedure TGtk3WSScrollingWinControl.ScrollBy(const AWinControl: TScrollingWinControl;
const DeltaX, DeltaY: integer);
var
Scrolled: PGtkScrolledWindow;
Adjustment: PGtkAdjustment;
h, v: Double;
NewPos: Double;
begin
{.$IFDEF GTK3DEBUGCORE}
// DebugLn('TGtk3WSScrollingWinControl.ScrollBy not implemented ');
{.$ENDIF}
if not AWinControl.HandleAllocated then exit;
Scrolled := TGtk3ScrollingWinControl(AWinControl.Handle).GetScrolledWindow;
if not Gtk3IsScrolledWindow(Scrolled) then
exit;
{$note below is old gtk2 implementation}
TGtk3ScrollingWinControl(AWinControl.Handle).ScrollX := TGtk3ScrollingWinControl(AWinControl.Handle).ScrollX + DeltaX;
TGtk3ScrollingWinControl(AWinControl.Handle).ScrollY := TGtk3ScrollingWinControl(AWinControl.Handle).ScrollY + DeltaY;
//TODO: change this part like in Qt using ScrollX and ScrollY variables
//GtkAdjustment calculation isn't good here (can go below 0 or over max)
// DebugLn('TGtk3WSScrollingWinControl.ScrollBy DeltaX=',dbgs(DeltaX),' DeltaY=',dbgs(DeltaY));
exit;
Adjustment := gtk_scrolled_window_get_hadjustment(Scrolled);
if Adjustment <> nil then
begin
h := gtk_adjustment_get_value(Adjustment);
NewPos := Adjustment^.upper - Adjustment^.page_size;
if h - DeltaX <= NewPos then
NewPos := h - DeltaX;
if NewPos < 0 then
NewPos := 0;
gtk_adjustment_set_value(Adjustment, NewPos);
end;
Adjustment := gtk_scrolled_window_get_vadjustment(Scrolled);
if Adjustment <> nil then
begin
v := gtk_adjustment_get_value(Adjustment);
NewPos := Adjustment^.upper - Adjustment^.page_size;
if v - DeltaY <= NewPos then
NewPos := v - DeltaY;
if NewPos < 0 then
NewPos := 0;
// writeln('OldValue ',dbgs(V),' NewValue ',dbgs(NewPos),' upper=',dbgs(Adjustment^.upper - Adjustment^.page_size));
gtk_adjustment_set_value(Adjustment, NewPos);
end;
AWinControl.Invalidate;
end;
{ TGtk3WSCustomForm }
class function TGtk3WSCustomForm.CreateHandle(const AWinControl: TWinControl;

12
lcl/interfaces/qt/qtwscontrols.pp
View File

@ -89,6 +89,7 @@ type
class procedure ConstraintsChange(const AWinControl: TWinControl); override;
class procedure PaintTo(const AWinControl: TWinControl; ADC: HDC; X, Y: Integer); override;
class procedure ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY: integer); override;
end;
{ TQtWSGraphicControl }
@ -435,6 +436,17 @@ begin
end;
end;
class procedure TQtWSWinControl.ScrollBy(const AWinControl: TWinControl;
DeltaX, DeltaY: integer);
var
Widget: TQtCustomControl;
begin
if not WSCheckHandleAllocated(AWinControl, 'ScrollBy') then
Exit;
Widget := TQtCustomControl(AWinControl.Handle);
Widget.viewport.scroll(DeltaX, DeltaY);
end;
{------------------------------------------------------------------------------
Method: TQtWSWinControl.SetBounds
Params: AWinControl - the calling object

22
lcl/interfaces/qt/qtwsforms.pp
View File

@ -37,8 +37,6 @@ type
TQtWSScrollingWinControl = class(TWSScrollingWinControl)
published
class procedure ScrollBy(const AWinControl: TScrollingWinControl;
const DeltaX, DeltaY: integer); override;
end;
{ TQtWSScrollBox }
@ -77,8 +75,7 @@ type
class procedure CloseModal(const ACustomForm: TCustomForm); override;
class procedure DestroyHandle(const AWinControl: TWinControl); override;
class procedure ScrollBy(const AWinControl: TScrollingWinControl;
const DeltaX, DeltaY: integer); override;
class procedure ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY: integer); override;
class procedure SetAllowDropFiles(const AForm: TCustomForm; AValue: Boolean); override;
class procedure SetFormBorderStyle(const AForm: TCustomForm; const AFormBorderStyle: TFormBorderStyle); override;
class procedure SetFormStyle(const AForm: TCustomform; const AFormStyle, AOldFormStyle: TFormStyle); override;
@ -136,19 +133,6 @@ uses qtint, LCLIntf
{$IFDEF VerboseQtResize}, LCLProc{$ENDIF}
;
{ TQtWSScrollingWinControl }
class procedure TQtWSScrollingWinControl.ScrollBy(
const AWinControl: TScrollingWinControl; const DeltaX, DeltaY: integer);
var
Widget: TQtCustomControl;
begin
if not WSCheckHandleAllocated(AWinControl, 'ScrollBy') then
Exit;
Widget := TQtCustomControl(AWinControl.Handle);
Widget.viewport.scroll(DeltaX, DeltaY);
end;
{------------------------------------------------------------------------------
Method: TQtWSCustomForm.CreateHandle
Params: None
@ -265,8 +249,8 @@ begin
w.Release;
end;
class procedure TQtWSCustomForm.ScrollBy(
const AWinControl: TScrollingWinControl; const DeltaX, DeltaY: integer);
class procedure TQtWSCustomForm.ScrollBy(const AWinControl: TWinControl;
DeltaX, DeltaY: integer);
{$IFDEF QTSCROLLABLEFORMS}
var
Widget: TQtMainWindow;

8
lcl/interfaces/qt/qtwsstdctrls.pp
View File

@ -175,6 +175,7 @@ type
class procedure SetWantReturns(const ACustomMemo: TCustomMemo; const NewWantReturns: boolean); override;
class procedure SetWantTabs(const ACustomMemo: TCustomMemo; const NewWantTabs: boolean); override;
class procedure SetWordWrap(const ACustomMemo: TCustomMemo; const NewWordWrap: boolean); override;
class procedure ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY: integer); override;
end;
{ TQtWSEdit }
@ -292,7 +293,6 @@ const
);
{ TQtWSScrollBar }
{------------------------------------------------------------------------------
@ -822,6 +822,12 @@ begin
TQtTextEdit(ACustomMemo.Handle).setLineWrapMode(WordWrapMap[NewWordWrap]);
end;
class procedure TQtWSCustomMemo.ScrollBy(const AWinControl: TWinControl;
DeltaX, DeltaY: integer);
begin
; // Do nothing.
end;
{ TQtWSCustomEdit }
{------------------------------------------------------------------------------

12
lcl/interfaces/win32/win32wscontrols.pp
View File

@ -81,6 +81,7 @@ type
class procedure Invalidate(const AWinControl: TWinControl); override;
class procedure PaintTo(const AWinControl: TWinControl; ADC: HDC; X, Y: Integer); override;
class procedure ShowHide(const AWinControl: TWinControl); override;
class procedure ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY: integer); override;
end;
{ TWin32WSGraphicControl }
@ -586,6 +587,17 @@ begin
SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or VisibilityToFlag[AWinControl.HandleObjectShouldBeVisible])
end;
function ScrollWindowPtr(hWnd: HWND; dx: longint; dy: longint;
prcScroll: pointer; prcClip: pointer; hrgnUpdate: HRGN; prcUpdate: LPRECT;
flags: UINT): WINBOOL; stdcall; external 'user32' name 'ScrollWindowEx';
class procedure TWin32WSWinControl.ScrollBy(const AWinControl: TWinControl;
DeltaX, DeltaY: integer);
begin
if Windows.IsWindowVisible(AWinControl.Handle) then
ScrollWindowPtr(AWinControl.Handle, DeltaX, DeltaY, nil, nil, 0, nil, 0);
end;
{ TWin32WSDragImageList }
class function TWin32WSDragImageList.BeginDrag(

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

@ -38,8 +38,6 @@ type
TWin32WSScrollingWinControl = class(TWSScrollingWinControl)
published
class procedure ScrollBy(const AWinControl: TScrollingWinControl;
const DeltaX, DeltaY: integer); override;
end;
{ TWin32WSScrollBox }
@ -212,19 +210,6 @@ begin
{$ENDIF}
end;
{ TWin32WSScrollingWinControl }
function ScrollWindowPtr(hWnd: HWND; dx: longint; dy: longint;
prcScroll: pointer; prcClip: pointer; hrgnUpdate: HRGN; prcUpdate: LPRECT;
flags: UINT): WINBOOL; stdcall; external 'user32' name 'ScrollWindowEx';
class procedure TWin32WSScrollingWinControl.ScrollBy(const AWinControl: TScrollingWinControl;
const DeltaX, DeltaY: integer);
begin
if Windows.IsWindowVisible(AWinControl.Handle) then
ScrollWindowPtr(AWinControl.Handle, DeltaX, DeltaY, nil, nil, 0, nil, 0);
end;
{ TWin32WSCustomForm }
function GetDesigningBorderStyle(const AForm: TCustomForm): TFormBorderStyle;

8
lcl/interfaces/win32/win32wsstdctrls.pp
View File

@ -195,6 +195,7 @@ type
class procedure SetCaretPos(const ACustomEdit: TCustomEdit; const NewPos: TPoint); override;
class procedure SetScrollbars(const ACustomMemo: TCustomMemo; const NewScrollbars: TScrollStyle); override;
class procedure SetWordWrap(const ACustomMemo: TCustomMemo; const NewWordWrap: boolean); override;
class procedure ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY: integer); override;
end;
{ TWin32WSEdit }
@ -1434,6 +1435,13 @@ begin
RecreateWnd(ACustomMemo);
end;
class procedure TWin32WSCustomMemo.ScrollBy(const AWinControl: TWinControl;
DeltaX, DeltaY: integer);
begin
SendMessage(AWinControl.Handle, EN_HSCROLL, 0, -DeltaX);
SendMessage(AWinControl.Handle, EN_VSCROLL, 0, -DeltaY); // or EM_LINESCROLL
end;
{ TWin32WSCustomStaticText }
function StaticTextWndProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;

11
lcl/interfaces/wince/winceextra.pp
View File

@ -63,7 +63,6 @@ const
WM_HIBERNATE = $03FF;
function DrawState(dc:HDC ; hbr : HBRUSH ; func: DRAWSTATEPROC ; lp:LPARAM; wp:WPARAM;x,y,cx,cy:integer;flags:UINT) : boolean;
function GetTopWindow(hWnd:HWND):HWND;
@ -80,13 +79,9 @@ function ImageList_Copy(himlDst: HIMAGELIST; iDst: longint; himlSrc: HIMAGELIST;
function ImageList_Copy(himlDst: HIMAGELIST; iDst: longint; himlSrc: HIMAGELIST; Src: longint; uFlags: UINT): BOOL; cdecl; external KernelDLL;
{$endif}
{$ifdef win32}
function ScrollWindowPtr(hWnd:HWND; XAmount:longint; YAmount:longint; lpRect: pointer; lpClipRect: pointer):WINBOOL; stdcall; external 'user32' name 'ScrollWindow';
{$else}
function ScrollWindowPtr(hWnd:HWND; dx:longint; dy:longint; prcScroll: lpRECT; prcClip: lpRECT;
hrgnUpdate: HRGN; prcUpdate: LPRECT; flags:UINT):longint; cdecl; external KernelDll name 'ScrollWindowEx';
{$endif}
function ScrollWindowPtr(hWnd: HWND; dx: longint; dy: longint; prcScroll: lpRECT; prcClip: lpRECT;
hrgnUpdate: HRGN; prcUpdate: LPRECT; flags: UINT): longint; cdecl;
external {$ifdef win32}'user32'{$else}KernelDll{$endif} name 'ScrollWindowEx';
const

15
lcl/interfaces/wince/wincewscontrols.pp
View File

@ -86,6 +86,7 @@ type
class procedure DestroyHandle(const AWinControl: TWinControl); override;
class procedure Invalidate(const AWinControl: TWinControl); override;
class procedure ShowHide(const AWinControl: TWinControl); override;
class procedure ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY: integer); override;
end;
{ TWinCEWSGraphicControl }
@ -449,6 +450,20 @@ begin
TWinCEWidgetSet(WidgetSet).ShowHide(AWinControl);
end;
class procedure TWinCEWSWinControl.ScrollBy(const AWinControl: TWinControl;
DeltaX, DeltaY: integer);
var
rgn: HRGN;
rect: trect;
begin
rgn := 0; //roozbeh : seems to be ok?
// GetClipRgn(AWinControl.Handle,rgn);
// roozbeh:which flags really are required?!
if Windows.IsWindowVisible(AWinControl.Handle) then
ScrollWindowPtr(AWinControl.Handle, DeltaX, DeltaY, nil, nil,
rgn, nil, SW_INVALIDATE or SW_ERASE or SW_SCROLLCHILDREN);
end;
{ TWinCEWSDragImageList }
class function TWinCEWSDragImageList.BeginDrag(

22
lcl/interfaces/wince/wincewsforms.pp
View File

@ -34,8 +34,6 @@ type
TWinCEWSScrollingWinControl = class(TWSScrollingWinControl)
published
class procedure ScrollBy(const AWinControl: TScrollingWinControl;
const DeltaX, DeltaY: integer); override;
end;
{ TWinCEWSScrollBox }
@ -147,26 +145,6 @@ begin
Result := Params.Window;
end;
{ TWinCEWSScrollingWinControl }
class procedure TWinCEWSScrollingWinControl.ScrollBy(const AWinControl: TScrollingWinControl;
const DeltaX, DeltaY: integer);
var
rgn: HRGN;
rect: trect;
begin
rgn := 0; //roozbeh : seems to be ok?
// GetClipRgn(AWinControl.Handle,rgn);
// roozbeh:which flags really are required?!
if Windows.IsWindowVisible(AWinControl.Handle) then
{$ifdef win32}
ScrollWindowPtr(AWinControl.Handle, DeltaX, DeltaY, nil, nil);
{$else}
ScrollWindowPtr(AWinControl.Handle, DeltaX, DeltaY, nil, nil,
rgn, nil, SW_INVALIDATE or SW_ERASE or SW_SCROLLCHILDREN);
{$endif}
end;
{ TWinCEWSCustomForm }
class function TWinCEWSCustomForm.CalcBorderIconsFlags(const AForm: TCustomForm): dword;

2
lcl/stdctrls.pp
View File

@ -804,7 +804,6 @@ type
TMemoScrollbar = class(TControlScrollBar)
protected
procedure SetControlPosition; override;
function GetHorzScrollBar: TControlScrollBar; override;
function GetVertScrollBar: TControlScrollBar; override;
public
@ -857,6 +856,7 @@ type
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Append(const Value: String);
procedure ScrollBy(DeltaX, DeltaY: Integer); override;
public
property Lines: TStrings read FLines write SetLines;
property HorzScrollBar: TMemoScrollBar read FHorzScrollBar write SetHorzScrollBar;

6
lcl/widgetset/wscontrols.pp
View File

@ -135,6 +135,7 @@ type
class procedure Invalidate(const AWinControl: TWinControl); virtual;
class procedure PaintTo(const AWinControl: TWinControl; ADC: HDC; X, Y: Integer); virtual;
class procedure ShowHide(const AWinControl: TWinControl); virtual; //TODO: rename to SetVisible(control, visible)
class procedure ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY: integer); virtual;
end;
TWSWinControlClass = class of TWSWinControl;
@ -389,6 +390,11 @@ class procedure TWSWinControl.ShowHide(const AWinControl: TWinControl);
begin
end;
class procedure TWSWinControl.ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY: integer);
begin
AWinControl.Invalidate;
end;
{ TWSDragImageList }
class function TWSDragImageList.BeginDrag(const ADragImageList: TDragImageList;

11
lcl/widgetset/wsforms.pp
View File

@ -49,8 +49,7 @@ type
TWSScrollingWinControlClass = class of TWSScrollingWinControl;
TWSScrollingWinControl = class(TWSWinControl)
published
class procedure ScrollBy(const AWinControl: TScrollingWinControl;
const DeltaX, DeltaY: integer); virtual;
// procedure ScrollBy is moved to TWSWinControl.
end;
{ TWSScrollBox }
@ -139,14 +138,6 @@ type
implementation
{ TWSScrollingWinControl }
class procedure TWSScrollingWinControl.ScrollBy(const AWinControl: TScrollingWinControl;
const DeltaX, DeltaY: integer);
begin
AWinControl.Invalidate;
end;
{ TWSCustomForm }
class procedure TWSCustomForm.CloseModal(const ACustomForm: TCustomForm);

1
lcl/widgetset/wsproc.pp
View File

@ -77,5 +77,4 @@ begin
end;
end.