This file is indexed.

/usr/lib/lazarus/0.9.30.4/lcl/dbctrls.pp is in lazarus-src-0.9.30.4 0.9.30.4-6.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

   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
 763
 764
 765
 766
 767
 768
 769
 770
 771
 772
 773
 774
 775
 776
 777
 778
 779
 780
 781
 782
 783
 784
 785
 786
 787
 788
 789
 790
 791
 792
 793
 794
 795
 796
 797
 798
 799
 800
 801
 802
 803
 804
 805
 806
 807
 808
 809
 810
 811
 812
 813
 814
 815
 816
 817
 818
 819
 820
 821
 822
 823
 824
 825
 826
 827
 828
 829
 830
 831
 832
 833
 834
 835
 836
 837
 838
 839
 840
 841
 842
 843
 844
 845
 846
 847
 848
 849
 850
 851
 852
 853
 854
 855
 856
 857
 858
 859
 860
 861
 862
 863
 864
 865
 866
 867
 868
 869
 870
 871
 872
 873
 874
 875
 876
 877
 878
 879
 880
 881
 882
 883
 884
 885
 886
 887
 888
 889
 890
 891
 892
 893
 894
 895
 896
 897
 898
 899
 900
 901
 902
 903
 904
 905
 906
 907
 908
 909
 910
 911
 912
 913
 914
 915
 916
 917
 918
 919
 920
 921
 922
 923
 924
 925
 926
 927
 928
 929
 930
 931
 932
 933
 934
 935
 936
 937
 938
 939
 940
 941
 942
 943
 944
 945
 946
 947
 948
 949
 950
 951
 952
 953
 954
 955
 956
 957
 958
 959
 960
 961
 962
 963
 964
 965
 966
 967
 968
 969
 970
 971
 972
 973
 974
 975
 976
 977
 978
 979
 980
 981
 982
 983
 984
 985
 986
 987
 988
 989
 990
 991
 992
 993
 994
 995
 996
 997
 998
 999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
{ $Id: dbctrls.pp 28579 2010-12-01 10:15:05Z vincents $}
{
 /***************************************************************************
                               DbCtrls.pp
                               ----------
                     An interface to DB aware Controls
                     Initial Revision : Sun Sep 14 2003


 ***************************************************************************/

 *****************************************************************************
 *                                                                           *
 *  This file is part of the Lazarus Component Library (LCL)                 *
 *                                                                           *
 *  See the file COPYING.modifiedLGPL.txt, included in this distribution,    *
 *  for details about the copyright.                                         *
 *                                                                           *
 *  This program is distributed in the hope that it will be useful,          *
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
 *                                                                           *
 *****************************************************************************
}
{
@abstract(common db aware controls, as in Delphi)
@author(Andrew Johnson <acjgenius@@earthlink.net>)
@created(Sun Sep 14 2003)
@lastmod($Date: 2010-12-01 10:15:05 +0000 (Wed, 01 Dec 2010) $)
}
unit DbCtrls;

{$mode objfpc}
{$H+}

interface          

uses
  Types, Classes, SysUtils, DB,
  LCLStrConsts, LCLProc, LMessages, LCLType, LResources, GraphType,
  Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons, MaskEdit, ExtCtrls,
  Calendar, Chart, Variants;

