rmd_dbwrap.pas

这是一个功能强大

      if Pos('LookupField.', s) = 1 then
      begin
        System.Delete(s, 1, 12);
        liField := FDataSet.FindField(s);
        liComponent := RMFindComponent(FDataSet.Owner, FFixupList.Value[i]);
        if (liComponent <> nil) and (liComponent is TDataSet) then
          liField.LookupDataset := TDataSet(liComponent);
      end
    end;
  except;
  end;

  FFixupList.Clear;
  inherited AfterLoaded;
end;

procedure TRMDDataset.ShowEditor;
var
  SaveActive: Boolean;
  tmpForm: TRMDFieldsEditorForm;
begin
  SaveActive := FDataSet.Active;
  FDataSet.Close;
  tmpForm := TRMDFieldsEditorForm.Create(nil);
  try
    tmpForm.DataSet := FDataSet;
    if tmpForm.ShowModal = mrOK then
      RMDesigner.BeforeChange;
  finally
    tmpForm.Free;
    FDataSet.Active := SaveActive;
  end;
end;

procedure TRMDDataset.LoadFields(aStream: TStream);
var
  i: Integer;
  liCount: Word;
  s: string;
  liField: TField;
  liFieldName: string;
  liFieldType: TFieldType;
  liLookup: Boolean;
  liFieldSize: Word;
  liFieldDefs: TFieldDefs;
begin
  liFieldDefs := FDataSet.FieldDefs;
  liCount := RMReadWord(aStream);
  for i := 0 to liCount - 1 do
  begin
    liFieldType := TFieldType(RMReadByte(aStream));
    liFieldName := RMReadString(aStream);
    liLookup := RMReadBoolean(aStream);
    liFieldSize := RMReadWord(aStream);
    liFieldDefs.Add(liFieldName, liFieldType, liFieldSize, False);
    liField := liFieldDefs[liFieldDefs.Count - 1].CreateField(FDataSet);
    if liLookup then
    begin
      liField.Lookup := True;
      liField.KeyFields := RMReadString(aStream);
      s := RMReadString(aStream);
      FFixupList['LookupField.' + liFieldName] := s;
      liField.LookupDataset := TDataSet(RMFindComponent(FDataSet.Owner, s));
      liField.LookupKeyFields := RMReadString(aStream);
      liField.LookupResultField := RMReadString(aStream);
    end;
  end;
end;

procedure TRMDDataset.SaveFields(aStream: TStream);
var
  i: Integer;
  s: string;
  SaveActive: Boolean;
begin
  SaveActive := FDataSet.Active;
  FDataSet.Close;
  RMWriteWord(aStream, FDataSet.FieldCount);
  for i := 0 to FDataSet.FieldCount - 1 do
  begin
    with FDataSet.Fields[i] do
    begin
      RMWriteByte(aStream, Byte(DataType));
      RMWriteString(aStream, FieldName);
      RMWriteBoolean(aStream, Lookup);
      RMWriteWord(aStream, Size);
      if Lookup then
      begin
        RMWriteString(aStream, KeyFields);
        if LookupDataset <> nil then
        begin
          s := LookupDataset.Name;
          if LookupDataset.Owner <> FDataSet.Owner then
            s := LookupDataset.Owner.Name + '.' + s;
        end
        else
          s := '';
        RMWriteString(aStream, s);
        RMWriteString(aStream, LookupKeyFields);
        RMWriteString(aStream, LookupResultField);
      end;
    end;
  end;
  FDataSet.Active := SaveActive;
end;

procedure TRMDDataset.DefinePopupMenu(aPopup: TRMCustomMenuItem);
var
  m: TRMMenuItem;
begin
  inherited DefinePopupMenu(aPopup);
  m := TRMMenuItem.Create(aPopup);
  m.Caption := RMLoadStr(rmRes + 3007);
  m.OnClick := P1Click;
  m.Enabled := FCanBrowse;
  aPopup.Add(m);
end;

procedure TRMDDataset.P1Click(Sender: TObject);
var
  tmp: TRMDFormPreviewData;
begin
  tmp := TRMDFormPreviewData.Create(nil);
  try
    FDataSet.Open;
    tmp.DataSource := FDataSource;
    if FDataSet.Active then
      tmp.ShowModal;
  finally
    tmp.Free;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMDTable}

procedure TRMDTable.LoadFromStream(aStream: TStream);
var
  lVersion: Integer;
begin
  inherited LoadFromStream(aStream);
  lVersion := RMReadWord(aStream);
  FFixupList['DatabaseName'] := RMReadString(aStream);
  FFixupList['TableName'] := RMReadString(aStream);
  FFixupList['IndexName'] := RMReadString(aStream);
  FFixupList['MasterSource'] := RMReadString(aStream);
  FFixupList['MasterFields'] := RMReadString(aStream);
  if FHaveFilter then
    FFixupList['Filter'] := RMReadString(aStream);
  FFixupList['Active'] := RMReadBoolean(aStream);
  if lVersion >= 1 then
    FFixupList['IndexFieldNames'] := RMReadString(aStream)
  else
    FFixupList['IndexFieldNames'] := '';
  DontUndo := True;
end;

procedure TRMDTable.SaveToStream(aStream: TStream);
begin
  inherited SaveToStream(aStream);
  RMWriteWord(aStream, 1);
  RMWriteString(aStream, DatabaseName);
  RMWriteString(aStream, TableName);
  RMWriteString(aStream, IndexName);
  RMWriteString(aStream, MasterSource);
  RMWriteString(aStream, MasterFields);
  if FHaveFilter then
    RMWriteString(aStream, Filter);
  RMWriteBoolean(aStream, Active);
  RMWriteString(aStream, IndexFieldNames);
