cxdblookupedit.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 871 行 · 第 1/2 页

PAS
871
字号
begin
  inherited LockDataChanged;
  // TODO: if GridMode
  if (DataController <> nil) and DataController.IsGridMode then
    Inc(FLockGridModeCount);
  if FLockGridModeCount <> 0 then
    DataController.LockGridModeNotify;
end;

procedure TcxCustomDBLookupEditProperties.LookupSourceFreeNotification(Sender: TComponent);
begin
  CheckLookup;
end;

procedure TcxCustomDBLookupEditProperties.SetDisplayColumnIndex(Value: Integer);
begin
  if IsDefinedByLookup and not FSyncLookup then
    DefineByLookupError;
  inherited SetDisplayColumnIndex(Value);
end;

procedure TcxCustomDBLookupEditProperties.SetLookupField(ALookupField: TField);
begin
  if FLookupField <> ALookupField then
  begin
    FLookupField := ALookupField;
    if FLookupField <> nil then
    begin
      // Lookup Source
      if FCachedLookupSource = nil then
        FCachedLookupSource := TDataSource.Create(nil);
      FLookupSource := FCachedLookupSource;

      FreeAndNil(FLookupSourceFreeNotificator);
      FLookupSourceFreeNotificator := TcxFreeNotificator.Create(nil);
      FLookupSourceFreeNotificator.OnFreeNotification := LookupSourceFreeNotification;
      FLookupSourceFreeNotificator.AddSender(FLookupField);

      FLookupSource.DataSet := FLookupField.LookupDataSet;
      // Sync Lookup Data
      if DataController <> nil then
      begin
        FSyncLookup := True;
        try
//          if DataController.DataSet <> FLookupSource.DataSet then // SC DB11573
            DataController.DataSource := FLookupSource;
          if GetDBLookupGridColumnIndexByFieldName(FLookupField.LookupResultField) = -1 then
            ListFieldNames := FLookupField.LookupResultField;
          KeyFieldNames := FLookupField.LookupKeyFields;
          ListFieldIndex := 0;
        finally
          FSyncLookup := False;
        end;
      end;
    end
    else
    begin
      FreeAndNil(FLookupSourceFreeNotificator);
      FLookupSource := nil;
      if (DataController <> nil) and (DataController.DataSource = FCachedLookupSource) then
        DataController.DataSource := nil;
    end;
  end;
end;

procedure TcxCustomDBLookupEditProperties.UnlockDataChanged;
begin
  if FLockGridModeCount <> 0 then
  begin
    if DataController <> nil then
      DataController.UnlockGridModeNotify;
    Dec(FLockGridModeCount);
  end;
  inherited UnlockDataChanged;
end;

function TcxCustomDBLookupEditProperties.FindByText(AItemIndex: Integer;
  const AText: string; APartialCompare: Boolean): Integer;

  function GetLocateOptions: TLocateOptions;
  begin
    Result := [];
    if not CaseSensitiveSearch then
      Include(Result, loCaseInsensitive);
    if APartialCompare then
      Result := Result + [loPartialKey];
  end;

  function GetLocateValue: Variant;
  begin
    Result := AText;
    // TDataSet.Locate does not work with empty strings passed as key values for numeric fields
    if (AText = '') and not (DataController.GetItemField(AItemIndex) is TStringField) then
      Result := Null;
  end;

var
  ADataSet: TDataSet;
  AListFieldName: string;
begin
  if not IsUseLookupList then
  begin
    Result := inherited FindByText(AItemIndex, AText, APartialCompare);
    Exit;
  end;

  Result := -1;
  LockDataChanged;
  try
    ADataSet := DataController.DataSet;
    AListFieldName := DataController.GetItemFieldName(AItemIndex);
    try
      if (ADataSet <> nil) and ADataSet.Active and (AItemIndex <> -1) and
        ADataSet.Locate(AListFieldName, GetLocateValue, GetLocateOptions) then
          Result := DataController.GetFocusedRecordIndex;
    except
      on EDatabaseError do;
      on EVariantError do;
    end;
  finally
    UnlockDataChanged;
  end;
end;

function TcxCustomDBLookupEditProperties.GetDisplayColumnIndex: Integer;
var
  AFieldName: string;
begin
  AFieldName := GetLookupResultFieldName;
  if AFieldName <> '' then
    Result := GetDBLookupGridColumnIndexByFieldName(AFieldName)
  else
    Result := inherited GetDisplayColumnIndex;
end;