Type
  { TFieldDataLink }

  TFieldDataLink = class(TDataLink)
  private
    FField: TField;
    FFieldName: string;

    FControl: TComponent;

    // Curent State of Affairs
    FEditing: Boolean;
    IsModified: Boolean;

    // Callbacks
    FOnDataChange: TNotifyEvent;
    FOnEditingChange: TNotifyEvent;
    FOnUpdateData: TNotifyEvent;
    FOnActiveChange: TNotifyEvent;
    FOnFocusRequest: TNotifyEvent;
    FOnLayoutChange: TNotifyEvent;

    function FieldCanModify: boolean;
    function GetCanModify: Boolean;

    // set current field
    procedure SetFieldName(const Value: string);

    // make sure the field/fieldname is valid before we do stuff with it
    function ValidateField : Boolean;
  protected
    // Testing Events
    procedure ActiveChanged; override;
    procedure DataSetChanged; override;
    procedure EditingChanged; override;
    procedure LayoutChanged; override;
    procedure RecordChanged(aField: TField); override;
    procedure UpdateData; override;

    procedure FocusControl(aField: TFieldRef); Override;
  public
    constructor Create;
    destructor Destroy; override;

    // for control intitiating db changes etc
    function Edit: Boolean;

    procedure Modified;
    procedure Reset;

    // Attached control
    property Control: TComponent read FControl write FControl;


    // Basic DB interfaces
    property Field: TField read FField;
    property FieldName: string read FFieldName write SetFieldName;

    // Current State of DB
    property CanModify: Boolean read GetCanModify;
    property Editing: Boolean read FEditing;

    // Our Callbacks
    property OnDataChange: TNotifyEvent read FOnDataChange write FOnDataChange;
    property OnEditingChange: TNotifyEvent read FOnEditingChange write FOnEditingChange;
    property OnUpdateData: TNotifyEvent read FOnUpdateData write FOnUpdateData;
    property OnActiveChange: TNotifyEvent read FOnActiveChange write FOnActiveChange;
    property OnFocusRequest: TNotifyEvent read FOnFocusRequest write FOnFocusRequest;
    property OnLayoutChange: TNotifyevent read FOnLayoutChange write FOnLayoutChange;
  end;



  { TDBLookup }
  {
  TDBLookup component is typically owned by a Lookup control like
  TDBLookupListBox or TDBLookupComboBox.
  The ListSource is the other dataset TDataSource from which to retrieve the lookup data
  The KeyField is the lookup key in the ListSource which corresponds to the DataField value
  The ListField is the name of the field in the ListSource to list into the
  Items property of the lookup control.
  which  data
  }

  TDBLookup = class(TComponent)
  private
    FLinkBookMark: TBookMark;
    FControlLink: TFieldDataLink;
    FControlItems: TStrings;
    FHasLookUpField: Boolean;
    FListLink: TFieldDataLink;
    FListSource: TDataSource;
    FDataFieldNames: string;
    FKeyFieldNames: string;
    FListFieldName: string;
    FListFieldIndex: Integer;
    FListLinkTmpSetActive: Boolean;
    FLookUpFieldIsCached: Boolean;
    FDataFields: TList;  // Data Fields to lookup/edit
    FKeyFields: TList;   // Keyfields in lookup dataset
    FListField: TField;  // Result field in lookup dataset
    FLookupCache: boolean;
    FLookupList: TLookupList;
    FNullValueKey: TShortcut;
    FOnClearSelection: TNotifyEvent;
    procedure ActiveChange(Sender: TObject);
    procedure EditingChange(Sender: TObject);
    procedure FetchLookupData;
    function GetKeyFieldName: string;
    function GetListSource: TDataSource;
    procedure LinkGetBookMark;
    procedure LinkGotoBookMark;
    procedure SetKeyFieldName(const Value: string);
    procedure SetListFieldName(const Value: string);
    procedure SetListSource(Value: TDataSource);
    procedure SetLookupCache(const Value: boolean);
    procedure NullKeyHandler(Sender: TObject; var Key: Word; Shift: TShiftState);
  protected
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure DoClearSelection;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Initialize(AControlDataLink: TFieldDataLink; AControlItems: TStrings);
    function ListFieldValue: string;
    procedure UpdateData(const AListFieldValue: string);
    function  GetKeyValue(const AListFieldValue: string): Variant;
    function  GetListValue(const AKeyValue: Variant; out ItemIndex:Integer): boolean;
    property LookupCache: boolean read FLookupCache  write SetLookupCache;
    // properties to be published by owner control
    // these are not used where data control Field is dbLookup
    property KeyField: string read GetKeyFieldName write SetKeyFieldName;
    property ListField: string read FListFieldName write SetListFieldName;
    property ListFieldIndex: Integer read FListFieldIndex write FListFieldIndex default 0;
    property ListSource: TDataSource read GetListSource write SetListSource;
    property NullValueKey: TShortcut read FNullValueKey write FNullValueKey;
    property OnClearSelection: TNotifyEvent read FOnClearSelection write FOnClearSelection;
  end;

  { TDBEdit }

  TDBEdit = class(TCustomMaskEdit)
  private
    FDataLink: TFieldDataLink;

    procedure DataChange(Sender: TObject);
    procedure UpdateData(Sender: TObject);
    procedure FocusRequest(Sender: TObject);
    procedure ActiveChange(Sender: TObject);
    procedure LayoutChange(Sender: TObject);
    
    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetField: TField;


    procedure SetDataField(const Value: string);
    procedure SetDataSource(Value: TDataSource);
    function IsReadOnly: boolean;
    procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
  protected
    function GetReadOnly: Boolean; override;
    procedure SetReadOnly(Value: Boolean); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: char); override;

    procedure Loaded; override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;

    function EditCanModify: Boolean; override;
    function GetEditText: string; override;

    procedure Change; override;
    procedure Reset; override;

    procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS;
    procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS;
    procedure LMPasteFromClip(var Message: TLMessage); message LM_PASTE;
    procedure LMCutToClip(var Message: TLMessage); message LM_CUT;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Field: TField read GetField;
  published
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;

    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;

    property Anchors;
    property AutoSize;
    property BorderSpacing;
    property BorderStyle;
    property CharCase;
    property Color;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property EditMask;
    property Font;
    property MaxLength;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PasswordChar;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEditingDone;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
    property OnUTF8KeyPress;
  end;


  { TDBText }

  TDBText = class(TCustomLabel)
  private
    FDataLink: TFieldDataLink;

    procedure DataChange(Sender: TObject);
    procedure ActiveChange(Sender: TObject);

    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetField: TField;

    procedure SetDataField(const Value: string);
    procedure SetDataSource(Value: TDataSource);
    procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
  protected
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    class procedure WSRegisterClass; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Field: TField read GetField;
  published
    property Align;
    property Alignment;
    property Anchors;
    property AutoSize;
    property BidiMode;
    property BorderSpacing;
    property Color;
    property Constraints;
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property FocusControl;
    property Font;
    property Layout;
    property ParentBidiMode;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowAccelChar;
    property ShowHint;
    property Transparent;
    property Visible;
    property WordWrap;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnChangeBounds;
    property OnContextPopup;
    property OnResize;
    property OnStartDrag;
    property OptimalFill;
  end;


  { TDBListBox }

  TCustomDBListBox = class(TCustomListBox)

    procedure EditingChange(Sender: TObject);
    procedure FocusRequest(Sender: TObject);

    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetField: TField;

    procedure SetItems(Values : TStrings); override;

    function GetReadOnly: Boolean;
    procedure SetReadOnly(Value: Boolean);

    procedure SetDataField(const Value: string);
    procedure SetDataSource(Value: TDataSource);
    procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
  protected
    FDataLink: TFieldDataLink;
    procedure DataChange(Sender: TObject); virtual;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;

    procedure Loaded; override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure UpdateData(Sender: TObject); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Click; override;
    procedure EditingDone; override;

    property Field: TField read GetField;
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;

    //same as dbedit need to match the datalink status
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
  end;


  TDBListBox = class(TCustomDBListBox)
  protected
    procedure DataChange(Sender: TObject); override;
    procedure UpdateData(Sender: TObject); override;
    class procedure WSRegisterClass; override;
  public
    // we need to overrride the write method for db aware.
    // the Read isn't an issue since the list will be updated
    // on data change anyway
    property Items write SetItems;
  published
    property Align;
    property Anchors;
    property BorderSpacing;
    property BorderStyle;
    property DataField;
    property DataSource;
    property DragCursor;
    property DragMode;
    property ExtendedSelect;
    property ItemHeight;
    property MultiSelect;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawItem;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyPress;
    property OnKeyDown;
    property OnKeyUp;
    property OnMouseMove;
    property OnMouseDown;
    property OnMouseUp;
    property OnResize;
    property OnStartDrag;
    property OnUTF8KeyPress;
    property ParentShowHint;
    property ReadOnly;
    property ShowHint;
    property Sorted;
    property Style;
    property TabOrder;
    property TabStop;
    property TopIndex;
    property Visible;
  end;


  { TDBLookupListBox }

  TDBLookupListBox = class(TCustomDBListBox)
  private
    FLookup: TDBLookup;
    procedure ActiveChange(Sender: TObject);
    function GetKeyField: string;
    function GetKeyValue: Variant;
    function GetListField: string;
    function GetListFieldIndex: Integer;
    function GetListSource: TDataSource;
    function GetLookupCache: boolean;
    function GetNullValueKey: TShortCut;
    procedure SetKeyField(const Value: string);
    procedure SetKeyValue(const AValue: Variant);
    procedure SetListField(const Value: string);
    procedure SetListFieldIndex(const Value: Integer);
    procedure SetListSource(const Value: TDataSource);
    procedure SetLookupCache(const Value: boolean);
    procedure RemoveSelection(Sender: TObject);
    procedure SetNullValueKey(const AValue: TShortCut);
  protected
    procedure DataChange(Sender: TObject); override;
    procedure InitializeWnd; override;
    procedure UpdateData(Sender: TObject); override;
  public
    constructor Create(AOwner: TComponent); override;
    property KeyValue: Variant read GetKeyValue write SetKeyValue;
  published
    property Align;
    property Anchors;
    property BorderSpacing;
    property BorderStyle;
    property DataField;
    property DataSource;
    property DragCursor;
    property DragMode;
//    property ExtendedSelect;
//    property ItemHeight;
    property KeyField: string read GetKeyField write SetKeyField;
    property ListField: string read GetListField write SetListField;
    property ListFieldIndex: Integer read GetListFieldIndex write SetListFieldIndex;
    property ListSource: TDataSource read GetListSource write SetListSource;
    property LookupCache: boolean read GetLookupCache  write SetLookupCache;
    property NullValueKey: TShortCut read GetNullValueKey write SetNullValueKey default 0;
//    property MultiSelect;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
//    property OnDrawItem;
    property OnEditingDone;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyPress;
    property OnKeyDown;
    property OnKeyUp;
    property OnMouseMove;
    property OnMouseDown;
    property OnMouseUp;
    property OnResize;
    property OnStartDrag;
    property OnUTF8KeyPress;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property Sorted;
//    property Style;
    property TabOrder;
    property TabStop;
    property TopIndex;
    property Visible;
  end;


  { TDBRadioGroup }

  TDBRadioGroup = class(TCustomRadioGroup)
  private
    FDataLink: TFieldDataLink;
    FOnChange: TNotifyEvent;
    FValue: string;
    FInSetValue: boolean;
    FValues: TStrings;
    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetField: TField;
    function GetReadOnly: Boolean;
    procedure SetDataField(const AValue: string);
    procedure SetDataSource(const AValue: TDataSource);
    procedure SetItems(const AValue: TStrings);
    procedure SetReadOnly(const AValue: Boolean);
    procedure SetValue(const AValue: string);
    procedure SetValues(const AValue: TStrings);
    procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
  protected
    procedure Change; virtual;
    procedure Notification(AComponent: TComponent;
                           Operation: TOperation); override;
    procedure DataChange(Sender: TObject);
    procedure UpdateData(Sender: TObject);
    property DataLink: TFieldDataLink read FDataLink;
    function GetButtonValue(Index: Integer): string;
    procedure UpdateRadioButtonStates; override;
    procedure Loaded; override;
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure EditingDone; override;
    property Field: TField read GetField;
    property ItemIndex;
    property Value: string read FValue write SetValue;
  published
    property Align;
    property Anchors;
    property BorderSpacing;
    property Caption;
    property Columns;
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Items write SetItems;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnChangeBounds;
    property OnClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseuP;
    property OnResize;
    property OnStartDrag;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
    property TabOrder;
    property TabStop;
    property Values: TStrings read FValues write SetValues;
    property Visible;
  end;


  { TDBCheckBox }

  TDBCheckBox = class(TCustomCheckBox)
  private
    FDataLink: TFieldDataLink;
    FValueCheck: string;
    FValueUncheck: string;
    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetField: TField;
    function GetReadOnly: Boolean;
    procedure SetDataField(const AValue: string);
    procedure SetDataSource(const AValue: TDataSource);
    procedure SetReadOnly(const AValue: Boolean);
    procedure SetValueCheck(const AValue: string);
    procedure SetValueUncheck(const AValue: string);
    procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
  protected
    function GetFieldCheckState: TCheckBoxState; virtual;
    procedure DataChange(Sender: TObject); virtual;
    procedure UpdateData(Sender: TObject); virtual;
    procedure FocusRequest(Sender: TObject); virtual;
    procedure Notification(AComponent: TComponent;
                           Operation: TOperation); override;
    procedure Loaded; override;
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure EditingDone; override;
    property Checked;
    property Field: TField read GetField;
    property State;
  published
    property AllowGrayed;
    property Align;
    property Anchors;
    property AutoSize;
    property BorderSpacing;
    property Caption;
    property Color;
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property Hint;
    property OnChange;
    property OnClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property ValueChecked: string read FValueCheck write SetValueCheck;
    property ValueUnchecked: string read FValueUncheck write SetValueUncheck;
    property Visible;
  end;
  
  
  { TCustomDBComboBox }

  TCustomDBComboBox = class(TCustomComboBox)
  private
    FDataLink: TFieldDataLink;
    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetField: TField;
    function GetReadOnly: Boolean;
    procedure SetDataField(const AValue: string);
    procedure SetDataSource(const AValue: TDataSource);
    procedure SetReadOnly(const AValue: Boolean);
    procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
  protected
    procedure DataChange(Sender: TObject); virtual;
    procedure ActiveChange(Sender: TObject); //virtual;
    procedure EditingChange(Sender: TObject); virtual;
    procedure Notification(AComponent: TComponent;
                           Operation: TOperation); override;
    procedure Change; override;
    procedure UpdateData(Sender: TObject); virtual;
    procedure FocusRequest(Sender: TObject); virtual;
    procedure Loaded; override;
    procedure UpdateText; virtual;
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure EditingDone; override;
    property Field: TField read GetField;
    property Text;
    property ItemIndex;
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
  end;


     { TDBComboBox }

  TDBComboBox = class(TCustomDBComboBox)
  protected
    procedure UpdateData(Sender: TObject); override;
    procedure UpdateText; override;
  published
    property Anchors;
    property ArrowKeysTraverseList;
    property AutoDropDown;
    property AutoSize;
    property BorderSpacing;
    property Color;
    property DataField;
    property DataSource;
    property DragCursor;
    property DragMode;
    property DropDownCount;
    property Enabled;
    property Font;
    property ItemHeight;
    property Items;
    property ItemWidth;
    property MaxLength default -1;
    property OnChange;
    property OnChangeBounds;
    property OnClick;
    property OnCloseUp;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawItem;
    property OnDropDown;
    property OnEditingDone;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnSelect;
    property OnStartDrag;
    property OnUTF8KeyPress;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property ReadOnly;
    property ShowHint;
    property Sorted;
    property Style;
    property TabOrder;
    property TabStop;
    property Visible;
  end;


  { TDBLookupComboBox }

  TDBLookupComboBox = class(TCustomDBComboBox)
  private
    FLookup: TDBLookup;
    procedure ActiveChange(Sender: TObject);
    function GetKeyField: string;
    function GetKeyValue: variant;
    function GetListField: string;
    function GetListFieldIndex: Integer;
    function GetListSource: TDataSource;
    function GetLookupCache: boolean;
    function GetNullValueKey: TShortCut;
    procedure SetKeyField(const Value: string);
    procedure SetKeyValue(const AValue: variant);
    procedure SetListField(const Value: string);
    procedure SetListFieldIndex(const Value: Integer);
    procedure SetListSource(const Value: TDataSource);
    procedure SetLookupCache(const Value: boolean);
    procedure SetNullValueKey(const AValue: TShortCut);
    procedure RemoveSelection(Sender: TObject);
  protected
    procedure InitializeWnd; override;
    procedure UpdateData(Sender: TObject); override;
    procedure UpdateText; override;
  public
    constructor Create(AOwner: TComponent); override;
    property KeyValue: variant read GetKeyValue write SetKeyValue;
  published
    property Align;
    property Anchors;
    property ArrowKeysTraverseList;
    property AutoComplete;
    property AutoDropDown;
    property AutoSize;
    property BorderSpacing;
    property Color;
    property DataField;
    property DataSource;
    property DragCursor;
    property DragMode;
    property DropDownCount;
    property Enabled;
    property Font;
