Skip to content

Commit 84468b1

Browse files
Merge pull request #3 from bruzzoneale/bruzzoneale_2023-06
Bruzzoneale 2023 06 - Thank you for your contributor
2 parents 452bd3a + b15f9a7 commit 84468b1

File tree

1 file changed

+139
-1
lines changed

1 file changed

+139
-1
lines changed

Source/Vcl.LabeledDBCtrls.pas

Lines changed: 139 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -297,6 +297,8 @@ TLabeledDbGrid = class;
297297
TCBCheckBoxedColumnEvent = procedure (Column: TColumn; var IsCheckBoxedColumn: Boolean) of object;
298298
TColumnNotifyEvent = procedure (Column: TColumn) of object;
299299

300+
TGridIncrementalSearchType = (stBeginsWith, stFilterBy);
301+
300302
TLabeledDbGrid = class(TDBGrid)
301303
private
302304
FBoundLabel: TControlBoundLabel;
@@ -320,6 +322,9 @@ TLabeledDbGrid = class(TDBGrid)
320322
FLinesPerRow: Integer;
321323
FRowMargin: Integer;
322324
FWrapAllText: Boolean;
325+
FColMoving: Boolean;
326+
FTitleMouseDown: boolean;
327+
FIncrementalSearchType: TGridIncrementalSearchType;
323328
function TitleOffset: Integer;
324329
procedure OnSearchTimer(Sender : TObject);
325330
procedure SetBoundCaption(const Value: TCaption);
@@ -344,6 +349,7 @@ TLabeledDbGrid = class(TDBGrid)
344349
function isCheckBoxedField(Field: TField): boolean;
345350
function isUnsortableField(Field: TField): boolean;
346351
procedure doIncrementalLocate;
352+
procedure doIncrementalFilter;
347353
procedure SetIncrementalSearchDelay(const Value: integer);
348354
function GetIncrementalSearchDelay: integer;
349355
procedure SetDrawCheckBoxImages(const Value: Boolean);
@@ -358,6 +364,7 @@ TLabeledDbGrid = class(TDBGrid)
358364
const AField: TField; Const AColumn: TColumn);
359365
function CalcRowMargin(const ARect: TRect): Integer;
360366
procedure SetWrapAllText(const Value: Boolean);
367+
procedure SetColMoving(const Value: Boolean);
361368
protected
362369
procedure SetParent(AParent: TWinControl); override;
363370
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
@@ -379,12 +386,17 @@ TLabeledDbGrid = class(TDBGrid)
379386
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
380387
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
381388
X, Y: Integer); override;
389+
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override;
390+
382391
function GetBorderStyle: TBorderStyle;
383392
{$IF DEFINE DXE8+}
384393
procedure ChangeScale(M, D: Integer; isDpiChange: Boolean); override;
385394
{$ELSE}
386395
procedure ChangeScale(M, D: Integer); override;
387396
{$ENDIF}
397+
398+
function CreateColumns: TDBGridColumns; override;
399+
388400
public
389401
procedure DefaultDrawColumnCell(const Rect: TRect; DataCol: Integer;
390402
Column: TColumn; State: TGridDrawState);
@@ -408,6 +420,8 @@ TLabeledDbGrid = class(TDBGrid)
408420
function ColumnIndexByFieldName(const AFieldName: string): Integer;
409421
function GetMouseOverField(X, Y: Integer): TField;
410422
function GetDefaultRowHeight: Integer;
423+
procedure ClearFilters;
424+
411425
published
412426
property TitleFont: TFont read GetTitleFont write SetTitleFont stored False;
413427
property IsEmpty: Boolean read GetIsEmpty;
@@ -431,6 +445,8 @@ TLabeledDbGrid = class(TDBGrid)
431445
property CanEditColumn: TCBCanEditColumn read FCanEditColumn write FCanEditColumn;
432446
property RowMargin: Integer read FRowMargin write SetRowMargin default 0;
433447
property WrapAllText: Boolean read FWrapAllText write SetWrapAllText default False;
448+
property ColMoving: Boolean read FColMoving write SetColMoving default True;
449+
property IncrementalSearchType: TGridIncrementalSearchType read FIncrementalSearchType write FIncrementalSearchType default stBeginsWith;
434450
end;
435451

