mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-11 06:55:59 +02:00
dbgrid.ThumbTracking and fixes from Jesus
git-svn-id: trunk@6759 -
This commit is contained in:
mattias
parent
cb7baa3546
commit
303e21e7b1
@ -155,6 +155,8 @@ type
|
||||
property Items[Index: Integer]: TColumn read GetColumn write SetColumn; default;
|
||||
end;
|
||||
|
||||
{ TCustomDbGrid }
|
||||
|
||||
TCustomDbGrid=class(TCustomGrid)
|
||||
private
|
||||
FDataLink: TComponentDataLink;
|
||||
@ -174,9 +176,11 @@ type
|
||||
FDrawingActiveRecord: Boolean;
|
||||
FEditingColumn: Integer;
|
||||
FOldPosition: Integer;
|
||||
FDefaultColWidths: boolean;
|
||||
function GetCurrentField: TField;
|
||||
function GetDataSource: TDataSource;
|
||||
function GetRecordCount: Integer;
|
||||
function GetThumbTracking: boolean;
|
||||
procedure OnRecordChanged(Field:TField);
|
||||
procedure OnDataSetChanged(aDataSet: TDataSet);
|
||||
procedure OnDataSetOpen(aDataSet: TDataSet);
|
||||
@ -193,6 +197,7 @@ type
|
||||
procedure SetCurrentField(const AValue: TField);
|
||||
procedure SetDataSource(const AValue: TDataSource);
|
||||
procedure SetOptions(const AValue: TDbGridOptions);
|
||||
procedure SetThumbTracking(const AValue: boolean);
|
||||
procedure UpdateBufferCount;
|
||||
procedure UpdateData;
|
||||
|
||||
@ -279,8 +284,10 @@ type
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
procedure DefaultDrawColumnCell(const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
|
||||
procedure ResetColWidths;
|
||||
destructor Destroy; override;
|
||||
property SelectedField: TField read GetCurrentField write SetCurrentField;
|
||||
property ThumbTracking: boolean read GetThumbTracking write SetThumbTracking;
|
||||
end;
|
||||
|
||||
|
||||
@ -431,6 +438,11 @@ begin
|
||||
result := FDataLink.DataSet.RecordCount;
|
||||
end;
|
||||
|
||||
function TCustomDbGrid.GetThumbTracking: boolean;
|
||||
begin
|
||||
Result := goThumbTracking in inherited Options;
|
||||
end;
|
||||
|
||||
function TCustomDbGrid.GetCurrentField: TField;
|
||||
begin
|
||||
result := GetFieldFromGridColumn( Col );
|
||||
@ -453,6 +465,7 @@ begin
|
||||
{$Ifdef dbgdbgrid}
|
||||
DebugLn('(',name,') ','TCustomDBGrid.OnDataSetOpen');
|
||||
{$endif}
|
||||
FDefaultColWidths := True;
|
||||
LinkActive(True);
|
||||
UpdateActive;
|
||||
end;
|
||||
@ -504,6 +517,7 @@ begin
|
||||
{$ifdef dbgdbgrid}
|
||||
DebugLn('(',name,') ','TCustomDBGrid.OnNewDataSet');
|
||||
{$endif}
|
||||
FDefaultColWidths := True;
|
||||
LinkActive(True);
|
||||
UpdateActive;
|
||||
end;
|
||||
@ -549,6 +563,7 @@ end;
|
||||
procedure TCustomDbGrid.SetDataSource(const AValue: TDataSource);
|
||||
begin
|
||||
if AValue = FDatalink.Datasource then Exit;
|
||||
FDefaultColWidths := True;
|
||||
FDataLink.DataSource := AValue;
|
||||
UpdateActive;
|
||||
end;
|
||||
@ -608,6 +623,14 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomDbGrid.SetThumbTracking(const AValue: boolean);
|
||||
begin
|
||||
if Avalue then
|
||||
inherited Options := Inherited Options + [goThumbTracking]
|
||||
else
|
||||
inherited Options := Inherited Options - [goThumbTracking];
|
||||
end;
|
||||
|
||||
procedure TCustomDbGrid.UpdateBufferCount;
|
||||
var
|
||||
BuffCount: Integer;
|
||||
@ -827,7 +850,7 @@ begin
|
||||
i := 0;
|
||||
result := -1;
|
||||
if FDataLink.Active then
|
||||
while (i<FDataLink.DataSet.FieldCount) do begin
|
||||
while (i<FDataLink.DataSet.FieldCount)and(Column>=0) do begin
|
||||
if FDataLink.Fields[i].Visible then begin
|
||||
Dec(Column);
|
||||
if Column<0 then begin
|
||||
@ -843,10 +866,12 @@ procedure TCustomDbGrid.UpdateGridColumnSizes;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
if dgIndicator in Options then
|
||||
ColWidths[0]:=12;
|
||||
for i:=FixedCols to ColCount-1 do
|
||||
ColWidths[i] := GetColumnWidth(i);
|
||||
if FDefaultColWidths then begin
|
||||
if dgIndicator in Options then
|
||||
ColWidths[0]:=12;
|
||||
for i:=FixedCols to ColCount-1 do
|
||||
ColWidths[i] := GetColumnWidth(i);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomDbGrid.UpdateScrollbarRange;
|
||||
@ -863,7 +888,9 @@ begin
|
||||
aRange := GetRecordCount + VisibleRowCount - 1;
|
||||
aPage := VisibleRowCount;
|
||||
if aPage<1 then aPage := 1;
|
||||
aPos := FDataLink.DataSet.RecNo;
|
||||
if FDatalink.BOF then aPos := 0 else
|
||||
if FDatalink.EOF then aPos := aRange
|
||||
else aPos := FDataLink.DataSet.RecNo - 1; // RecNo is 1 based
|
||||
end else begin
|
||||
aRange := 6;
|
||||
aPage := 2;
|
||||
@ -1505,12 +1532,14 @@ procedure TCustomDbGrid.HeaderSized(IsColumn: Boolean; Index: Integer);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
if IsColumn then
|
||||
if IsColumn then begin
|
||||
if Columns.Enabled then begin
|
||||
i := ColumnIndexFromGridColumn(Index);
|
||||
if i>=0 then
|
||||
Columns[i].Width := ColWidths[Index];
|
||||
end;
|
||||
FDefaultColWidths := True;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomDbGrid.UpdateActive;
|
||||
@ -1521,8 +1550,10 @@ begin
|
||||
DebugLn(Name,'.UpdateActive: ActiveRecord=', dbgs(ActiveRecord),
|
||||
' FixedRows=',dbgs(FixedRows), ' Row=', dbgs(Row));
|
||||
{$endif}
|
||||
if FixedRows + ActiveRecord <> Row then
|
||||
if FixedRows + ActiveRecord <> Row then begin
|
||||
InvalidateRow(Row);
|
||||
EditingColumn(Col, false);
|
||||
end;
|
||||
Row:= FixedRows + ActiveRecord;
|
||||
end;
|
||||
//Invalidate;
|
||||
@ -1598,6 +1629,8 @@ begin
|
||||
FDataLink.OnUpdateData:=@OnUpdateData;
|
||||
FDataLink.VisualControl:= True;
|
||||
|
||||
FDefaultColWidths := True;
|
||||
|
||||
FOptions := [dgColumnResize, dgTitles, dgIndicator, dgRowLines, dgColLines,
|
||||
dgConfirmDelete, dgCancelOnExit, dgTabs, dgEditing, dgAlwaysShowSelection];
|
||||
|
||||
@ -1657,6 +1690,14 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomDbGrid.ResetColWidths;
|
||||
begin
|
||||
if not FDefaultColWidths then begin
|
||||
FDefaultColWidths := True;
|
||||
LayoutChanged;
|
||||
end;
|
||||
end;
|
||||
|
||||
destructor TCustomDbGrid.Destroy;
|
||||
begin
|
||||
FDataLink.OnDataSetChanged:=nil;
|
||||
@ -1961,6 +2002,9 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.31 2005/02/06 22:43:38 mattias
|
||||
dbgrid.ThumbTracking and fixes from Jesus
|
||||
|
||||
Revision 1.30 2005/01/16 13:16:31 mattias
|
||||
added DoCompareCells, changed OnCompareCell from Jesus
|
||||
|
||||
|
||||
@ -436,7 +436,6 @@ type
|
||||
ValidGrid: Boolean; // true if there is something to show
|
||||
AccumWidth: TList; // Accumulated width per column
|
||||
AccumHeight: TList; // Accumulated Height per row
|
||||
HScrDiv,VScrDiv: Double; // Transform const for ThumbTracking
|
||||
TLColOff,TLRowOff: Integer; // TopLeft Offset in pixels
|
||||
MaxTopLeft: TPoint; // Max Top left ( cell coorditates)
|
||||
end;
|
||||
@ -770,6 +769,7 @@ type
|
||||
procedure EndUpdate(UO: TUpdateOption); overload;
|
||||
procedure EndUpdate(FullUpdate: Boolean); overload;
|
||||
procedure EndUpdate; overload;
|
||||
procedure EraseBackground(DC: HDC); override;
|
||||
procedure ExchangeColRow(IsColumn: Boolean; index, WithIndex: Integer);
|
||||
function IscellSelected(aCol,aRow: Integer): Boolean;
|
||||
function IscellVisible(aCol, aRow: Integer): Boolean;
|
||||
@ -1882,8 +1882,6 @@ var
|
||||
TW:= Integer(AccumWidth[MaxTopLeft.X])-(HsbRange-ClientWidth);
|
||||
HsbRange:=HsbRange + TW - FixedWidth + 1;
|
||||
end;
|
||||
if HsbRange>ClientWidth then
|
||||
HscrDiv := Double(ColCount-FixedCols-1)/(HsbRange-ClientWidth);
|
||||
end;
|
||||
end else
|
||||
if FScrollBars in [ssHorizontal, ssBoth] then HsbRange:=0;
|
||||
@ -1891,14 +1889,10 @@ var
|
||||
if ScrollBarAutomatic(ssVertical) then begin
|
||||
if VSbVisible then begin
|
||||
VSbRange:= GridHeight + 2 - Integer(BorderStyle){ + dh};
|
||||
|
||||
if not (goSmoothScroll in Options) then begin
|
||||
TH:= Integer(accumHeight[MaxTopLeft.Y])-(VsbRange-ClientHeight);
|
||||
VsbRange:=VsbRange + TH -FixedHeight + 1;
|
||||
end;
|
||||
|
||||
if VSbRange>ClientHeight then
|
||||
VScrDiv:= Double(RowCount-FixedRows-1)/(VsbRange-ClientHeight);
|
||||
end;
|
||||
end else
|
||||
if FScrollBars in [ssVertical, ssBoth] then VsbRange:= 0;
|
||||
@ -1914,8 +1908,6 @@ begin
|
||||
FGCache.ScrollWidth:=FGCache.ClientWidth-FGCache.FixedWidth;
|
||||
FGCache.ScrollHeight:=FGCache.ClientHeight-FGCache.FixedHeight;
|
||||
FGCache.MaxTopLeft:=CalcMaxTopLeft;
|
||||
FGCache.HScrDiv:=0;
|
||||
FGCache.VScrDiv:=0;
|
||||
if not(goSmoothScroll in Options) then begin
|
||||
FGCache.TLColOff:=0;
|
||||
FGCache.TLRowOff:=0;
|
||||
@ -2644,42 +2636,18 @@ begin
|
||||
if goTabs in Options then Msg.Result:= Msg.Result or DLGC_WANTTAB;
|
||||
end;
|
||||
|
||||
//
|
||||
// NOTE: WMHScroll and VMHScroll
|
||||
// This methods are used to pre-calculate the scroll position
|
||||
//
|
||||
procedure TCustomGrid.WMHScroll(var message: TLMHScroll);
|
||||
var
|
||||
C,TL,CTL: Integer;
|
||||
begin
|
||||
|
||||
// Avoid invalidating right know, just let the scrollbar
|
||||
// calculate its position
|
||||
{
|
||||
BeginUpdate;
|
||||
Inherited;
|
||||
message.Result:=1;
|
||||
EndUpdate(uoNone);
|
||||
}
|
||||
|
||||
{$IfDef dbgScroll}
|
||||
DebugLn('HSCROLL: Code=',IntToStr(message.ScrollCode),' Position=', IntToStr(message.Pos));
|
||||
{$Endif}
|
||||
|
||||
|
||||
if FGCache.HScrDiv<=0 then Exit;
|
||||
if FEditor<>nil then
|
||||
EditorGetValue;
|
||||
|
||||
if goThumbTracking in Options then begin
|
||||
C:=FFixedCols + Round( message.Pos * FGCache.HScrDiv );
|
||||
if (FCol<>C) then begin
|
||||
Inc(FUpdateScrollBarsCount);
|
||||
MoveExtend(False, C, FRow);
|
||||
Dec(FUpdateScrollBarsCount);
|
||||
end;
|
||||
end else begin
|
||||
|
||||
TL:= Integer(FGCache.AccumWidth[ FGCache.MaxTopLeft.X ]) - FGCAche.FixedWidth;
|
||||
CTL:= Integer(FGCache.AccumWidth[ FtopLeft.X ]) - FGCache.FixedWidth;
|
||||
|
||||
@ -2694,8 +2662,13 @@ begin
|
||||
SB_PAGEDOWN: C := CTL + FGCache.ClientWidth;
|
||||
SB_PAGEUP: C := CTL - FGCache.ClientWidth;
|
||||
// Scrolls to the current scroll bar position
|
||||
SB_THUMBPOSITION,
|
||||
SB_THUMBTRACK: C := message.Pos;
|
||||
SB_THUMBPOSITION:
|
||||
C := Message.Pos;
|
||||
SB_THUMBTRACK:
|
||||
if goThumbTracking in Options then
|
||||
C := message.Pos
|
||||
else
|
||||
Exit;
|
||||
// Ends scrolling
|
||||
SB_ENDSCROLL: Exit;
|
||||
end;
|
||||
@ -2733,34 +2706,16 @@ begin
|
||||
Invalidate;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomGrid.WMVScroll(var message: TLMVScroll);
|
||||
var
|
||||
C, TL, CTL: Integer;
|
||||
begin
|
||||
// Avoid invalidating right know, just let the scrollbar
|
||||
// calculate its position
|
||||
{
|
||||
BeginUpdate;
|
||||
Inherited;
|
||||
message.Result:=1;
|
||||
EndUpdate(uoNone);
|
||||
}
|
||||
{$IfDef dbgScroll}
|
||||
DebugLn('VSCROLL: Code=',IntToStr(message.ScrollCode),' Position=', IntToStr(message.Pos));
|
||||
{$Endif}
|
||||
|
||||
if FGCache.VScrDiv<=0 then Exit;
|
||||
if FEditor<>nil then EditorGetValue;
|
||||
if goThumbTracking in Options then begin
|
||||
C:=FFixedRows + Round( message.Pos * FGCache.VScrDiv );
|
||||
if (C<>FRow) then begin
|
||||
Inc(FUpdateScrollBarsCount);
|
||||
MoveExtend(False, FCol, C);
|
||||
Dec(FUpdateScrollBarsCount);
|
||||
end;
|
||||
end else begin
|
||||
|
||||
TL:= Integer(FGCache.AccumHeight[ FGCache.MaxTopLeft.Y ]) - FGCache.FixedHeight;
|
||||
CTL:= Integer(FGCache.AccumHeight[ FtopLeft.Y ]) - FGCache.FixedHeight;
|
||||
@ -2776,8 +2731,13 @@ begin
|
||||
SB_PAGEDOWN: C := CTL + FGCache.ClientHeight;
|
||||
SB_PAGEUP: C := CTL - FGCache.ClientHeight;
|
||||
// Scrolls to the current scroll bar position
|
||||
SB_THUMBPOSITION,
|
||||
SB_THUMBTRACK: C := message.Pos;
|
||||
SB_THUMBPOSITION:
|
||||
C := message.Pos;
|
||||
SB_THUMBTRACK:
|
||||
if goThumbTracking in Options then
|
||||
C := message.Pos
|
||||
else
|
||||
Exit;
|
||||
// Ends scrolling
|
||||
SB_ENDSCROLL: Exit;
|
||||
end;
|
||||
@ -2814,7 +2774,6 @@ begin
|
||||
Invalidate;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomGrid.WMChar(var message: TLMChar);
|
||||
var
|
||||
@ -4233,6 +4192,11 @@ begin
|
||||
EndUpdate(true);
|
||||
end;
|
||||
|
||||
procedure TCustomGrid.EraseBackground(DC: HDC);
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
function TCustomGrid.IsCellSelected(aCol, aRow: Integer): Boolean;
|
||||
begin
|
||||
Result:= (FRange.Left<=aCol) and
|
||||
|
||||
Loading…
Reference in New Issue
Block a user