//    property ItemHeight;
//    property ItemWidth;
    property KeyField: string read GetKeyField write SetKeyField;
    property ListField: string read GetListField write SetListField;
    property ListFieldIndex: Integer read GetListFieldIndex write SetListFieldIndex;
    property ListSource: TDataSource read GetListSource write SetListSource;
    property LookupCache: boolean read GetLookupCache  write SetLookupCache;
//    property MaxLength default -1;
    property NullValueKey: TShortCut read GetNullValueKey write SetNullValueKey default 0;
    property OnChange;
    property OnChangeBounds;
    property OnClick;
    property OnCloseUp;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawItem;
    property OnDropDown;
    property OnEditingDone;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnSelect;
    property OnStartDrag;
    property OnUTF8KeyPress;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property Sorted;
    property Style;
    property TabOrder;
    property TabStop;
    property Visible;
  end;

  { TDBMemo }

  TDBMemo = class(TCustomMemo)
  private
    FDataLink: TFieldDataLink;
    FAutoDisplay: Boolean;
    FDBMemoFocused: Boolean;
    FDBMemoLoaded: Boolean;
    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetField: TField;
    procedure SetAutoDisplay(const AValue: Boolean);
    procedure SetDataField(const AValue: string);
    procedure SetDataSource(const AValue: TDataSource);
    procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
  protected
    function GetReadOnly: Boolean; override;
    procedure SetReadOnly(AValue: Boolean); override;
    procedure DataChange(Sender: TObject); virtual;
    procedure ActiveChange(Sender: TObject); virtual;
    procedure Notification(AComponent: TComponent;
                           Operation: TOperation); override;
    procedure UpdateData(Sender: TObject); virtual;
    procedure FocusRequest(Sender: TObject); virtual;
    procedure Loaded; override;
    procedure Change; override;
    procedure KeyPress(var Key:Char); override;
    procedure WndProc(var AMessage : TLMessage); override;
    class procedure WSRegisterClass; override;
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure EditingDone; override;
    procedure LoadMemo; virtual;
    property Field: TField read GetField;
  published
    property Align;
    property Anchors;
    property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True;
    property BorderSpacing;
    property BorderStyle;
    property CharCase;
    property Color;
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property DragCursor;
    property DragMode;
    property Font;
    property MaxLength;
    property OnChange;
    property OnDragDrop;
    property OnDragOver;
    property OnEditingDone;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnStartDrag;
    property OnUTF8KeyPress;
    property ParentFont;
    property PopupMenu;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
    property ScrollBars;
    property TabOrder;
    property Tabstop;
    property Visible;
    property WordWrap;
  end;
  
  
  { TDBGroupBox }
  
  TDBGroupBox = class(TCustomGroupBox)
    FDataLink: TFieldDataLink;
    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetField: TField;
    procedure SetDataField(const AValue: string);
    procedure SetDataSource(const AValue: TDataSource);
    procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
  protected
    procedure DataChange(Sender: TObject); virtual;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    property Field: TField read GetField;
  published
    property Align;
    property Anchors;
    property BorderSpacing;
    property Caption;
    property ClientHeight;
    property ClientWidth;
    property Color;
    property Constraints;
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDrag;
    property OnUTF8KeyPress;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
  end;
  

  { TDBImage }

  TDBImage = class(TCustomImage)
  private
    FAutoDisplay: Boolean;
    FDataLink: TFieldDataLink;
    FQuickDraw: Boolean;
    FPictureLoaded: boolean;
    FUpdatingRecord: boolean;
    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetField: TField;
    function GetReadOnly: Boolean;
    procedure SetAutoDisplay(const AValue: Boolean);
    procedure SetDataField(const AValue: string);
    procedure SetDataSource(const AValue: TDataSource);
    procedure SetReadOnly(const AValue: Boolean);
    procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
  protected
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure DataChange(Sender: TObject); virtual;
    procedure UpdateData(Sender: TObject); virtual;
    procedure ActiveChange(Sender: TObject); virtual;
    procedure PictureChanged(Sender: TObject); override;
    procedure LoadPicture; virtual;
    procedure Loaded; override;
    class procedure WSRegisterClass; override;
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    property Field: TField read GetField;
    procedure Change; virtual;
  published
    property Align;
    property Anchors;
    property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True;
    property AutoSize;
    property BorderSpacing;
    property Center;
    property Constraints;
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property DragCursor;
    property DragMode;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
    property Proportional;
    property QuickDraw: Boolean read FQuickDraw write FQuickDraw default True;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
    property Stretch;
    property Transparent;
    property Visible;
  end;

  { TDBCalendar }

  TDBCalendar = class(TCalendar)
    FDataLink: TFieldDataLink;

    procedure DataChange(Sender: TObject);
    procedure UpdateData(Sender: TObject);
    procedure FocusRequest(Sender: TObject);

    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetField: TField;

    function GetReadOnly: Boolean;
    procedure SetReadOnly(Value: Boolean);

    procedure SetDate(const AValue: String);

    procedure SetDataField(const Value: string);
    procedure SetDataSource(Value: TDataSource);
    procedure UpdateDate(const AValue: string);
    procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
  protected
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure EditingDone; override;

    property Field: TField read GetField;
  published
    property BorderSpacing;
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;

    Property Date write SetDate stored False;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;

    property DisplaySettings stored False;
    property DragCursor;
    property DragMode;
    property Visible;
    property OnClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseMove;
    property OnMouseDown;
    property OnDayChanged;
    property OnMonthChanged;
    property OnStartDrag;
    property OnYearChanged;
  end;


  { TDBCustomNavigator }

