Merge branch 'main' of https://github.com/EtheaDev/DBAwareLabeledComponents

Author: carloBarazzetta

Source/Vcl.LabeledDBCtrls.pas

@@ -297,6 +297,8 @@   TLabeledDbGrid = class;
   TCBCheckBoxedColumnEvent = procedure (Column: TColumn; var IsCheckBoxedColumn: Boolean) of object;
   TColumnNotifyEvent = procedure (Column: TColumn) of object;
 
+  TGridIncrementalSearchType = (stBeginsWith, stFilterBy);
+
   TLabeledDbGrid = class(TDBGrid)
   private
     FBoundLabel: TControlBoundLabel;
@@ -320,6 +322,9 @@   TLabeledDbGrid = class(TDBGrid)
     FLinesPerRow: Integer;
     FRowMargin: Integer;
     FWrapAllText: Boolean;
+    FColMoving: Boolean;
+    FTitleMouseDown: boolean;
+    FIncrementalSearchType: TGridIncrementalSearchType;
     function TitleOffset: Integer;
     procedure OnSearchTimer(Sender : TObject);
     procedure SetBoundCaption(const Value: TCaption);
@@ -344,6 +349,7 @@   TLabeledDbGrid = class(TDBGrid)
     function isCheckBoxedField(Field: TField): boolean;
     function isUnsortableField(Field: TField): boolean;
     procedure doIncrementalLocate;
+    procedure doIncrementalFilter;
     procedure SetIncrementalSearchDelay(const Value: integer);
     function GetIncrementalSearchDelay: integer;
     procedure SetDrawCheckBoxImages(const Value: Boolean);
@@ -358,6 +364,7 @@   TLabeledDbGrid = class(TDBGrid)
       const AField: TField; Const AColumn: TColumn);
     function CalcRowMargin(const ARect: TRect): Integer;
     procedure SetWrapAllText(const Value: Boolean);
+    procedure SetColMoving(const Value: Boolean);
   protected
     procedure SetParent(AParent: TWinControl); override;
     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
@@ -379,12 +386,17 @@   TLabeledDbGrid = class(TDBGrid)
     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
       X, Y: Integer); override;
+      procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override;
+
     function GetBorderStyle: TBorderStyle;
     {$IF DEFINE DXE8+}
     procedure ChangeScale(M, D: Integer; isDpiChange: Boolean); override;
     {$ELSE}
     procedure ChangeScale(M, D: Integer); override;
     {$ENDIF}
+
+    function  CreateColumns: TDBGridColumns; override;
+
   public
     procedure DefaultDrawColumnCell(const Rect: TRect; DataCol: Integer;
       Column: TColumn; State: TGridDrawState);
@@ -408,6 +420,8 @@   TLabeledDbGrid = class(TDBGrid)
     function ColumnIndexByFieldName(const AFieldName: string): Integer;
     function GetMouseOverField(X, Y: Integer): TField;
     function GetDefaultRowHeight: Integer;
+    procedure ClearFilters;
+
   published
     property TitleFont: TFont read GetTitleFont write SetTitleFont stored False;
     property IsEmpty: Boolean read GetIsEmpty;
@@ -431,6 +445,8 @@   TLabeledDbGrid = class(TDBGrid)
     property CanEditColumn: TCBCanEditColumn read FCanEditColumn write FCanEditColumn;
     property RowMargin: Integer read FRowMargin write SetRowMargin default 0;
     property WrapAllText: Boolean read FWrapAllText write SetWrapAllText default False;
+    property ColMoving: Boolean read FColMoving write SetColMoving default True;
+    property IncrementalSearchType: TGridIncrementalSearchType read FIncrementalSearchType write FIncrementalSearchType default stBeginsWith;
   end;
 
   TNavInsMode = (imInsert, imAppend);
@@ -449,6 +465,14 @@ implementation
   DBActns, UxTheme, UITypes,
   //Labeled components
   Vcl.DbAwareLabeledUtils, Vcl.LabeledCtrls;
+  
+type
+  TXColumn = class(TColumn)
+  private
+    FTitleCaption: string;
+  public
+    property TitleCaption: string read FTitleCaption write FTitleCaption;
+  end;
 
 var
   DbGridPrintSupport: TStringList;
@@ -1199,10 +1223,17 @@ constructor TLabeledDbGrid.Create(AOwner: TComponent);
   FDrawCheckBoxImages := True;
   FShowSortOrder := True;
   FIncrementalSearch := False;
+  FIncrementalSearchType := stBeginsWith;
   FSearchTimer := TTimer.Create(nil);
   FSearchTimer.Interval := INCREMENTAL_DELAY_DEFAULT;
   FSearchTimer.Enabled := False;
   FSearchTimer.OnTimer := OnSearchTimer;
+  FColMoving := True;
+end;
+
+function TLabeledDbGrid.CreateColumns: TDBGridColumns;
+begin
+  Result := TDBGridColumns.Create(Self, TXColumn)
 end;
 
 procedure TLabeledDbGrid.VisibleChanging;
@@ -1337,6 +1368,8 @@ procedure TLabeledDbGrid.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGr
   SortOrder: TCBSortOrder;
   LRect: TRect;
   LDataLinkActive: Boolean;
+
+  Text: string;
 begin
   dxGridSortedShapeMinWidth := ARect.Bottom - ARect.Top; //16
   //se è il record corrente aggiorno il flag in modo tale che nell'evento
@@ -1351,6 +1384,26 @@ procedure TLabeledDbGrid.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGr
       FDrawingCurrentRecord := True
     else
       FDrawingCurrentRecord := False;
