53
53
FDataLink.ReadOnly:=AValue;
56
procedure TDBCheckBox.SetValueCheck(const AValue: string);
58
if FValueCheck=AValue then exit;
63
procedure TDBCheckBox.SetValueUncheck(const AValue: string);
65
if FValueUncheck=AValue then exit;
66
FValueUncheck:=AValue;
56
procedure TDBCheckBox.SetValueChecked(const AValue: string);
58
if FValueChecked=AValue then exit;
59
FValueChecked:=AValue;
63
procedure TDBCheckBox.SetValueUnchecked(const AValue: string);
65
if FValueUnchecked=AValue then exit;
66
FValueUnchecked:=AValue;
70
//check if Word is equal to S or is one of the ; delimitted words in s
71
//whitespace between Word and delimiter is ignored (Delphi behavior)
72
function FindWord(const Word, S: String): Boolean;
82
J := I + Length(Word);
84
while Result and (J < L) do
94
while Result and (I > 0) do
70
105
function TDBCheckBox.GetFieldCheckState: TCheckBoxState;
72
107
FieldText: string;
108
DataLinkField: TField;
74
if FDatalink.Field=nil then begin
110
DataLinkField := FDataLink.Field;
111
if DatalinkField=nil then begin
75
112
Result:=cbUnchecked;
78
if FDataLink.Field.IsNull then
115
if DataLinkField.IsNull then
80
else if FDataLink.Field.DataType = ftBoolean then begin
81
if FDataLink.Field.AsBoolean then
117
else if DataLinkField.DataType = ftBoolean then begin
118
if DataLinkField.AsBoolean then
84
121
Result:=cbUnchecked;
87
FieldText:=FDatalink.Field.AsString;
88
if AnsiSameText(FValueCheck,FieldText) then
123
FieldText:=UpperCase(DatalinkField.AsString);
124
if FindWord(FieldText,UpperCase(FValueChecked)) then
90
else if AnsiSameText(FValueUncheck,FieldText) then
126
else if FindWord(FieldText,UpperCase(FValueUnchecked)) then
97
135
State:=GetFieldCheckState;
138
procedure TDBCheckBox.DoOnChange;
140
//avoid reseting value when state changes
141
FDataLink.OnDataChange := nil;
142
if FDatalink.Edit then begin
144
FDataLink.UpdateRecord;
146
State:=GetFieldCheckState;
147
FDataLink.OnDataChange := @DataChange;
148
inherited DoOnChange;
100
151
procedure TDBCheckBox.UpdateData(Sender: TObject);
102
153
NewFieldText: string;
108
159
FDataLink.Field.AsBoolean:=Checked
111
NewFieldText:=FValueCheck
162
NewFieldText:=FValueChecked
113
NewFieldText:=FValueUncheck;
164
NewFieldText:=FValueUnchecked;
114
165
// ToDo: use Field.Text
115
166
FDataLink.Field.AsString:=Trim(NewFieldText);
119
procedure TDBCheckBox.FocusRequest(Sender: TObject);
121
//the FieldLink has requested the control
122
//recieve focus for some reason..
123
//perhaps an error occured?
127
procedure TDBCheckBox.Notification(AComponent: TComponent; Operation: TOperation
170
procedure TDBCheckBox.Notification(AComponent: TComponent; Operation: TOperation);
130
172
inherited Notification(AComponent, Operation);
131
173
if (Operation=opRemove) then begin
137
procedure TDBCheckBox.Loaded;
140
if (csDesigning in ComponentState) then
144
procedure TDBCheckBox.EditingDone;
146
if FDatalink.Edit then begin
148
FDataLink.UpdateRecord;
150
State:=GetFieldCheckState;
151
inherited EditingDone;
154
179
procedure TDBCheckBox.CMGetDataLink(var Message: TLMessage);
156
181
Message.Result := PtrUInt(FDataLink);