rmd_dbwrap.pas

进销存·完整的·有数据库的·非常完整·只得参考

    else
      Result := '0';
  end;

begin
  SaveView := CurView;
  CurView := nil;
  SavePage := CurPage;
  CurPage := ParentPage;
  SaveBand := CurBand;
  CurBand := nil;
  i := 0;
  try
    while i < ParamCount do
    begin
      if ParamKind[i] = rmpkValue then
      begin
        if DocMode = dmPrinting then
          ParamValue[i] := RMParser.Calc(ParamText[i])
        else
          ParamValue[i] := DefParamValue(i);
      end;
      Inc(i);
    end;
  except
    Memo.Clear;
    Memo.Add(ParamText[i]);
    CurView := Self;
    raise;
  end;
  CurView := SaveView;
  CurPage := SavePage;
  CurBand := SaveBand;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMDDataset}

constructor TRMDDataset.Create;
begin
  inherited Create;
  FDataSource := TDataSource.Create(RMDialogForm);
  FDataSource.DataSet := nil;

  FDBDataSet := TRMDBDataSet.Create(RMDialogForm);
  FDBDataSet.DataSource := FDataSource;

  Flags := Flags or flDontUndo;
  FCanBrowse := True;
  FHaveFilter := True;
end;

destructor TRMDDataset.Destroy;
begin
  if Assigned(RMDialogForm) then
  begin
    FDBDataset.Free;
    FDataSource.Free;
    FDataSet.Free;
  end;
  inherited Destroy;
end;

procedure TRMDDataset._GetDatabases(Sender: TObject);
var
  liProp: PRMPropRec;
begin
  liProp := PropRec['Database'];
  try
    GetDatabases(liProp^.Enum);
  except
    liProp^.Enum.Clear;
  end;
end;

procedure TRMDDataset.DefineProperties;
begin
  inherited DefineProperties;
  AddProperty('Active', [rmdtBoolean], nil);
  AddEnumProperty('Database', '', [Null], _GetDatabases);
  AddProperty('Fields', [rmdtHasEditor, rmdtOneObject], FieldsEditor);
  AddProperty('FieldCount', [], nil);
  if FHaveFilter then
    AddProperty('Filter', [rmdtString], nil);
  AddProperty('EOF', [], nil);
  AddProperty('RecordCount', [], nil);
{$IFNDEF Delphi2}
  AddProperty('IsEmpty', [], nil);
{$ENDIF}
end;

procedure TRMDDataset.SetPropValue(Index: string; Value: Variant);
var
  d: TComponent;
  ds: TDataSource;
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'NAME' then
  begin
    FDataSource.Name := 'S' + FDataSet.Name;
    FDBDataSet.Name := '_' + FDataSet.Name;
  end
  else if Index = 'ACTIVE' then
  begin
    if Boolean(Value) and (Self is TRMDQuery) then
    begin
      d := RMFindComponent(FDataSet.Owner, Prop['DataSource']);
      if d <> nil then
      begin
        ds := RMGetDataSource(FDataSet.Owner, TDataSet(d));
        if (ds <> nil) and (ds.DataSet <> nil) then
          ds.DataSet.Open;
      end;
    end;
    FDataSet.Active := Value;
  end
  else if Index = 'FILTER' then
  begin
    FDataSet.Filter := Value;
    FDataSet.Filtered := Trim(Value) <> '';
  end;
end;

function TRMDDataset.GetPropValue(Index: string): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
  if Index = 'ACTIVE' then
    Result := FDataSet.Active
  else if Index = 'FILTER' then
    Result := FDataSet.Filter
  else if Index = 'EOF' then
    Result := FDataSet.Eof
  else if Index = 'RECORDCOUNT' then
    Result := FDataSet.RecordCount
  else if Index = 'FIELDCOUNT' then
    Result := FDataSet.FieldCount
{$IFNDEF Delphi2}
  else if Index = 'ISEMPTY' then
    Result := FDataSet.IsEmpty
{$ENDIF}
end;

