📄 dblookupeh.pas
字号:
FreeAndNil(FDropDownBox);
// FDropDownBox := nil;
inherited Destroy;
end;
function TCustomDBLookupComboboxEh.CanModify(TryEdit: Boolean): Boolean;
function MasterFieldsCanModify: Boolean;
var i: Integer;
begin
Result := True;
for i := 0 to Length(FMasterFields) - 1 do
if not FMasterFields[i].CanModify then
begin
Result := False;
Exit;
end;
end;
begin
Result := (FKeyTextIndependent or FListActive) and
not ReadOnly and
((FDataLink.DataSource = nil) or (Length(FMasterFields) <> 0) and MasterFieldsCanModify);
if TryEdit and Result and (Length(FMasterFields) <> 0) then
Result := FDataLink.Edit;
end;
function TCustomDBLookupComboboxEh.CreateEditButton: TEditButtonEh;
begin
Result := TVisibleEditButtonEh.Create(Self {,FEditSpeedButton});
end;
function TCustomDBLookupComboboxEh.CreateDataLink: TFieldDataLinkEh;
begin
Result := TFieldDataLinkEh(TDataSourceLinkEh.Create);
TDataSourceLinkEh(Result).FDBLookupControl := Self;
end;
procedure TCustomDBLookupComboboxEh.CheckNotCircular;
begin
if FListLink.Active and FListLink.DataSet.IsLinkedTo(DataSource) then
DatabaseError(SCircularDataLink);
end;
procedure TCustomDBLookupComboboxEh.CheckNotLookup;
begin
if FLookupMode then DatabaseError(SPropDefByLookup);
if FDataLink.DataSourceFixed then DatabaseError(SDataSourceFixed);
end;
function TCustomDBLookupComboboxEh.DefaultAlignment: TAlignment;
begin
if FKeyTextIndependent then Result := inherited DefaultAlignment
else Result := taLeftJustify;
end;
procedure TCustomDBLookupComboboxEh.UpdateDataFields;
function MasterFieldNames: String;
var i: Integer;
begin
Result := '';
for i := 0 to Length(FMasterFields) - 1 do
if Result = '' then
Result := FMasterFields[i].FieldName else
Result := Result + ';' + FMasterFields[i].FieldName;
end;
begin
if FDataFieldsUpdating then Exit;
FDataFieldsUpdating := True;
try
SetLength(FDataFields, 0); //FDataField := nil;
SetLength(FMasterFields, 0); //FMasterField := nil;
FMasterFieldNames := '';
if FDataLink.DataSetActive and (FDataFieldName <> '') then
begin
CheckNotCircular;
FDataFields := GetFieldsProperty(FDataLink.DataSet, Self, FDataFieldName);
if (Length(FDataFields) = 1) and (FDataFields[0].FieldKind = fkLookup) then
FMasterFields := GetFieldsProperty(FDataLink.DataSet, Self, FDataFields[0].KeyFields)
else
FMasterFields := FDataFields;
FMasterFieldNames := MasterFieldNames;
end;
SetLookupMode((Length(FDataFields) = 1) and (FDataFields[0].FieldKind = fkLookup));
if FMasterFieldNames = '' then DataLink.FieldName := FDataFieldName
else DataLink.FieldName := FMasterFieldNames;
UpdateKeyTextIndependent;
UpdateReadOnly;
UpdateEditButtonControlsState; //UpdateButtonState;
if not FKeyTextIndependent then
DataLink.RecordChanged(nil);
finally
FDataFieldsUpdating := False;
end;
end;
procedure TCustomDBLookupComboboxEh.UpdateListFields;
var
DataSet: TDataSet;
ResultField: TField;
i: Integer;
OldModified: Boolean;
begin
if ListVisible then Exit;
FListActive := False;
UpdateEditButtonControlsState;
//FKeyField := nil;
FListField := nil;
FListFields.Clear;
if FListLink.Active and (FKeyFieldName <> '') then
begin
CheckNotCircular;
DataSet := FListLink.DataSet;
FKeyFields := GetFieldsProperty(DataSet, Self, FKeyFieldName);
GetFieldsProperty(FListFields, DataSet, Self, FListFieldName);
if FLookupMode then
begin
ResultField := GetFieldProperty(DataSet, Self, FDataFields[0].LookupResultField);
if FListFields.IndexOf(ResultField) < 0 then
FListFields.Insert(0, ResultField);
FListField := ResultField;
end else
begin
if FListFields.Count = 0 then
for i := 0 to Length(FKeyFields) - 1 do FListFields.Add(FKeyFields[i]);
if (FListFieldIndex >= 0) and (FListFieldIndex < FListFields.Count) then
FListField := TField(FListFields[FListFieldIndex]) else
FListField := TField(FListFields[0]);
end;
FListActive := True;
end;
UpdateKeyTextIndependent;
UpdateReadOnly;
UpdateEditButtonControlsState; //UpdateButtonState;
//KeyValueChanged; //Comment to avoid update data on loss focus
OldModified := Modified;
if not FKeyTextIndependent then
if not FListActive then
if csDesigning in ComponentState then
SetEditText(Name)
else {if not DataIndepended then}
SetEditText('')
else if FFocused and SpecListMode and LocateDataSourceKey(FullListSource) then
SetEditText(GetDisplayText(FullListSource.DataSet.FieldByName(FListField.FieldName)))
else if DropDownBox.SpecRow.Visible and
(DropDownBox.SpecRow.LocateKey(FKeyValue) or
(DropDownBox.SpecRow.ShowIfNotInKeyList and not LocateKey)
) then
SetEditText(DropDownBox.SpecRow.CellText[ListFieldIndex])
else if not LocateKey then
SetEditText('')
else
SetEditText(GetDisplayText(FListField));
if OldModified <> Modified then
begin
Modified := OldModified;
FDataLink.SetModified(OldModified);
end;
Invalidate;
end;
procedure TCustomDBLookupComboboxEh.DataChanged;
begin
//if (Field = nil) or (Field = FMasterField) then
if DataIndepended and
(TDataSourceLinkEh(FDataLink).FDataIndependentValueAsText = True) then
begin
SetEditText(VarToStr(DataLink.DataIndependentValue));
LocateStr(Text, False);
end else
begin
if DataLink.DataSetActive and (Length(FMasterFields) > 0) and
(FMasterFieldNames <> '') then
SetKeyValue(DataLink.DataSet.FieldValues[FMasterFieldNames])
else if DataIndepended then
SetKeyValue(DataLink.DataIndependentValue)
else
SetKeyValue(Null);
if ListActive then
if FFocused and SpecListMode and LocateDataSourceKey(FullListSource) then
SetEditText(GetDisplayText(FullListSource.DataSet.FieldByName(FListField.FieldName)))
else if DropDownBox.SpecRow.Visible and
(DropDownBox.SpecRow.LocateKey(FKeyValue) or
(DropDownBox.SpecRow.ShowIfNotInKeyList and not LocateKey)
)
then
SetEditText(DropDownBox.SpecRow.CellText[ListFieldIndex])
else if not LocateKey then
SetEditText('');
end;
Modified := False;
end;
function TCustomDBLookupComboboxEh.GetKeyFieldName: String;
begin
if FLookupMode then Result := '' else Result := FKeyFieldName;
end;
function TCustomDBLookupComboboxEh.GetListSource: TDataSource;
begin
if FLookupMode then Result := nil else Result := FListSource//FListLink.DataSource;
end;
function TCustomDBLookupComboboxEh.UsedListSource: TDataSource;
begin
if Focused and Assigned(DropDownBox.ListSource) and not (csDesigning in ComponentState) then
Result := DropDownBox.ListSource
else if FLookupMode then
Result := FLookupSource
else
Result := ListSource;
end;
function TCustomDBLookupComboboxEh.SpecListMode: Boolean;
begin
Result := (UsedListSource <> nil) and (UsedListSource = DropDownBox.ListSource);
end;
function TCustomDBLookupComboboxEh.FullListSource: TDataSource;
begin
if FLookupMode
then Result := FLookupSource
else Result := ListSource;
end;
function TCustomDBLookupComboboxEh.LocateDataSourceKey(DataSource: TDataSource): Boolean;
begin
Result := False;
if (DataSource = nil) or (DataSource.DataSet = nil) then Exit;
if not VarIsNull(FKeyValue) and DataSource.DataSet.Active and
CompatibleVarValue(FKeyFields, FKeyValue) and
DataSource.DataSet.Locate(FKeyFieldName, FKeyValue, [])
then
Result := True;
end;
procedure TCustomDBLookupComboboxEh.UpdateListLinkDataSource;
begin
FListLink.DataSource := UsedListSource;
end;
procedure TCustomDBLookupComboboxEh.KeyValueChanged;
begin
FDataLink.Modified;
Modified := True;
if not FKeyTextIndependent then
if ListActive then
begin
if LocateKey and not DropDownBox.SpecRow.LocateKey(FKeyValue) then
SetEditText(GetDisplayText(FListField));
{else if KeyValue = Null then
SetEditText('')}
end
else if csDesigning in ComponentState then
SetEditText(Name);
{else if Style = csDropDownListEh then
SetEditText('');}
if FListVisible then
FDataList.KeyValue := KeyValue;
if (Style = csDropDownListEh) and HandleAllocated then SelectAll;
if Assigned(FOnKeyValueChanged) then FOnKeyValueChanged(Self);
end;
procedure TCustomDBLookupComboboxEh.ListLinkDataChanged;
begin
end;
function TCustomDBLookupComboboxEh.ButtonEnabled: Boolean;
begin
Result := inherited ButtonEnabled and
(ListActive or Assigned(OnButtonClick) or Assigned(OnButtonDown));
end;
function TCustomDBLookupComboboxEh.LocateKey: Boolean;
var
KeySave: Variant;
begin
Result := False;
try
KeySave := FKeyValue;
if not VarIsNull(FKeyValue) and FListLink.DataSet.Active and
CompatibleVarValue(FKeyFields, FKeyValue) and
FListLink.DataSet.Locate(FKeyFieldName, FKeyValue, []) then
begin
Result := True;
FKeyValue := KeySave;
end;
except
end;
end;
procedure TCustomDBLookupComboboxEh.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if Operation = opRemove then
if (FListLink <> nil) and (AComponent = ListSource)
then ListSource := nil
else if (FDropDownBox <> nil) and (AComponent = FDropDownBox.ListSource) then
begin
FDropDownBox.ListSource := nil;
Reset;
end;
end;
procedure TCustomDBLookupComboboxEh.ProcessSearchStr(Str: String);
var
S, SearchText: String;
OldSelLenght: Integer;
begin
if (FListField <> nil) and (FListField.FieldKind in [fkData, fkInternalCalc]) {and
(FListField.DataType in [ftString, ftWideString])} then
if CanModify(True) then
begin
if (Length(Str) = 1) and (Str[1] = #8) then {BACKSPACE}
begin
if Length(Text) = SelLength then
begin
SelStart := MAXINT;
SelLength := -1;
end else
begin
OldSelLenght := Abs(SelLength);
SelStart := MAXINT;
SelLength := -OldSelLenght - 1;
end
end else
begin
SearchText := Copy(Text, 1, SelStart);
S := SearchText + Str;
LocateStr(S, True);
end;
end;
end;
procedure TCustomDBLookupComboboxEh.HookOnChangeEvent(Sender: TObject);
begin
FTextBeenChanged := True;
end;
function TCustomDBLookupComboboxEh.LocateStr(Str: String; PartialKey: Boolean): Boolean;
var
Options: TLocateOptions;
CurOnChangeEvent: TNotifyEvent;
begin
Result := False;
if not FListActive or not CanModify(True) then Exit;
if PartialKey then
Options := [loCaseInsensitive, loPartialKey]
else
Options := [loCaseInsensitive];
try
Result := FListLink.DataSet.Locate(FListField.FieldName, Str, Options);
if Result then
begin
FTextBeenChanged := False;
CurOnChangeEvent := OnChange;
OnChange := HookOnChangeEvent;
SetKeyValue(FListLink.DataSet.FieldValues[FKeyFieldName]);
SetEditText(GetDisplayText(FListField));
SelStart := Length(Text);
SelLength := Length(Str) - SelStart;
OnChange := CurOnChangeEvent;
if FTextBeenChanged and Assigned(OnChange) then
OnChange(Self);
end else if Style = csDropDownEh then
SetKeyValue(Null);
except
{ If you attempt to search for a String larger than what the field
can hold, and exception will be raised. Just trap it and
reset the SearchText back to the old value. }
if Style = csDropDownListEh then
begin
SetEditText(Text);
SelStart := Length(Text);
SelLength := Length(Text) - SelStart;
end else
SetKeyValue(Null);
end;
end;
procedure TCustomDBLookupComboboxEh.SelectKeyValue(const Value: Variant);
begin
if Length(FMasterFields) > 0 then
begin
if FDataLink.Edit then
FDataLink.DataSet.FieldValues[FMasterFieldNames] := Value;
end else
begin
SetKeyValue(Value);
if FDataPosting then Exit;
try
UpdateData;
except
FDataLink.Reset;
raise;
end;
end;
if ListActive and not LocateKey and not
( DropDownBox.SpecRow.Visible and
(DropDownBox.SpecRow.LocateKey(FKeyValue) or
(DropDownBox.SpecRow.ShowIfNotInKeyList and not LocateKey))
)
then
SetEditText('');
// Repaint;
// Click;
end;
procedure TCustomDBLookupComboboxEh.SetDataFieldName(const Value: String);
begin
if FDataFieldName <> Value then
begin
FDataFieldName := Value;
UpdateDataFields;
end;
end;
procedure TCustomDBLookupComboboxEh.SetKeyFieldName(const Value: String);
begin
CheckNotLookup;
if FKeyFieldName <> Value then
begin
FKeyFieldName := Value;
FDataList.KeyField := Value;
UpdateListFields;
end;
end;
procedure TCustomDBLookupComboboxEh.SetKeyValue(const Value: Variant);
begin
if not VarEquals(FKeyValue, Value) then
begin
FKeyValue := Value;
KeyValueChanged;
end;
end;
procedure TCustomDBLookupComboboxEh.SetListFieldName(const Value: String);
begin
if FListFieldName <> Value then
begin
FListFieldName := Value;
FDataList.ListField := Value;
UpdateListFields;
end;
end;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -