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
|
{%MainUnit ../dbctrls.pp}
{******************************************************************************
TDBListBox
data aware ListBox, base found in dbctrls.pp
******************************************************************************
*****************************************************************************
This file is part of the Lazarus Component Library (LCL)
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
*****************************************************************************
}
// included by dbctrls.pp
{ Private Methods }
function TCustomDBListBox.GetDataField: string;
begin
Result := FDataLink.FieldName;
end;
function TCustomDBListBox.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;
function TCustomDBListBox.GetField: TField;
begin
Result := FDataLink.Field;
end;
procedure TCustomDBListBox.SetItems(Values : TStrings);
begin
Items.Assign(Values);
DataChange(Self);
end;
//we want to override the readonly state so we can
//reflect the state of the Datalink/Field
function TCustomDBListBox.GetReadOnly: Boolean;
begin
//we want to override the readonly state so we can
//reflect the state of the Datalink/Field
Result := FDataLink.ReadOnly;
end;
procedure TCustomDBListBox.SetReadOnly(Value: Boolean);
begin
//we want to override the readonly state so we can
//reflect the state of the Datalink/Field, so changing
//readonly changes the DataLink to ReadOnly, and when Editing
//changes the 'real' Readonly state will be updated to match
//according to the editing flag, which will always be false if
//this is true anyway. so I think all should be happy...
FDataLink.ReadOnly := Value;
end;
procedure TCustomDBListBox.SetDataField(const Value: string);
begin
FDataLink.FieldName := Value;
end;
procedure TCustomDBListBox.SetDataSource(Value: TDataSource);
begin
ChangeDataSource(Self,FDataLink,Value);
end;
procedure TCustomDBListBox.CMGetDataLink(var Message: TLMessage);
begin
Message.Result := PtrUInt(FDataLink);
end;
{ Protected Methods}
procedure TCustomDBListBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
inherited KeyDown(Key,Shift);
case Key of
VK_ESCAPE:
begin
//cancel out of editing by reset on esc
FDataLink.Reset;
Key := VK_UNKNOWN;
end;
VK_DOWN, VK_UP:
begin
FDataLink.Edit;
end;
end;
end;
procedure TCustomDBListBox.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
// if the datasource is being removed then we need to make sure
// we are updated or we can get AV/Seg's *cough* as I foolishly
// discovered firsthand....
if (Operation=opRemove) then begin
if (FDataLink<>nil) and (AComponent=DataSource) then
DataSource:=nil;
end;
end;
{ Public Methods }
constructor TCustomDBListBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FDataLink := TFieldDataLink.Create;
FDataLink.Control := Self;
FDataLink.OnDataChange := @DataChange;
FDataLink.OnUpdateData := @UpdateData;
end;
destructor TCustomDBListBox.Destroy;
begin
FDataLink.Destroy;
inherited Destroy;
end;
function TCustomDBListBox.ExecuteAction(AAction: TBasicAction): Boolean;
begin
Result := inherited ExecuteAction(AAction) or
(FDataLink <> nil) and FDataLink.ExecuteAction(AAction);
end;
function TCustomDBListBox.UpdateAction(AAction: TBasicAction): Boolean;
begin
Result := inherited UpdateAction(AAction) or
(FDataLink <> nil) and FDataLink.UpdateAction(AAction);
end;
|
