pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

Fix the RxDBGrid Scrollbar drag bug. When drag the vertical bar to first and last and the records are not fully display, there is not first or last record.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2070 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
yangjixian
2011-10-12 13:35:03 +00:00
parent 719a515e21
commit 19359ddf86
3 changed files with 168 additions and 68 deletions
Download Patch File Download Diff File Expand all files Collapse all files

68
components/rx/Demos/RxDBGrid/RxDBGridDemo.lpi
View File

@ -80,14 +80,14 @@
<LoadedDesigner Value="True"/>
</Unit1>
<Unit2>
<Filename Value="../../../../fpcsrc/fcl/db/db.pp"/>
<Filename Value="../../../fpcsrc/fcl/db/db.pp"/>
<UnitName Value="db"/>
<TopLine Value="1112"/>
<CursorPos X="17" Y="1116"/>
<UsageCount Value="8"/>
</Unit2>
<Unit3>
<Filename Value="../../../../fpcsrc/fcl/db/dataset.inc"/>
<Filename Value="../../../fpcsrc/fcl/db/dataset.inc"/>
<TopLine Value="1134"/>
<CursorPos X="21" Y="1139"/>
<UsageCount Value="8"/>
@ -111,21 +111,21 @@
</Bookmarks>
</Unit5>
<Unit6>
<Filename Value="../../../../lcl/lresources.pp"/>
<Filename Value="../../../lcl/lresources.pp"/>
<UnitName Value="LResources"/>
<TopLine Value="2626"/>
<CursorPos X="1" Y="2644"/>
<UsageCount Value="8"/>
</Unit6>
<Unit7>
<Filename Value="../../../../lcl/grids.pas"/>
<Filename Value="../../../lcl/grids.pas"/>
<UnitName Value="Grids"/>
<TopLine Value="385"/>
<CursorPos X="33" Y="394"/>
<UsageCount Value="9"/>
</Unit7>
<Unit8>
<Filename Value="../../../../lcl/dbgrids.pas"/>
<Filename Value="../../../lcl/dbgrids.pas"/>
<UnitName Value="DBGrids"/>
<TopLine Value="187"/>
<CursorPos X="30" Y="199"/>
@ -139,46 +139,46 @@
<UsageCount Value="9"/>
</Unit9>
<Unit10>
<Filename Value="../../../../lcl/include/wincontrol.inc"/>
<Filename Value="../../../lcl/include/wincontrol.inc"/>
<TopLine Value="7217"/>
<CursorPos X="1" Y="7236"/>
<UsageCount Value="8"/>
</Unit10>
<Unit11>
<Filename Value="../../../../lcl/include/control.inc"/>
<Filename Value="../../../lcl/include/control.inc"/>
<TopLine Value="1"/>
<CursorPos X="1" Y="1"/>
<UsageCount Value="8"/>
</Unit11>
<Unit12>
<Filename Value="../../../../lcl/lclmessageglue.pas"/>
<Filename Value="../../../lcl/lclmessageglue.pas"/>
<UnitName Value="LCLMessageGlue"/>
<TopLine Value="92"/>
<CursorPos X="46" Y="96"/>
<UsageCount Value="8"/>
</Unit12>
<Unit13>
<Filename Value="../../../../lcl/controls.pp"/>
<Filename Value="../../../lcl/controls.pp"/>
<UnitName Value="Controls"/>
<TopLine Value="1779"/>
<CursorPos X="60" Y="1798"/>
<UsageCount Value="8"/>
</Unit13>
<Unit14>
<Filename Value="../../../../../../install/2/rxdbgrid.diff"/>
<Filename Value="../../../install/2/rxdbgrid.diff"/>
<TopLine Value="1"/>
<CursorPos X="1" Y="21"/>
<SyntaxHighlighter Value="None"/>
<UsageCount Value="8"/>
</Unit14>
<Unit15>
<Filename Value="../../../../lcl/interfaces/gtk/gtkdevicecontext.inc"/>
<Filename Value="../../../lcl/interfaces/gtk/gtkdevicecontext.inc"/>
<TopLine Value="626"/>
<CursorPos X="1" Y="644"/>
<UsageCount Value="8"/>
</Unit15>
<Unit16>
<Filename Value="../../../../lcl/interfaces/gtk2/gtk2winapi.inc"/>
<Filename Value="../../../lcl/interfaces/gtk2/gtk2winapi.inc"/>
<TopLine Value="559"/>
<CursorPos X="1" Y="577"/>
<UsageCount Value="8"/>
@ -201,7 +201,7 @@
<UsageCount Value="8"/>
</Unit18>
<Unit19>
<Filename Value="../../../../lcl/include/winapih.inc"/>
<Filename Value="../../../lcl/include/winapih.inc"/>
<TopLine Value="211"/>
<CursorPos X="10" Y="223"/>
<UsageCount Value="8"/>
@ -228,34 +228,34 @@
<UsageCount Value="9"/>
</Unit22>
<Unit23>
<Filename Value="../../../../ideintf/idewindowintf.pas"/>
<Filename Value="../../../ideintf/idewindowintf.pas"/>
<UnitName Value="IDEWindowIntf"/>
<TopLine Value="31"/>
<CursorPos X="1" Y="1"/>
<UsageCount Value="8"/>
</Unit23>
<Unit24>
<Filename Value="../../../../lcl/extdlgs.pas"/>
<Filename Value="../../../lcl/extdlgs.pas"/>
<UnitName Value="ExtDlgs"/>
<TopLine Value="105"/>
<CursorPos X="35" Y="122"/>
<UsageCount Value="8"/>
</Unit24>
<Unit25>
<Filename Value="../../../../lcl/dialogs.pp"/>
<Filename Value="../../../lcl/dialogs.pp"/>
<UnitName Value="Dialogs"/>
<TopLine Value="62"/>
<CursorPos X="21" Y="79"/>
<UsageCount Value="8"/>
</Unit25>
<Unit26>
<Filename Value="../../../../lcl/include/commondialog.inc"/>
<Filename Value="../../../lcl/include/commondialog.inc"/>
<TopLine Value="80"/>
<CursorPos X="17" Y="84"/>
<UsageCount Value="8"/>
</Unit26>
<Unit27>
<Filename Value="../../../../lcl/widgetset/wsdialogs.pp"/>
<Filename Value="../../../lcl/widgetset/wsdialogs.pp"/>
<UnitName Value="WSDialogs"/>
<TopLine Value="132"/>
<CursorPos X="3" Y="136"/>
@ -278,34 +278,34 @@
<UsageCount Value="8"/>
</Unit29>
<Unit30>
<Filename Value="../../../../lcl/buttonpanel.pas"/>
<Filename Value="../../../lcl/buttonpanel.pas"/>
<UnitName Value="ButtonPanel"/>
<TopLine Value="11"/>
<CursorPos X="6" Y="15"/>
<UsageCount Value="9"/>
</Unit30>
<Unit31>
<Filename Value="../../../../lcl/extctrls.pp"/>
<Filename Value="../../../lcl/extctrls.pp"/>
<UnitName Value="ExtCtrls"/>
<TopLine Value="604"/>
<CursorPos X="15" Y="607"/>
<UsageCount Value="9"/>
</Unit31>
<Unit32>
<Filename Value="../../../../lcl/include/customimage.inc"/>
<Filename Value="../../../lcl/include/customimage.inc"/>
<TopLine Value="67"/>
<CursorPos X="3" Y="69"/>
<UsageCount Value="9"/>
</Unit32>
<Unit33>
<Filename Value="../../../../../../install/fpcsrc/rtl/objpas/classes/classesh.inc"/>
<Filename Value="../../../install/fpcsrc/rtl/objpas/classes/classesh.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="426"/>
<CursorPos X="17" Y="448"/>
<UsageCount Value="16"/>
</Unit33>
<Unit34>
<Filename Value="../../../../../smsprog/sms_send_deamon/smsSendGui/smssendaboutunit.pas"/>
<Filename Value="../../../smsprog/sms_send_deamon/smsSendGui/smssendaboutunit.pas"/>
<ComponentName Value="smsSendAboutForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
@ -315,7 +315,7 @@
<UsageCount Value="9"/>
</Unit34>
<Unit35>
<Filename Value="../../../../../smsprog/sms_shared/smsabstarctconstunit.pas"/>
<Filename Value="../../../smsprog/sms_shared/smsabstarctconstunit.pas"/>
<UnitName Value="smsAbstarctConstUnit"/>
<TopLine Value="1"/>
<CursorPos X="42" Y="11"/>
@ -356,7 +356,7 @@
<UsageCount Value="9"/>
</Unit39>
<Unit40>
<Filename Value="../../../../doceditor/lazdeopts.pp"/>
<Filename Value="../../../doceditor/lazdeopts.pp"/>
<UnitName Value="LazDEOpts"/>
<TopLine Value="43"/>
<CursorPos X="1" Y="56"/>
@ -377,14 +377,14 @@
<UsageCount Value="9"/>
</Unit42>
<Unit43>
<Filename Value="../../../../ideintf/dbpropedits.pas"/>
<Filename Value="../../../ideintf/dbpropedits.pas"/>
<UnitName Value="DBPropEdits"/>
<TopLine Value="13"/>
<CursorPos X="6" Y="19"/>
<UsageCount Value="9"/>
</Unit43>
<Unit44>
<Filename Value="../../../../ideintf/propedits.pp"/>
<Filename Value="../../../ideintf/propedits.pp"/>
<UnitName Value="PropEdits"/>
<TopLine Value="1"/>
<CursorPos X="6" Y="26"/>
@ -425,7 +425,7 @@
<UsageCount Value="12"/>
</Unit48>
<Unit49>
<Filename Value="../../../../../../install/fpcsrc/rtl/objpas/classes/classes.inc"/>
<Filename Value="../../../install/fpcsrc/rtl/objpas/classes/classes.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="429"/>
<CursorPos X="33" Y="447"/>
@ -434,7 +434,7 @@
<DefaultSyntaxHighlighter Value="Text"/>
</Unit49>
<Unit50>
<Filename Value="../../../../lcl/actnlist.pas"/>
<Filename Value="../../../lcl/actnlist.pas"/>
<UnitName Value="ActnList"/>
<WindowIndex Value="0"/>
<TopLine Value="206"/>
@ -444,7 +444,7 @@
<DefaultSyntaxHighlighter Value="Text"/>
</Unit50>
<Unit51>
<Filename Value="../../../../lcl/lclproc.pas"/>
<Filename Value="../../../lcl/lclproc.pas"/>
<UnitName Value="LCLProc"/>
<WindowIndex Value="0"/>
<TopLine Value="1154"/>
@ -463,14 +463,14 @@
<DefaultSyntaxHighlighter Value="Text"/>
</Unit52>
<Unit53>
<Filename Value="../../../../../../install/fpcsrc/rtl/objpas/classes/collect.inc"/>
<Filename Value="../../../install/fpcsrc/rtl/objpas/classes/collect.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="286"/>
<CursorPos X="1" Y="288"/>
<UsageCount Value="15"/>
</Unit53>
<Unit54>
<Filename Value="../../../../../../wine/1/1/rx.diff"/>
<Filename Value="../../../wine/1/1/rx.diff"/>
<WindowIndex Value="0"/>
<TopLine Value="1"/>
<CursorPos X="1" Y="9"/>
@ -478,7 +478,7 @@
<DefaultSyntaxHighlighter Value="Diff"/>
</Unit54>
<Unit55>
<Filename Value="../../../../../../install/fpcsrc/packages/fcl-db/src/base/db.pas"/>
<Filename Value="../../../install/fpcsrc/packages/fcl-db/src/base/db.pas"/>
<UnitName Value="db"/>
<WindowIndex Value="0"/>
<TopLine Value="541"/>
@ -486,7 +486,7 @@
<UsageCount Value="10"/>
</Unit55>
<Unit56>
<Filename Value="../../../../lcl/include/canvas.inc"/>
<Filename Value="../../../lcl/include/canvas.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="1116"/>
<CursorPos X="1" Y="1132"/>