type
  TDBNavButton = class;
  TDBNavDataLink = class;

  TDBNavGlyph = (ngEnabled, ngDisabled);
  TDBNavButtonType = (nbFirst, nbPrior, nbNext, nbLast,
                  nbInsert, nbDelete, nbEdit, nbPost, nbCancel, nbRefresh);
  TDBNavButtonSet = set of TDBNavButtonType;
  TDBNavButtonStyle = set of (nsAllowTimer, nsFocusRect);
  TDBNavButtonDirection = (nbdHorizontal,nbdVertical);
  
  // for Delphi compatibility
  TNavigateBtn = TDBNavButtonType;

  TDBNavClickEvent = procedure(Sender: TObject;
                                Button: TDBNavButtonType) of object;
  
const
  DefaultDBNavigatorButtons = [nbFirst, nbPrior, nbNext, nbLast,
    nbInsert, nbDelete, nbEdit, nbPost, nbCancel, nbRefresh];
  DBNavButtonResourceName: array[TDBNavButtonType] of string = (
 { nbFirst   } 'DBNavFirst',
 { nbPrior   } 'DBNavPrior',
 { nbNext    } 'DBNavNext',
 { nbLast    } 'DBNavLast',
 { nbInsert  } 'DBNavInsert',
 { nbDelete  } 'DBNavDelete',
 { nbEdit    } 'DBNavEdit',
 { nbPost    } 'DBNavPost',
 { nbCancel  } 'DBNavCancel',
 { nbRefresh } 'DBNavRefresh'
    );

