tntjvdblookup.pas

TntExUpdate 是 流行的 TntUnicodeControls控件的扩展包.包括很难找到的 TntJVCL 也在里面. TntSysUtils2.pas/TntSysUtilsEx.pa

procedure TTntJvLookupControl.CheckNotCircular;
begin
  {
  if FDataLink.Active and FDataLink.DataSet.IsLinkedTo(LookupSource) then
    _DBError(SCircularDataLink);
  }
  if FDataLink.Active and ((DataSource = LookupSource) or
    (FDataLink.DataSet = FLookupLink.DataSet)) then
    _DBError(SCircularDataLink);
end;

procedure TTntJvLookupControl.CheckDataLinkActiveChanged;
var
  TestField: TField;
begin
  if FDataLink.Active and (FDataFieldName <> '') then
  begin
    TestField := FDataLink.DataSet.FieldByName(FDataFieldName);
    if Pointer(FDataField) <> Pointer(TestField) then
    begin
      FDataField := nil;
      FMasterField := nil;
      CheckNotCircular;
      FDataField := TestField;
      FMasterField := FDataField;
      DataLinkRecordChanged(nil);
    end;
  end;
end;

procedure TTntJvLookupControl.DataLinkActiveChanged;
begin
  FDataField := nil;
  FMasterField := nil;
  if FDataLink.Active and (FDataFieldName <> '') then
  begin
    CheckNotCircular;
    FDataField := FDataLink.DataSet.FieldByName(FDataFieldName);
    FMasterField := FDataField;
  end;
  SetLookupMode((FDataField <> nil) and FDataField.Lookup);
  DataLinkRecordChanged(nil);
end;

procedure TTntJvLookupControl.DataLinkRecordChanged(Field: TField);
begin
  if (Field = nil) or (Field = FMasterField) then
  begin
    if (FMasterField <> nil) and FMasterField.DataSet.Active then
    begin
      SetValueKey(GetAsWideString(FMasterField));
    end
    else
      SetValueKey(FEmptyValue);
  end;
end;

function TTntJvLookupControl.ExecuteAction(Action: TBasicAction): Boolean;
begin
  Result := inherited ExecuteAction(Action) or ((FDataLink <> nil) and
    FDataLink.ExecuteAction(Action));
end;

function TTntJvLookupControl.UpdateAction(Action: TBasicAction): Boolean;
begin
  Result := inherited UpdateAction(Action) or ((FDataLink <> nil) and
    FDataLink.UpdateAction(Action));
end;

function TTntJvLookupControl.UseRightToLeftAlignment: Boolean;
begin
  Result := DBUseRightToLeftAlignment(Self, Field);
end;

function TTntJvLookupControl.GetBorderSize: Integer;
var
  Params: TCreateParams;
  R: TRect;
begin
  CreateParams(Params);
  SetRect(R, 0, 0, 0, 0);
  AdjustWindowRectEx(R, Params.Style, False, Params.ExStyle);
  Result := R.Bottom - R.Top;
end;

function TTntJvLookupControl.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

function TTntJvLookupControl.GetLookupField: string;
begin
  if FLookupMode then
    Result := ''
  else
    Result := FLookupFieldName;
end;

function TTntJvLookupControl.GetLookupSource: TDataSource;
begin
  if FLookupMode then
    Result := nil
  else
    Result := FLookupLink.DataSource;
end;

function TTntJvLookupControl.GetReadOnly: Boolean;
begin
  Result := FDataLink.ReadOnly;
end;

function TTntJvLookupControl.GetField: TField;
begin
  if Assigned(FDataLink) then
    Result := FDataField
  else
    Result := nil;
end;

// (rom) is this useful for other components? It seems superior.

function TTntJvLookupControl.DefaultTextHeight: Integer;
var
  DC: HDC;
  SaveFont: HFONT;
  Metrics: TTextMetric;
begin
  DC := GetDC(HWND_DESKTOP);
  SaveFont := SelectObject(DC, Font.Handle);
  GetTextMetrics(DC, Metrics);
  SelectObject(DC, SaveFont);
  ReleaseDC(HWND_DESKTOP, DC);
  Result := Metrics.tmHeight;
end;

function TTntJvLookupControl.GetTextHeight: Integer;
begin
  Result := Max(DefaultTextHeight, FItemHeight);
