rmd_dbwrap.pas

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

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

procedure TRMDTable._GetIndexs(Sender: TObject);
var
  liProp: PRMPropRec;
begin
  liProp := PropRec['IndexName'];
  try
    GetIndexNames(liProp^.Enum);
  except
  end;
end;

procedure TRMDTable._GetMasterSource(Sender: TObject);
var
  liProp: PRMPropRec;
begin
  liProp := PropRec['MasterSource'];
  RMGetComponents(FDataSet.Owner, TDataSet, liProp^.Enum, FDataSet);
  liProp^.Enum.Sort;
end;

procedure TRMDTable._GetTableNames(Sender: TObject);
var
  liProp: PRMPropRec;
begin
  try
    liProp := PropRec['TableName'];
    GetTableNames(liProp^.Enum);
  except
  end;
end;

procedure TRMDTable.DefineProperties;
begin
  inherited DefineProperties;
  AddEnumProperty('IndexName', '', [Null], _GetIndexs);
  AddProperty('MasterFields', [rmdtHasEditor, rmdtOneObject], JoinEditor);
  AddEnumProperty('MasterSource', '', [Null], _GetMasterSource);
  AddEnumProperty('TableName', '', [Null], _GetTableNames);
end;

procedure TRMDTable.JoinEditor(Sender: TObject);
var
  str: string;
begin
  with TRMDFieldsLinkForm.Create(nil) do
  begin
    MasterDS := RMFindComponent(FDataSet.Owner, Prop['MasterSource']) as TDataSet;
    DetailDS := Self;
    if MasterDS <> nil then
    begin
      str := Prop['MasterFields'];
      if Execute(str) then
      begin
        Prop['MasterFields'] := str;
        RMDesigner.AfterChange;
      end;
    end;
    Free;
  end;
end;

procedure TRMDTable.LoadFromStream(Stream: TStream);
begin
  inherited LoadFromStream(Stream);
  if FHaveFilter then
    Prop['Filter'] := RMReadString(Stream);
  Prop['IndexName'] := RMReadString(Stream);
  Prop['MasterFields'] := RMReadString(Stream);
  FFixupList['MasterSource'] := RMReadString(Stream);
  Prop['TableName'] := RMReadString(Stream);
  FFixupList['Active'] := RMReadBoolean(Stream);
end;

procedure TRMDTable.SaveToStream(Stream: TStream);
begin
  inherited SavetoStream(Stream);
  if FHaveFilter then
    RMWriteString(Stream, FDataSet.Filter);
  RMWriteString(Stream, Prop['IndexName']);
  RMWriteString(Stream, Prop['MasterFields']);
  RMWriteString(Stream, Prop['MasterSource']);
  RMWriteString(Stream, Prop['TableName']);
  RMWriteBoolean(Stream, FDataSet.Active);
end;

procedure TRMDTable.Loaded;
begin
  try
    Prop['Database'] := FFixupList['Database'];
    Prop['MasterSource'] := FFixupList['MasterSource'];
    FDataSet.Active := FFixupList['Active'];
  except;
  end;
  inherited Loaded;
end;

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

constructor TRMDQuery.Create;
begin
  inherited Create;
  FEditSQLAsText := FALSE;
  FVisualSQL := TStringList.Create;
  FParams := TRMVariables.Create;
end;

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

procedure TRMDQuery.DefineProperties;

  function GetMasterSource: string;
  var
    i: Integer;
    sl: TStringList;
  begin
    Result := '';
    sl := TStringList.Create;
    RMGetComponents(FDataSet.Owner, TDataSet, sl, FDataSet);
    sl.Sort;
    for i := 0 to sl.Count - 1 do
      Result := Result + sl[i] + ';';
    sl.Free;
  end;

begin
  inherited DefineProperties;
  AddEnumProperty('DataSource', GetMasterSource, [Null], nil);
  AddProperty('Params', [rmdtHasEditor], ParamsEditor);
  AddProperty('SQL', [rmdtHasEditor], SQLEditor);
  AddProperty('SQL.Count', [], nil);
  AddProperty('UseSQLBuilder', [rmdtBoolean], nil);
end;

procedure TRMDQuery.SetPropValue(Index: string; Value: Variant);
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'USESQLBUILDER' then
    EditSQLAsText := not Value;
end;

function TRMDQuery.GetPropValue(Index: string): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
  if Index = 'USESQLBUILDER' then
    Result := not EditSQLAsText;
end;

function TRMDQuery.DoMethod(const MethodName: string; Pars: array of Variant): Variant;
var
	lIndex: Integer;
  s: string;