type

  { TDBCustomNavigator }

  TDBCustomNavigator = class(TCustomPanel)
  private
    FBeforeAction: TDBNavClickEvent;
    FConfirmDelete: Boolean;
    FDataLink: TDBNavDataLink;
    FDirection: TDBNavButtonDirection;
    FFlat: Boolean;
    FOnNavClick: TDBNavClickEvent;
    FShowButtonHints: boolean;
    FVisibleButtons: TDBNavButtonSet;
    FDefaultHints: TStrings;
    FHints: TStrings;
    FUpdateButtonsNeeded: boolean;
    FUpdateButtonsLock: integer;
    FOriginalHints: String;
    procedure DefaultHintsChanged(Sender: TObject);
    function GetDataSource: TDataSource;
    function GetHints: TStrings;
    procedure SetDataSource(const AValue: TDataSource);
    procedure SetDirection(const AValue: TDBNavButtonDirection);
    procedure SetFlat(const AValue: Boolean);
    procedure SetHints(const AValue: TStrings);
    procedure SetShowButtonHints(const AValue: boolean);
    procedure SetVisibleButtons(const AValue: TDBNavButtonSet);
    procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
  protected
    Buttons: array[TDBNavButtonType] of TDBNavButton;
    procedure DataChanged; virtual;
    procedure EditingChanged; virtual;
    procedure ActiveChanged; virtual;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure UpdateButtons; virtual;
    procedure UpdateHints; virtual;
    procedure HintsChanged(Sender: TObject); virtual;
    procedure ButtonClickHandler(Sender: TObject); virtual;
    class function GetControlClassDefaultSize: TSize; override;
    procedure BeginUpdateButtons; virtual;
    procedure EndUpdateButtons; virtual;
    procedure SetEnabled(Value: Boolean); override;
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure BtnClick(Index: TNavigateBtn); virtual;
    function VisibleButtonCount: integer; virtual;
  public
    property BeforeAction: TDBNavClickEvent read FBeforeAction write FBeforeAction;
    property ConfirmDelete: Boolean read FConfirmDelete write FConfirmDelete default True;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property Direction: TDBNavButtonDirection read FDirection write SetDirection default nbdHorizontal;
    property Flat: Boolean read FFlat write SetFlat default False;
    property Hints: TStrings read GetHints write SetHints;
    property OnClick: TDBNavClickEvent read FOnNavClick write FOnNavClick;
    property VisibleButtons: TDBNavButtonSet read FVisibleButtons
                             write SetVisibleButtons default DefaultDBNavigatorButtons;
    property ShowButtonHints: boolean read FShowButtonHints write SetShowButtonHints default true;
  end;
  
  
  { TDBNavButton }

  TDBNavButton = class(TSpeedButton)
  private
    FIndex: TDBNavButtonType;
    FNavStyle: TDBNavButtonStyle;
  protected
  public
    destructor Destroy; override;
    property NavStyle: TDBNavButtonStyle read FNavStyle write FNavStyle;
    property Index: TDBNavButtonType read FIndex write FIndex;
  end;


  { TNavDataLink }

  TDBNavDataLink = class(TDataLink)
  private
    FNavigator: TDBCustomNavigator;
  protected
    procedure EditingChanged; override;
    procedure DataSetChanged; override;
    procedure ActiveChanged; override;
  public
    constructor Create(TheNavigator: TDBCustomNavigator);
    destructor Destroy; override;
  end;


  { TDBNavigator }

  TDBNavigator = class(TDBCustomNavigator)
  published
    property Align default alNone;
    property Alignment;
    property Anchors;
    property AutoSize;
    property BeforeAction;
    property BevelInner;
    property BevelOuter;
    property BevelWidth;
    property BorderSpacing;
    property BorderStyle;
    property BorderWidth;
    property Caption;
    property ChildSizing;
    property ClientHeight;
    property ClientWidth;
    property Color default clBackground;
    property ConfirmDelete;
    property DataSource;
    property Direction;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Flat;
    property Font;
    property Hints;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDrag;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop default False;
    property Visible;
    property VisibleButtons;
  end;
  

// ToDo: Move this to db.pp
function ExtractFieldName(const Fields: string; var StartPos: Integer): string;

procedure FillBarChart(BC: TBarChart; DS: TDataset;
  const LabelField, ValueField: String; AColor: TColor);

procedure ChangeDataSource(AControl: TControl; Link: TDataLink;
  NewDataSource: TDataSource);

procedure Register;

implementation

var
  FieldClasses: TList;

procedure RegFields(const AFieldClasses: array of TFieldClass);
var I: Integer;
    FieldClass: TFieldClass;
begin
  if FieldClasses = nil then FieldClasses := TList.Create;
  for I := Low(AFieldClasses) to High(AFieldClasses) do begin
    FieldClass := AFieldClasses[I];
    if (FieldClass <> Nil) And (FieldClasses.IndexOf(FieldClass) = -1) then
    begin
      FieldClasses.Add(FieldClass);
      RegisterNoIcon([FieldClass]);
      RegisterClass(FieldClass);
    end;
  end;
end;

function ExtractFieldName(const Fields: string; var StartPos: Integer): string;
var
  i: Integer;
begin
  i:=StartPos;
  while (i<=Length(Fields)) and (Fields[i]<>';') do Inc(i);
  Result:=Trim(Copy(Fields,StartPos,i-StartPos));
  if (i<=Length(Fields)) and (Fields[i]=';') then Inc(i);
  StartPos:=i;
end;

procedure FillBarChart(BC: TBarChart; DS: TDataset;
  const LabelField, ValueField: String; AColor: TColor);
Var
  LF : TList;
  VF : TField;
  I : Integer;
  L : String;
begin
  VF:=DS.FieldByName(ValueField);
  LF:=TList.Create;
  Try
    DS.GetFieldList(LF,LabelField);
    With DS do
      begin
      While Not EOF do
        begin
        L:='';
        For I:=0 to LF.Count-1 do
          begin
          If L<>'' then
            L:=L+' ';
          L:=L+TField(LF[i]).AsString;
          end;
        BC.AddBar(L, VF.AsInteger, AColor);
        Next;
        end;
      end;
  Finally
    LF.Free;
  end;
end;

procedure ChangeDataSource(AControl: TControl; Link: TDataLink;
  NewDataSource: TDataSource);
begin
  if Link.DataSource=NewDataSource then exit;
  if Link.DataSource<>nil then
    Link.DataSource.RemoveFreeNotification(AControl);
  Link.DataSource:=NewDataSource;
  if Link.DataSource<>nil then
    Link.DataSource.FreeNotification(AControl);