end;

procedure TTntJvLookupControl.KeyValueChanged;
begin
end;

procedure TTntJvLookupControl.DisplayValueChanged;
begin
end;

procedure TTntJvLookupControl.ListLinkActiveChanged;
var
  DataSet: TDataSet;
  ResultField: TField;
begin
  FListActive := False;
  FKeyField := nil;
  FDisplayField := nil;
  FListFields.Clear;
  if FLookupLink.Active and (FLookupFieldName <> '') then
  begin
    CheckNotCircular;
    DataSet := FLookupLink.DataSet;
    FKeyField := DataSet.FieldByName(FLookupFieldName);
    DataSet.GetFieldList(FListFields, FLookupDisplay);
    if FLookupMode then
    begin
      ResultField := DataSet.FieldByName(FDataField.LookupResultField);
      if FListFields.IndexOf(ResultField) < 0 then
        FListFields.Insert(0, ResultField);
      FDisplayField := ResultField;
    end
    else
    begin
      if FListFields.Count = 0 then
        FListFields.Add(FKeyField);
      if (FDisplayIndex >= 0) and (FDisplayIndex < FListFields.Count) then
        FDisplayField := FListFields[FDisplayIndex]
      else
        FDisplayField := FListFields[0];
    end;
    { Reset LookupFormat if the number of specifiers > fields count
      else function Format will raise an error }
    if GetSpecifierCount(FLookupFormat) > FListFields.Count then
      FLookupFormat := '';

    FListActive := True;
  end;
  FLocate.DataSet := FLookupLink.DataSet;
end;

procedure TTntJvLookupControl.ListLinkDataChanged;
begin
end;

function TTntJvLookupControl.LocateDisplay: Boolean;
begin
  Result := False;
  try
    Result := Locate(FDisplayField, FDisplayValue, True);
  except
  end;
end;

function TTntJvLookupControl.LocateKey: Boolean;
begin
  Result := False;
  try
    Result := not ValueIsEmpty(FValue) and Locate(FKeyField, FValue, True);
  except
  end;
end;

procedure TTntJvLookupControl.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    if (FDataLink <> nil) and (AComponent = DataSource) then
      DataSource := nil;
    if (FLookupLink <> nil) and (AComponent = LookupSource) then
      LookupSource := nil;
    if AComponent = FMasterField then
      FMasterField := nil;
  end;
end;

function TTntJvLookupControl.SearchText(var AValue: WideString): Boolean;
begin
  Result := False;
  if FDisplayField <> nil then
    if (AValue <> '') and Locate(FDisplayField, AValue, False) then
    begin
      SelectKeyValue(GetAsWideString(FKeyField));
      AValue := Copy(GetAsWideString(FDisplayField), 1, Length(AValue));
      Result := True;
    end
    else
    if AValue = '' then
    begin
      FLookupLink.DataSet.First;
      SelectKeyValue(GetAsWideString(FKeyField));
      AValue := '';
    end;
end;

procedure TTntJvLookupControl.ProcessSearchKey(Key: WideChar);
var
  TickCount: Longint;
  S: WideString;
begin
  S := '';
  if (FDisplayField <> nil) {and (FDisplayField.DataType = ftString)} then
    case Key of
      #9, #27:
        FSearchText := '';
      Char(VK_BACK), #32..#255:
        if CanModify then
        begin
          if not FPopup then
          begin
            TickCount := GetTickCount;
            if TickCount - SearchTickCount > 2000 then
              FSearchText := '';
            SearchTickCount := TickCount;
          end;
          if Key = Char(VK_BACK) then
            S := Copy(FSearchText, 1, Length(FSearchText) - 1)
          else
          if Length(FSearchText) < 32 then
            S := FSearchText + Key;
          if SearchText(S) or (S = '') then
            FSearchText := S;
        end;
    end;
end;

