Skip to content

Commit

Permalink
Merge branch 'main' of https://github.com/EtheaDev/DBAwareLabeledComp…
Browse files Browse the repository at this point in the history 
…onents
  • Loading branch information
@carloBarazzetta
carloBarazzetta committed Aug 21, 2023
2 parents 6163efb + 84468b1 commit af3c342
Showing 1 changed file with 139 additions and 1 deletion.
140 changes: 139 additions & 1 deletion Source/Vcl.LabeledDBCtrls.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand All @@ -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);
Expand All @@ -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);
Expand All @@ -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;
Expand All @@ -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);
Expand All @@ -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;
Expand All @@ -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);
Expand All @@ -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;
Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -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
Expand All @@ -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;
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -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
Expand All @@ -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);
Expand Down Expand Up @@ -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);
Expand Down

0 comments on commit af3c342

Please sign in to comment.