IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Delphi Discussion :

Coordonnées d'une cellule d'une DBGrid


Sujet :

Delphi

  1. #1
    Membre confirmé
    Avatar de JP.NUAGE
    Profil pro
    Inscrit en
    Avril 2006
    Messages
    769
    Détails du profil
    Informations personnelles :
    Âge : 81
    Localisation : France

    Informations forums :
    Inscription : Avril 2006
    Messages : 769
    Points : 542
    Points
    542
    Par défaut Coordonnées d'une cellule d'une DBGrid
    Bonjour à tous

    Une souris, cela peut tomber par terre et en panne ! Pour ne pas bloquer l'utilisation du programme, je voudrais créer une fonction qui, dans une grille, en donnant la ligne et le nom de la cellule, simule un double clic.
    J'ai la fonction qui simule le doucle clic : SimuleClicSouris. Elle fonctionne bien si je donne en dur les coordonnées d'une cellule. En revanche, je n'arrive pas à récupérer ces coordonnées si je donne le nom de la cellule.

    Voici le code de la fonction de recherche. La ligne est déjà sélectionnée.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    DBGrid.SelectedField := 'CELLULE_A_MODIFIER';
     
    TABLE.Edit;
     
    CoordonneesCelluleActive.Right:=DBGrid.Columns[DBGrid.SelectedIndex].Grid.ClientRect.Right;
    CoordonneesCelluleActive.Bottom:=DBGrid.Columns[DBGrid.SelectedIndex].Grid.ClientRect.Bottom;
     
    SimuleClickSouris(CoordonneesCelluleActive.Right-3,CoordonneesCelluleActive.Bottom-3);
     
    SimuleClickSouris(CoordonneesCelluleActive.Right-3,CoordonneesCelluleActive.Bottom-3);
    J'ai contrôlé que la cellule est bien sélectionnée. Visuellement, le curseur est dessus. En revanche, le double clic ne se fait pas.
    Si je donne en dur CoordonneesCelluleActive.Right et CoordonneesCelluleActive.Bottom (par exemple 400 et 600), le double clic se fait bien sur la cellule qui a ces coordonnées. Or moi, c'est en "mou" que je voudrais que cela fonctionne. Qu'ai-je loupé ?
    Ce qui se conçoit bien s'énonce clairement
    Et les mots pour le dire viennent aisément (Boileau)

  2. #2
    Rédacteur/Modérateur

    Avatar de SergioMaster
    Homme Profil pro
    Développeur informatique retraité
    Inscrit en
    Janvier 2007
    Messages
    15 042
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 67
    Localisation : France, Loire Atlantique (Pays de la Loire)

    Informations professionnelles :
    Activité : Développeur informatique retraité
    Secteur : Industrie

    Informations forums :
    Inscription : Janvier 2007
    Messages : 15 042
    Points : 40 955
    Points
    40 955
    Billets dans le blog
    62
    Par défaut
    Bonjour le revenant,

    partant de ta signature sur le forum, ne serait-il pas plus simple de racheter une souris
    plus sérieusement de simplement indiquer la cellule (col et row) ?
    bien sûr TDBGrid ne permet pas d'y accéder mais une simple petite astuce et c'est chose faite :


    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
     
    // essais 
    ..
    type 
      TMyGrid = Class(TDBGrid)   
      private
         function GetColumnByFieldName(Sender : TDBGrid;F : String) : Integer;
       end;
     
      TForm1 = class(TForm) 
        dbgrd1 : TDBGrid;
        .....
     
    implementation
     
    // se positionner sur la colonne 3
    //with TMyGrid(dbgrid1) do 
    //   begin
    //      col:=3;     
    //   end;
     
    // se positionner comme c'est un test c'est bien évidemment via un autre click :ptdr: 
    procedure TForm1.btn3Click(Sender: TObject);
    begin
    with TMyGrid(dbgrd1) do
     begin
       col:=GetColumnByFieldName(dbgrd1,'LIBELLE_APPOSE');
       if Col>0 then begin
         dbgrd1.SetFocus;  // se focalise 
         dbgrd1DblClick(Sender); // fait ce que ferait le doubleclick
       end;
     end;
    end;
     
    // faire quelque chose avec le dblclick 
    procedure TForm1.dbgrd1DblClick(Sender: TObject);
    begin
    with TMyGrid(dbgrd1) do
     begin
       ShowMessage(DbGrd1.SelectedField.FieldName);   // c'est bien la colonne 'LIBELLE_APPOSE' qui est "focalisée"
     end;
    end;
     
    { TMyGrid }
    // obtenir la colonne en fonction du nom du champ
    function TMyGrid.GetColumnByFieldName(Sender : TDBGrid;F: String): Integer;
    var i : integer;
    begin
      result:=-1;
      for i:=0 to Sender.Columns.Count-1 do
        begin
          if CompareStr(Sender.Columns[i].FieldName,F)=0 then
           begin
             result:=i+1;
             Exit;
           end;
        end;
    end;
    P.S. fait à la va vite donc certainement simplifiable
    Serge
    MVP Embarcadero
    Delphi installés : D3,D7,D2010,XE4,XE7,D10 (Rio, Sidney), D11 (Alexandria), D12 (Athènes)
    SGBD : Firebird 2.5, 3, SQLite
    générateurs États : FastReport, Rave, QuickReport
    OS : Window Vista, Windows 10, Windows 11, Ubuntu, Androïd

  3. #3
    Rédacteur/Modérateur

    Avatar de SergioMaster
    Homme Profil pro
    Développeur informatique retraité
    Inscrit en
    Janvier 2007
    Messages
    15 042
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 67
    Localisation : France, Loire Atlantique (Pays de la Loire)

    Informations professionnelles :
    Activité : Développeur informatique retraité
    Secteur : Industrie

    Informations forums :
    Inscription : Janvier 2007
    Messages : 15 042
    Points : 40 955
    Points
    40 955
    Billets dans le blog
    62
    Par défaut pour les coordonnées
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    procedure TForm1.dbgrd1DblClick(Sender: TObject);
    begin
    with TMyGrid(dbgrd1) do
     begin
       ShowMessage(Format('Top %d right %d',[CellRect(col,row).Top,CellRect(Col,Row).Right]));
     end;
    end;
    MVP Embarcadero
    Delphi installés : D3,D7,D2010,XE4,XE7,D10 (Rio, Sidney), D11 (Alexandria), D12 (Athènes)
    SGBD : Firebird 2.5, 3, SQLite
    générateurs États : FastReport, Rave, QuickReport
    OS : Window Vista, Windows 10, Windows 11, Ubuntu, Androïd

  4. #4
    Expert éminent sénior
    Avatar de ShaiLeTroll
    Homme Profil pro
    Développeur C++\Delphi
    Inscrit en
    Juillet 2006
    Messages
    13 459
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : France, Seine Saint Denis (Île de France)

    Informations professionnelles :
    Activité : Développeur C++\Delphi
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Juillet 2006
    Messages : 13 459
    Points : 24 873
    Points
    24 873
    Par défaut
    Pour les manipulations du DBGrid, je me suis fait une classe en D7 en m'inspirant du concept des Assistant du C# tout nouveau à l'époque

    HitOnEllipsisButton devrait t'intéresser, je dessine un bouton "..." permanent contrairement à celui de la DBGrid qui n'apparait que lorsque l'on clic et je l'utilise aussi en mettant la grille en ReadOnly et n'avoir QUE mes propres "inplace editor"
    Je dois donc à l'inverse de toi, savoir si l'on clic sur le bouton

    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
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
    270
    271
    272
    273
    274
    275
    276
    277
    278
    279
    280
    281
    282
    283
    284
    285
    286
    287
    288
    289
    290
    291
    292
    293
    294
    295
    296
    297
    298
    299
    300
    301
    302
    303
    304
    305
    306
    307
    308
    309
    310
    311
    312
    313
    314
    315
    316
    317
    318
    319
    320
    321
    322
    323
    324
    325
    326
    327
    328
    329
    330
    331
    332
    333
    334
    335
    336
    337
    338
    339
    340
    341
    342
    343
    344
    345
    346
    347
    348
    349
    350
    351
    352
    353
    354
    355
    356
    357
    358
    359
    360
    361
    362
    363
    364
    365
    366
    367
    368
    369
    370
    371
    372
    373
    374
    375
    376
    377
    378
    379
    380
    381
    382
    383
    384
    385
    386
    387
    388
    389
    390
    391
    392
    393
    394
    395
    396
    397
    398
    399
    400
    401
    402
    403
    404
    405
    406
    407
    408
    409
    410
    411
    412
    413
    414
    415
    416
    417
    418
    419
    420
    421
    422
    423
    424
    425
    426
    427
    428
    429
    430
    431
    432
    433
    434
    435
    436
    437
    438
    439
    440
    441
    442
    443
    444
    445
    446
    447
    448
    449
    450
    451
    452
    453
    454
    455
    456
    457
    458
    459
    460
    461
    462
    463
    464
    465
    466
    467
    468
    469
    470
    471
    472
    473
    474
    475
    476
    477
    478
    479
    480
    481
    482
    483
    484
    485
    486
    487
    488
    489
    490
    491
    492
    493
    494
    495
    496
    497
    498
    499
    500
    501
    502
    503
    504
    505
    506
    507
    508
    509
    510
    511
    512
    513
    514
    515
    516
    517
    518
    519
    520
    521
    522
    523
    524
    525
    526
    527
    528
    529
    530
    531
    532
    533
    534
    535
    536
    537
    538
    539
    540
    541
    542
    543
    544
    545
    546
    547
    548
    549
    550
    551
    552
    553
    554
    555
    556
    557
    558
    559
    560
    561
    562
    563
    564
    565
    566
    567
    568
    569
    570
    571
    572
    573
    574
    575
    576
    577
    578
    579
    580
    581
    582
    583
    584
    585
    586
    587
    588
    589
    590
    591
    592
    593
    594
    595
    596
    597
    598
    599
    600
    601
    602
    603
    604
    605
    606
    607
    608
    609
    610
    611
    612
    613
    614
    615
    616
    617
    618
    619
    620
    621
    622
    623
    624
    625
    626
    627
    628
    629
    630
    631
    632
    633
    634
    635
    636
    637
    638
    639
    640
    641
    642
    643
    644
    645
    646
    647
    648
    649
    650
    651
    652
    653
    654
    655
    656
    657
    658
    659
    660
    661
    662
    663
    664
    665
    666
    667
    668
    669
    670
    671
    672
    673
    674
    675
    676
    677
    678
    679
    680
    681
    682
    683
    684
    685
    686
    687
    688
    689
    690
    691
    692
    693
    694
    695
    696
    697
    698
    699
    700
    701
    702
    703
    704
    705
    706
    707
    708
    709
    710
    711
    712
    713
    714
    715
    716
    717
    718
    719
    720
    721
    722
    723
    724
    725
    726
    727
    728
    729
    730
    731
    732
    733
    734
    735
    736
    737
    738
    739
    740
    741
    742
    743
    744
    745
    746
    747
    748
    749
    750
    751
    752
    753
    754
    755
    756
    757
    758
    759
    760
    761
    762
    //------------------------------------------------------------------------------
    (*                SoLuTions is an Versatile Library for Delphi                 -
     *                                                                             -
     *  Version alternative publiée sur "www.developpez.net"                       -
     *  Post : "Glyph, bmp ou autre dans Title DBGrid "                            -
     *  Post Number : 4016213                                                      -
     *  Post URL = "http://www.developpez.net/forums/d687339/environnements-developpement/delphi/composants-vcl/glyph-bmp-title-dbgrid/#post4016213"
     *                                                                             -
     *  Copyright "SLT Solutions", (©2006)                                         -
     *  contributeur : ShaiLeTroll (2007) - Passage en Classe d'un code procédural -
     *  contributeur : ShaiLeTroll (2012) - Renommage Fichier et Correction XE2    -
     *  contributeur : ShaiLeTroll (2012) - Gestion des Styles sous C++BuilderXE2  -
     *  contributeur : ShaiLeTroll (2012) - Documentation Insight                  -
     *  contributeur : ShaiLeTroll (2014) - Traduction du code C++Builder vers DelphiXE2
     *                                                                             -
     *                                                                             -
     * Ce logiciel est un programme informatique servant à aider les développeurs  -
     * Delphi avec une bibliothèque polyvalente, adaptable et fragmentable.        -
     *                                                                             -
     * Ce logiciel est régi par la licence CeCILL-C soumise au droit français et   -
     * respectant les principes de diffusion des logiciels libres. Vous pouvez     -
     * utiliser, modifier et/ou redistribuer ce programme sous les conditions      -
     * de la licence CeCILL-C telle que diffusée par le CEA, le CNRS et l'INRIA    -
     * sur le site "http://www.cecill.info".                                       -
     *                                                                             -
     * En contrepartie de l'accessibilité au code source et des droits de copie,   -
     * de modification et de redistribution accordés par cette licence, il n'est   -
     * offert aux utilisateurs qu'une garantie limitée.  Pour les mêmes raisons,   -
     * seule une responsabilité restreinte pèse sur l'auteur du programme,  le     -
     * titulaire des droits patrimoniaux et les concédants successifs.             -
     *                                                                             -
     * A cet égard  l'attention de l'utilisateur est attirée sur les risques       -
     * associés au chargement,  à l'utilisation,  à la modification et/ou au       -
     * développement et à la reproduction du logiciel par l'utilisateur étant      -
     * donné sa spécificité de logiciel libre, qui peut le rendre complexe à       -
     * manipuler et qui le réserve donc à des développeurs et des professionnels   -
     * avertis possédant  des  connaissances  informatiques approfondies.  Les     -
     * utilisateurs sont donc invités à charger  et  tester  l'adéquation  du      -
     * logiciel à leurs besoins dans des conditions permettant d'assurer la        -
     * sécurité de leurs systèmes et ou de leurs données et, plus généralement,    -
     * à l'utiliser et l'exploiter dans les mêmes conditions de sécurité.          -
     *                                                                             -
     * Le fait que vous puissiez accéder à cet en-tête signifie que vous avez      -
     * pris connaissance de la licence CeCILL-C, et que vous en avez accepté les   -
     * termes.                                                                     -
     *                                                                             -
     *----------------------------------------------------------------------------*)
    unit SLT.Controls.VCL.DBGridsEx;
     
    interface
     
    uses
      System.Classes, System.SysUtils, System.Types,
      Vcl.Controls, Vcl.Grids, Vcl.DBGrids, Vcl.Themes, Vcl.Graphics, Vcl.ExtCtrls,
      Data.DB,
      Winapi.Windows,
      SLT.Common.SystemEx;
     
    type
      /// <summary>Erreur liée à l'assistant TDBGridSLTAssistant de la classe TDBGrid</summary>
      EDBGridSLTAssistantError = class(Exception);
     
      /// <summary>Assistance de la classe TDBGrid </summary>
      /// <remarks>Le TDBGridSLTAssistant n'est pas un class helper car lors de sa création en 2002 sous Delphi 5, le code était procédural,
      /// lors de la refonte en classe en 2007 et 2012, les versions utilisées était Delphi 7 et C++Builder 2007 puis C++Builder XE2.
      /// <para>Reprise en Delphi XE2 (en 2014) en s'inspirant du concept des Assistances de classes (Class Helper) du Delphi
      /// tout en conservant une approche OO sous la forme d'une classe externe plus élégant et explicite que les véritables "class helper".</para></remarks>
      TDBGridSLTAssistant = class(TObject)
      public
        type
          TColumnSortDirection = (csdNone, csdAscending, csdDescending);
      strict private
        type
          TDBGridHack = class(TDBGrid);
      private
        // Accesseurs
        class function GetThemeUseColumnColor(): Boolean; static;
      private
        // Membres privés
        FDBGrid: TDBGrid;
     
        function GetColRowScreenRect(ACol, ARow: Longint): TRect;
      public
        // Constructeurs
        constructor Create(ADBGrid: TDBGrid); overload;
        constructor Create(Sender: TObject); overload;
     
        /// <summary>EditButtonInputDatePicker fournit un assistant d'implémentation d'un TDBGrid.OnEditButtonClick</summary>
        function EditButtonInputDatePicker(const Msg: string; AField: TField): Boolean;
     
        /// <summary>EditButtonInputCombo fournit un assistant d'implémentation d'un TDBGrid.OnCellClick gérant manuellement un d'Ellipis avec une grille en ReadOnly</summary>
        /// <param name="Msg">descriptif de la liste déroulante</param>
        /// <param name="APickList">Cela fourni la liste déroulante</param>
        /// <param name="APickListIndex">Cela fourni la valeur courante</param>
        /// <returns>Indique qu'élément a été selectionné dans la liste déroulante</returns>
        function ShowCombo(const Msg: string; APickList: TStrings; var APickListIndex: Integer): Boolean;
     
        /// <summary>DrawCheckBox fournit un assistant d'implémentation d'un TDBGrid.OnDrawColumnCell qui dessine une case à cocher centrée dans la zone définie par ARect</summary>
        /// <param name="ARect">Zone à dessiner</param>
        /// <param name="AChecked">Etat de la case à cocher</param>
        /// <param name="AEnabled">la case à cocher est-elle active</param>
        /// <param name="ABackgroundColor">Couleur de fond, clNone pour utiliser la couleur du thème</param>
        /// <param name="AState">Etat de la cellule d'une grille qui est en cours de restitution</param>
        procedure DrawCheckBox(const ARect: TRect; AChecked: Boolean; AEnabled: Boolean = True; ABackgroundColor: TColor = clNone; AState: TGridDrawState = []);
     
        /// <summary>DrawEllipsisButton fournit un assistant d'implémentation d'un TDBGrid.OnDrawColumnCell qui dessine un bouton '...' dans la zone définie par ARect</summary>
        /// <param name="ARect">Zone à dessiner, la taille et l'alignement sont calculés automatiquement</param>
        /// <param name="ABackgroundColor">Couleur de fond, clNone pour utiliser la couleur du thème</param>
        /// <param name="AColumn">La colonne dont l'on souhaite avoir un bouton '...'</param>
        /// <param name="AState">Etat de la cellule d'une grille qui est en cours de restitution</param>
        procedure DrawEllipsisButton(const ARect: TRect; ABackgroundColor: TColor = clNone; AColumn: TColumn = nil; AState: TGridDrawState = []);
     
        /// <summary>HitOnEllipsisButton fournit un assistant d'implémentation d'un TDBGrid.CellClick avec un bouton '...'</summary>
        /// <param name="AColumn">La colonne avec un bouton '...'</param>
        /// <returns>Indique que la souris est sur le bouton</returns>
        function HitOnEllipsisButton(AColumn: TColumn): Boolean;
     
        /// <summary>GetColumnScreenRect fournit un assistant d'implémentation d'un TDBGrid.OnCellClick qui donne la position et dimension de la cellule</summary>
        /// <param name="AColumn">La colonne dont l'on souhaite connaitre la position</param>
        /// <returns>la position du bouton en coordonnées écran de la grille TDBGrid possédant cette TColumn, ces coordonnées écran sont compatibles avec le curseur de la souris idéal pour la fonction PtInRects.</returns>
        function GetColumnScreenRect(const AColumn: TColumn): TRect;
     
        /// <summary>GetColumnTitleScreenRect fournit un assistant d'implémentation d'un TDBGrid.OnTitleClick qui donne la position et dimension du titre de la colonne</summary>
        /// <param name="AColumn">La colonne dont l'on souhaite connaitre la position du titre</param>
        /// <returns>la position du bouton en coordonnées écran de la grille TDBGrid possédant cette TColumn, ces coordonnées écran sont compatibles avec le curseur de la souris idéal pour la fonction PtInRects.</returns>
        function GetColumnTitleScreenRect(const AColumn: TColumn): TRect;
     
        /// <summary>GetEllipsisButtonRect fournit un assistant d'implémentation d'un TDBGrid.OnCellClick qui donne la position théorique d'un bouton '...'</summary>
        /// <param name="AColumn">La colonne dans lequel pourrait exister un bouton dît ellipse, la taille et l'alignement sont calculés automatiquement</param>
        /// <returns>la position du bouton en coordonnées écran de la grille TDBGrid possédant cette TColumn, ces coordonnées écran sont compatibles avec le curseur de la souris idéal pour la fonction PtInRects.</returns>
        function GetEllipsisButtonScreenRect(const AColumn: TColumn): TRect;
     
        /// <summary>HitOnTitle permet de déterminer si la souris est sur la ligne des titres de colonnes </summary>
        /// <param name="AColumn">La colonne sous la souris</param>
        /// <returns>Indique que la souris est sur la ligne des titres de colonnes</returns>
        function HitOnTitle(out AColumn: TColumn): Boolean;
     
        /// <summary>HitOnColumnCell permet de déterminer la colonne sous la souris en excluant la ligne des titres </summary>
        /// <param name="AColumn">La colonne sous la souris</param>
        /// <returns>Indique que la souris est dans une cellule de donnée</returns>
        function HitOnColumnCell(out AColumn: TColumn): Boolean;
     
        /// <summary>DrawTextWithBackgroundColor fournit un assistant d'implémentation d'un TDBGrid.OnDrawColumnCell qui dessine un texte et un fond coloré dans la zone définie par ARect</summary>
        /// <param name="ABackgroundColor">Couleur de fond, la couleur inverse sera utilisé pour le texte pour garantir le constrate</param>
        /// <param name="ARect">Zone à dessiner</param>
        /// <param name="AColumn">Indique la colonne concerné cela donne accès à la donnée via Field et aux informations tel que Alignment</param>
        /// <param name="AState">Le paramètre AState indique si la cellule a la focalisation et si la cellule est une cellule fixe de la partie immobile de la grille</param>
        procedure DrawTextWithBackgroundColor(ABackgroundColor: TColor; const ARect: TRect; AColumn: TColumn; AState: TGridDrawState);
     
        /// <summary>DrawColumnArrowSort fournit un assistant d'implémentation d'un TDBGrid.OnTitleClick qui gère le dessin d'une fleche marquant un tri sur une colonne</summary>
        /// <param name="AColumn">Indique la colonne concernée cela donne accès à la donnée via Field et aux informations tel que Title.Caption</param>
        /// <param name="ASortDirection">Sens du tri</param>
        procedure DrawColumnArrowSort(const AColumn: TColumn; ASortDirection: TColumnSortDirection);
     
        /// <summary>GetThemedBackgroundColor renvoie la couleur de fond d'une TDBGrid dans le thème actif</summary>
        function GetThemedBackgroundColor(): TColor;
     
        // Méthodes d'ergonomie
        procedure ZoomColumnTitleWidth(AZoomPourcent: Integer);
     
        // Propriétés
        property DBGrid: TDBGrid read FDBGrid;
      public
        class property ThemeUseColumnColor: Boolean read GetThemeUseColumnColor;
      end;
     
    implementation
     
    uses System.Math,
      SLT.Controls.VCL.DialogsEx, SLT.Controls.VCL.GraphicsEx, SLT.Common.TypesEx;
     
    const
      ERR_UNASSISTED_CLASS = 'La Classe d''Assistance %s ne prend pas en charge la classe %s mais la classe %s';
     
    { TDBGridSLTAssistant }
     
    //------------------------------------------------------------------------------
    constructor TDBGridSLTAssistant.Create(ADBGrid: TDBGrid);
    begin
      inherited Create();
     
      FDBGrid := ADBGrid;
    end;
     
    //------------------------------------------------------------------------------
    constructor TDBGridSLTAssistant.Create(Sender: TObject);
    begin
      inherited Create();
     
      if Assigned(Sender) then
      begin
        if Sender is TDBGrid then
          FDBGrid := TDBGrid(Sender)
        else
          raise EDBGridSLTAssistantError.CreateFmt(ERR_UNASSISTED_CLASS, [ClassName(), Sender.ClassName(), TDBGrid.ClassName()]);
      end
      else
        raise EDBGridSLTAssistantError.CreateFmt(ERR_UNASSISTED_CLASS, [ClassName(), '[nil]', TDBGrid.ClassName()])
    end;
     
    //------------------------------------------------------------------------------
    procedure TDBGridSLTAssistant.DrawCheckBox(const ARect: TRect; AChecked: Boolean; AEnabled: Boolean = True; ABackgroundColor: TColor = clNone; AState: TGridDrawState = []);
    const
      CSelected: array[TGridDrawingStyle] of TThemedGrid = (
        tgClassicCellSelected, tgCellSelected, tgGradientCellSelected);
    var
      uState: UINT;
      tbState: TThemedButton;
      Details: TThemedElementDetails;
      StyleColor: TColor;
      Buffer: Vcl.Graphics.TBitmap;
      BufferRect: TRect;
    begin
      if StyleServices.Enabled then
      begin
        // Un bug sur DrawElement d'un TThemedButton dans un DBGrid provoque sur les thèmes foncés une perte de la couleur de fond !
        // En attendant une meilleure solution, j'utilise un Buffer temporaire pour dessiner le ThemedButton CheckBox
        Buffer := Vcl.Graphics.TBitmap.Create();
        try
          BufferRect := Rect(0, 0, ARect.Width, ARect.Height);
          Buffer.SetSize(BufferRect.Width, BufferRect.Height);
     
          if ABackgroundColor = clNone then
          begin
            // On dessine un fond normal assurant normalement un bon constrate avec la CheckBox
            Details := StyleServices.GetElementDetails(tgCellNormal);
            StyleServices.GetElementColor(Details, ecFillColor, StyleColor);
          end
          else
            StyleColor := ABackgroundColor;
     
          // Même si la cellule est sélectionné, on laisse un fond neutre pour mieux voir la CheckBox
          // Force un fond opaque pour cacher le texte !
          Buffer.Canvas.Brush.Color := StyleColor;
          Buffer.Canvas.Brush.Style := bsSolid;
          Buffer.Canvas.FillRect(BufferRect);
     
          tbState := tbCheckBoxUncheckedNormal;
          if AChecked then
            tbState := tbCheckBoxCheckedNormal;
     
          if not AEnabled then
          begin
            if AChecked then
              tbState := tbCheckBoxCheckedDisabled
            else
              tbState := tbCheckBoxUncheckedDisabled;
          end;
     
          Details := StyleServices.GetElementDetails(tbState);
          StyleServices.DrawElement(Buffer.Canvas.Handle, Details, BufferRect, BufferRect);
          // Dessin final
          DBGrid.Canvas.Draw(ARect.Left, ARect.Top, Buffer);
        finally
          Buffer.Free();
        end;
      end
      else
      begin
        uState := DFCS_BUTTONCHECK;
        if AChecked then
          uState := uState or DFCS_CHECKED;
     
        if not AEnabled then
          uState := uState or DFCS_INACTIVE;
     
        DBGrid.Canvas.FillRect(ARect);
        DrawFrameControl(DBGrid.Canvas.Handle, ARect, DFC_BUTTON, uState);
      end;
    end;
     
    //------------------------------------------------------------------------------
    type
      TArrowImage = class(TPanel)
        FImage: TImage;
      public
        constructor Create(AOwner: TComponent); override;
      published
        property Image: TImage read FImage write FImage;
      end;
     
    //------------------------------------------------------------------------------
    constructor TArrowImage.Create(AOwner: TComponent);
    begin
      inherited Create(AOwner);
     
      if AOwner is TWinControl then begin
        Self.Parent := TWinControl(AOwner);
      end;
     
      Self.BevelInner := bvNone;
      Self.BevelOuter := bvNone;
      Self.AutoSize := True;
      Self.ParentColor := False;
      Self.ParentBackground := False;
      Self.Enabled := False;
      Self.Visible := False;
     
      FImage := TImage.Create(Self);
      FImage.Parent := Self;
      FImage.Transparent := False;
      FImage.AutoSize := True;
      FImage.Enabled := False;
    end;
     
    //------------------------------------------------------------------------------
    procedure TDBGridSLTAssistant.DrawColumnArrowSort(const AColumn: TColumn; ASortDirection: TColumnSortDirection);
     
      function GetArrow(): TArrowImage;
      var
        I: Integer;
      begin
        for I := 0 to DBGrid.ComponentCount - 1 do
          if DBGrid.Components[I] is TArrowImage then
            Exit(TArrowImage(DBGrid.Components[I]));
     
        Result := TArrowImage.Create(DBGrid);
      end;
     
    const
      CSelected: array[TGridDrawingStyle] of TThemedGrid = (
        tgClassicCellSelected, tgCellSelected, tgGradientCellSelected);
    var
      Buffer: Vcl.Graphics.TBitmap;
      AllowArrow: Boolean;
      ColumnRect: TRect;
      ColumnTopLeft: TPoint;
      ColumnTitle: string;
      BorderSizeX, BorderSizeY, ArrowSizeX, ArrowSizeY: Integer;
      TextWidth, ArrowPosition: Integer;
      BorderRect, ArrowRect: TRect;
      Arrow: TArrowImage;
      P1, P2, P3: TPoint;
      Triangle: array[0..2] of TPoint;
    begin
      Arrow := GetArrow();
      AllowArrow := Assigned(AColumn) and (ASortDirection <> csdNone);
     
      // Gestion des cas où la fleche ne doit pas être dessiner !
      if AllowArrow then
      begin
        ColumnRect := GetColumnTitleScreenRect(AColumn);
        AllowArrow := ColumnRect.Height > 6;
      end;
     
      // Dessin de la fleche
      if AllowArrow then
      begin
        // j'utilise un Buffer temporaire pour dessiner la fleche
        Buffer := Vcl.Graphics.TBitmap.Create();
        try
          BorderSizeY := ColumnRect.Height - 2;
          ArrowSizeY := BorderSizeY - 4;
          ArrowSizeX := ArrowSizeY * 2 - 1;
          BorderSizeX := ArrowSizeX + 4;
          if (BorderSizeX > 0) and (BorderSizeY > 0)  then
            Buffer.SetSize(BorderSizeX, BorderSizeY)
          else
            Exit;
     
          // Agrandi la colonne en fonction du le libellé
          case AColumn.Title.Alignment of
            taLeftJustify:
              begin
                ColumnTitle := AColumn.Title.Caption;
                TextWidth := TFontSLTToolHelp.GetTextWidth(ColumnTitle, AColumn.Font);
                AColumn.Width := Max(AColumn.Width, TextWidth + BorderSizeX * 2);
                ArrowPosition := TextWidth + BorderSizeX div 2;
              end;
     
            taCenter:
              begin
                ColumnTitle := AColumn.Title.Caption;
                TextWidth := TFontSLTToolHelp.GetTextWidth(ColumnTitle, AColumn.Font);
                AColumn.Width := Max(AColumn.Width, TextWidth + BorderSizeX * 3);
                ArrowPosition := (AColumn.Width + TextWidth + BorderSizeX div 2) div 2;
              end;
     
            taRightJustify:
              begin
                ColumnTitle := AColumn.Title.Caption;
                TextWidth := TFontSLTToolHelp.GetTextWidth(ColumnTitle, AColumn.Font);
                AColumn.Width := Max(AColumn.Width, TextWidth + BorderSizeX * 2);
                ArrowPosition := BorderSizeX div 2;
              end;
            else
            begin
              Arrow.Visible := False;
              Exit;
            end;
          end;
     
          // Dessine le Triangle
          with TCanvasSLTAssistant.Create(Buffer.Canvas) do
          try
            // Fond opaque avec contour
            BorderRect := Rect(0, 0, BorderSizeX, BorderSizeY);
            Buffer.Canvas.Pen.Color := AColumn.Title.Font.Color;
            Buffer.Canvas.Brush.Color := TCanvasSLTAssistant.GetConstratedColor(AColumn.Title.Font.Color);
            Buffer.Canvas.Rectangle(BorderRect.Left, BorderRect.Top, BorderRect.Right, BorderRect.Bottom);
     
            // Fleche
            ArrowRect := Rect(2, 2, 1 + ArrowSizeX, 1 + ArrowSizeY);
            Buffer.Canvas.Pen.Color := AColumn.Title.Font.Color;
            Buffer.Canvas.Brush.Color := AColumn.Title.Font.Color;
     
            if ASortDirection = csdAscending then
            begin
              P1 := Point(ArrowRect.Left, ArrowRect.Bottom);
              P2 := Point(ArrowRect.Left + ArrowSizeY - 1, ArrowRect.Top);
              P3 := Point(ArrowRect.Right, ArrowRect.Bottom);
            end
            else if ASortDirection = csdDescending then
            begin
              P1 := Point(ArrowRect.Left, ArrowRect.Top);
              P2 := Point(ArrowRect.Left + ArrowSizeY - 1, ArrowRect.Bottom);
              P3 := Point(ArrowRect.Right, ArrowRect.Top);
            end;
     
            Triangle[0] := P1;
            Triangle[1] := P2;
            Triangle[2] := P3;
     
            Canvas.Polygon(Triangle);
          finally
            Free();
          end;
     
          // Dessin final
          Arrow.Image.Picture.Assign(Buffer);
     
          ColumnTopLeft := DBGrid.ScreenToClient(ColumnRect.TopLeft);
          Inc(ColumnTopLeft.X, ArrowPosition);
          Arrow.Left := ColumnTopLeft.X;
          Arrow.Top := ColumnTopLeft.Y + 1;
          Arrow.Visible := True;
          Arrow.BringToFront();
        finally
          Buffer.Free();
        end;
      end
      else
        Arrow.Visible := False;
    end;
     
    //------------------------------------------------------------------------------
    procedure TDBGridSLTAssistant.DrawEllipsisButton(const ARect: TRect; ABackgroundColor: TColor = clNone; AColumn: TColumn = nil; AState: TGridDrawState = []);
    const
      CSelected: array[TGridDrawingStyle] of TThemedGrid = (
        tgClassicCellSelected, tgCellSelected, tgGradientCellSelected);
    var
      Details: TThemedElementDetails;
      StyleColor: TColor;
      Buffer: Vcl.Graphics.TBitmap;
      BufferRect, ButtonRect: TRect;
      BufferWidth, ButtonWidth: Integer;
      W, X, Y: Integer;
    begin
      // j'utilise un Buffer temporaire pour dessiner le ThemedButton sur un fond coloré et ses trois points
      Buffer := Vcl.Graphics.TBitmap.Create();
      try
        ButtonWidth := GetSystemMetrics(SM_CXVSCROLL);
        BufferWidth := ButtonWidth + 2;
        BufferRect := Rect(0, 0, BufferWidth, ARect.Height);
        Buffer.SetSize(BufferRect.Width, BufferRect.Height);
     
        if ABackgroundColor = clNone then
        begin
          // On dessine un fond normal assurant normalement un bon constrate avec le bouton '...'
          Details := StyleServices.GetElementDetails(tgCellNormal);
          if not StyleServices.GetElementColor(Details, ecFillColor, StyleColor) then
            StyleColor := DBGrid.Color; // Si les thèmes ne sont pas activé comme sous CITRIX, ce utilise la couleur de la Grille
        end
        else
          StyleColor := ABackgroundColor;
     
        // Si selectionné, on affiche en fond la mise en évidence de la sélection
        // sinon on force un fond opaque pour cacher le dessin original !
        if (ABackgroundColor = clNone) and (gdSelected in AState) then
        begin
          ButtonRect := BufferRect;
          InflateRect(ButtonRect, 1, 0); // les bordures en dehors du buffer ne seront ainsi pas dessinées (inspiré des tricheries dans TCustomGrid.DrawCellHighlight)
          StyleServices.DrawElement(Buffer.Canvas.Handle, StyleServices.GetElementDetails(CSelected[DBGrid.DrawingStyle]), ButtonRect);
        end
        else
        begin
          Buffer.Canvas.Brush.Color := StyleColor;
          Buffer.Canvas.Brush.Style := bsSolid;
          Buffer.Canvas.FillRect(BufferRect);
        end;
     
        ButtonRect := BufferRect;
        InflateRect(ButtonRect, -1, -1);
     
        if StyleServices.Enabled then
        begin
          Details := StyleServices.GetElementDetails(tgEllipsisButtonNormal);
          StyleServices.DrawElement(Buffer.Canvas.Handle, Details, ButtonRect);
        end
        else
          DrawEdge(Buffer.Canvas.Handle, ButtonRect, EDGE_RAISED, BF_RECT or BF_MIDDLE);
     
        // Dessine les trois points
        // Centrage
        X := BufferRect.Width div 2;
        Y := BufferRect.Height div 2;
        W := ButtonWidth shr 3;
        if W = 0 then
         W := 1;
        // Point central
        PatBlt(Buffer.Canvas.Handle, X, Y, W, W, DSTINVERT);
        // Point de gauche
        PatBlt(Buffer.Canvas.Handle, X - (W * 2), Y, W, W, DSTINVERT);
        // Point de droite
        PatBlt(Buffer.Canvas.Handle, X + (W * 2), Y, W, W, DSTINVERT);
     
        // Dessin final
        if not DBGrid.UseRightToLeftAlignment and (not Assigned(AColumn) or ((AColumn.Alignment <> taRightJustify) and not (AColumn.Field is TNumericField))) then
          DBGrid.Canvas.Draw(ARect.Left + ARect.Width - BufferWidth, ARect.Top, Buffer)
        else
          DBGrid.Canvas.Draw(ARect.Left, ARect.Top, Buffer);
     
      finally
        Buffer.Free();
      end;
    end;
     
    //------------------------------------------------------------------------------
    procedure TDBGridSLTAssistant.DrawTextWithBackgroundColor(ABackgroundColor: TColor; const ARect: TRect; AColumn: TColumn; AState: TGridDrawState);
    var
      vText: string;
      vRect: TRect;
    begin
      with DBGrid.Canvas do
      begin
        //  Force un fond opaque pour cacher le texte !
        Brush.Style := bsSolid;
        Brush.Color := ColorToRGB(ABackgroundColor);
        FillRect(ARect);
     
        // TextRect encapsule DraxTextEx et est aussi pénible avec ses paramètres in-out !
        vRect := ARect;
        if Assigned(AColumn.Field) then
          vText := AColumn.Field.DisplayText;
        Font.Color := TCanvasSLTAssistant.GetConstratedColor(ABackgroundColor); // Couleur de luminosité inverse : Contraste garanti pour les couleurs claires ou foncées
     
        // Gestion de l'Alignment corrigé selon de Vcl.DBGrids.WriteText
        // DT_CENTER Centers text horizontally in the rectangle.
        // DT_VCENTER Centers text vertically. This value is used only with the DT_SINGLELINE value.
        if AColumn.Alignment = taLeftJustify then
          TextRect(vRect, vRect.Left + 3, vRect.Top + 2, vText)
        else if AColumn.Alignment = taCenter then
          TextRect(vRect, vText, [tfCenter, tfSingleLine, tfVerticalCenter])
        else
        begin
          vRect.Right := vRect.Right - 3;
          TextRect(vRect, vText, [tfRight, tfSingleLine, tfVerticalCenter]);
        end;
     
        if (gdRowSelected in AState) or ((dgRowSelect in DBGrid.Options) and (gdSelected in AState)) then
        begin
          // Pour ne pas dessiner les bords de focus entre les colonnes (inspiré des tricheries dans TCustomGrid.DrawCellHighlight)
          vRect := ARect;
          InflateRect(vRect, 1, 0);
          DrawFocusRect(vRect);
        end
        else
          if gdSelected in AState then
            DrawFocusRect(vRect);
      end;
    end;
     
    //------------------------------------------------------------------------------
    function TDBGridSLTAssistant.EditButtonInputDatePicker(const Msg: string; AField: TField): Boolean;
    var
      Value: TDateTime;
    begin
      if not AField.IsNull then
        Value := AField.AsDateTime
      else
        Value := Date();
     
      Result := TSLTMessageDlg.InputDateTime(Msg, Value, idtkDate);
      if Result then
      begin
        // Le AutoEdit ne fait pas effet sur un Ellipsis button !
        if not (AField.DataSet.State in [dsEdit, dsInsert]) then
          AField.DataSet.Edit();
        AField.AsDateTime := Value;
      end;
    end;
     
    //------------------------------------------------------------------------------
    function TDBGridSLTAssistant.GetColRowScreenRect(ACol, ARow: Integer): TRect;
    begin
      Result := TDBGridHack(DBGrid).CellRect(ACol, ARow);
      if not Result.IsEmpty() then
      begin
        // CellRect ne renvoie pas de coordonnées écran malgré ce que dit l'aide !
        Result.TopLeft := DBGrid.ClientToScreen(Result.TopLeft);
        Result.BottomRight := DBGrid.ClientToScreen(Result.BottomRight);
     
        InflateRect(Result, -1, -1);
      end;
    end;
     
    //------------------------------------------------------------------------------
    function TDBGridSLTAssistant.GetColumnScreenRect(const AColumn: TColumn): TRect;
    var
      Col, Row: Integer;
    begin
      Col := AColumn.Index;
      if dgIndicator in DBGrid.Options then
        Inc(Col);
      Row := TDBGridHack(DBGrid).Row;
     
      Result := GetColRowScreenRect(Col, Row);
    end;
     
    //------------------------------------------------------------------------------
    function TDBGridSLTAssistant.GetColumnTitleScreenRect(const AColumn: TColumn): TRect;
    var
      Col, Row: Integer;
    begin
      Col := AColumn.Index;
      if dgIndicator in DBGrid.Options then
        Inc(Col);
      Row := 0; // le Titre !
     
      Result := GetColRowScreenRect(Col, Row);
    end;
     
    //------------------------------------------------------------------------------
    function TDBGridSLTAssistant.GetEllipsisButtonScreenRect(const AColumn: TColumn): TRect;
    var
      ButtonWidth: Integer;
    begin
      Result := GetColumnScreenRect(AColumn);
     
      ButtonWidth := GetSystemMetrics(SM_CXVSCROLL);
      if not DBGrid.UseRightToLeftAlignment and (AColumn.Alignment <> taRightJustify) and not (AColumn.Field is TNumericField) then
        Result.Left := Result.Right - ButtonWidth
      else
        Result.Width := ButtonWidth;
    end;
     
    //------------------------------------------------------------------------------
    function TDBGridSLTAssistant.GetThemedBackgroundColor(): TColor;
    var
      Details: TThemedElementDetails;
    begin
      if StyleServices.Enabled then
      begin
        Details := StyleServices.GetElementDetails(tgCellNormal);
        StyleServices.GetElementColor(Details, ecFillColor, Result);
      end
      else
        Result := clWindow;
    end;
     
    //------------------------------------------------------------------------------
    class function TDBGridSLTAssistant.GetThemeUseColumnColor(): Boolean;
    begin
      // En XE2, cela ne gère pas la propriété Color des TColumns
    {$IF CompilerVersion = CompilerVersionXE2}
      Result := not StyleServices.Enabled or StyleServices.IsSystemStyle;
    {$ELSE}
      raise EAbstractError.Create('TDBGridSLTAssistant.GetThemeUseColumnColor');
    {$IFEND}
    end;
     
    //------------------------------------------------------------------------------
    function TDBGridSLTAssistant.HitOnColumnCell(out AColumn: TColumn): Boolean;
    var
      HitPoint: TPoint;
      HitCoord: TGridCoord;
    begin
      HitPoint := Mouse.CursorPos;
      HitPoint := DBGrid.ScreenToClient(HitPoint);
      HitCoord := DBGrid.MouseCoord(HitPoint.X, HitPoint.Y);
     
      if dgTitles in DBGrid.Options then
        Dec(HitCoord.Y);
     
      Result := (HitCoord.Y >= 0);
     
      if Result then
      begin
        if dgIndicator in DBGrid.Options then
          Dec(HitCoord.X);
     
        AColumn := DBGrid.Columns[HitCoord.X];
      end;
    end;
     
    //------------------------------------------------------------------------------
    function TDBGridSLTAssistant.HitOnEllipsisButton(AColumn: TColumn): Boolean;
    var
      HitPoint: TPoint;
      GridRect, ButtonRect: TRect;
    begin
      Result := False;
     
      if AColumn.ButtonStyle = cbsEllipsis then
      begin
        HitPoint := Mouse.CursorPos;
        GridRect := DBGrid.BoundsRect;
        GridRect.TopLeft := DBGrid.Parent.ClientToScreen(GridRect.TopLeft);
        GridRect.BottomRight := DBGrid.Parent.ClientToScreen(GridRect.BottomRight);
     
        if PtInRect(GridRect, HitPoint) then
        begin
          ButtonRect := GetEllipsisButtonScreenRect(AColumn);
     
          Result := PtInRect(ButtonRect, HitPoint);
        end;
      end;
    end;
     
    //------------------------------------------------------------------------------
    function TDBGridSLTAssistant.HitOnTitle(out AColumn: TColumn): Boolean;
    var
      HitPoint: TPoint;
      HitCoord: TGridCoord;
    begin
      Result := False;
      if dgTitles in DBGrid.Options then
      begin
        HitPoint := Mouse.CursorPos;
        HitPoint := DBGrid.ScreenToClient(HitPoint);
        HitCoord := DBGrid.MouseCoord(HitPoint.X, HitPoint.Y);
        Result := (HitCoord.Y = 0);
        if Result then
        begin
          if dgIndicator in DBGrid.Options then
            Dec(HitCoord.X);
     
          AColumn := DBGrid.Columns[HitCoord.X];
        end;
      end;
    end;
     
    //------------------------------------------------------------------------------
    procedure TDBGridSLTAssistant.ZoomColumnTitleWidth(AZoomPourcent: Integer);
    const
      AUTOSIZE_WIDTH = 64;
    var
      I: Integer;
    begin
      for I := 0 to DBGrid.Columns.Count - 1 do
        with DBGrid.Columns[I] do
          if Width <> AUTOSIZE_WIDTH then
            Width := Round(Width * AZoomPourcent / 100);
    end;
     
    //------------------------------------------------------------------------------
    function TDBGridSLTAssistant.ShowCombo(const Msg: string; APickList: TStrings; var APickListIndex: Integer): Boolean;
    begin
      Result := TSLTMessageDlg.InputCombo(Msg, APickList, APickListIndex);
    end;
     
    end.
    Aide via F1 - FAQ - Guide du développeur Delphi devant un problème - Pensez-y !
    Attention Troll Méchant !
    "Quand un homme a faim, mieux vaut lui apprendre à pêcher que de lui donner un poisson" Confucius
    Mieux vaut se taire et paraître idiot, Que l'ouvrir et de le confirmer !
    L'ignorance n'excuse pas la médiocrité !

    L'expérience, c'est le nom que chacun donne à ses erreurs. (Oscar Wilde)
    Il faut avoir le courage de se tromper et d'apprendre de ses erreurs

  5. #5
    Membre confirmé
    Avatar de JP.NUAGE
    Profil pro
    Inscrit en
    Avril 2006
    Messages
    769
    Détails du profil
    Informations personnelles :
    Âge : 81
    Localisation : France

    Informations forums :
    Inscription : Avril 2006
    Messages : 769
    Points : 542
    Points
    542
    Par défaut
    Je crois que ma demande porte à confusion. Voici donc des précisions.

    Je ne cherche pas à me positionner sur une cellule, cela je le fais sans problème. Je cherche à obtenir, une fois dans la cellule, les coordonnées X et Y d'un point de cette cellule, par exemple le bord droit et/ou le bord inférieur. La fonction SimuleClicSouris activera alors un évènement OnDblClic
    Ce qui se conçoit bien s'énonce clairement
    Et les mots pour le dire viennent aisément (Boileau)

  6. #6
    Membre expert
    Avatar de Charly910
    Homme Profil pro
    Ingénieur TP
    Inscrit en
    Décembre 2006
    Messages
    2 345
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Ingénieur TP
    Secteur : Bâtiment Travaux Publics

    Informations forums :
    Inscription : Décembre 2006
    Messages : 2 345
    Points : 3 123
    Points
    3 123
    Par défaut
    Bonjour,

    est ce que c'est l'équivalent de CellRect(ACol: Longint; ARow: Longint): TRect; de la TStringGrid que tu veux pour la DBGrid ?

    je pense qu'il faudrait que tu récupère la hauteur des lignes (RowHeights) et la largeur des colonnes (?) de la DBGrid :

    Voir la FAQ

    Puis tu peux calculer les X et Y de la cellule sélectionnée en utilisant Top et Left et Row et Col.

    A tester ...

    A+
    Charly

  7. #7
    Membre confirmé
    Avatar de JP.NUAGE
    Profil pro
    Inscrit en
    Avril 2006
    Messages
    769
    Détails du profil
    Informations personnelles :
    Âge : 81
    Localisation : France

    Informations forums :
    Inscription : Avril 2006
    Messages : 769
    Points : 542
    Points
    542
    Par défaut
    La solution que tu proposes, Charly910, est intéressante. Seul bémol : elle suppose pas mal de lignes de code dans mon cas, car les colonnes n'ont pas toutes la même largeur. Je ne ferme donc pas la discussion, des fois qu'une autre idée viendrait. En attendant, je teste ce que tu proposes.

    Merci à toi
    Ce qui se conçoit bien s'énonce clairement
    Et les mots pour le dire viennent aisément (Boileau)

  8. #8
    Expert confirmé
    Avatar de anapurna
    Homme Profil pro
    Développeur informatique
    Inscrit en
    Mai 2002
    Messages
    3 419
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : Arts - Culture

    Informations forums :
    Inscription : Mai 2002
    Messages : 3 419
    Points : 5 818
    Points
    5 818
    Par défaut
    salut

    un truc un peu dans ce genre là ?

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
     
      Point := Mouse.CursorPos;
      Point  := dbgrid.ScreenToClient(Point);
      GC     := dbgrid.MouseCoord(Point.X, Point.Y);
      ...
    Nous souhaitons la vérité et nous trouvons qu'incertitude. [...]
    Nous sommes incapables de ne pas souhaiter la vérité et le bonheur, et sommes incapables ni de certitude ni de bonheur.
    Blaise Pascal
    PS : n'oubliez pas le tag

  9. #9
    Membre confirmé
    Avatar de JP.NUAGE
    Profil pro
    Inscrit en
    Avril 2006
    Messages
    769
    Détails du profil
    Informations personnelles :
    Âge : 81
    Localisation : France

    Informations forums :
    Inscription : Avril 2006
    Messages : 769
    Points : 542
    Points
    542
    Par défaut
    J'ai essayé la solution de Charly910. Deux problèmes qui la rendent, me semble-t-il, inutilisable

    1 : la hauteur des lignes n'est pas accessible (enfin, je ne l'ai trouvée nulle part)
    2 : Il faut ajouter la distance entre le haut de la grille et la haut de la fenêtre. Idem pour la largeur, en ajoutant la distance entre le bord de la grille et le bord de la fenêtre. Or ma grille est dans un Panel, lui-même dans un TabSheet inclus dans un autre Panel. Bref une véritable poupée russe.

    Enfin, il n'y a pas 1 mais 2 grilles concernées, donc soit double code, soit une bardé de test pour savoir où je suis.

    J'ai espéré un moment avoir la solution suivante :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    var Rect : Trect;
    .
    .
    Ma_Grille.Focused;
    Ma_Grille.selectedField := 'CHAMP_A_TRAITER';
    CoordonneeCelluleActive.TopLeft := Ma_Grille.ClientToScreen(Rect.Topleft);
    CoordonneeCelluleActive.Right := CoordonneeCelluleActive.TopLeft.X +6;
    CoordonneeCelluleActive.Bottom := CoordonneeCelluleActive.TopLeft.Y +6;
    Ce qui, si cela avait fonctionné, aurait pointé dans la cellule. Mais j'ai obtenu des coordonnées de l'ordre de 200000. Je pense que Rect n'est pas correctement attaché à la cellule et je pointe aux environs de Jupiter, si pas plus loin !
    Ce qui se conçoit bien s'énonce clairement
    Et les mots pour le dire viennent aisément (Boileau)

  10. #10
    Rédacteur/Modérateur

    Avatar de SergioMaster
    Homme Profil pro
    Développeur informatique retraité
    Inscrit en
    Janvier 2007
    Messages
    15 042
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 67
    Localisation : France, Loire Atlantique (Pays de la Loire)

    Informations professionnelles :
    Activité : Développeur informatique retraité
    Secteur : Industrie

    Informations forums :
    Inscription : Janvier 2007
    Messages : 15 042
    Points : 40 955
    Points
    40 955
    Billets dans le blog
    62
    Par défaut
    Bonjour,

    j'avais indiqué dans mon second message comment obtenir les coordonnées au sein de la grille, pour obtenir les coordonnées par rapport à l'écran

    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
      TMyGrid = class(TDBGrid)
       private
        function GetColumnByFieldName(F : String) : Integer;
        function GetCellPos: TRect;
        function GetScreenCellPos: TRect;
       end;
     
    ...
     
    { TMyGrid }
     
    function TMyGrid.GetCellPos: TRect;
    begin
    result:=CellRect(Col,Row);
    end;
     
     
    function TMyGrid.GetColumnByFieldName(F: String): Integer;
    var i : integer;
    begin
      result:=-1;
      for i:=0 to Self.Columns.Count-1 do
        begin
          if CompareStr(Self.Columns[i].FieldName,F)=0 then
           begin
             result:=i+1;
             Exit;
           end;
        end;
    end;
     
    function TMyGrid.GetScreenCellPos: TRect;
    begin
    Result.TopLeft:=ClientToScreen(GetCellPos.TopLeft);
    Result.BottomRight:=ClientToScreen(GetCellPos.BottomRight);
    end;
    en guise de test
    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
     
    //sélectionne une colonne particulière de la ligne en cours
    procedure TForm1.btn3Click(Sender: TObject);
    begin
    with TMyGrid(dbgrd1) do
     begin
        col:=GetColumnByFieldName(dbgrd1,'LIBELLE_APPOSE');
      end;
    dbgrd1.SetFocus; // donne le focus à la grille (pour voir la cellule sélectionnée)
    dbgrd1DblClick(Sender); // exécute le double click (pas besoin de "simuler" des clics de souris) 
    end;
     
    procedure TForm1.dbgrd1DblClick(Sender: TObject);
    var ARect : TRect;
    begin
    with TMyGrid(dbgrd1) do
     begin
       ARect:=GetScreenCellPos;
       // affichage d'un popupmenu à droite de la cellule sélectionnée
       pm1.Popup(ARect.Right,ARect.Top);
     end;
    end;
    Or ma grille est dans un Panel, lui-même dans un TabSheet inclus dans un autre Panel. Bref une véritable poupée russe.
    pas de problème de poupées russes avec mon code
    Enfin, il n'y a pas 1 mais 2 grilles concernées, donc soit double code, soit une bardé de test pour savoir où je suis.
    comme il s'agit d'un "hacking" même code pour plusieurs grilles sans soucis
    MVP Embarcadero
    Delphi installés : D3,D7,D2010,XE4,XE7,D10 (Rio, Sidney), D11 (Alexandria), D12 (Athènes)
    SGBD : Firebird 2.5, 3, SQLite
    générateurs États : FastReport, Rave, QuickReport
    OS : Window Vista, Windows 10, Windows 11, Ubuntu, Androïd

  11. #11
    Membre confirmé
    Avatar de JP.NUAGE
    Profil pro
    Inscrit en
    Avril 2006
    Messages
    769
    Détails du profil
    Informations personnelles :
    Âge : 81
    Localisation : France

    Informations forums :
    Inscription : Avril 2006
    Messages : 769
    Points : 542
    Points
    542
    Par défaut
    Et bien c'est résolu ! Solution de SergioMaster

    Merci à tous
    Ce qui se conçoit bien s'énonce clairement
    Et les mots pour le dire viennent aisément (Boileau)

  12. #12
    Expert éminent sénior
    Avatar de ShaiLeTroll
    Homme Profil pro
    Développeur C++\Delphi
    Inscrit en
    Juillet 2006
    Messages
    13 459
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : France, Seine Saint Denis (Île de France)

    Informations professionnelles :
    Activité : Développeur C++\Delphi
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Juillet 2006
    Messages : 13 459
    Points : 24 873
    Points
    24 873
    Par défaut
    Citation Envoyé par JP.NUAGE Voir le message
    1 : la hauteur des lignes n'est pas accessible (enfin, je ne l'ai trouvée nulle part)
    et RowHeights fonctionne mais il faut passer par TDBGridHack mais CellRect est du coup plus pratique

    Citation Envoyé par JP.NUAGE Voir le message
    2 : Il faut ajouter la distance entre le haut de la grille et la haut de la fenêtre. Idem pour la largeur, en ajoutant la distance entre le bord de la grille et le bord de la fenêtre. Or ma grille est dans un Panel, lui-même dans un TabSheet inclus dans un autre Panel. Bref une véritable poupée russe.
    ClientToScreen sert justement a convertir les coordonnées d'un Control par rapport à son parent* en coordonnées écran
    * parent de parent de parent ... jusqu'à l'arrière-arrière-arrière-grand-mamy-russe

    Que ce soit dans GetScreenCellPos ou TDBGridSLTAssistant.GetColRowScreenRect

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    //------------------------------------------------------------------------------
    function TDBGridSLTAssistant.GetColRowScreenRect(ACol, ARow: Integer): TRect;
    begin
      Result := TDBGridHack(DBGrid).CellRect(ACol, ARow);
      if not Result.IsEmpty() then
      begin
        // CellRect ne renvoie pas de coordonnées écran malgré ce que dit l'aide !
        Result.TopLeft := DBGrid.ClientToScreen(Result.TopLeft);
        Result.BottomRight := DBGrid.ClientToScreen(Result.BottomRight);
     
        InflateRect(Result, -1, -1);
      end;
    end;
    Aide via F1 - FAQ - Guide du développeur Delphi devant un problème - Pensez-y !
    Attention Troll Méchant !
    "Quand un homme a faim, mieux vaut lui apprendre à pêcher que de lui donner un poisson" Confucius
    Mieux vaut se taire et paraître idiot, Que l'ouvrir et de le confirmer !
    L'ignorance n'excuse pas la médiocrité !

    L'expérience, c'est le nom que chacun donne à ses erreurs. (Oscar Wilde)
    Il faut avoir le courage de se tromper et d'apprendre de ses erreurs

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Réponses: 0
    Dernier message: 24/02/2017, 12h03
  2. Réponses: 2
    Dernier message: 29/07/2016, 16h49
  3. [Toutes versions] coller les données d'une plage d'une cellule dans une cellule d'une autre feuille[VBA]
    Par arthson dans le forum Macros et VBA Excel
    Réponses: 1
    Dernier message: 24/01/2012, 17h37
  4. [XL-2002] Macro de comparaison d'une cellule d'une feuille avec une cellule d'une autre feuille.
    Par steelydan dans le forum Macros et VBA Excel
    Réponses: 6
    Dernier message: 08/09/2010, 12h59
  5. Recherche une valeur d'une cellule dans une colonne d'une autre feuille
    Par kourria dans le forum Macros et VBA Excel
    Réponses: 8
    Dernier message: 21/06/2007, 13h48

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo