LCL, implements EndEllipsis text style (windows) and use it for showing ... in grid cells, also implements cell hints in dbgrid, from wp, issue #20777

git-svn-id: trunk@34018 -

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

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

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
+  PrepareCellHints(cell.x, cell.y); // in DBGrid, set the active record to cell.y
-    FOnGetCellHint(Self, cell.x, cell.y, txt1);
+  try
-  if (goTruncCellHints in Options) and (cell.y >= 0) and (cell.y >= 0) then begin
+    if (goCellHints in Options) then
-    txt2 := GetCellHintText(cell.x, cell.y);
+      txt1 := GetCellHintText(cell.x, cell.y);
-    if (txt2 <> '') then begin
+    if (goTruncCellHints in Options) then begin
-      gds := [];
+      txt2 := GetTruncCellHintText(cell.x, cell.y);
-      if (cell.x < FFixedCols) or (cell.y < FFixedRows) then
+      gds := GetGridDrawState(cell.x, cell.y);
-        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;
       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
+  if FCellHintPriority = chpTruncOnly then begin
-  else if txt1 <> '' then
+    if (txt2 <> '') then
-    txt := txt1
+      txt := txt2
-  else if txt2 <> '' then
+    else
-    txt := txt2;
+      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<FFixedRows then
+      gds := GetGridDrawState(ACol, ARow);
-        include(gds, gdFixed)
-      else begin
-        if (aCol=FCol)and(aRow=FRow) then
-          gds := gds + [gdFocused, gdSelected]
-        else
-        if IsCellSelected[aCol, aRow] then
-          include(gds, gdSelected);
-      end;
-
       DoDrawCell;
     end;
 
@@ -5919,6 +5936,7 @@ end;
 procedure TCustomGrid.MouseMove(Shift: TShiftState; X, Y: Integer);
 var
   p: TPoint;
+  obe: boolean;  // stored "AllowOutboundEvents"
 begin
   inherited MouseMove(Shift, X, Y);
 
@@ -5957,7 +5975,13 @@ begin
         if goRowSizing in Options then
           doRowSizing(X,Y);
 
-        p := MouseCoord(X, Y);
+        obe := AllowOutboundEvents;
+        AllowOutboundEvents := false;
+        try
+          p := MouseCoord(X, Y);
+        finally
+          AllowOutboundEvents := obe;
+        end;
         with FGCache do
           if (MouseCell.X <> 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:='...';

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;