Discussion :

[Invité]

Bonjour,

je possède les Grids TMS mais je les trouve mal adaptées à ce dont j'ai besoin (i.e. trop lourdes car mal documentées au niveau de mes besoins) .

En Lazarus, j'obtiens ceci à partir de la dbGrid native :
Pièce jointe 468641

J'ai besoin :

1. de pouvoir 'stretcher' la colonne de mon choix (pas forcément la dernière comme ici), les tailles des autres colonnes étant automatiquement ajustées (sauf [pt 4] les ftMemo qui bénéficient d'un traitement particulier).
2. d'indiquer graphiquement le tri engagé et son sens, sachant que je définis les colonnes triables dans mon composant
3. de laisser la possibilité de chercher dans certaines colonnes (également définies dans le composant) en intégrant un TEdit dans l'entête
4. et même si cela ne figure pas sur le dessin, d'intègrer également la possibilité d'adapter la taille des cellules au multiligne à partir d'un vieux code que j'avais élaboré il y a quelques années.

Sergio ayant montré la voie pour fabriquer des composants (VCL ne m'intéresse pas), j'aimerais réaliser l'identique sous Delphi FMX et malheureusement compte tenu de la structure adoptée par les TGrids, je ne vois pas comment aborder le problème.
En Lazarus, l'interface ressemble à cela :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
unit lzDbGrid;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, LResources, Graphics,
  Grids, DBGrids, DB {TBookMark, TField}, Math {Max}, LCLProc {FreeThenNil},
  Controls {Controls},
  LCLintf {CellToRect},
  StdCtrls {TEdit},
  Forms {Application.xxx},
  uni;
 
type
  { TGridHelper }
  TGridHelper = class helper for TDBGrid
    function GetIndexOfColumnByName(const aName: string;
      bVisible: boolean = False): integer;
    function GetAutoColumnWidth(aIndex: integer): integer;
  end;
 
  TlzCustomDbGrid = class(TCustomDbGrid);
 
  { TDbGrid }
  TlzDbGrid = class(TDbGrid)
  private
    { Private declarations }
    FImageSort: TBitmap;
    FImageSortAsc: TBitmap;
    FImageSortDesc: TBitmap;
    FImageSearch: TBitmap;
    FBmp: TBitmap;
    FImageRefresh: TBitmap;
    FSelectedFont: TFont;
    FStretchColumnFieldname: string;
    FColumnToStretchIndex: integer;
    FColumnToStretchWidth: integer;
    FSortedColumnsFieldName: string;
    slSortedColumns: TStringList;
    FSearchedColumnsFieldName: string;
    slSearchedColumns: TStringList;
    bRect: TRect;
    edSEARCH: TEdit;
    //Events
    FOnTitleClick: TDBGridClickEvent;
    //Methods Events
    procedure SelfOnTitleClick(Sender: TColumn);
    //Methods
    procedure SetImageSort(Value: TBitmap);
    procedure SetImageSortAsc(Value: TBitmap);
    procedure SetImageSortDesc(Value: TBitmap);
    procedure SetImageSearch(Value: TBitmap);
    procedure SetImageRefresh(Value: TBitmap);
    procedure SetSelectedFont(const Value: TFont);
    procedure SetStretchColumnFieldname(Value: string);
    procedure edSEARCHcharge(aRect: TRect);
    procedure edSEARCHChange(Sender: TObject);
    function CellToRect(): TRect;
    procedure SetSortedColumnsFieldName(Value: string);
    procedure SetSearchedColumnsFieldName(Value: string);
    procedure Split(const Delimiter: char; Input: string; const Strings: TStrings);
 
  protected
    { Protected declarations }
    procedure DrawCell(aCol, aRow: integer; aRect: TRect; aState: TGridDrawState);
      override;
    procedure DoPrepareCanvas(aCol, aRow: integer; aState: TGridDrawState); override;
    procedure HeaderSized(IsColumn: boolean; index: integer); override;
    procedure Resize; override;
    procedure Loaded; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: integer); override;
    function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): boolean; override;
    function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): boolean; override;
    procedure KeyDown(var Key: word; Shift: TShiftState); override;
    procedure MouseMove(Shift: TShiftState; X, Y: integer); override;
    procedure SetColumnToStretchWidth;
 
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    property SelectedColor;
    property ImageSort: TBitmap read FImageSort write SetImageSort;
    property ImageSortAsc: TBitmap read FImageSortAsc write SetImageSortAsc;
    property ImageSortDesc: TBitmap read FImageSortDesc write SetImageSortDesc;
    property ImageSearch: TBitmap read FImageSearch write SetImageSearch;
    property ImageRefresh: TBitmap read FImageRefresh write SetImageRefresh;
    property StretchColumnFieldname: string
      read FStretchColumnFieldname write SetStretchColumnFieldname;
    property SelectedFont: TFont read FSelectedFont write SetSelectedFont;
    property SortedColumnsFieldname: string
      read FSortedColumnsFieldname write SetSortedColumnsFieldname;
    property SearchedColumnsFieldname: string
      read FSearchedColumnsFieldname write SetSearchedColumnsFieldname;
    //Events
    property OnTitleClick: TDBGridClickEvent read FOnTitleClick write FOnTitleClick;
    //Methods
    procedure Paint; override;
  end;

Cela me paraît relativement simple parce que la notion de cells est directement implémentée dans la TDBGrid. Mais avec la TGrid de Delphi, il en est tout autrement.

Quelqu'un pourrait-il m'orienter vers le début d'une approche FMX ?

Merci. Cordialement. Gilles