dblookupeh.pas

自己做的用delphi开发的学生成绩管理系统。

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 := FListFields[FListFieldIndex] else
        FListField := 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 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(FListField.DisplayText);
  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 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;

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(FListField.DisplayText);
      {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(FListField.DisplayText);
      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;

type
  TWinControlCracker = class(TWinControl) end;

procedure TCustomDBLookupComboboxEh.SetListSource(Value: TDataSource);
begin