function TcxCustomDBLookupEditProperties.GetDisplayLookupText(const AKey: TcxEditValue): string;
var
  ARecordIndex: Integer;
  AItemIndex: Integer;
  ADataSet: TDataSet;
begin
  Result := '';
  AItemIndex := GetListIndex;
  if (AItemIndex <> -1) and (DataController <> nil) then
  begin
    if IsUseLookupList then
    begin

      // TODO: proc?
      if FLookupList.Find(AKey, ARecordIndex) then
        Result := FLookupList[ARecordIndex]^.DisplayText
      else
      begin
        ADataSet := DataController.DataSet;
        LockDataChanged;
        try
          if (ADataSet <> nil) and ADataSet.Active and (ListField <> nil) and
            CanCallDataSetLocate(DataController.DataSet, KeyFieldNames, AKey) and
            ADataSet.Locate(KeyFieldNames, AKey, []) then
            Result := ListField.AsString {ListField.DisplayText}
          else
            Result := '';
        finally
          UnlockDataChanged;
        end;
        FLookupList.Insert(ARecordIndex, AKey, Result);
      end;

    end
    else
    begin
      ARecordIndex := GetRecordIndexByKey(AKey);
      if ARecordIndex <> -1 then
        Result := DataController.DisplayTexts[ARecordIndex, AItemIndex];
    end;
  end;
end;

function TcxCustomDBLookupEditProperties.GetDefaultHorzAlignment: TAlignment;
begin
  if ListField <> nil then
    Result := ListField.Alignment
  else
    Result := inherited GetDefaultHorzAlignment;
end;

function TcxCustomDBLookupEditProperties.GetDefaultMaxLength: Integer;
begin
  if ListField <> nil then
    Result := ListField.Size
  else
    Result := inherited GetDefaultMaxLength;
end;

function TcxCustomDBLookupEditProperties.GetIncrementalFiltering: Boolean;
begin
  if IsUseLookupList then
    Result := False
  else
    Result := inherited GetIncrementalFiltering;
end;

function TcxCustomDBLookupEditProperties.GetKeyByRecordIndex(ARecordIndex: Integer): Variant;
begin
  if (ARecordIndex <> -1) and (DataController <> nil) then
    Result := DataController.GetRecordId(ARecordIndex)
  else
    Result := Null;
end;

class function TcxCustomDBLookupEditProperties.GetLookupDataClass: TcxInterfacedPersistentClass;
begin
  Result := TcxCustomDBLookupEditLookupData;
end;

function TcxCustomDBLookupEditProperties.GetLookupResultFieldName: string;
begin
  if GetLookupField <> nil then
    Result := GetLookupField.LookupResultField
  else
    Result := '';
end;

function TcxCustomDBLookupEditProperties.GetNullKey: Variant;
var
  I, C: Integer;
begin
  if IsMultipleFieldNames(KeyFieldNames) then
  begin
    C := GetFieldNamesCount(KeyFieldNames);
    Result := VarArrayCreate([0, C - 1], varVariant);
    for I := 0 to C - 1 do
      Result[I] := Null;
  end
  else
    Result := Null;
end;

function TcxCustomDBLookupEditProperties.GetRecordIndexByKey(const AKey: Variant): Integer;
begin
  try
    Result := DataController.FindRecordIndexByKey(AKey);
  except
    on EVariantError do
      Result := -1;
  end;
end;

function TcxCustomDBLookupEditProperties.GetIsUseLookupList: Boolean;
begin
  Result := FLookupList <> nil;
end;

function TcxCustomDBLookupEditProperties.GetKeyFieldNames: string;
begin
  if DataController <> nil then
    Result := DataController.KeyFieldNames
  else
    Result := '';
end;

function TcxCustomDBLookupEditProperties.GetListField: TField;
var
  AListIndex: Integer;
begin
  AListIndex := GetListIndex;
  if AListIndex <> -1 then
    Result := GetDBLookupGridColumnField(AListIndex)
  else
    Result := nil;
end;

function TcxCustomDBLookupEditProperties.GetListFieldIndex: Integer;
begin
  Result := inherited DisplayColumnIndex;
end;

function TcxCustomDBLookupEditProperties.GetListFieldNames: string;
var
  I: Integer;
begin
  Result := '';
  if GetLookupGridColumnCount > 0 then
  begin
   Result := GetDBLookupGridColumnFieldName(0);
   for I := 1 to GetLookupGridColumnCount - 1 do
     Result := Result + ';' + GetDBLookupGridColumnFieldName(I);
  end;
end;