function TRMDDataset.DoMethod(const MethodName: string; Pars: array of Variant): Variant;
var
  d: TComponent;
  ds: TDataSource;
  fs: TField;
begin
  Result := inherited DoMethod(MethodName, Pars);
  if MethodName = 'GETINDEXPROPERTY' then
  begin
    if Pars[0] = 'FIELDS' then
      Result := FDataSet.FieldByName(Pars[1]).AsVariant;
  end
  else if MethodName = 'OPEN' then
  begin
    if Self is TRMDQuery then
    begin
      d := RMFindComponent(FDataSet.Owner, Prop['DataSource']);
      if d <> nil then
      begin
        ds := RMGetDataSource(FDataSet.Owner, TDataSet(d));
        if (ds <> nil) and (ds.DataSet <> nil) then
          ds.DataSet.Open;
      end;
    end;
    FDataSet.Open;
  end
  else if MethodName = 'CLOSE' then
    FDataSet.Close
  else if MethodName = 'NEXT' then
    FDataSet.Next
  else if MethodName = 'PRIOR' then
    FDataSet.Prior
  else if MethodName = 'FIRST' then
    FDataSet.First
  else if MethodName = 'LAST' then
    FDataSet.Last
  else if MethodName = 'MOVEBY' then
  	FDataSet.MoveBy(RMParser.Calc(Pars[0]))
  else if MethodName = 'LOCATE' then
  	Result := FDataSet.Locate(RMParser.Calc(Pars[0]), RMParser.Calc(Pars[1]), [])
  else if MethodName = 'BOF' then
    Result := FDataSet.Bof
  else if MethodName = 'EOF' then
    Result := FDataSet.Eof
  else if MethodName = 'FIELDBYNAME' then
    Result := FDataSet.FieldByName(RMParser.Calc(Pars[0])).AsVariant
  else if MethodName = 'FIELDBYNUMBER' then
  begin
    fs := FDataSet.Fields[RMParser.Calc(Pars[0])];
    if fs <> nil then
      Result := fs.AsVariant;
  end;
end;

function TRMDDataset.GetDatabaseName: string;
begin
  Result := Prop['Database'];
end;

procedure TRMDDataset.SetDatabaseName(const Value: string);
begin
  Prop['Database'] := Value;
end;

procedure TRMDDataset.SetDataSet(Value: TDataSet);
begin
  if FDataSet <> Value then
  begin
    FDataSet := Value;
    FDataSource.DataSet := FDataSet;
    if Self is TRMDQuery then
      FDataSet.BeforeOpen := TRMDQuery(Self).OnBeforeOpenQueryEvent;
  end;
end;

procedure TRMDDataset.Loaded;
var
  i: Integer;
  s: string;
  ds: TDataSet;
  f: TField;
begin
  try
    for i := 0 to FFixupList.Count - 1 do
    begin
      s := FFixupList.Name[i];
      if s[1] = '.' then // lookup field
      begin
        f := FDataSet.FindField(Copy(s, 2, 255));
        ds := RMFindComponent(FDataSet.Owner, FFixupList.Value[i]) as TDataSet;
        f.LookupDataset := ds;
      end
    end;
//    Prop['Active'] := FFixupList['Active'];
  except;
  end;
  FFixupList.Clear;
end;

procedure TRMDDataset.ShowEditor;
begin
  FieldsEditor(nil);
end;

procedure TRMDDataset.FieldsEditor(Sender: TObject);
var
  SaveActive: Boolean;
  tmpForm: TRMDFieldsEditorForm;
begin
  SaveActive := FDataSet.Active;
  FDataSet.Close;

  tmpForm := TRMDFieldsEditorForm.Create(nil);
  tmpForm.DataSet := FDataSet;
  tmpForm.ShowModal;
  tmpForm.Free;

  RMDesigner.BeforeChange;
  FDataSet.Active := SaveActive;
end;

procedure TRMDDataset.LoadFromStream(Stream: TStream);

  procedure LoadFields;
  var
    i: Integer;
    n: Word;
    s: string;
    Field: TField;
    ds1: TDataset;
    fName: string;
    fType: TFieldType;
    fLookup: Boolean;
    fSize: Word;
    fDefs: TFieldDefs;
  begin
    fDefs := FDataSet.FieldDefs;
    Stream.Read(n, 2); // FieldCount
    for i := 0 to n - 1 do
    begin
      fType := TFieldType(RMReadByte(Stream)); // DataType
      fName := RMReadString(Stream); // FieldName
      fLookup := RMReadBoolean(Stream); // Lookup
      fSize := RMReadWord(Stream); // Size

      fDefs.Add(fName, fType, fSize, False);
      Field := fDefs[fDefs.Count - 1].CreateField(FDataSet);
      if fLookup then
      begin
        with Field do
        begin
          Lookup := True;
          KeyFields := RMReadString(Stream); // KeyFields
          s := RMReadString(Stream); // LookupDataset
          ds1 := RMFindComponent(FDataSet.Owner, s) as TDataSet;
          FFixupList['.' + FieldName] := s;
          LookupDataset := ds1;
          LookupKeyFields := RMReadString(Stream); // LookupKeyFields
          LookupResultField := RMReadString(Stream); // LookupResultField
        end;
      end;
    end;
  end;

begin
  FFixupList.Clear;
  inherited LoadFromStream(Stream);
  LoadFields;
  FFixupList['Database'] := RMReadString(Stream);
  Prop['Database'] := FFixupList['Database']; //RMReadString(Stream);
end;

procedure TRMDDataset.SaveToStream(Stream: TStream);

  procedure SaveFields;
  var
    i: Integer;
    s: string;
    SaveActive: Boolean;
  begin
    SaveActive := FDataSet.Active;
    FDataSet.Close;
    RMWriteWord(Stream, FDataSet.FieldCount); // FieldCount
    for i := 0 to FDataSet.FieldCount - 1 do
    begin
      with FDataSet.Fields[i] do
      begin
        RMWriteByte(Stream, Byte(DataType)); // DataType
        RMWriteString(Stream, FieldName); // FieldName
        RMWriteBoolean(Stream, Lookup); // Lookup
        RMWriteWord(Stream, Size); // Size

        if Lookup then
        begin
          RMWriteString(Stream, KeyFields); // KeyFields
          if LookupDataset <> nil then
          begin
            s := LookupDataset.Name;
            if LookupDataset.Owner <> FDataSet.Owner then
              s := LookupDataset.Owner.Name + '.' + s;
          end
          else
            s := '';
          RMWriteString(Stream, s); // LookupDataset
          RMWriteString(Stream, LookupKeyFields); // LookupKeyFields
          RMWriteString(Stream, LookupResultField); // LookupResultField
        end;
      end;
    end;
    FDataSet.Active := SaveActive;
  end;

begin
  inherited SaveToStream(Stream);
  SaveFields;
  RMWriteString(Stream, Prop['Database']);
end;

procedure TRMDDataset.DefinePopupMenu(Popup: TPopupMenu);
var
  m: TMenuItem;
begin
  inherited DefinePopupMenu(Popup);
  m := TMenuItem.Create(Popup);
  m.Caption := RMLoadStr(rmRes + 3007);
  m.OnClick := P1Click;
  m.Enabled := FCanBrowse;
  Popup.Items.Add(m);
end;

procedure TRMDDataset.P1Click(Sender: TObject);
begin
  try
    FDataSet.Active := TRUE;
  except
    raise;
  end;
  with TRMDFormPreviewData.Create(nil) do
  begin
    DataSource := Self.FDataSource;
    ShowModal;
    Free;
  end;
end;