61
components/rx/Demos/RxDBGrid/rxdbgridmainunit.lfm
View File

@ -1,11 +1,11 @@
object RxDBGridMainForm: TRxDBGridMainForm
Left = 299
Left = 232
Height = 786
Top = 6
Top = 47
Width = 1187
ActiveControl = Panel1
Caption = 'RxDBGrid Demo'
ClientHeight = 761
ClientHeight = 764
ClientWidth = 1187
Menu = MainMenu1
OnCreate = FormCreate
@ -13,8 +13,8 @@ object RxDBGridMainForm: TRxDBGridMainForm
LCLVersion = '0.9.31'
object RxDBGrid1: TRxDBGrid
Left = 0
Height = 696
Top = 65
Height = 698
Top = 66
Width = 1187
TitleButtons = True
AutoSort = True
@ -208,28 +208,29 @@ object RxDBGridMainForm: TRxDBGridMainForm
Options = [dgEditing, dgTitles, dgIndicator, dgColumnResize, dgColumnMove, dgColLines, dgRowLines, dgTabs, dgAlwaysShowSelection, dgConfirmDelete, dgCancelOnExit, dgMultiselect, dgHeaderPushedLook]
ParentColor = False
PopupMenu = PopupMenu1
Scrollbars = ssVertical
TabOrder = 0
TitleStyle = tsNative
UseXORFeatures = True
end
object Panel1: TPanel
Left = 0
Height = 65
Height = 66
Top = 0
Width = 1187
Align = alTop
AutoSize = True
ClientHeight = 65
ClientHeight = 66
ClientWidth = 1187
TabOrder = 1
object Label1: TLabel
AnchorSideLeft.Control = Button2
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel1
Left = 260
Height = 18
Left = 279
Height = 14
Top = 7
Width = 36
Width = 29
BorderSpacing.Around = 6
Caption = 'Mode'
ParentColor = False
@ -240,7 +241,7 @@ object RxDBGridMainForm: TRxDBGridMainForm
Left = 7
Height = 29
Top = 7
Width = 84
Width = 93
Action = actCalcTotal
AutoSize = True
BorderSpacing.Around = 6
@ -250,10 +251,10 @@ object RxDBGridMainForm: TRxDBGridMainForm
AnchorSideLeft.Control = Button1
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel1
Left = 97
Left = 106
Height = 29
Top = 7
Width = 157
Width = 167
Action = actOptimizeColumnsWidthAll
AutoSize = True
BorderSpacing.Around = 6
@ -264,11 +265,11 @@ object RxDBGridMainForm: TRxDBGridMainForm
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = CheckBox2
AnchorSideTop.Side = asrBottom
Left = 489
Height = 22
Left = 508
Height = 23
Hint = 'Use filter line'
Top = 35
Width = 81
Top = 36
Width = 79
BorderSpacing.Left = 6
Caption = 'Use filter'
OnChange = CheckBox1Change
@ -278,12 +279,12 @@ object RxDBGridMainForm: TRxDBGridMainForm
AnchorSideLeft.Control = Label1
AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrBottom
Left = 266
Left = 285
Height = 27
Top = 31
Top = 27
Width = 217
BorderSpacing.Around = 6
ItemHeight = 0
ItemHeight = 19
ItemIndex = 0
Items.Strings = (
'Edit mode'
@ -298,11 +299,11 @@ object RxDBGridMainForm: TRxDBGridMainForm
AnchorSideLeft.Control = ComboBox1
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel1
Left = 489
Height = 22
Left = 508
Height = 23
Hint = 'Auto fill column width'
Top = 7
Width = 129
Width = 128
BorderSpacing.Around = 6
Caption = 'Auto fill columns'
OnChange = CheckBox2Change
@ -312,10 +313,10 @@ object RxDBGridMainForm: TRxDBGridMainForm
AnchorSideLeft.Control = CheckBox2
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel1
Left = 624
Height = 22
Left = 642
Height = 23
Top = 7
Width = 117
Width = 116
BorderSpacing.Around = 6
Caption = 'Show indicator'
Checked = True
@ -328,10 +329,10 @@ object RxDBGridMainForm: TRxDBGridMainForm
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = CheckBox3
AnchorSideTop.Side = asrBottom
Left = 624
Height = 22
Top = 35
Width = 114
Left = 642
Height = 23
Top = 36
Width = 110
BorderSpacing.Around = 6
Caption = 'Show headers'
Checked = True

107
components/rx/rxdbgrid.pas
View File

@ -370,7 +370,7 @@ type
FFilterListEditor: TFilterListCellEditor;
FOldPosition: Integer;
FVersion: integer;
FPropertyStorageLink: TPropertyStorageLink;
FRxDbGridLookupComboEditor: TCustomControl;
@ -412,8 +412,9 @@ type
procedure UpdateJMenuStates;
procedure UpdateJMenuKeys;
function SortEngineOptions: TRxSortEngineOptions;
procedure WMVScroll(var Message : TLMVScroll); message LM_VScroll;
procedure GetScrollbarParams(out aRange, aPage, aPos: Integer);
procedure RestoreEditor;
//storage
procedure OnIniSave(Sender: TObject);
procedure OnIniLoad(Sender: TObject);
@ -1015,7 +1016,6 @@ begin
);
end;
procedure TRxDBGrid.SetTitleButtons(const AValue: boolean);
begin
if AValue then
@ -1024,6 +1024,105 @@ begin
Options := Options - [dgHeaderPushedLook];
end;
procedure TRxDBGrid.GetScrollbarParams(out aRange, aPage, aPos: Integer);
begin
if (DataSource.DataSet<>nil) and DataSource.DataSet.Active then begin
if DataSource.DataSet.IsSequenced then begin
aRange := DataSource.DataSet.RecordCount + VisibleRowCount - 1;
aPage := VisibleRowCount;
if aPage<1 then aPage := 1;
if DataSource.DataSet.BOF then aPos := 0 else
if DataSource.DataSet.EOF then aPos := aRange
else
aPos := DataSource.DataSet.RecNo - 1; // RecNo is 1 based
if aPos<0 then aPos:=0;
end else begin
aRange := 6;
aPage := 2;
if DataSource.DataSet.EOF then aPos := 4 else
if DataSource.DataSet.BOF then aPos := 0
else aPos := 2;
end;
end else begin
aRange := 0;
aPage := 0;
aPos := 0;
end;
end;
procedure TRxDBGrid.RestoreEditor;
begin
if EditorMode then begin
EditorMode := False;
EditorMode := True;
end;
end;
procedure TRxDBGrid.WMVScroll(var Message: TLMVScroll);
var
IsSeq: boolean;
aPos, aRange, aPage: Integer;
DeltaRec: integer;
function MaxPos: Integer;
begin
if IsSeq then
result := DataSource.DataSet.RecordCount - 1
else
result := 4;
end;
procedure DsMoveBy(Delta: Integer);
begin
DataSource.DataSet.MoveBy(Delta);
GetScrollbarParams(aRange, aPage, aPos);
end;
procedure DsGoto(BOF: boolean);
begin
if BOF then DataSource.DataSet.First
else DataSource.DataSet.Last;
GetScrollbarParams(aRange, aPage, aPos);
end;
begin
if not DataSource.DataSet.Active then exit;
{$ifdef dbgDBGrid}
DebugLn('VSCROLL: Code=',SbCodeToStr(Message.ScrollCode),
' Position=', dbgs(Message.Pos),' OldPos=',Dbgs(FOldPosition));
{$endif}
IsSeq := DataSource.DataSet.IsSequenced;
case Message.ScrollCode of
SB_TOP:
DsGoto(True);
SB_BOTTOM:
DsGoto(False);
SB_PAGEUP:
DsMoveBy(-VisibleRowCount);
SB_LINEUP:
DsMoveBy(-1);
SB_LINEDOWN:
DsMoveBy(1);
SB_PAGEDOWN:
DsMoveBy(VisibleRowCount);
SB_THUMBPOSITION:
DsMoveBy(Message.Pos - FOldPosition)
else
Exit;
end;
ScrollBarPosition(SB_VERT, aPos);
FOldPosition:=aPos;
if EditorMode then
RestoreEditor;
{$ifdef dbgDBGrid}
DebugLn('---- Diff=',dbgs(DeltaRec), ' FinalPos=',dbgs(aPos));
{$endif}
end;
procedure TRxDBGrid.SetAutoSort(const AValue: boolean);
var
S: string;