LCL, dbgrid, fixed scrollbar disappearing when scrollbars=ssAutoVertical, issue #9689

git-svn-id: trunk@12145 -
This commit is contained in:
jesus 2007-09-23 04:35:18 +00:00
parent 893d84a49e
commit d77f7bb377
2 changed files with 106 additions and 89 deletions

View File

@ -33,7 +33,6 @@ TComponentDatalink idea was taken from Joanna Carter's article
unit DBGrids;
{$mode objfpc}{$H+}
{$define EnableIsSeq}
{$IF defined(VER2_0_2) and defined(win32)}
// FPC <= 2.0.2 compatibility code
@ -366,6 +365,7 @@ type
function ValueMatch(const BaseValue, TestValue: string): Boolean;
procedure ToggleSelectedRow;
procedure SelectRecord(AValue: boolean);
procedure GetScrollbarParams(out aRange, aPage, aPos: Integer);
protected
procedure AddAutomaticColumns;
procedure BeforeMoveSelection(const DCol,DRow: Integer); override;
@ -408,6 +408,9 @@ type
function GetImageForCheckBox(CheckBoxView: TDBGridCheckBoxState): TBitmap;
function GetIsCellSelected(aCol, aRow: Integer): boolean; override;
function GridCanModify: boolean;
procedure GetSBVisibility(out HsbVisible,VsbVisible:boolean);override;
procedure GetSBRanges(const HsbVisible,VsbVisible: boolean;
out HsbRange,VsbRange, HsbPage, VsbPage:Integer); override;
procedure HeaderClick(IsColumn: Boolean; index: Integer); override;
procedure HeaderSized(IsColumn: Boolean; Index: Integer); override;
procedure KeyDown(var Key : Word; Shift : TShiftState); override;
@ -421,12 +424,10 @@ type
procedure RemoveAutomaticColumns;
procedure SelectEditor; override;
procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
function ScrollBarAutomatic(Which: TScrollStyle): boolean; override;
function SelectCell(aCol, aRow: Integer): boolean; override;
procedure UpdateActive; virtual;
procedure UpdateData; virtual;
function UpdateGridCounts: Integer;
procedure UpdateVertScrollbar(const aVisible: boolean; const aRange,aPage: Integer); override;
procedure VisualChange; override;
procedure WMVScroll(var Message : TLMVScroll); message LM_VScroll;
procedure WndProc(var TheMessage : TLMessage); override;
@ -1183,7 +1184,7 @@ begin
' Position=', dbgs(Message.Pos),' OldPos=',Dbgs(FOldPosition));
{$endif}
IsSeq := FDatalink.DataSet.IsSequenced {$ifndef EnableIsSeq} and false {$endif};
IsSeq := FDatalink.DataSet.IsSequenced;
case Message.ScrollCode of
SB_TOP:
DsGoto(True);
@ -1351,40 +1352,17 @@ end;
procedure TCustomDBGrid.UpdateScrollbarRange;
var
aRange, aPage: Integer;
aPos: Integer;
isSeq: boolean;
aRange, aPage, aPos: Integer;
ScrollInfo: TScrollInfo;
begin
if not HandleAllocated then exit;
if FDatalink.Active then begin
IsSeq := FDatalink.dataset.IsSequenced{$ifndef EnableIsSeq}and false{$endif};
if IsSeq then begin
aRange := GetRecordCount + VisibleRowCount - 1;
aPage := VisibleRowCount;
if aPage<1 then aPage := 1;
if FDatalink.BOF then aPos := 0 else
if FDatalink.EOF then aPos := aRange
else
aPos := FDataLink.DataSet.RecNo - 1; // RecNo is 1 based
if aPos<0 then aPos:=0;
end else begin
aRange := 6;
aPage := 2;
if FDatalink.EOF then aPos := 4 else
if FDatalink.BOF then aPos := 0
else aPos := 2;
end;
end else begin
aRange := 0;
aPage := 0;
aPos := 0;
end;
//ScrollBarRange(SB_VERT, aRange, aPage);
//ScrollBarPosition(SB_VERT, aPos);
GetScrollBarParams(aRange, aPage, aPos);
FillChar(ScrollInfo, SizeOf(ScrollInfo), 0);
ScrollInfo.cbSize := SizeOf(ScrollInfo);
{TODO: try to move this out}
{$ifdef WINDOWS}
ScrollInfo.fMask := SIF_ALL or SIF_DISABLENOSCROLL;
ScrollInfo.ntrackPos := 0;
@ -1405,7 +1383,6 @@ begin
(ScrollBars in [ssBoth, ssVertical]) or
((Scrollbars in [ssAutoVertical, ssAutoBoth]) and (aRange>aPAge))
);
FOldPosition := aPos;
{$ifdef dbgDBGrid}
DebugLn('UpdateScrollBarRange: Handle=',IntToStr(Handle),
@ -1432,7 +1409,6 @@ begin
{$ifdef dbgDBGrid} DebugLn('doLayoutChanged INIT'); {$endif}
if UpdateGridCounts=0 then
EmptyGrid;
UpdateScrollBarRange;
RestoreEditor;
{$ifdef dbgDBGrid} DebugLn('doLayoutChanged FIN'); {$endif}
end;
@ -2146,18 +2122,6 @@ begin
FTempText := Value;
end;
function TCustomDBGrid.ScrollBarAutomatic(Which: TScrollStyle): boolean;
begin
if Which=ssHorizontal then
Result:= true
else
Result:=inherited ScrollBarAutomatic(Which);
{$ifdef dbgScroll}
DebugLn('TCustomDBGrid.ScrollbarAutomatic Which=',dbgs(Ord(Which)),
' Result=',dbgs(Result));
{$endif}
end;
function TCustomDBGrid.SelectCell(aCol, aRow: Integer): boolean;
begin
Result:= (ColWidths[aCol] > 0) and (RowHeights[aRow] > 0);
@ -2356,6 +2320,33 @@ begin
and FDataLink.Active and FDatalink.DataSet.CanModify;
end;
procedure TCustomDBGrid.GetSBVisibility(out HsbVisible, VsbVisible: boolean);
var
aRange,aPage,aPos: Integer;
begin
inherited GetSBVisibility(HsbVisible, VsbVisible);
VSbVisible := (ScrollBars in [ssVertical, ssBoth]);
if not VSbVisible and ScrollBarAutomatic(ssVertical) then begin
GetScrollbarParams(aRange,aPage, aPos);
if ARange>aPage then
VSbVisible:=True;
end;
end;
procedure TCustomDBGrid.GetSBRanges(const HsbVisible, VsbVisible: boolean; out
HsbRange, VsbRange, HsbPage, VsbPage: Integer);
var
aPos: Integer;
begin
inherited GetSBRanges(HsbVisible, VsbVisible, HsbRange, VsbRange, HsbPage, VsbPage);
if VSbVisible then
GetScrollbarParams(VsbRange, VsbPage, aPos)
else begin
VsbRange := 0;
VsbPage := 0;
end;
end;
procedure TCustomDBGrid.MoveSelection;
begin
if FSelectionLock then
@ -2654,22 +2645,6 @@ begin
{$IfDef dbgDBGrid}DebugLn('TCustomDbgrid.UpdateGridCounts END');{$endif}
end;
procedure TCustomDBGrid.UpdateVertScrollbar(const aVisible: boolean;
const aRange, aPage: Integer);
begin
{$ifdef DbgScroll}
DebugLn('TCustomDBGrid.UpdateVertScrollbar: Vis=',dbgs(aVisible),
' Range=',dbgs(aRange),' Page=',dbgs(aPage));
{$endif}
if (Scrollbars in [ssAutoVertical, ssAutoBoth]) then begin
// ssAutovertical and ssAutoBoth would get the scrollbar hidden
// but this case should be handled as if the scrollbar where
// ssVertical or ssBoth
ScrollBarShow(SB_VERT, True)
end else
ScrollBarShow(SB_VERT, AVisible);
end;
procedure TCustomDBGrid.VisualChange;
begin
if FVisualChangeCount=0 then begin
@ -2802,6 +2777,32 @@ begin
FSelectedRows.CurrentRowSelected := AValue;
end;
procedure TCustomDBGrid.GetScrollbarParams(out aRange, aPage, aPos: Integer);
begin
if (FDatalink<>nil) and FDatalink.Active then begin
if FDatalink.dataset.IsSequenced then begin
aRange := GetRecordCount + VisibleRowCount - 1;
aPage := VisibleRowCount;
if aPage<1 then aPage := 1;
if FDatalink.BOF then aPos := 0 else
if FDatalink.EOF then aPos := aRange
else
aPos := FDataLink.DataSet.RecNo - 1; // RecNo is 1 based
if aPos<0 then aPos:=0;
end else begin
aRange := 6;
aPage := 2;
if FDatalink.EOF then aPos := 4 else
if FDatalink.BOF then aPos := 0
else aPos := 2;
end;
end else begin
aRange := 0;
aPage := 0;
aPos := 0;
end;
end;
destructor TCustomDBGrid.Destroy;
begin
FUncheckedBitmap.Free;

View File

@ -633,7 +633,6 @@ type
function GetBorderWidth: Integer;
function GetRowCount: Integer;
function GetRowHeights(Arow: Integer): Integer;
procedure GetSBVisibility(out HsbVisible,VsbVisible:boolean);
function GetSelection: TGridRect;
function GetTopRow: Longint;
function GetVisibleColCount: Integer;
@ -776,6 +775,9 @@ type
function GetDefaultColumnTitle(Column: Integer): string; virtual;
function GetDefaultEditor(Column: Integer): TWinControl;
function GetScrollBarPosition(Which: integer): Integer;
procedure GetSBVisibility(out HsbVisible,VsbVisible:boolean);virtual;
procedure GetSBRanges(const HsbVisible,VsbVisible: boolean;
out HsbRange,VsbRange, HsbPage, VsbPage:Integer); virtual;
function GetEditMask(ACol, ARow: Longint): string; dynamic;
function GetEditText(ACol, ARow: Longint): string; dynamic;
function GetFixedcolor: TColor; virtual;
@ -2314,34 +2316,16 @@ procedure TCustomGrid.ResetSizes;
procedure CalcScrollbarsRange;
var
HsbVisible, VsbVisible: boolean;
HsbRange, VsbRange, Tw, Th: Integer;
HsbRange,VsbRange: Integer;
HsbPage, VsbPage: Integer;
begin
with FGCache do begin
// Horizontal scrollbar
GetSBVisibility(HsbVisible, VsbVisible);
if HsbVisible then begin
HsbRange:=GridWidth + 2 - GetBorderWidth;
if not (goSmoothScroll in Options) then begin
TW:= integer(PtrUInt(AccumWidth[MaxTopLeft.X]))-(HsbRange-ClientWidth);
HsbRange:=HsbRange + TW - FixedWidth + 1;
end;
end else
HsbRange:=0;
// Vertical scrollbar
if VsbVisible then begin
VSbRange:= GridHeight + 2 - GetBorderWidth;
if not (goSmoothScroll in Options) then begin
TH:= integer(PtrUInt(accumHeight[MaxTopLeft.Y]))-(VsbRange-ClientHeight);
VsbRange:=VsbRange + TH -FixedHeight + 1;
end;
end else
VsbRange:= 0;
UpdateVertScrollBar(VsbVisible, VsbRange, ClientHeight);
UpdateHorzScrollBar(HsbVisible, HsbRange, ClientWidth);
{$ifdef DbgVisualChange}
GetSBRanges(HsbVisible,VsbVisible,HsbRange,VsbRange,HsbPage,VsbPage);
UpdateVertScrollBar(VsbVisible, VsbRange, VsbPage);
UpdateHorzScrollBar(HsbVisible, HsbRange, HsbPage);
{$ifdef DbgScroll}
DebugLn('VRange=',dbgs(VsbRange),' Visible=',dbgs(VSbVisible));
DebugLn('HRange=',dbgs(HsbRange),' Visible=',dbgs(HSbVisible));
{$endif}
@ -2474,7 +2458,7 @@ procedure TCustomGrid.ScrollBarShow(Which: Integer; aValue: boolean);
begin
if HandleAllocated then begin
{$Ifdef DbgScroll}
DebugLn('ScrollbarShow: Which=',IntToStr(Which), ' Avalue=',BoolToStr(AValue));
DebugLn('ScrollbarShow: Which=',IntToStr(Which), ' Avalue=',dbgs(AValue));
{$endif}
ShowScrollBar(Handle,Which,aValue);
if Which in [SB_BOTH, SB_VERT] then FVSbVisible := AValue else
@ -3577,6 +3561,38 @@ begin
if ScrollBarAutomatic(ssHorizontal) then
HsbVisible := HsbVisible and not AutoFillColumns;
{$ifdef dbgscroll}
DebugLn('TCustomGrid.GetSBVisibility H=',dbgs(HsbVisible),' V=',dbgs(VsbVisible));
{$endif}
end;
procedure TCustomGrid.GetSBRanges(const HsbVisible, VsbVisible: boolean; out
HsbRange, VsbRange, HsbPage, VSbPage: Integer);
var
Tw, Th: Integer;
begin
with FGCache do begin
if HsbVisible then begin
HsbRange:=GridWidth + 2 - GetBorderWidth;
if not (goSmoothScroll in Options) then begin
TW:= integer(PtrUInt(AccumWidth[MaxTopLeft.X]))-(HsbRange-ClientWidth);
HsbRange:=HsbRange + TW - FixedWidth + 1;
end;
end else
HsbRange:=0;
if VsbVisible then begin
VSbRange:= GridHeight + 2 - GetBorderWidth;
if not (goSmoothScroll in Options) then begin
TH:= integer(PtrUInt(accumHeight[MaxTopLeft.Y]))-(VsbRange-ClientHeight);
VsbRange:=VsbRange + TH -FixedHeight + 1;
end;
end else
VsbRange:= 0;
HsbPage := ClientWidth;
VSbPage := ClientHeight;
end;
end;
procedure TCustomGrid.UpdateSBVisibility;