end;

procedure Register;
begin
  RegisterComponents('Data Controls',[TDBNavigator,TDBText,TDBEdit,TDBMemo,
    TDBImage,TDBListBox,TDBLookupListBox,TDBComboBox,TDBLookupComboBox,
    TDBCheckBox, TDBRadioGroup, TDBCalendar,TDBGroupBox]);
  RegFields(DefaultFieldClasses);
end;

function TFieldDataLink.FieldCanModify: boolean;
var
  FieldList: TList;
  i: Integer;
begin
  result := Assigned(FField);
  if not result then
    exit;

  if FField.FieldKind=fkLookup then
  begin
    FieldList := TList.Create;
    try
      DataSet.GetFieldList(FieldList, FField.KeyFields);
      result := (FieldList.Count>0);
      i := 0;
      while result and (i<FieldList.Count) do
      begin
        result := TField(FieldList[i]).CanModify;
        inc(i);
      end;
    finally
      FieldList.Free;
    end;
  end else
    result := FField.CanModify;
end;

{TFieldDataLink  Private Methods}
{
  If the field exists and can be modified, then
  we CanModify as long as this hasn't been set
  ReadOnly somewhere else. Do we need any extra tests here?
}
function TFieldDataLink.GetCanModify: Boolean;
begin
  if FieldCanModify then
    Result := not ReadOnly
  else
    Result := False;
end;

{
  Set the FieldName and then update the field to match,

  If we are changing the field from a previously valid field
  we need to make sure the editing state is updated, and that the
  DataChanged method is called, easiest way I think is to set the field
  to nil then call EditingChanged and Reset before we actually set the
  proper field. This way if this turns out to be an invalid fieldname we
  are already nil anyway and all the changes to state have been made.

  Next we look up the FieldByName on the attatched DataSource.. which we have
  to make sure exists first. assuming this worked properly, then we will have a
  valid Field again, so now we need to update the Editing state again
  and call the DataChanged again, so Reset. And then we are done... I think.

  If I am missing anything or am doing this all wrong please fix :)
}
procedure TFieldDataLink.SetFieldName(const Value: string);
begin
  if FFieldName <> Value then
  begin
    FFieldName := Value;
    If Assigned(FField) then begin
      FField := nil;
      EditingChanged;
      Reset;
    end;
    if (Value = '') then
      Exit;
    If Assigned(DataSource) and Assigned(DataSource.DataSet) then
      FField := DataSource.DataSet.FieldByName(FFieldName);

    If Assigned(FField) then begin
      EditingChanged;
      Reset;
    end;
  end;
end;

{
  Several functions seem to need to test the validity of
  the field/fieldname, so lets put it into its own function.
  This function checks if FField is assigned and if matches with current field
  instance of the linked dataset. If not, try to set the field name.
  Returns true if FField is set.
}
function TFieldDataLink.ValidateField : Boolean;
var
  RealFieldName : String;
begin
  Result := (FField <> nil) and (DataSet.FindField(FFieldName) = FField);
  if not Result then begin
    RealFieldName := FFieldName;
    if (RealFieldName <> '') then begin
      FFieldName := '';
      SetFieldName(RealFieldName);
    end;

    Result := (RealFieldName <> '') and Assigned(FField);
  end;
end;


{TFieldDataLink  Protected Methods}

{ Delphi Help ->
    Changes to the Active property trigger the ActiveChanged method.
    If an OnActiveChange event handler is assigned, ActiveChanged calls
    this event handler. If ActiveChanged is triggered by a transition into
    an active state, then before calling the event handler, ActiveChanged makes
    sure that the Field for this TFieldDataLink is still valid.
  <-- Delphi Help

   So... just call event if exists? unles Active then we test validity of
   field. does this simply mean not nil? or is more involved?
   call mock routine for now
   
   if it becomes inactive then the field is not valid anymore isn't?
}
procedure TFieldDataLink.ActiveChanged;
begin
  if Active and not ValidateField
  then
    exit;

  if not Active then
    FField := nil;
    
  if Assigned(FOnActiveChange) then
    FOnActiveChange(Self);
end;

{ not in the delphi version(well not int the help anyway)
  but the db version is calling RecordChange with nil,
  which is invalid if we have a real value, so just call reset
}
procedure TFieldDataLink.DataSetChanged;
begin
  //workaround to fpc bug 16428 (LayoutChanged not being called)
  //in some situations (e.g. creating fields at design time) the
  //FField can point to an invalid reference leading to a crash
  //todo: remove ValidateField after fpc bug 16428 is fixed
  ValidateField;
  reset;
end;


{ Delphi Help ->
    Changing the field binding can change the validity of the CanModify
    property, since individual field components can disallow edits. If
    TFieldDataLink is in an editing state when the Field property is changed,
    EditingChanged checks the CanModify property. If CanModify is False, it
    changes back out of the editing state.

    Note: This differs significantly from the inherited EditingChanged method
    of TDataLink. The functionality of the inherited method is replaced in
    TFieldDataLink by the OnEditingChange event handler.
  <-- Delphi Help

  ok so another event... but this time we simply change modified state
  if Editing and not CanModify? or do we also change to match if
  if not Editing and CanModify? i.e If Editing <> CanModify??  Will assume
  the latter just in case. easy to change back if I am wrong.

  Also based on this we replace parent routine, so do we need to keep track
  of Editing state ourself? I hope this is right. Anyone know for sure?

  OK .. based on the Modified routine we need to turn off
  our IsModified routine when succesfull right? so for now just turn
  it off as per my example.
}
procedure TFieldDataLink.EditingChanged;
var
  RealEditState : Boolean;
