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

increased scroll position for gtk from 15bit to 31bit from Colin Western

Browse Source 
git-svn-id: trunk@7470 -
This commit is contained in:
mattias 2005-08-01 10:11:31 +00:00
parent 74e3212731
commit 637b578aab
3 changed files with 34 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
lcl/grids.pas
View File

@ -698,6 +698,7 @@ type
function GetDefaultColumnReadOnly(Column: Integer): boolean; virtual;
function GetDefaultColumnTitle(Column: Integer): string; virtual;
function GetDefaultEditor(Column: Integer): TWinControl;
function GetScrollBarPosition(Which: integer): Integer;
function GetEditMask(ACol, ARow: Longint): string; dynamic;
function GetEditText(ACol, ARow: Longint): string; dynamic;
function GetFixedcolor: TColor; virtual;
@ -2919,10 +2920,10 @@ begin
SB_PAGEUP: C := CTL - FGCache.ClientWidth;
// Scrolls to the current scroll bar position
SB_THUMBPOSITION:
C := Message.Pos;
C := GetScrollBarPosition(SBS_HORZ);
SB_THUMBTRACK:
if goThumbTracking in Options then
C := message.Pos
C := GetScrollBarPosition(SBS_HORZ)
else
Exit;
// Ends scrolling
@ -2997,10 +2998,10 @@ begin
SB_PAGEUP: C := CTL - FGCache.ClientHeight;
// Scrolls to the current scroll bar position
SB_THUMBPOSITION:
C := message.Pos;
C := GetScrollBarPosition(SBS_VERT);
SB_THUMBTRACK:
if goThumbTracking in Options then
C := message.Pos
C := GetScrollBarPosition(SBS_VERT)
else
Exit;
// Ends scrolling
@ -5258,6 +5259,18 @@ begin
end;
end;
function TCustomGrid.GetScrollBarPosition(Which: integer): Integer;
var
ScrollInfo: TScrollInfo;
begin
if HandleAllocated then begin
ScrollInfo.cbSize := SizeOf(ScrollInfo);
ScrollInfo.fMask := SIF_POS;
GetScrollInfo(Handle, Which, ScrollInfo);
Result:=ScrollInfo.nPos;
end;
end;
function TCustomGrid.GetDefaultColumnWidth(Column: Integer): Integer;
begin
result := FDefColWidth;

2
lcl/include/controlscrollbar.inc
View File

@ -322,7 +322,7 @@ begin
SB_PAGEDOWN:
Inc(NewPos, FPage);
SB_THUMBPOSITION, SB_THUMBTRACK:
NewPos := Pos;
NewPos := GetPosition; { Read scroll bar as TLMScroll message does not provide full range }
SB_TOP:
NewPos := 0;
SB_BOTTOM:

20
lcl/interfaces/gtk/gtkcallback.inc
View File

@ -2535,7 +2535,10 @@ begin
Result := CallBackDefaultReturn;
Msg.Msg := LM_HSCROLL;
with Msg do begin
pos := Round(Range^.Adjustment^.Value);
if Range^.Adjustment^.value <= High(pos) then
pos := Round(Range^.Adjustment^.Value)
else
pos := High(pos); { Out of simple range }
ScrollBar := HWND(Range);
ScrollCode := ScrollTypeToSbCode(False, Scroll,
gtk_range_get_update_policy(Range));
@ -2551,7 +2554,10 @@ begin
Result := CallBackDefaultReturn;
Msg.Msg := LM_VSCROLL;
with Msg do begin
pos := Round(Range^.Adjustment^.Value);
if Range^.Adjustment^.value <= High(pos) then
pos := Round(Range^.Adjustment^.Value)
else
pos := High(pos); { Out of simple range }
ScrollBar := HWND(Range);
ScrollCode := ScrollTypeToSbCode(True, Scroll,
gtk_range_get_update_policy(Range));
@ -2571,7 +2577,10 @@ begin
if Scroll<>nil then begin
Msg.Msg := LM_HSCROLL;
with Msg do begin
pos := Round(Adjustment^.Value);
if Adjustment^.value <= High(pos) then
pos := Round(Adjustment^.Value)
else
pos := High(pos); { Out of simple range }
ScrollBar := HWND(Scroll);
ScrollType := get_gtk_scroll_type(Scroll);
ScrollCode := ScrollTypeToSbCode(False, ScrollType,
@ -2593,7 +2602,10 @@ begin
if Scroll<>nil then begin
Msg.Msg := LM_VSCROLL;
with Msg do begin
pos := Round(Adjustment^.Value);
if Adjustment^.value <= High(pos) then
pos := Round(Adjustment^.Value)
else
pos := High(pos); { Out of simple range }
ScrollBar := HWND(Scroll);
ScrollType := get_gtk_scroll_type(Scroll);
ScrollCode := ScrollTypeToSbCode(True, ScrollType,