begin
  Result := inherited DoMethod(MethodName, Pars);
  if MethodName = 'SETPARAMVALUE' then
	begin
  	ParamText[RMParser.Calc(Pars[0])] := RMParser.Calc(Pars[1]);
  end
  else if MethodName = 'SETPARAMVALUEBYNAME' then
  begin
  	lIndex := 0;
    s := RMParser.Calc(Pars[0]);
    while lIndex < ParamCount do
    begin
			if AnsiCompareText(s, ParamName[lIndex]) = 0 then
      	Break;
    end;
    if lIndex < ParamCount then
	  	ParamText[lIndex] := RMParser.Calc(Pars[1]);
  end;
end;

procedure TRMDQuery.Loaded;
var
  i: Integer;
begin
  try
    Prop['Database'] := FFixupList['Database'];
    Prop['DataSource'] := FFixupList['DataSource'];
    Prop['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;
    FDataSet.Active := FFixupList['Active'];
  except
  end;
  inherited Loaded;
end;

function TRMDQuery.GetParamCount: Integer;
begin
  Result := Prop['Params.Count'];
end;

function TRMDQuery.GetSQL: string;
begin
  Result := Prop['SQL'];
end;

procedure TRMDQuery.SetSQL(aSQL: string);
begin
  Prop['SQL'] := aSQL;
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(Stream: TStream);
var
  s: string;

  procedure ReadParams;
  var
    i: Integer;
    w: Word;
  begin
    Stream.Read(FParamCount, 2);
    for i := 0 to FParamCount - 1 do
    begin
      Stream.Read(w, 2);
      FFixupList['ParamType' + IntToStr(i)] := RMParamTypes[w];
      Stream.Read(w, 2);
      FFixupList['ParamKind' + IntToStr(i)] := TRMParamKind(w);
      FFixupList['ParamText' + IntToStr(i)] := RMReadString(Stream);
    end;
  end;

begin
  inherited LoadFromStream(Stream);
  if FHaveFilter then
    Prop['Filter'] := RMReadString(Stream);
  s := RMReadString(Stream);
  FFixupList['DataSource'] := s;
  Prop['DataSource'] := FFixupList['DataSource'];
  FFixupList['SQL'] := RMReadString(Stream);
  FFixupList['Active'] := RMReadBoolean(Stream);
  ReadParams;

  FEditSQLAsText := RMReadBoolean(Stream);
  RMReadMemo(Stream, FVisualSQL);
end;

procedure TRMDQuery.SaveToStream(Stream: TStream);

  procedure WriteParams;
  var
    i: Integer;
    count, j: Word;
  begin
    count := ParamCount;
    Stream.Write(count, 2);
    for i := 0 to count - 1 do
    begin
      for j := Low(RMParamTypes) to High(RMParamTypes) do
      begin
        if ParamType[i] = RMParamTypes[j] then
          Break;
      end;
      Stream.Write(j, 2);
      j := Word(ParamKind[i]);
      Stream.Write(j, 2);
      RMWriteString(Stream, ParamText[i]);
    end;
  end;

begin
  inherited SavetoStream(Stream);
  if FHaveFilter then
    RMWriteString(Stream, FDataSet.Filter);
  RMWriteString(Stream, Prop['DataSource']);
  RMWriteString(Stream, Prop['SQL']);
  RMWriteBoolean(Stream, FDataSet.Active);
  WriteParams;

  RMWriteBoolean(Stream, FEditSQLAsText);
  RMWriteMemo(Stream, FVisualSQL);
end;

procedure TRMDQuery.SQLEditor(Sender: TObject);
begin
  with TRMDQueryDesignerForm.Create(nil) do
  begin
    Query := Self;
    if ShowModal = mrOK then
    begin
      RMDesigner.BeforeChange;
      RMDesigner.AfterChange;
    end;
    Free;
  end;
end;

procedure TRMDQuery.ParamsEditor(Sender: TObject);
begin
  if ParamCount > 0 then
  begin
    with TRMDParamsForm.Create(nil) do
    begin
      Query := Self;
      Caption := Self.Name + ' ' + RMLoadStr(SParams);
      if ShowModal = mrOk then
        RMDesigner.Modified := True;
      Free;
    end;
  end;
end;

procedure TRMDQuery.OnBeforeOpenQueryEvent(DataSet: TDataSet);
var
  i: Integer;
  SaveView: TRMView;
  SavePage: TRMPage;
  SaveBand: TRMBand;

  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
  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;

initialization

finalization

end.