begin
  RealEditState := (CanModify and Inherited Editing);

  if (FEditing <> RealEditState) then
  begin
    FEditing := RealEditState;
    if not FEditing then
      IsModified := False;
    if Assigned(FOnEditingChange) then
      FOnEditingChange(Self);
  end;
end;

{ Delphi Help ->
    LayoutChanged is called after changes in the layout of one of the
    containers of the Control for this TFieldDataLink that might change the
    validity of its field binding. For example, if the Control is embedded
    within a TCustomDBGrid, and one of the columns is deleted, the Field
    property for the Control might become invalid.
  <-- Delphi Help

  So... just another field validity check? call our mock routine...
}
procedure TFieldDataLink.LayoutChanged;
begin
  ValidateField;
  if Assigned(FOnLayoutChange) then
    FOnLayoutChange(Self);
end;

{ Delphi Help ->
    Applications can not call this protected method. It is triggered
    automatically when the contents of the current record change.
    RecordChanged calls the OnDataChange event handler if there is one.
  <-- Delphi Help

  Ok so just a simple Event Handler.. what. no extra tests? we gotta
  have at least one.. :)

  yeah lets go ahead and make sure the field matches the
  internal one. can it ever not? and if not what about nil? do we
  need to do something special? maybe another test is needed later....

  does this only get called after Modified? assume so till I know otherwise
  and turn off IsModified.

  hah. same thing as Reset but with a test so lets just call Reset and let
  it do the work
}
procedure TFieldDataLink.RecordChanged(aField: TField);
begin
  if (aField = FField) then
     Reset;
end;

{ Delphi Help ->
    UpdateData overrides the default UpdateData method to call the
    OnUpdateData event handler where the data-aware control can write any
    pending edits to the record in the dataset.
  <-- Delphi Help

  where..can write pending events. So I guess when we have already
  called Modified? Aka if not IsModified exit otherwise call event?
  works for me.
}
procedure TFieldDataLink.UpdateData;
begin
  if not IsModified then
    exit;

  if Assigned(FOnUpdateData) then
    FOnUpdateData(Self);

  IsModified := False;
end;

{ Delphi Help ->
    Call FocusControl to give the Control associated with this TFieldDataLink
    object the input focus. FocusControl checks whether the Control can receive
    input focus, and if so, calls its SetFocus method to move focus to the
    Control.
  <-- Delphi Help

  so seems it just calls SetFocus on TWinControls, since this DataLink should
  really go into the FCL, we just add our own callback which the DB aware
  controls that can get focus then assign to do the real SetFocus, thus removing
  need for visual dependency.
}

procedure TFieldDataLink.FocusControl(aField: TFieldRef);
begin
  If Assigned(aField) and (aField^ = FField) then
    if Assigned(FOnFocusRequest) then begin
      aField^ := nil;
      FOnFocusRequest(Self);
    end;
end;

{TFieldDataLink  Public Methods}

constructor TFieldDataLink.Create;
begin
  inherited Create;
  VisualControl := True;
  FField := nil;
  FFieldname := '';
end;

destructor TFieldDataLink.Destroy;
begin
  inherited Destroy;
end;

{ Delphi Help ->
    Use Edit to try to ensure that the contents of the field can be modified.
    A return value of True indicates that the field was already in an editing
    state, or that the DataSource was successfully changed to allow editing.
    A return value of False indicates that the DataSource could not be changed
    to allow editing. For example, if the CanModify property is False, Edit
    fails, and returns False.
  <-- Delphi Help

  ok so the way I see it, since the inherited function calls EditingChanged,
  which we have already overriden to modify our own Editing state if its invalid,
  I should just be calling the inherited routine here, but only if CanModify,
  since there is no point otherwise. But since we _are_ keeping track of editing
  state ourselves we return our own state, not the inherited. If anyone know
  better please fix.
}
function TFieldDataLink.Edit: Boolean;
begin
  if (not FEditing) and CanModify then
    inherited Edit;

  Result := FEditing;
end;

{ Delphi Help ->
    Call Modified when the Control for this TFieldDataLink begins processing
    edits.
  <-- Delphi Help

  ok so. well _that's_ helpfull. for the moment going to keep track
  by adding an IsModified... based on the other functions thus far
  we need to know whether we are in state, so I am assuming it goes

  Call Modified ->
    IsModified:=True;//Waiting for modifications

  Call SomeFunction->
    If IsModified then begin
      (do something)
      IsModified := False;//All modifications complete
    end
    else
     (do something else? exit?);
}
procedure TFieldDataLink.Modified;
begin
  IsModified := True;
end;

{ Delphi Help ->
    The Control that owns a TFieldDataLink object calls its Reset method to
    process a UI action that cancels edits to the field. Reset calls the
    OnDataChange event handler without writing any pending changes to the
    record in the dataset.
  <-- Delphi Help

  hrmm. just call to the OnDataChange Event, and turn off IsModified I guess
  better ideas anyone?

  oh huh. same thing as RecordChanged but without the test so I can just
  have it call this instead :)
}
procedure TFieldDataLink.Reset;
begin
  if active and Assigned(FOnDataChange) then
    FOnDataChange(Self);

  IsModified := False;
end;

{$Include dblookup.inc}
{$Include dbedit.inc}
{$Include dbtext.inc}
{$Include customdblistbox.inc}
{$Include dblistbox.inc}
{$Include dblookuplistbox.inc}
{$Include dbradiogroup.inc}
{$Include dbcheckbox.inc}
{$Include customdbcombobox.inc}
{$Include dbcombobox.inc}
{$Include dblookupcombobox.inc}
{$Include dbmemo.inc}
{$Include dbgroupbox.inc}
{$Include dbimage.inc}
{$Include dbcalendar.inc}
{$Include dbcustomnavigator.inc}


initialization
  {$I lcl_dbnav_images.lrs}

finalization
  FieldClasses.Free;

end.