end;

procedure TRMDTable.AfterLoaded;
var
  lValue: Variant;
begin
  try
    DatabaseName := FFixupList['DatabaseName'];
    TableName := FFixupList['TableName'];
    MasterSource := FFixupList['MasterSource'];
    MasterFields := FFixupList['MasterFields'];
    if FHaveFilter then
      Filter := FFixupList['Filter'];

    IndexName := FFixupList['IndexName'];
    lValue := FFixupList['IndexFieldNames'];
    if (lValue <> Null) and (string(lValue) <> '') then
      IndexFieldNames := lValue;

    DBInternalLoaded;
    Active := FFixupList['Active'];
  except;
  end;
  inherited AfterLoaded;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMDQuery}

constructor TRMDQuery.Create;
begin
  inherited Create;
  FUseSQLBuilder := True;
  FVisualSQL := TStringList.Create;
  FParams := TRMVariables.Create;
end;

destructor TRMDQuery.Destroy;
begin
  FVisualSQL.Free;
  FParams.Free;
  inherited Destroy;
end;

procedure TRMDQuery.AfterLoaded;
var
  i: Integer;
begin
  try
    DatabaseName := FFixupList['DatabaseName'];
    DataSource := FFixupList['DataSource'];
    SQL := FFixupList['SQL'];
    for i := 0 to FParamCount - 1 do
    begin
      ParamType[i] := FFixupList['ParamType' + IntToStr(i)];
      ParamKind[i] := FFixupList['ParamKind' + IntToStr(i)];
      ParamText[i] := FFixupList['ParamText' + IntToStr(i)];
    end;
    Active := FFixupList['Active'];
  except
  end;

  DontUndo := True;
  inherited AfterLoaded;
end;

function TRMDQuery.ParamIndex(const ParName: string): Integer;
var
  i: Integer;
begin
  Result := -1;
  for i := 0 to ParamCount - 1 do
  begin
    if AnsiCompareText(ParamName[i], ParName) = 0 then
    begin
      Result := i;
      Exit;
    end;
  end;
end;

procedure TRMDQuery.LoadFromStream(aStream: TStream);

  procedure _ReadParams;
  var
    i: Integer;
  begin
    FParamCount := RMReadWord(aStream);
    for i := 0 to FParamCount - 1 do
    begin
      FFixupList['ParamType' + IntToStr(i)] := RMParamTypes[RMReadByte(aStream)];
      FFixupList['ParamKind' + IntToStr(i)] := TRMParamKind(RMReadByte(aStream));
      FFixupList['ParamText' + IntToStr(i)] := RMReadString(aStream);
    end;
  end;

begin
  inherited LoadFromStream(aStream);
  RMReadWord(aStream);
  FFixupList['DatabaseName'] := RMReadString(aStream);
  FFixupList['DataSource'] := RMReadString(aStream);
  FUseSQLBuilder := RMReadBoolean(aStream);
  FFixupList['SQL'] := RMReadString(aStream);
  RMReadMemo(aStream, FVisualSQL);
  if FHaveFilter then
    Filter := RMReadString(aStream);
  _ReadParams;
  FFixupList['Active'] := RMReadBoolean(aStream);
end;

procedure TRMDQuery.SaveToStream(aStream: TStream);

  procedure _WriteParams;
  var
    i, j, liCount: Integer;
  begin
    liCount := ParamCount;
    RMWriteWord(aStream, liCount);
    for i := 0 to liCount - 1 do
    begin
      j := Low(RMParamTypes);
      while j < High(RMParamTypes) do
      begin
        if ParamType[i] = RMParamTypes[j] then
          Break;
        Inc(j);
      end;
      RMWriteByte(aStream, j);
      RMWriteByte(aStream, Byte(ParamKind[i]));
      RMWriteString(aStream, ParamText[i]);
    end;
  end;

begin
  inherited SavetoStream(aStream);
  RMWriteWord(aStream, 0);
  RMWriteString(aStream, DatabaseName);
  RMWriteString(aStream, DataSource);
  RMWriteBoolean(aStream, FUseSQLBuilder);
  RMWriteString(aStream, SQL);
  RMWriteMemo(aStream, FVisualSQL);
  if FHaveFilter then
    RMWriteString(aStream, FDataSet.Filter);
  _WriteParams;
  RMWriteBoolean(aStream, FDataSet.Active);
end;

procedure TRMDQuery.Prepare;
begin
  Active := False;
  //  OnBeforeOpenQueryEvent(FDataSet);
end;

procedure TRMDQuery.OnBeforeOpenQueryEvent(DataSet: TDataSet);
var
  i: Integer;
  lParamText: string;

  function DefParamValue(index: Integer): string;
  begin
    if ParamType[index] in [ftDate, ftDateTime] then
      Result := '01.01.00'
    else if ParamType[index] = ftTime then
      Result := '00:00'
    else
      Result := '0';
  end;

begin
  i := 0;
  try
    while i < ParamCount do
    begin
      //李献军 old: if ParamKind[i] = rmpkValue then
      //目的：如果已经设置了参数则继续执行出现错误，所以进行判断付值后不再重新付值
      if (ParamKind[i] = rmpkValue) { and (VarType(ParamValue[i]) = varEmpty) } then
      begin
        if FDataSet <> nil then
          FDataSet.Close;

        if DocMode = rmdmDesigning then
          ParamValue[i] := DefParamValue(i)