procedure TTntJvLookupControl.ResetField;
begin
  { if (FDataLink.DataSource = nil) or
    ((FDataLink.DataSource <> nil) and CanModify) then
  begin
    if (FDataLink.DataSource <> nil) and (FMasterField <> nil) and
      FDataLink.Edit then
    begin
      if FEmptyValue = '' then
        FMasterField.Clear
      else
        FMasterField.AsString := FEmptyValue;
                  end; }// Polaris
  if (FDataLink.DataSource = nil) or
    (FMasterField = nil) or FDataLink.Edit then
  begin
    if FDataLink.Edit then
      SetFieldValue(FMasterField, FEmptyValue); // Polaris
    FValue := FEmptyValue;
    FDisplayValue := '';
    inherited Text := DisplayEmpty;
    Invalidate;
    Click;
  end;
end;

procedure TTntJvLookupControl.ClearValue;
begin
  SetValueKey(FEmptyValue);
end;

procedure TTntJvLookupControl.SelectKeyValue(const Value: WideString);
begin
  if FMasterField <> nil then
  begin
    if CanModify and FDataLink.Edit then
    begin
      if FDataField = FMasterField then
        FDataField.DataSet.Edit;
      // FMasterField.AsString := Value;
      SetFieldValue(FMasterField, Value); // Polaris
    end
    else
      Exit;
  end
  else
    SetValueKey(Value);
  UpdateDisplayValue;
  Repaint;
  Click;
end;

procedure TTntJvLookupControl.SetDataFieldName(const Value: string);
begin
  if FDataFieldName <> Value then
  begin
    FDataFieldName := Value;
    DataLinkActiveChanged;
  end;
end;

procedure TTntJvLookupControl.SetDataSource(Value: TDataSource);
begin
  FDataLink.DataSource := Value;
  if Value <> nil then
    Value.FreeNotification(Self);
end;

procedure TTntJvLookupControl.SetListStyle(Value: TLookupListStyle);
begin
  if FListStyle <> Value then
  begin
    FListStyle := Value;
    Invalidate;
  end;
end;

procedure TTntJvLookupControl.SetFieldsDelimiter(Value: Char);
begin
  if FFieldsDelimiter <> Value then
  begin
    FFieldsDelimiter := Value;
    if ListStyle = lsDelimited then
      Invalidate;
  end;
end;

procedure TTntJvLookupControl.SetLookupField(const Value: string);
begin
  CheckNotFixed;
  if FLookupFieldName <> Value then
  begin
    FLookupFieldName := Value;
    ListLinkActiveChanged;
    if FListActive then
      DataLinkRecordChanged(nil);
  end;
end;

procedure TTntJvLookupControl.SetDisplayEmpty(const Value: WideString);
begin
  if FDisplayEmpty <> Value then
  begin
    UpdateDisplayEmpty(Value);
    FDisplayEmpty := Value;
    if not (csReading in ComponentState) then
      Invalidate;
  end;
end;

procedure TTntJvLookupControl.SetEmptyValue(const Value: WideString);
begin
  if FEmptyValue <> Value then
  begin
    if ValueIsEmpty(FValue) then
      FValue := Value;
    FEmptyValue := Value;
  end;
end;

// Polaris begin

procedure TTntJvLookupControl.SetFieldValue(Field: TField; const Value: WideString);
begin
  if Value = FEmptyValue then
    if (FEmptyValue = '') and FEmptyStrIsNull then
      Field.Clear
    else
      Field.Value := FEmptyValue
  else
    Field.Value := Value;
end;

procedure TTntJvLookupControl.SetEmptyStrIsNull(const Value: Boolean);
begin
  if FEmptyStrIsNull <> Value then
  begin
    FEmptyStrIsNull := Value;
    if CanModify and (FDataLink.DataSource <> nil) and FDataLink.Edit then
      if FMasterField <> nil then
        SetFieldValue(FMasterField, FValue)
      else
        SetFieldValue(FDataField, FValue);
  end;
end;
// Polaris end

procedure TTntJvLookupControl.SetEmptyItemColor(Value: TColor);
begin
  if FEmptyItemColor <> Value then
  begin
    FEmptyItemColor := Value;
    if not (csReading in ComponentState) and (DisplayEmpty <> '') then
      Invalidate;
  end;
end;

procedure TTntJvLookupControl.UpdateDisplayEmpty(const Value: WideString);
begin
end;

procedure TTntJvLookupControl.SetDisplayValue(const Value: WideString);
{var S: string; }// Polaris
begin
  if (FDisplayValue <> Value) and CanModify and (FDataLink.DataSource <> nil) and
    Locate(FDisplayField, Value, True) then