+
+    // artifizio per avere i puntini di sospensione anche in caso di troncatura del testo sul titolo
+    if not FTitleMouseDown and (gdFixed in AState) and (ACol > 0) and not(csDesigning in ComponentState) then
+    begin
+      DrawColumn := Columns[ACol];
+      Text := TXColumn(DrawColumn).TitleCaption;
+
+      if Text = '' then
+      begin
+        Text := DrawColumn.Title.Caption;
+        TXColumn(DrawColumn).TitleCaption := Text; // prima assegnazione della caption originale
+      end;
+
+      if (StrRicercaIncrementale <> '') and (SelectedIndex = ACol) then
+        Text := '[' + StrRicercaIncrementale + '] '+Text;
+
+      DrawColumn.Title.Caption := TruncStringInRect(Canvas, ARect, Text, 2) ;
+    end;
+    //--ale
+
   finally
     Inc(ACol, IndicatorOffset);
   end;
@@ -1619,6 +1672,9 @@ procedure TLabeledDbGrid.SetOnBkCellColorAssign(const Value: TCBBkCellColorAssig
 procedure TLabeledDbGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
   Y: Integer);
 begin
+  FTitleMouseDown := (Button = mbLeft) and (Shift = [ssLeft])
+         and isMouseOverTitleColumn(X,Y) and not Sizing(X,Y);
+
   inherited;
   if (Button = mbLeft) and (Shift = [ssLeft]) then
   begin
@@ -2135,12 +2191,67 @@ procedure TLabeledDbGrid.doIncrementalSearch(Key: Char);
   FSearchTimer.Enabled := True;
 end;
 
+procedure TLabeledDbGrid.doIncrementalFilter;
+var
+  IntValue: Integer;
+  DateValue: TDateTime;
+begin
+  FSearchTimer.Enabled := False;
+
+  if (DataSource = nil) or (Datasource.DataSet = nil) or (SelectedField = nil) then
+    Exit;
+
+  Datasource.DataSet.Filtered := False;
+
+  if StrRicercaIncrementale = '' then
+    Datasource.DataSet.Filter := ''
+  else
+  begin
+    Screen.Cursor := crHourGlass;
+    Try
+      if SelectedField.InheritsFrom(TNumericField) then
+      begin
+        if TryStrToInt(StrRicercaIncrementale, IntValue) then
+          Datasource.DataSet.Filter := SelectedField.FieldName + '='+ IntValue.ToString;
+      end
+      else if SelectedField.InheritsFrom(TDateField) then
+      begin
+        if TryStrToDateTime(StrRicercaIncrementale, DateValue) then
+          Datasource.DataSet.Filter := SelectedField.FieldName + '='+ QuotedStr(DateToStr(DateValue));
+      end
+      else if SelectedField.InheritsFrom(TDateTimeField) or SelectedField.InheritsFrom(TSQLTimeStampField) then
+      begin
+        if TryStrToDateTime(StrRicercaIncrementale, DateValue) then
+          Datasource.DataSet.Filter := SelectedField.FieldName + '>='+ QuotedStr(DateTimeToStr(DateValue));
+      end
+      else
+        Datasource.DataSet.Filter := SelectedField.FieldName+ ' like ' +QuotedStr('%'+StrRicercaIncrementale+'%');
+
+      Datasource.DataSet.Filtered := True;
+    Finally
+      Screen.Cursor := crDefault;
+    End;
+  end;
+end;
+
+procedure TLabeledDbGrid.ClearFilters;
+begin
+  ChangeStrSearch('');
+  OnSearchTimer(self);
+end;
+
+
+
 procedure TLabeledDbGrid.doIncrementalLocate;
 var
   IntValue: Integer;
   DateValue: TDateTime;
 begin
   FSearchTimer.Enabled := False;
+
+  if (DataSource = nil) or (Datasource.DataSet = nil) or (SelectedField = nil) then
+    Exit;
+
   if StrRicercaIncrementale <> '' then
   begin
     Screen.Cursor := crHourGlass;
@@ -2308,6 +2419,13 @@ procedure TLabeledDbGrid.MouseMove(Shift: TShiftState; X, Y: Integer);
   end;
 end;
 
+procedure TLabeledDbGrid.MouseUp(Button: TMouseButton; Shift: TShiftState;
+  X, Y: Integer);
+begin
+  FTitleMouseDown := False;
+  inherited;
+end;
+
 procedure TLabeledDbGrid.SetCheckBoxedFields(const Value: string);
 begin
   if FCheckBoxedFields <> Value then
@@ -2318,7 +2436,10 @@ procedure TLabeledDbGrid.SetCheckBoxedFields(const Value: string);
 
 procedure TLabeledDbGrid.OnSearchTimer(Sender: TObject);
 begin
-  doIncrementalLocate;
+  case FIncrementalSearchType of
+    stBeginsWith: doIncrementalLocate;
+    stFilterBy  : doIncrementalFilter;
+  end;
 end;
 
 procedure TLabeledDbGrid.SetIncrementalSearchDelay(const Value: integer);
@@ -2373,6 +2494,23 @@ function TLabeledDbGrid.ChangeColumnFieldName(const OldFieldName,
     Column.FieldName := NewFieldName;
 end;
 
+
+type
+  THackCustomGrid = class(TCustomGrid)
+  public
+    property Options;
+  end;
+
+procedure TLabeledDbGrid.SetColMoving(const Value: Boolean);
+begin
+  FColMoving := Value;
+  with THackCustomGrid(Self) do
+  if Value then
+    Options := Options + [goColMoving]
+  else
+    Options := Options - [goColMoving];
+end;
+
 { TLabeledDBLabel }
 
 constructor TLabeledDBLabel.Create(AOwner: TComponent);