diff --git a/lcl/dbgrids.pas b/lcl/dbgrids.pas index 57b640664e..3c66ebbf8d 100644 --- a/lcl/dbgrids.pas +++ b/lcl/dbgrids.pas @@ -69,7 +69,10 @@ type dgAutoSizeColumns, dgAnyButtonCanSelect, // any mouse button can move selection dgDisableDelete, // disable deleting records with Ctrl+Delete - dgDisableInsert // disable inserting (or append) records + dgDisableInsert, // disable inserting (or append) records + dgCellHints, // show individual cell hints + dgTruncCellHints, // show cell hints if cell text is too long + dgCellEllipsis // show ... if cell text is truncated ); TDbGridOptions = set of TDbGridOption; @@ -115,6 +118,10 @@ type TDbGridCheckboxStateEvent = procedure(Sender: TObject; Column: TColumn; var AState: TCheckboxState) of object; + + TDbGridCellHintEvent = + procedure(Sender: TObject; Column: TColumn; var AText: String) of object; + type { TBMStringList } @@ -308,6 +315,8 @@ type FOnPrepareCanvas: TPrepareDbGridCanvasEvent; FKeyBookmark: TBookmarkStr; FKeySign: Integer; + FSavedRecord: Integer; + FOnGetCellHint: TDbGridCellHintEvent; procedure EmptyGrid; function GetColumns: TDBGridColumns; function GetCurrentColumn: TColumn; @@ -401,6 +410,7 @@ type function FieldIndexFromGridColumn(AGridCol: Integer): Integer; function FirstGridColumn: Integer; override; function GetBufferCount: integer; + function GetCellHintText(aCol, aRow: Integer): String; override; function GetDefaultColumnAlignment(Column: Integer): TAlignment; override; function GetDefaultColumnWidth(Column: Integer): Integer; override; function GetDefaultColumnReadOnly(Column: Integer): boolean; override; @@ -416,6 +426,7 @@ type function GetIsCellSelected(aCol, aRow: Integer): boolean; override; function GetIsCellTitle(aCol,aRow: Integer): boolean; override; procedure GetSelectedState(AState: TGridDrawState; out IsSelected:boolean); override; + function GetTruncCellHintText(aCol, aRow: Integer): string; override; function GridCanModify: boolean; procedure GetSBVisibility(out HsbVisible,VsbVisible:boolean);override; procedure GetSBRanges(const HsbVisible,VsbVisible: boolean; @@ -432,12 +443,14 @@ type procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure PrepareCanvas(aCol,aRow: Integer; aState:TGridDrawState); override; + procedure PrepareCellHints(aCol,aRow: Integer); override; procedure RemoveAutomaticColumns; procedure ResetSizes; override; procedure SelectEditor; override; procedure SetEditText(ACol, ARow: Longint; const Value: string); override; procedure SetFixedCols(const AValue: Integer); override; function SelectCell(aCol, aRow: Integer): boolean; override; + procedure UnprepareCellHints; override; procedure UpdateActive; virtual; procedure UpdateAutoSizeColumns; procedure UpdateData; virtual; @@ -465,6 +478,7 @@ type property OnColumnSized: TNotifyEvent read FOnColumnSized write FOnColumnSized; property OnDrawColumnCell: TDrawColumnCellEvent read FOnDrawColumnCell write FOnDrawColumnCell; property OnFieldEditMask: TGetDbEditMaskEvent read FOnFieldEditMask write FOnFieldEditMask; + property OnGetCellHint: TDbGridCellHintEvent read FOnGetCellHint write FOnGetCellHint; property OnPrepareCanvas: TPrepareDbGridCanvasEvent read FOnPrepareCanvas write FOnPrepareCanvas; property OnSelectEditor: TDbGridSelEditorEvent read FOnSelectEditor write FOnSelectEditor; property OnTitleClick: TDBGridClickEvent read FOnTitleClick write FOnTitleClick; @@ -510,6 +524,7 @@ type property BiDiMode; property BorderSpacing; property BorderStyle; + property CellHintPriority; property Color; property Columns; // stored false; property Constraints; @@ -563,6 +578,7 @@ type property OnEnter; property OnExit; property OnFieldEditMask; + property OnGetCellHint; property OnKeyDown; property OnKeyPress; property OnKeyUp; @@ -1017,6 +1033,21 @@ begin else Exclude(OldOptions, goHeaderPushedLook); + if dgCellHints in FOptions then + Include(OldOptions, goCellHints) + else + Exclude(OldOptions, goCellHints); + + if dgTruncCellHints in FOptions then + Include(OldOptions, goTruncCellHints) + else + Exclude(OldOptions, goTruncCellHints); + + if dgCellEllipsis in FOptions then + Include(OldOptions, goCellEllipsis) + else + Exclude(OldOptions, goCellEllipsis); + if (dgIndicator in ChangedOptions) then begin if (dgIndicator in FOptions) then FixedCols := FixedCols + 1 @@ -1293,6 +1324,46 @@ begin Result := 0; end; +procedure TCustomDBGrid.PrepareCellHints(ACol, ARow: Integer); +begin + FSavedRecord := DataLink.ActiveRecord; + DataLink.ActiveRecord := ARow - FixedRows; +end; + +procedure TCustomDBGrid.UnprepareCellHints; +begin + DataLink.ActiveRecord := FSavedRecord; +end; + +function TCustomDBGrid.GetCellHintText(ACol, ARow: Integer): String; +var + C: TColumn; +begin + Result := ''; + if (ARow < FixedRows) then + exit; + if Assigned(FOnGetCellHint) then begin + C := ColumnFromGridColumn(ACol) as TColumn; + FOnGetCellHint(self, C, Result); + end; + +end; + +function TCustomDBGrid.GetTruncCellHintText(ACol, ARow: integer): String; +var + F: TField; +begin + Result := ''; + if ARow < FixedRows then + exit; + F := GetFieldFromGridColumn(ACol); + if (F <> nil) then + if (F.DataType <> ftBlob) then + Result := F.DisplayText + else + Result := '(blob)'; +end; + // obtain the field either from a Db column or directly from dataset fields function TCustomDBGrid.GetFieldFromGridColumn(Column: Integer): TField; var diff --git a/lcl/graphics.pp b/lcl/graphics.pp index 5f1d72089d..9ea91774ba 100644 --- a/lcl/graphics.pp +++ b/lcl/graphics.pp @@ -111,6 +111,7 @@ type // too fit between left and right boundaries // try to break into multiple lines between // words + // See also EndEllipsis. Opaque : boolean; // TextRect: Fills background with current Brush // TextOut : Fills background with current @@ -119,6 +120,12 @@ type SystemFont: Boolean; // Use the system font instead of Canvas Font RightToLeft: Boolean; //For RightToLeft text reading (Text Direction) + + EndEllipsis: Boolean; // TextRect Only: If line of text is too long + // to fit between left and right boundaries + // truncates the text and adds "..." + // If Wordbreak is set as well, Workbreak will + // dominate. end; const diff --git a/lcl/grids.pas b/lcl/grids.pas index 8fcf32933b..2e08b16c2d 100644 --- a/lcl/grids.pas +++ b/lcl/grids.pas @@ -106,7 +106,8 @@ type goFixedColSizing, // Allow to resize fixed columns goDontScrollPartCell, // clicking partially visible cells will not scroll goCellHints, // show individual cell hints - goTruncCellHints // show cell hints if cell text is too long + goTruncCellHints, // show cell hints if cell text is too long + goCellEllipsis // show "..." if cell text is too long ); TGridOptions = set of TGridOption; @@ -153,6 +154,11 @@ type TMouseWheelOption = (mwCursor, mwGrid); + TCellHintPriority = (chpAll, chpAllNoDefault, chpTruncOnly); + // The grid can display three types of hint: the default hint (Hint property), + // individual cell hints (OnCellHint event), and hints for truncated cells. + // TCellHintPriority determines how the overall hint is combined when more + // multiple hint texts are to be displayed. const soAll: TSaveOptions = [soDesign, soAttributes, soContent, soPosition]; @@ -726,6 +732,7 @@ type FRowAutoInserted: Boolean; FMouseWheelOption: TMouseWheelOption; FSavedHint: String; + FCellHintPriority: TCellHintPriority; FOnGetCellHint: TGetCellHintEvent; procedure AdjustCount(IsColumn:Boolean; OldValue, NewValue:Integer); procedure CacheVisibleGrid; @@ -945,6 +952,7 @@ type function GetDefaultColumnTitle(Column: Integer): string; virtual; function GetDefaultEditor(Column: Integer): TWinControl; virtual; function GetDefaultRowHeight: integer; virtual; + function GetGridDrawState(ACol, ARow: Integer): TGridDrawState; function GetImageForCheckBox(const aCol,aRow: Integer; CheckBoxView: TCheckBoxState): TBitmap; virtual; function GetScrollBarPosition(Which: integer): Integer; @@ -961,6 +969,7 @@ type function GetLastVisibleRow: Integer; function GetSelectedColor: TColor; virtual; function GetTitleShowPrefix(Column: Integer): boolean; + function GetTruncCellHintText(ACol, ARow: Integer): string; virtual; function GridColumnFromColumnIndex(ColumnIndex: Integer): Integer; procedure GridMouseWheel(shift: TShiftState; Delta: Integer); virtual; procedure HeaderClick(IsColumn: Boolean; index: Integer); virtual; @@ -992,6 +1001,7 @@ type procedure Paint; override; procedure PickListItemSelected(Sender: TObject); procedure PrepareCanvas(aCol,aRow: Integer; aState:TGridDrawState); virtual; + procedure PrepareCellHints(ACol, ARow: Integer); virtual; procedure ResetEditor; procedure ResetOffset(chkCol, ChkRow: Boolean); procedure ResetSizes; virtual; @@ -1021,6 +1031,7 @@ type procedure TopLeftChanged; virtual; function TryMoveSelection(Relative: Boolean; var DCol, DRow: Integer): Boolean; procedure UnLockEditor; + procedure UnprepareCellHints; virtual; procedure UpdateHorzScrollBar(const aVisible: boolean; const aRange,aPage,aPos: Integer); virtual; procedure UpdateSelectionRange; procedure UpdateVertScrollbar(const aVisible: boolean; const aRange,aPage,aPos: Integer); virtual; @@ -1040,6 +1051,7 @@ type property AutoFillColumns: boolean read FAutoFillColumns write SetAutoFillColumns default false; property BorderStyle:TBorderStyle read FGridBorderStyle write SetBorderStyle default bsSingle; property BorderColor: TColor read FBorderColor write SetBorderColor default cl3DDKShadow; + property CellHintPriority: TCellHintPriority read FCellHintPriority write FCellHintPriority default chpTruncOnly; property Col: Integer read FCol write SetCol; property ColCount: Integer read GetColCount write SetColCount default 5; property ColumnClickSorts: boolean read FColumnClickSorts write SetColumnClickSorts default false; @@ -1566,6 +1578,7 @@ type property BiDiMode; property BorderSpacing; property BorderStyle; + property CellHintPriority; property Color; property ColCount; property ColumnClickSorts; @@ -3437,6 +3450,7 @@ begin CurrentTextStyle.Layout := GetColumnLayout(aCol, gdFixed in AState); CurrentTextStyle.ShowPrefix := ((gdFixed in aState) and (aRow < FFixedRows)) and GetTitleShowPrefix(aCol); CurrentTextStyle.RightToLeft := UseRightToLeftReading; + CurrentTextStyle.EndEllipsis := (goCellEllipsis in Options); Canvas.TextStyle := CurrentTextStyle; end else begin Canvas.TextStyle := DefaultTextStyle; @@ -3447,6 +3461,14 @@ begin DoPrepareCanvas(aCol, aRow, aState); end; +procedure TCustomGrid.PrepareCellHints(ACol, ARow: Integer); +begin +end; + +procedure TCustomGrid.UnprepareCellHints; +begin +end; + procedure TCustomGrid.ResetEditor; begin EditorGetValue(True); @@ -3516,44 +3538,49 @@ var w: Integer; gds: TGridDrawState; begin + if ([goCellHints, goTruncCellHints]*Options = []) then + exit; + cell := MouseToCell(APoint); + if (cell.x = -1) or (cell.y = -1) then + exit; txt := ''; txt1 := ''; txt2 := ''; - if (goCellHints in Options) and Assigned(FOnGetCellHint) then - FOnGetCellHint(Self, cell.x, cell.y, txt1); - if (goTruncCellHints in Options) and (cell.y >= 0) and (cell.y >= 0) then begin - txt2 := GetCellHintText(cell.x, cell.y); - if (txt2 <> '') then begin - gds := []; - if (cell.x < FFixedCols) or (cell.y < FFixedRows) then - include(gds, gdFixed) - else begin - if (cell.x=FCol) and (cell.y=FRow) then - gds := gds + [gdFocused, gdSelected] - else - if IsCellSelected[cell.x, cell.y] then - include(gds, gdSelected); - end; - with FGCache do begin - if (cell.x=HotCell.x) and (cell.y=HotCell.y) and not IsPushCellActive() then - include(gds, gdHot); - if ClickCellPushed and (cell.x=PushedCell.x) and (cell.y=PushedCell.y) then - include(gds, gdPushed); - end; + PrepareCellHints(cell.x, cell.y); // in DBGrid, set the active record to cell.y + try + if (goCellHints in Options) then + txt1 := GetCellHintText(cell.x, cell.y); + if (goTruncCellHints in Options) then begin + txt2 := GetTruncCellHintText(cell.x, cell.y); + gds := GetGridDrawState(cell.x, cell.y); PrepareCanvas(cell.x, cell.y, gds); w := Canvas.TextWidth(txt2) + constCellPadding*2; if w < ColWidths[cell.x] then txt2 := ''; end; + finally + UnprepareCellHints; end; - if (txt1 <> '') and (txt2 <> '') then - txt := txt1 + #13 + txt2 - else if txt1 <> '' then - txt := txt1 - else if txt2 <> '' then - txt := txt2; + + if FCellHintPriority = chpTruncOnly then begin + if (txt2 <> '') then + txt := txt2 + else + txt := txt1; + end else begin + if (txt1 <> '') and (txt2 <> '') then + txt := txt1 + #13 + txt2 + else if txt1 <> '' then + txt := txt1 + else if txt2 <> '' then + txt := txt2; + if (FCellHintPriority = chpAll) and (txt <> '') then + txt := FSavedHint + #13 + txt; + end; + if (txt = '') and (FSavedHint <> '') then + txt := FSavedHint; if (txt <> '') and not EditorMode and not (csDesigning in ComponentState) then begin Hint := txt; @@ -3782,7 +3809,7 @@ end; procedure TCustomGrid.DrawRow(aRow: Integer); var - Gds: TGridDrawState; + gds: TGridDrawState; aCol: Integer; Rs: Boolean; R: TRect; @@ -3795,11 +3822,11 @@ var with FGCache do begin if (aCol=HotCell.x) and (aRow=HotCell.y) and not IsPushCellActive() then begin Include(gds, gdHot); - HotCellPainted:=True; + HotCellPainted := True; end; if ClickCellPushed and (aCol=PushedCell.x) and (aRow=PushedCell.y) then begin Include(gds, gdPushed); - end; + end; end; Canvas.SaveHandleState; @@ -3831,18 +3858,8 @@ begin ColRowToOffset(True, True, aCol, R.Left, R.Right); if (R.Left>=R.Right) or not HorizontalIntersect(R, ClipArea) then continue; - gds := []; Rs := (goRowSelect in Options); - if ARow p.X) or (MouseCell.Y <> p.Y) then begin Application.CancelHint; @@ -7454,8 +7478,18 @@ begin end; function TCustomGrid.GetCellHintText(ACol, ARow: Integer): string; +var + txt1: String; + txt2: String; begin - result := GetCells(ACol, ARow); + Result := ''; + if Assigned(FOnGetCellHint) then + FOnGetCellHint(self, ACol, ARow, result); +end; + +function TCustomGrid.GetTruncCellHintText(ACol, ARow: Integer): String; +begin + Result := GetCells(ACol, ARow); end; function TCustomGrid.GetCells(ACol, ARow: Integer): string; @@ -7983,6 +8017,26 @@ begin FreeWorkingCanvas(tmpCanvas); end; +function TCustomGrid.GetGridDrawState(ACol, ARow: Integer): TGridDrawState; +begin + Result := []; + if ARow < FFixedRows then + include(Result, gdFixed) + else begin + if (aCol = FCol) and (aRow = FRow) then + Result := Result + [gdFocused, gdSelected] + else + if IsCellSelected[aCol, aRow] then + include(Result, gdSelected); + end; + with FGCache do begin + if (ACol = HotCell.x) and (ARow = HotCell.y) and not IsPushCellActive() + then Include(Result, gdHot); + if ClickCellPushed and (ACol = PushedCell.x) and (ARow = PushedCell.y) + then Include(Result, gdPushed); + end; +end; + function TCustomGrid.GetScrollBarPosition(Which: integer): Integer; var ScrollInfo: TScrollInfo; @@ -8426,6 +8480,8 @@ begin FDefaultTextStyle.Wordbreak := False; FDefaultTextStyle.SingleLine:= True; + FCellHintPriority := chpTruncOnly; + FButtonEditor := TButtonCellEditor.Create(nil); FButtonEditor.Name:='ButtonEditor'; FButtonEditor.Caption:='...'; diff --git a/lcl/include/canvas.inc b/lcl/include/canvas.inc index 0501726249..c812ee02c3 100644 --- a/lcl/include/canvas.inc +++ b/lcl/include/canvas.inc @@ -1171,8 +1171,13 @@ begin tlCenter : Options := Options or DT_VCENTER; tlBottom : Options := Options or DT_BOTTOM; end; - if Style.WordBreak then + if Style.EndEllipsis then + Options := Options or DT_END_ELLIPSIS; + if Style.WordBreak then begin Options := Options or DT_WORDBREAK; + if Style.EndEllipsis then + Options := Options and not DT_END_ELLIPSIS; + end; if Style.SingleLine then Options := Options or DT_SINGLELINE;