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

Implented Scrollbar for gtk2

Browse Source 
Rewrote Scrolling code for Gtk2 Customcontrols. Now all scrollcodes are reported

git-svn-id: trunk@14587 -
This commit is contained in:
andrew 2008-03-20 02:59:03 +00:00
parent bcc1df0450
commit 3cb1419cb4
3 changed files with 201 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -70,13 +70,16 @@ type
TGtkWSWinControl = class(TWSWinControl)
private
protected
{$IFDEF GTK1}
class procedure SetCCCallbacks(const AWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo);
{$ENDIF}
public
// Internal public
class procedure SetCallbacks(const AGTKObject: PGTKObject; const AComponent: TComponent);
public
{$IFDEF GTK1}
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; override;
{$ENDIF}
class procedure AddControl(const AControl: TControl); override;
class function CanFocus(const AWinControl: TWinControl): Boolean; override;
class procedure ConstraintsChange(const AWinControl: TWinControl); override;
@ -318,6 +321,7 @@ begin
gtk_frame_set_shadow_type(PGtkFrame(Widget), BorderStyleShadowMap[ABorderStyle]);
end;
{$IFDEF GTK1}
class procedure TGtkWSWinControl.SetCCCallbacks(const AWidget: PGtkWidget;
const AWidgetInfo: PWidgetInfo);
begin
@ -328,6 +332,7 @@ begin
SetCallback(LM_VSCROLL, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
end;
end;
{$ENDIF}
class procedure TGtkWSWinControl.SetCallbacks(const AGTKObject: PGTKObject;
const AComponent: TComponent);
@ -351,6 +356,7 @@ begin
GtkWidgetSet.SetCallback(LM_DROPFILES, AGTKObject, AComponent);
end;
{$IFDEF GTK1}
class function TGtkWSWinControl.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND;
var
@ -381,6 +387,7 @@ begin
Set_RC_Name(AWinControl, Widget);
SetCCCallbacks(Widget, WidgetInfo);
end;
{$ENDIF}
class procedure TGtkWSWinControl.SetChildZPosition(
const AWinControl, AChild: TWinControl;

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

@ -35,7 +35,8 @@ uses
////////////////////////////////////////////////////
Controls,
////////////////////////////////////////////////////
Gtk2, Gdk2, Glib2, GtkGlobals,
Classes,
Gtk2, Gdk2, Glib2, GtkGlobals, GtkDef,
GtkWsControls,
gtkProc, LCLType,
WSControls, WSLCLClasses, WSProc;
@ -65,6 +66,8 @@ type
private
protected
public
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; override;
class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; override;
class procedure SetText(const AWinControl: TWinControl; const AText: string); override;
class procedure SetBorderStyle(const AWinControl: TWinControl; const ABorderStyle: TBorderStyle); override;
@ -94,11 +97,141 @@ type
public
end;
function Gtk2RangeScrollCB(ARange: PGtkRange; AScrollType: TGtkScrollType;
AValue: gdouble; AWidgetInfo: PWidgetInfo): gboolean; cdecl;
implementation
uses Gtk2Int, LMessages, Math;
{ TGtk2WSWinControl }
function GtkScrollTypeToScrollCode(ScrollType: TGtkScrollType): LongWord;
begin
case ScrollType of
GTK_SCROLL_NONE : Result := SB_ENDSCROLL;
GTK_SCROLL_JUMP : Result := SB_THUMBPOSITION;
GTK_SCROLL_STEP_BACKWARD : Result := SB_LINELEFT;
GTK_SCROLL_STEP_FORWARD : Result := SB_LINERIGHT;
GTK_SCROLL_PAGE_BACKWARD : Result := SB_PAGELEFT;
GTK_SCROLL_PAGE_FORWARD : Result := SB_PAGERIGHT;
GTK_SCROLL_STEP_UP : Result := SB_LINEUP;
GTK_SCROLL_STEP_DOWN : Result := SB_LINEDOWN;
GTK_SCROLL_PAGE_UP : Result := SB_PAGEUP;
GTK_SCROLL_PAGE_DOWN : Result := SB_PAGEDOWN;
GTK_SCROLL_STEP_LEFT : Result := SB_LINELEFT;
GTK_SCROLL_STEP_RIGHT : Result := SB_LINERIGHT;
GTK_SCROLL_PAGE_LEFT : Result := SB_PAGELEFT;
GTK_SCROLL_PAGE_RIGHT : Result := SB_PAGERIGHT;
GTK_SCROLL_START : Result := SB_TOP;
GTK_SCROLL_END : Result := SB_BOTTOM;
end;
end;
function Gtk2RangeScrollCB(ARange: PGtkRange; AScrollType: TGtkScrollType;
AValue: gdouble; AWidgetInfo: PWidgetInfo): gboolean; cdecl;
var
Msg: TLMVScroll;
begin
Result := CallBackDefaultReturn;
//Assert(False, Format('Trace:[Gtk2RangeScrollCB] Value: %d', [RoundToInt(AValue)]));
if G_OBJECT_TYPE(ARange) = gtk_hscrollbar_get_type then
Msg.Msg := LM_HSCROLL
else
Msg.Msg := LM_VSCROLL;
with Msg do begin
Pos := Round(AValue);
if Pos < High(SmallPos) then
SmallPos := Pos
else
SmallPos := High(SmallPos);
ScrollBar := HWND(PtrUInt(ARange));
ScrollCode := GtkScrollTypeToScrollCode(AScrollType);
end;
Result := DeliverMessage(AWidgetInfo^.LCLObject, Msg) <> 0;
end;
function Gtk2ScrolledWindowScrollCB(AScrollWindow: PGtkScrolledWindow; AEvent: PGdkEventScroll; AWidgetInfo: PWidgetInfo): gboolean; cdecl;
var
Msg: TLMVScroll;
AValue: Double;
Range: PGtkRange;
begin
case AEvent^.direction of
GDK_SCROLL_UP,
GDK_SCROLL_DOWN: Msg.Msg := LM_VSCROLL;
GDK_SCROLL_LEFT,
GDK_SCROLL_RIGHT: Msg.Msg := LM_HSCROLL;
end;
case Msg.Msg of
LM_VSCROLL: Range := GTK_RANGE(AScrollWindow^.vscrollbar);
LM_HSCROLL: Range := GTK_RANGE(AScrollWindow^.hscrollbar);
end;
AValue := power(Range^.adjustment^.page_size, 2 / 3);
if AEvent^.direction = GDK_SCROLL_UP then
AValue := -AValue;
AValue := gtk_range_get_value(Range) + AValue;
AValue := Max(AValue, Range^.adjustment^.lower);
AValue := Min(AValue, Range^.adjustment^.upper - Range^.adjustment^.page_size);
with Msg do begin
Pos := Round(AValue);
if Pos < High(SmallPos) then
SmallPos := Pos
else
SmallPos := High(SmallPos);
ScrollBar := HWND(PtrUInt(Range));
ScrollCode := SB_THUMBPOSITION;
end;
Result := DeliverMessage(AWidgetInfo^.LCLObject, Msg) <> 0;
end;
class function TGtk2WSWinControl.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND;
var
Widget: PGtkWidget;
WidgetInfo: PWidgetInfo;
Allocation: TGTKAllocation;
begin
Widget := GTK2WidgetSet.CreateAPIWidget(AWinControl);
{$IFDEF DebugLCLComponents}
DebugGtkWidgets.MarkCreated(Widget, dbgsName(AWinControl));
{$ENDIF}
Result := THandle(PtrUInt(Widget));
if Result = 0 then Exit;
WidgetInfo := GetWidgetInfo(Widget); // Widget info already created in CreateAPIWidget
WidgetInfo^.Style := AParams.Style;
WidgetInfo^.ExStyle := AParams.ExStyle;
WidgetInfo^.WndProc := PtrUInt(AParams.WindowClass.lpfnWndProc);
// set allocation
Allocation.X := AParams.X;
Allocation.Y := AParams.Y;
Allocation.Width := AParams.Width;
Allocation.Height := AParams.Height;
gtk_widget_size_allocate(Widget, @Allocation);
Set_RC_Name(AWinControl, Widget);
TGtkWSWinControl.SetCallbacks(GTK_OBJECT(Widget), AWinControl);
g_signal_connect(GTK_SCROLLED_WINDOW(Widget)^.hscrollbar, 'change-value', TGCallback(@Gtk2RangeScrollCB), WidgetInfo);
g_signal_connect(GTK_SCROLLED_WINDOW(Widget)^.vscrollbar, 'change-value', TGCallback(@Gtk2RangeScrollCB), WidgetInfo);
g_signal_connect(Widget, 'scroll-event', TGCallback(@Gtk2ScrolledWindowScrollCB), WidgetInfo);
end;
class function TGtk2WSWinControl.GetText(const AWinControl: TWinControl;
var AText: String): Boolean;
var

62
lcl/interfaces/gtk2/gtk2wsstdctrls.pp
View File

@ -71,10 +71,13 @@ type
{ TGtk2WSScrollBar }
TGtk2WSScrollBar = class(TGtkWSScrollBar)
TGtk2WSScrollBar = class(TWSScrollBar)
private
protected
class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
public
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure SetParams(const AScrollBar: TCustomScrollBar); override;
end;
{ TGtk2WSCustomGroupBox }
@ -344,7 +347,7 @@ function GetComboBoxEntry(Widget: PGtkWidget): PGtkEntry;
implementation
uses GtkWSControls, LCLMessageGlue;
uses GtkWSControls, Gtk2WSControls, LCLMessageGlue, Forms;
function GetComboBoxEntry(Widget: PGtkWidget): PGtkEntry;
begin
@ -1723,6 +1726,59 @@ begin
//debugln('TGtkWSButton.GetPreferredSize ',DbgSName(AWinControl),' PreferredWidth=',dbgs(PreferredWidth),' PreferredHeight=',dbgs(PreferredHeight));
end;
{ TGtk2WSScrollBar }
class procedure TGtk2WSScrollBar.SetCallbacks(const AGtkWidget: PGtkWidget;
const AWidgetInfo: PWidgetInfo);
begin
TGtkWSWinControl.SetCallbacks(PGtkObject(AGtkWidget), TComponent(AWidgetInfo^.LCLObject));
g_signal_connect(AGtkWidget, 'change-value', TGCallback(@Gtk2RangeScrollCB), AWidgetInfo);
end;
class function TGtk2WSScrollBar.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle;
var
Adjustment: PGtkAdjustment = nil;
Widget: PGtkWidget;
WidgetInfo: PWidgetInfo;
begin
with TScrollBar(AWinControl) do
begin
{ Adjustment := GTK_ADJPgtkAdjustment(
gtk_adjustment_new(1, Min, Max, SmallChange, LargeChange,
Pagesize));
} if (Kind = sbHorizontal) then
Widget := gtk_hscrollbar_new(Adjustment)
else
Widget := gtk_vscrollbar_new(Adjustment);
end;
Result := TLCLIntfHandle(PtrUInt(Widget));
{$IFDEF DebugLCLComponents}
DebugGtkWidgets.MarkCreated(Widget, dbgsName(AWinControl));
{$ENDIF}
WidgetInfo := CreateWidgetInfo(Pointer(Result), AWinControl, AParams);
Set_RC_Name(AWinControl, Widget);
SetCallbacks(Widget, WidgetInfo);
end;
class procedure TGtk2WSScrollBar.SetParams(const AScrollBar: TCustomScrollBar);
var
Adjustment: PGtkAdjustment;
Range: PGtkRange;
begin
with AScrollBar do
begin
Range := GTK_RANGE(Pointer(Handle));
//set properties for the range
gtk_range_set_range (Range, Min, Max);
gtk_range_set_increments(Range, SmallChange, LargeChange);
gtk_range_set_value (Range, Position);
end;
end;
initialization
////////////////////////////////////////////////////
@ -1731,7 +1787,7 @@ initialization
// To improve speed, register only classes
// which actually implement something
////////////////////////////////////////////////////
// RegisterWSComponent(TScrollBar, TGtk2WSScrollBar);
RegisterWSComponent(TScrollBar, TGtk2WSScrollBar);
RegisterWSComponent(TCustomGroupBox, TGtk2WSCustomGroupBox);
// RegisterWSComponent(TGroupBox, TGtk2WSGroupBox);
RegisterWSComponent(TCustomComboBox, TGtk2WSCustomComboBox);