436452
TNavInsMode = (imInsert, imAppend);
@@ -449,6 +465,14 @@ implementation
449465
DBActns, UxTheme, UITypes,
450466
//Labeled components
451467
Vcl.DbAwareLabeledUtils, Vcl.LabeledCtrls;
468+
469+
type
470+
TXColumn = class(TColumn)
471+
private
472+
FTitleCaption: string;
473+
public
474+
property TitleCaption: string read FTitleCaption write FTitleCaption;
475+
end;
452476

453477
var
454478
DbGridPrintSupport: TStringList;
@@ -1199,10 +1223,17 @@ constructor TLabeledDbGrid.Create(AOwner: TComponent);
11991223
FDrawCheckBoxImages := True;
12001224
FShowSortOrder := True;
12011225
FIncrementalSearch := False;
1226+
FIncrementalSearchType := stBeginsWith;
12021227
FSearchTimer := TTimer.Create(nil);
12031228
FSearchTimer.Interval := INCREMENTAL_DELAY_DEFAULT;
12041229
FSearchTimer.Enabled := False;
12051230
FSearchTimer.OnTimer := OnSearchTimer;
1231+
FColMoving := True;
1232+
end;
1233+
1234+
function TLabeledDbGrid.CreateColumns: TDBGridColumns;
1235+
begin
1236+
Result := TDBGridColumns.Create(Self, TXColumn)
12061237
end;
12071238

12081239
procedure TLabeledDbGrid.VisibleChanging;
@@ -1337,6 +1368,8 @@ procedure TLabeledDbGrid.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGr
13371368
SortOrder: TCBSortOrder;
13381369
LRect: TRect;
13391370
LDataLinkActive: Boolean;
1371+
1372+
Text: string;
13401373
begin
13411374
dxGridSortedShapeMinWidth := ARect.Bottom - ARect.Top; //16
13421375
//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
13511384
FDrawingCurrentRecord := True
13521385
else
13531386
FDrawingCurrentRecord := False;
1387+
1388+
// artifizio per avere i puntini di sospensione anche in caso di troncatura del testo sul titolo
1389+
if not FTitleMouseDown and (gdFixed in AState) and (ACol > 0) and not(csDesigning in ComponentState) then
1390+
begin
1391+
DrawColumn := Columns[ACol];
1392+
Text := TXColumn(DrawColumn).TitleCaption;
1393+
1394+
if Text = '' then
1395+
begin
1396+
Text := DrawColumn.Title.Caption;
1397+
TXColumn(DrawColumn).TitleCaption := Text; // prima assegnazione della caption originale
1398+
end;
1399+
1400+
if (StrRicercaIncrementale <> '') and (SelectedIndex = ACol) then
1401+
Text := '[' + StrRicercaIncrementale + '] '+Text;
1402+
1403+
DrawColumn.Title.Caption := TruncStringInRect(Canvas, ARect, Text, 2) ;
1404+
end;
1405+
//--ale
1406+
13541407
finally
13551408
Inc(ACol, IndicatorOffset);
13561409
end;
@@ -1619,6 +1672,9 @@ procedure TLabeledDbGrid.SetOnBkCellColorAssign(const Value: TCBBkCellColorAssig
16191672
procedure TLabeledDbGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
16201673
Y: Integer);
16211674
begin
1675+
FTitleMouseDown := (Button = mbLeft) and (Shift = [ssLeft])
1676+
and isMouseOverTitleColumn(X,Y) and not Sizing(X,Y);
1677+
16221678
inherited;
16231679
if (Button = mbLeft) and (Shift = [ssLeft]) then
16241680
begin
@@ -2132,12 +2188,67 @@ procedure TLabeledDbGrid.doIncrementalSearch(Key: Char);
21322188
FSearchTimer.Enabled := True;
21332189
end;
21342190