procedure TcxCustomDBLookupEditProperties.SetIsUseLookupList(Value: Boolean);
begin
  if (FLookupList <> nil) <> Value then
  begin
    if Value then
    begin
      FLookupList := TcxLookupList.Create;
    end
    else
    begin
      FLookupList.Free;
      FLookupList := nil;
    end;
    Changed;
  end;
end;

procedure TcxCustomDBLookupEditProperties.SetKeyFieldNames(const Value: string);
begin
  if IsDefinedByLookup and not FSyncLookup then
    DefineByLookupError;
  if DataController <> nil then
    DataController.KeyFieldNames := Value;
end;

procedure TcxCustomDBLookupEditProperties.SetListFieldIndex(Value: Integer);
begin
  inherited DisplayColumnIndex := Value;
end;

procedure TcxCustomDBLookupEditProperties.SetListFieldNames(const Value: string);
var
  AChanged: Boolean;
begin
  AChanged := ListFieldNames <> Value;
  DBLookupGridBeginUpdate;
  try
    DBLookupGridCreateColumnsByFieldNames(Value);
    CheckLookupColumn;
    CheckDisplayColumnIndex;
  finally
    DBLookupGridEndUpdate;
  end;
  if AChanged then
    Changed;
end;

{ TcxCustomDBLookupEdit }

class function TcxCustomDBLookupEdit.GetPropertiesClass: TcxCustomEditPropertiesClass;
begin
  Result := TcxCustomDBLookupEditProperties;
end;

function TcxCustomDBLookupEdit.GetClearValue: TcxEditValue;

  function GetNullArray: Variant;
  var
    AFieldList: TObjectList;
    I: Integer;
  begin
    AFieldList := TObjectList.Create(False);
    try
      ActiveProperties.FLookupSource.DataSet.GetFieldList(AFieldList, ActiveProperties.KeyFieldNames);
      Result := VarArrayCreate([0, AFieldList.Count - 1], varVariant);
      for I := 0 to AFieldList.Count - 1 do
        Result[I] := Null;
    finally
      AFieldList.Free;
    end;
  end;

begin
  if (ActiveProperties.GetEditValueSource(InternalFocused) = evsKey) and
    (Pos(';', ActiveProperties.KeyFieldNames) <> 0) then
    Result := GetNullArray
  else
    Result := inherited GetClearValue;
end;

function TcxCustomDBLookupEdit.IsValidChar(AChar: Char): Boolean;
begin
  if ActiveProperties.ListField <> nil then
    Result := ActiveProperties.ListField.IsValidChar(AChar)
  else
    Result := True;
end;

function TcxCustomDBLookupEdit.ItemIndexToLookupKey(AItemIndex: Integer): TcxEditValue;
begin
  Result := ActiveProperties.GetKeyByRecordIndex(AItemIndex);
end;

function TcxCustomDBLookupEdit.LookupKeyToEditValue(const AKey: TcxEditValue): TcxEditValue;
begin
  Result := AKey;
end;

function TcxCustomDBLookupEdit.LookupKeyToItemIndex(const AKey: TcxEditValue): Integer;
begin
  Result := ActiveProperties.GetRecordIndexByKey(AKey);
end;

procedure TcxCustomDBLookupEdit.PopupWindowClosed(Sender: TObject);
begin
  inherited PopupWindowClosed(Sender);
  if ActiveProperties.DataController.DataModeController.SyncMode then
    ILookupData.CurrentKey := EditValue;
end;

procedure TcxCustomDBLookupEdit.PrepareDisplayValue(
  const AEditValue: TcxEditValue; var DisplayValue: TcxEditValue;
  AEditFocused: Boolean);
begin
  if (ActiveProperties.DropDownListStyle <> lsEditList) and not Focused and
    ActiveProperties.CanDisplayArbitraryEditValue then
      DisplayValue := VarToStr(AEditValue)
  else
    ActiveProperties.PrepareDisplayValue(AEditValue, DisplayValue, AEditFocused);
end;

function TcxCustomDBLookupEdit.GetProperties: TcxCustomDBLookupEditProperties;
begin
  Result := TcxCustomDBLookupEditProperties(FProperties);
end;

function TcxCustomDBLookupEdit.GetActiveProperties: TcxCustomDBLookupEditProperties;
begin
  Result := TcxCustomDBLookupEditProperties(InternalGetActiveProperties);
end;

procedure TcxCustomDBLookupEdit.SetProperties(Value: TcxCustomDBLookupEditProperties);
begin
  FProperties.Assign(Value);
end;

{ TcxDBLookupEditDataBinding }

function TcxDBLookupEditDataBinding.IsLookupControl: Boolean;
begin
  Result := True;
end;

end.

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?