On 29.11.2015 20:25, Juha Manninen wrote:
I implemented TCustomMemo.ScrollBy together with fixing issue:
http://bugs.freepascal.org/view.php?id=29067
See my comment there.
Now I need help to test the changes, especially the widgetsets I could
not test myself.
Windows experts, is my solution for Windows OK?
Juha, unfortunately I think the refactoring was not good. It opened too
many issues.
1.) The biggest problem: TScrollBox stopped working completely on Win32.
If you place TWinControl descendants into TScrollBox, they do not
scroll. I wanted to fix it by adding the SW_SCROLLCHILDREN parameter to
ScrollWindowEx
https://msdn.microsoft.com/en-us/library/windows/desktop/bb787593(v=vs.85).aspx
but then the scrolling of the child controls moves them "hard" - the
scroll bars disappear and the controls change their LeftTop positions.
2.) You heavily changed TWinControl.ScrollBy function.
3.) IMO it's not a bug that TCustomMemo.ScrollBy doesn't work like you
expect. But if you want to change TCustomMemo.ScrollBy behavior, change
only its behavior, not TWinControl.ScrollBy.
4.) Maybe it's better to introduce TCustomMemo.TopLine property. Because
if you hide scrollbars (ScrollBars = ssNone), you cannot use
VertScrollBar.Position either because it's unavailable. This approach is
good on Windows as it supports the EM_GETFIRSTVISIBLELINE and
EM_LINESCROLL messages. I don't know if such functionality is supported
on other WS, though.
Please see the patch attached. It reverts 50523 and introduces
TCustomMemo.TopLine.
In my opinion, we have 2 possibilities:
A) Implement TCustomMemo.TopLine on all WS where it is possible.
- or -
B) Revert TWinControl.ScrollBy and implement TCustomMemo.ScrollBy only.
IMO (A) is the way to go. ScrollBy is a different function. E.g.
TCustomGrid and TListBox do not support ScrollBy the way you do in
TCustomMemo either. IMO it is just a misunderstanding that somebody
thinks ScrollBy should move the ScrollBars.
We need to solve (1) definitely.
Ondrej
Index: lcl/controls.pp
===================================================================
--- lcl/controls.pp (revision 50545)
+++ lcl/controls.pp (working copy)
@@ -2163,8 +2163,7 @@
procedure DisableAlign;
procedure EnableAlign;
procedure ReAlign; // realign all children
- procedure ScrollBy_WS(DeltaX, DeltaY: Integer);
- procedure ScrollBy(DeltaX, DeltaY: Integer); virtual;
+ //procedure ScrollBy(DeltaX, DeltaY: Integer); virtual;
procedure WriteLayoutDebugReport(const Prefix: string); override;
procedure AutoAdjustLayout(AMode: TLayoutAdjustmentPolicy;
const AFromDPI, AToDPI, AOldFormWidth, ANewFormWidth: Integer); override;
Index: lcl/forms.pp
===================================================================
--- lcl/forms.pp (revision 50545)
+++ lcl/forms.pp (working copy)
@@ -92,7 +92,7 @@
FOldScrollInfoValid: Boolean;
protected
FControl: TWinControl;
- FPosition: Integer;
+ FPosition, FPrevPosition: Integer;
function ControlHandle: HWnd; virtual;
function GetAutoScroll: boolean; virtual;
function GetIncrement: TScrollBarInc; virtual;
@@ -109,6 +109,7 @@
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,6 +169,8 @@
procedure WMVScroll(var Message : TLMVScroll); message LM_VScroll;
procedure WMMouseWheel(var Message: TLMMouseEvent); message LM_MOUSEWHEEL;
procedure ComputeScrollbars; virtual;
+ procedure ScrollbarHandler(ScrollKind: TScrollBarKind;
+ OldPosition: Integer); virtual;
procedure SetAutoScroll(Value: Boolean); virtual;
procedure Loaded; override;
procedure Resizing(State: TWindowState); virtual;
@@ -178,7 +181,7 @@
destructor Destroy; override;
procedure UpdateScrollbars;
class function GetControlClassDefaultSize: TSize; override;
- procedure ScrollBy(DeltaX, DeltaY: Integer); override;
+ procedure ScrollBy(DeltaX, DeltaY: Integer); virtual;
procedure ScrollInView(AControl: TControl);
published
property HorzScrollBar: TControlScrollBar read FHorzScrollBar write
SetHorzScrollBar;
@@ -1796,7 +1799,7 @@
{$endif}
uses
- WSControls, WSForms; // Widgetset uses circle is allowed
+ WSForms; // Widgetset uses circle is allowed
var
HandlingException: Boolean = False;
Index: lcl/include/controlscrollbar.inc
===================================================================
--- lcl/include/controlscrollbar.inc (revision 50545)
+++ lcl/include/controlscrollbar.inc (working copy)
@@ -70,14 +70,11 @@
if Value = FPosition then
exit;
- // scroll logical client area of FControl
- if Kind = sbVertical then
- FControl.ScrollBy(0, FPosition - Value)
- else
- FControl.ScrollBy(FPosition - Value, 0);
-
// now actually set the position
+ FPrevPosition := FPosition;
FPosition := Value;
+ // scroll logical client area of FControl
+ SetControlPosition;
// check that the new position is also set on the scrollbar
if HandleAllocated and (GetScrollPos(ControlHandle, IntfBarKind[Kind]) <>
FPosition) then
@@ -97,6 +94,12 @@
end;
end;
+procedure TControlScrollBar.SetControlPosition;
+begin
+ if FControl is TScrollingWinControl then
+ TScrollingWinControl(FControl).ScrollbarHandler(Kind, FPrevPosition);
+end;
+
function TControlScrollBar.GetIncrement: TScrollBarInc;
begin
Result := FIncrement;
Index: lcl/include/custommemo.inc
===================================================================
--- lcl/include/custommemo.inc (revision 50545)
+++ lcl/include/custommemo.inc (working copy)
@@ -15,6 +15,13 @@
{off $DEFINE DEBUG_MEMO}
+{------------------------------------------------------------------------------
+ Method: TCustomMemo.Create
+ Params:
+ Returns:
+
+ Constructor for the class
+
------------------------------------------------------------------------------}
constructor TCustomMemo.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
@@ -29,6 +36,13 @@
AutoSize := False;
end;
+{------------------------------------------------------------------------------
+ Method: TCustomMemo.Destroy
+ Params: None
+ Returns: Nothing
+
+ Destructor for the class.
+
------------------------------------------------------------------------------}
destructor TCustomMemo.Destroy;
begin
FreeThenNil(FLines);
@@ -37,16 +51,20 @@
inherited Destroy;
end;
+{------------------------------------------------------------------------------
+ Method: TCustomMemo.Append
+ Params:
+ Returns:
+
+
------------------------------------------------------------------------------}
procedure TCustomMemo.Append(const Value: String);
begin
Lines.Add(Value);
end;
-procedure TCustomMemo.ScrollBy(DeltaX, DeltaY: Integer);
-begin
- ScrollBy_WS(DeltaX, DeltaY);
-end;
-
+{------------------------------------------------------------------------------
+ procedure TCustomMemo.SetHorzScrollBar(const AValue: TMemoScrollBar);
+
------------------------------------------------------------------------------}
procedure TCustomMemo.SetHorzScrollBar(const AValue: TMemoScrollBar);
begin
if FHorzScrollBar=AValue then exit;
@@ -61,6 +79,9 @@
TWSCustomMemoClass(WidgetSetClass).SetCaretPos(Self, Value);
end;
+{------------------------------------------------------------------------------
+ procedure TCustomMemo.SetVertScrollBar(const AValue: TMemoScrollBar);
+
------------------------------------------------------------------------------}
procedure TCustomMemo.SetVertScrollBar(const AValue: TMemoScrollBar);
begin
if FVertScrollBar=AValue then exit;
@@ -192,6 +213,12 @@
inherited;
end;
+{------------------------------------------------------------------------------
+ Method: TCustomMemo.SetLines
+ Params:
+ Returns:
+
+
------------------------------------------------------------------------------}
procedure TCustomMemo.SetLines(const Value: TStrings);
begin
if (Value <> nil) then
@@ -208,6 +235,14 @@
end;
end;
+procedure TCustomMemo.SetTopLine(const aTopLine: Integer);
+begin
+ TWSCustomMemoClass(WidgetSetClass).SetTopLine(Self, aTopLine);
+end;
+
+{------------------------------------------------------------------------------
+ procedure TCustomMemo.SetScrollbars(const Value : TScrollStyle);
+
------------------------------------------------------------------------------}
procedure TCustomMemo.SetScrollBars(const Value: TScrollStyle);
begin
if Value <> FScrollbars then begin
@@ -217,6 +252,9 @@
end;
end;
+{------------------------------------------------------------------------------
+ procedure TCustomMemo.Loaded;
+
------------------------------------------------------------------------------}
procedure TCustomMemo.Loaded;
begin
inherited Loaded;
@@ -254,6 +292,11 @@
Result.CY := 90;
end;
+function TCustomMemo.GetTopLine: Integer;
+begin
+ Result := TWSCustomMemoClass(WidgetSetClass).GetTopLine(Self);
+end;
+
procedure TCustomMemo.UTF8KeyPress(var UTF8Key: TUTF8Char);
begin
inherited UTF8KeyPress(UTF8Key);
@@ -269,6 +312,12 @@
TWSCustomMemoClass(WidgetSetClass).SetWantTabs(Self, NewWantTabs);
end;
+{------------------------------------------------------------------------------
+ Method: TCustomMemo.SetWordWrap
+ Params:
+ Returns:
+
+
------------------------------------------------------------------------------}
procedure TCustomMemo.SetWordWrap(const Value: boolean);
begin
if Value <> FWordWrap then
Index: lcl/include/memoscrollbar.inc
===================================================================
--- lcl/include/memoscrollbar.inc (revision 50545)
+++ lcl/include/memoscrollbar.inc (working copy)
@@ -11,6 +11,11 @@
{ TMemoScrollbar }
+procedure TMemoScrollbar.SetControlPosition;
+begin
+ //TCustomMemo(FControl).ScrollBy(FPosition - FPrevPosition); No good!
+end;
+
function TMemoScrollbar.GetHorzScrollBar: TControlScrollBar;
begin
Result:=TCustomMemo(FControl).HorzScrollBar;
Index: lcl/include/scrollingwincontrol.inc
===================================================================
--- lcl/include/scrollingwincontrol.inc (revision 50545)
+++ lcl/include/scrollingwincontrol.inc (working copy)
@@ -248,7 +248,13 @@
procedure TScrollingWinControl.ScrollBy(DeltaX, DeltaY: Integer);
begin
- ScrollBy_WS(DeltaX, DeltaY);
+ if HandleAllocated and IsWindowVisible(Handle) then
+ begin
+ TWSScrollingWinControlClass(WidgetSetClass).ScrollBy(Self, DeltaX, DeltaY);
+ //Invalidate;
+ end
+ {else
+ inherited ScrollBy(DeltaX, DeltaY);}
end;
procedure TScrollingWinControl.ScrollInView(AControl: TControl);
@@ -277,6 +283,15 @@
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;
Index: lcl/include/wincontrol.inc
===================================================================
--- lcl/include/wincontrol.inc (revision 50545)
+++ lcl/include/wincontrol.inc (working copy)
@@ -6134,15 +6134,7 @@
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);
+{procedure TWinControl.ScrollBy(DeltaX, DeltaY: Integer);
var
i: Integer;
begin
@@ -6150,7 +6142,7 @@
for i := 0 to ControlCount - 1 do
with Controls[i] do
SetBounds(Left + DeltaX, Top + DeltaY, Width, Height);
-end;
+end;}
{------------------------------------------------------------------------------
TWinControl Remove
Index: lcl/interfaces/carbon/carbonwscontrols.pp
===================================================================
--- lcl/interfaces/carbon/carbonwscontrols.pp (revision 50545)
+++ lcl/interfaces/carbon/carbonwscontrols.pp (working copy)
@@ -85,7 +85,6 @@
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 }
@@ -380,15 +379,6 @@
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
@@ -467,8 +457,8 @@
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;
@@ -483,8 +473,8 @@
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;
Index: lcl/interfaces/carbon/carbonwsforms.pp
===================================================================
--- lcl/interfaces/carbon/carbonwsforms.pp (revision 50545)
+++ lcl/interfaces/carbon/carbonwsforms.pp (working copy)
@@ -39,6 +39,7 @@
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 }
@@ -129,6 +130,21 @@
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 }
{------------------------------------------------------------------------------
Index: lcl/interfaces/cocoa/cocoawscommon.pas
===================================================================
--- lcl/interfaces/cocoa/cocoawscommon.pas (revision 50545)
+++ lcl/interfaces/cocoa/cocoawscommon.pas (working copy)
@@ -100,7 +100,6 @@
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;
Index: lcl/interfaces/cocoa/cocoawsforms.pp
===================================================================
--- lcl/interfaces/cocoa/cocoawsforms.pp (revision 50545)
+++ lcl/interfaces/cocoa/cocoawsforms.pp (working copy)
@@ -62,6 +62,7 @@
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 }
Index: lcl/interfaces/customdrawn/customdrawnwsforms.pp
===================================================================
--- lcl/interfaces/customdrawn/customdrawnwsforms.pp (revision 50545)
+++ lcl/interfaces/customdrawn/customdrawnwsforms.pp (working copy)
@@ -52,8 +52,8 @@
TCDWSScrollBox = class(TWSScrollBox)
published
-// class procedure ScrollBy(const AWinControl: TWinControl;
-// DeltaX, DeltaY: integer); override;
+// class procedure ScrollBy(const AWinControl: TScrollingWinControl;
+// const DeltaX, DeltaY: integer); override;
end;
{ TCDWSCustomFrame }
@@ -60,8 +60,8 @@
TCDWSCustomFrame = class(TWSCustomFrame)
published
-// class procedure ScrollBy(const AWinControl: TWinControl;
-// DeltaX, DeltaY: integer); override;
+// class procedure ScrollBy(const AWinControl: TScrollingWinControl;
+// const DeltaX, DeltaY: integer); override;
end;
{ TCDWSFrame }
Index: lcl/interfaces/gtk2/gtk2wscontrols.pp
===================================================================
--- lcl/interfaces/gtk2/gtk2wscontrols.pp (revision 50545)
+++ lcl/interfaces/gtk2/gtk2wscontrols.pp (working copy)
@@ -91,11 +91,11 @@
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 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 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;
+
+ class procedure SetBiDiMode(const AWinControl: TWinControl;
UseRightToLeftAlign, {%H-}UseRightToLeftReading, {%H-}UseRightToLeftScrollBar :
Boolean); override;
end;
{ TGtk2WSGraphicControl }
@@ -625,39 +625,6 @@
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
Index: lcl/interfaces/gtk2/gtk2wsforms.pp
===================================================================
--- lcl/interfaces/gtk2/gtk2wsforms.pp (revision 50545)
+++ lcl/interfaces/gtk2/gtk2wsforms.pp (working copy)
@@ -39,8 +39,9 @@
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 }
@@ -67,9 +68,9 @@
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: TWinControl; DeltaX, DeltaY:
integer); override;
+ class procedure ScrollBy(const AWinControl: TScrollingWinControl; const
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;
@@ -458,7 +459,7 @@
g_idle_remove_by_data(Data);
end;
-class procedure TGtk2WSCustomForm.ScrollBy(const AWinControl: TWinControl;
DeltaX, DeltaY: integer);
+class procedure TGtk2WSCustomForm.ScrollBy(const AWinControl:
TScrollingWinControl; const DeltaX, DeltaY: integer);
var
Layout: PGtkLayout;
WidgetInfo: PWidgetInfo;
@@ -958,7 +959,8 @@
end;
end;
-class procedure TGtk2WSScrollingWinControl.SetColor(const AWinControl:
TWinControl);
+class procedure TGtk2WSScrollingWinControl.SetColor(
+ const AWinControl: TWinControl);
begin
if not WSCheckHandleAllocated(AWinControl, 'SetColor')
then Exit;
@@ -969,6 +971,39 @@
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;
Index: lcl/interfaces/gtk3/gtk3wscontrols.pp
===================================================================
--- lcl/interfaces/gtk3/gtk3wscontrols.pp (revision 50545)
+++ lcl/interfaces/gtk3/gtk3wscontrols.pp (working copy)
@@ -110,7 +110,6 @@
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;
@@ -543,54 +542,6 @@
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(
Index: lcl/interfaces/gtk3/gtk3wsforms.pp
===================================================================
--- lcl/interfaces/gtk3/gtk3wsforms.pp (revision 50545)
+++ lcl/interfaces/gtk3/gtk3wsforms.pp (working copy)
@@ -51,8 +51,10 @@
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 }
@@ -153,6 +155,54 @@
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;
Index: lcl/interfaces/gtk/gtkwscontrols.pp
===================================================================
--- lcl/interfaces/gtk/gtkwscontrols.pp (revision 50545)
+++ lcl/interfaces/gtk/gtkwscontrols.pp (working copy)
@@ -88,8 +88,8 @@
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;
Index: lcl/interfaces/gtk/gtkwsforms.pp
===================================================================
--- lcl/interfaces/gtk/gtkwsforms.pp (revision 50545)
+++ lcl/interfaces/gtk/gtkwsforms.pp (working copy)
@@ -40,6 +40,7 @@
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;
@@ -184,6 +185,13 @@
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
Index: lcl/interfaces/qt/qtwscontrols.pp
===================================================================
--- lcl/interfaces/qt/qtwscontrols.pp (revision 50545)
+++ lcl/interfaces/qt/qtwscontrols.pp (working copy)
@@ -89,7 +89,6 @@
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 }
@@ -437,59 +436,6 @@
end;
end;
-class procedure TQtWSWinControl.ScrollBy(const AWinControl: TWinControl;
- DeltaX, DeltaY: integer);
-var
- Widget: TQtCustomControl;
- ABar: TQtScrollBar;
- APosition: Integer;
-begin
- if not WSCheckHandleAllocated(AWinControl, 'ScrollBy') then
- Exit;
- if TQtWidget(AWinControl.Handle) is TQtCustomControl then
- begin
- Widget := TQtCustomControl(AWinControl.Handle);
- Widget.viewport.scroll(DeltaX, DeltaY);
- end else
- if TQtWidget(AWinControl.Handle) is TQtAbstractScrollArea then
- begin
- ABar := TQtAbstractScrollArea(AWinControl.Handle).horizontalScrollBar;
- if ABar = nil then
- exit;
- if ABar.getTracking then
- APosition := ABar.getSliderPosition
- else
- APosition := ABar.getValue;
- if DeltaX <> 0 then
- begin
- APosition += -DeltaX;
- if ABar.getTracking then
- ABar.setSliderPosition(APosition)
- else
- ABar.setValue(APosition);
- end;
- ABar := TQtAbstractScrollArea(AWinControl.Handle).verticalScrollBar;
- if ABar = nil then
- exit;
- if ABar.getTracking then
- APosition := ABar.getSliderPosition
- else
- APosition := ABar.getValue;
- if DeltaY <> 0 then
- begin
- APosition += -DeltaY;
- if ABar.getTracking then
- ABar.setSliderPosition(APosition)
- else
- ABar.setValue(APosition);
- end;
- end
- {$IFDEF VerboseQt}
- else
- DebugLn(Format('WARNING: TQtWSWinControl.ScrollBy(): Qt widget handle %s
is not TQtCustomControl',[DbgSName(TQtWidget(AWinControl.Handle))]));
- {$ENDIF}
-end;
-
{------------------------------------------------------------------------------
Method: TQtWSWinControl.SetBounds
Params: AWinControl - the calling object
Index: lcl/interfaces/qt/qtwsforms.pp
===================================================================
--- lcl/interfaces/qt/qtwsforms.pp (revision 50545)
+++ lcl/interfaces/qt/qtwsforms.pp (working copy)
@@ -37,6 +37,8 @@
TQtWSScrollingWinControl = class(TWSScrollingWinControl)
published
+ class procedure ScrollBy(const AWinControl: TScrollingWinControl;
+ const DeltaX, DeltaY: integer); override;
end;
{ TQtWSScrollBox }
@@ -75,7 +77,8 @@
class procedure CloseModal(const ACustomForm: TCustomForm); override;
class procedure DestroyHandle(const AWinControl: TWinControl); override;
- class procedure ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY:
integer); override;
+ class procedure ScrollBy(const AWinControl: TScrollingWinControl;
+ const 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;
@@ -133,6 +136,19 @@
{$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
@@ -249,8 +265,8 @@
w.Release;
end;
-class procedure TQtWSCustomForm.ScrollBy(const AWinControl: TWinControl;
- DeltaX, DeltaY: integer);
+class procedure TQtWSCustomForm.ScrollBy(
+ const AWinControl: TScrollingWinControl; const DeltaX, DeltaY: integer);
{$IFDEF QTSCROLLABLEFORMS}
var
Widget: TQtMainWindow;
Index: lcl/interfaces/qt/qtwsstdctrls.pp
===================================================================
--- lcl/interfaces/qt/qtwsstdctrls.pp (revision 50545)
+++ lcl/interfaces/qt/qtwsstdctrls.pp (working copy)
@@ -292,6 +292,7 @@
);
+
{ TQtWSScrollBar }
{------------------------------------------------------------------------------
Index: lcl/interfaces/win32/win32wscontrols.pp
===================================================================
--- lcl/interfaces/win32/win32wscontrols.pp (revision 50545)
+++ lcl/interfaces/win32/win32wscontrols.pp (working copy)
@@ -81,7 +81,6 @@
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 }
@@ -587,13 +586,6 @@
SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or
VisibilityToFlag[AWinControl.HandleObjectShouldBeVisible])
end;
-class procedure TWin32WSWinControl.ScrollBy(const AWinControl: TWinControl;
- DeltaX, DeltaY: integer);
-begin
- if Windows.IsWindowVisible(AWinControl.Handle) then
- ScrollWindowEx(AWinControl.Handle, DeltaX, DeltaY, nil, nil, 0, nil,
SW_INVALIDATE or SW_ERASE);
-end;
-
{ TWin32WSDragImageList }
class function TWin32WSDragImageList.BeginDrag(
Index: lcl/interfaces/win32/win32wsforms.pp
===================================================================
--- lcl/interfaces/win32/win32wsforms.pp (revision 50545)
+++ lcl/interfaces/win32/win32wsforms.pp (working copy)
@@ -38,6 +38,8 @@
TWin32WSScrollingWinControl = class(TWSScrollingWinControl)
published
+ class procedure ScrollBy(const AWinControl: TScrollingWinControl;
+ const DeltaX, DeltaY: integer); override;
end;
{ TWin32WSScrollBox }
@@ -210,6 +212,18 @@
{$ENDIF}
end;
+{ TWin32WSScrollingWinControl }
+
+function ScrollWindowPtr(hWnd: HWND; dx: longint; dy: longint;
+ prcScroll: pointer; prcClip: pointer): WINBOOL; stdcall; external 'user32'
name 'ScrollWindow';
+
+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);
+end;
+
{ TWin32WSCustomForm }
function GetDesigningBorderStyle(const AForm: TCustomForm): TFormBorderStyle;
Index: lcl/interfaces/win32/win32wsstdctrls.pp
===================================================================
--- lcl/interfaces/win32/win32wsstdctrls.pp (revision 50545)
+++ lcl/interfaces/win32/win32wsstdctrls.pp (working copy)
@@ -195,7 +195,9 @@
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;
+
+ class function GetTopLine(const ACustomMemo: TCustomMemo): integer;
override;
+ class procedure SetTopLine(const ACustomMemo: TCustomMemo; const
NewTopLine: integer); override;
end;
{ TWin32WSEdit }
@@ -1365,6 +1367,12 @@
Result := TWin32MemoStrings.Create(ACustomMemo.Handle, ACustomMemo)
end;
+class function TWin32WSCustomMemo.GetTopLine(const ACustomMemo: TCustomMemo
+ ): integer;
+begin
+ Result := ACustomMemo.Perform(EM_GETFIRSTVISIBLELINE, 0, 0);
+end;
+
class procedure TWin32WSCustomMemo.AppendText(const ACustomMemo: TCustomMemo;
const AText: string);
var
S: string;
@@ -1429,6 +1437,12 @@
RecreateWnd(ACustomMemo);
end;
+class procedure TWin32WSCustomMemo.SetTopLine(const ACustomMemo: TCustomMemo;
+ const NewTopLine: integer);
+begin
+ SendMessage(ACustomMemo.Handle, EM_LINESCROLL, 0, NewTopLine);
+end;
+
class procedure TWin32WSCustomMemo.SetWordWrap(const ACustomMemo: TCustomMemo;
const NewWordWrap: boolean);
begin
// TODO: check if can be done without recreation
@@ -1435,12 +1449,6 @@
RecreateWnd(ACustomMemo);
end;
-class procedure TWin32WSCustomMemo.ScrollBy(const AWinControl: TWinControl;
- DeltaX, DeltaY: integer);
-begin
- SendMessage(AWinControl.Handle, EM_LINESCROLL, -DeltaX, -DeltaY);
-end;
-
{ TWin32WSCustomStaticText }
function StaticTextWndProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;
Index: lcl/interfaces/wince/winceextra.pp
===================================================================
--- lcl/interfaces/wince/winceextra.pp (revision 50545)
+++ lcl/interfaces/wince/winceextra.pp (working copy)
@@ -63,6 +63,7 @@
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;
@@ -79,11 +80,15 @@
function ImageList_Copy(himlDst: HIMAGELIST; iDst: longint; himlSrc:
HIMAGELIST; Src: longint; uFlags: UINT): BOOL; cdecl; external KernelDLL;
{$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';
+{$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}
+
const
// BlendOp flags
AC_SRC_OVER = $00;
Index: lcl/interfaces/wince/wincewscontrols.pp
===================================================================
--- lcl/interfaces/wince/wincewscontrols.pp (revision 50545)
+++ lcl/interfaces/wince/wincewscontrols.pp (working copy)
@@ -86,7 +86,6 @@
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 }
@@ -450,20 +449,6 @@
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(
Index: lcl/interfaces/wince/wincewsforms.pp
===================================================================
--- lcl/interfaces/wince/wincewsforms.pp (revision 50545)
+++ lcl/interfaces/wince/wincewsforms.pp (working copy)
@@ -34,6 +34,8 @@
TWinCEWSScrollingWinControl = class(TWSScrollingWinControl)
published
+ class procedure ScrollBy(const AWinControl: TScrollingWinControl;
+ const DeltaX, DeltaY: integer); override;
end;
{ TWinCEWSScrollBox }
@@ -145,6 +147,26 @@
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;
Index: lcl/stdctrls.pp
===================================================================
--- lcl/stdctrls.pp (revision 50545)
+++ lcl/stdctrls.pp (working copy)
@@ -804,6 +804,7 @@
TMemoScrollbar = class(TControlScrollBar)
protected
+ procedure SetControlPosition; override;
function GetHorzScrollBar: TControlScrollBar; override;
function GetVertScrollBar: TControlScrollBar; override;
public
@@ -828,7 +829,9 @@
FWantReturns: Boolean;
FWantTabs: boolean;
FWordWrap: Boolean;
+ function GetTopLine: Integer;
procedure SetHorzScrollBar(const AValue: TMemoScrollBar);
+ procedure SetTopLine(const aTopLine: Integer);
procedure SetVertScrollBar(const AValue: TMemoScrollBar);
protected
class procedure WSRegisterClass; override;
@@ -856,7 +859,6 @@
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;
@@ -865,6 +867,7 @@
property WantReturns: Boolean read FWantReturns write SetWantReturns
default true;
property WantTabs: Boolean read FWantTabs write SetWantTabs default false;
property WordWrap: Boolean read FWordWrap write SetWordWrap default true;
+ property TopLine: Integer read GetTopLine write SetTopLine;
end;
Index: lcl/widgetset/wscontrols.pp
===================================================================
--- lcl/widgetset/wscontrols.pp (revision 50545)
+++ lcl/widgetset/wscontrols.pp (working copy)
@@ -135,7 +135,6 @@
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;
@@ -390,11 +389,6 @@
begin
end;
-class procedure TWSWinControl.ScrollBy(const AWinControl: TWinControl; DeltaX,
DeltaY: integer);
-begin
- AWinControl.Invalidate;
-end;
-
{ TWSDragImageList }
class function TWSDragImageList.BeginDrag(const ADragImageList: TDragImageList;
Index: lcl/widgetset/wsforms.pp
===================================================================
--- lcl/widgetset/wsforms.pp (revision 50545)
+++ lcl/widgetset/wsforms.pp (working copy)
@@ -49,7 +49,8 @@
TWSScrollingWinControlClass = class of TWSScrollingWinControl;
TWSScrollingWinControl = class(TWSWinControl)
published
- // procedure ScrollBy is moved to TWSWinControl.
+ class procedure ScrollBy(const AWinControl: TScrollingWinControl;
+ const DeltaX, DeltaY: integer); virtual;
end;
{ TWSScrollBox }
@@ -138,6 +139,14 @@
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);
Index: lcl/widgetset/wsproc.pp
===================================================================
--- lcl/widgetset/wsproc.pp (revision 50545)
+++ lcl/widgetset/wsproc.pp (working copy)
@@ -77,4 +77,5 @@
end;
+
end.
Index: lcl/widgetset/wsstdctrls.pp
===================================================================
--- lcl/widgetset/wsstdctrls.pp (revision 50545)
+++ lcl/widgetset/wsstdctrls.pp (working copy)
@@ -178,6 +178,8 @@
class procedure SetWantTabs(const ACustomMemo: TCustomMemo; const
NewWantTabs: boolean); virtual;
class procedure SetWantReturns(const ACustomMemo: TCustomMemo; const
NewWantReturns: boolean); virtual;
class procedure SetWordWrap(const ACustomMemo: TCustomMemo; const
NewWordWrap: boolean); virtual;
+ class function GetTopLine(const ACustomMemo: TCustomMemo): integer;
virtual;
+ class procedure SetTopLine(const ACustomMemo: TCustomMemo; const
NewTopLine: integer); virtual;
end;
TWSCustomMemoClass = class of TWSCustomMemo;
@@ -602,6 +604,12 @@
Result := ACustomMemo.Lines; //use default if the WS has not defined any
end;
+class function TWSCustomMemo.GetTopLine(const ACustomMemo: TCustomMemo
+ ): integer;
+begin
+ Result := 0;
+end;
+
class procedure TWSCustomMemo.FreeStrings(var AStrings: TStrings);
begin
AStrings.Free;
@@ -612,6 +620,11 @@
begin
end;
+class procedure TWSCustomMemo.SetTopLine(const ACustomMemo: TCustomMemo;
+ const NewTopLine: integer);
+begin
+end;
+
class procedure TWSCustomMemo.SetWantTabs(const ACustomMemo: TCustomMemo;
const NewWantTabs: boolean);
begin
end;
--
_______________________________________________
Lazarus mailing list
Lazarus@lists.lazarus.freepascal.org
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