2191+
procedure TLabeledDbGrid.doIncrementalFilter;
2192+
var
2193+
IntValue: Integer;
2194+
DateValue: TDateTime;
2195+
begin
2196+
FSearchTimer.Enabled := False;
2197+
2198+
if (DataSource = nil) or (Datasource.DataSet = nil) or (SelectedField = nil) then
2199+
Exit;
2200+
2201+
Datasource.DataSet.Filtered := False;
2202+
2203+
if StrRicercaIncrementale = '' then
2204+
Datasource.DataSet.Filter := ''
2205+
else
2206+
begin
2207+
Screen.Cursor := crHourGlass;
2208+
Try
2209+
if SelectedField.InheritsFrom(TNumericField) then
2210+
begin
2211+
if TryStrToInt(StrRicercaIncrementale, IntValue) then
2212+
Datasource.DataSet.Filter := SelectedField.FieldName + '='+ IntValue.ToString;
2213+
end
2214+
else if SelectedField.InheritsFrom(TDateField) then
2215+
begin
2216+
if TryStrToDateTime(StrRicercaIncrementale, DateValue) then
2217+
Datasource.DataSet.Filter := SelectedField.FieldName + '='+ QuotedStr(DateToStr(DateValue));
2218+
end
2219+
else if SelectedField.InheritsFrom(TDateTimeField) or SelectedField.InheritsFrom(TSQLTimeStampField) then
2220+
begin
2221+
if TryStrToDateTime(StrRicercaIncrementale, DateValue) then
2222+
Datasource.DataSet.Filter := SelectedField.FieldName + '>='+ QuotedStr(DateTimeToStr(DateValue));
2223+
end
2224+
else
2225+
Datasource.DataSet.Filter := SelectedField.FieldName+ ' like ' +QuotedStr('%'+StrRicercaIncrementale+'%');
2226+
2227+
Datasource.DataSet.Filtered := True;
2228+
Finally
2229+
Screen.Cursor := crDefault;
2230+
End;
2231+
end;
2232+
end;
2233+
2234+
procedure TLabeledDbGrid.ClearFilters;
2235+
begin
2236+
ChangeStrSearch('');
2237+
OnSearchTimer(self);
2238+
end;
2239+
2240+
2241+
21352242
procedure TLabeledDbGrid.doIncrementalLocate;
21362243
var
21372244
IntValue: Integer;
21382245
DateValue: TDateTime;
21392246
begin
21402247
FSearchTimer.Enabled := False;
2248+
2249+
if (DataSource = nil) or (Datasource.DataSet = nil) or (SelectedField = nil) then
2250+
Exit;
2251+
21412252
if StrRicercaIncrementale <> '' then
21422253
begin
21432254
Screen.Cursor := crHourGlass;
@@ -2305,6 +2416,13 @@ procedure TLabeledDbGrid.MouseMove(Shift: TShiftState; X, Y: Integer);
23052416
end;
23062417
end;
23072418

2419+
procedure TLabeledDbGrid.MouseUp(Button: TMouseButton; Shift: TShiftState;
2420+
X, Y: Integer);
2421+
begin
2422+
FTitleMouseDown := False;
2423+
inherited;
2424+
end;
2425+
23082426
procedure TLabeledDbGrid.SetCheckBoxedFields(const Value: string);
23092427
begin
23102428
if FCheckBoxedFields <> Value then
@@ -2315,7 +2433,10 @@ procedure TLabeledDbGrid.SetCheckBoxedFields(const Value: string);
23152433

23162434
procedure TLabeledDbGrid.OnSearchTimer(Sender: TObject);
23172435
begin
2318-
doIncrementalLocate;
2436+
case FIncrementalSearchType of
2437+
stBeginsWith: doIncrementalLocate;
2438+
stFilterBy : doIncrementalFilter;
2439+
end;
23192440
end;
23202441

23212442
procedure TLabeledDbGrid.SetIncrementalSearchDelay(const Value: integer);
@@ -2370,6 +2491,23 @@ function TLabeledDbGrid.ChangeColumnFieldName(const OldFieldName,
23702491
Column.FieldName := NewFieldName;
23712492
end;
23722493

2494+
2495+
type
2496+
THackCustomGrid = class(TCustomGrid)
2497+
public
2498+
property Options;
2499+
end;
2500+
2501+
procedure TLabeledDbGrid.SetColMoving(const Value: Boolean);
2502+
begin
2503+
FColMoving := Value;
2504+
with THackCustomGrid(Self) do
2505+
if Value then
2506+
Options := Options + [goColMoving]
2507+
else
2508+
Options := Options - [goColMoving];
2509+
end;
2510+
23732511
{ TLabeledDBLabel }
23742512

23752513
constructor TLabeledDBLabel.Create(AOwner: TComponent);

0 commit comments

Comments
 (0)