rmd_diamond.pas

report machine 2.3 功能强大

  end
  else if Index = 'MASTERFIELDS' then
    FTable.MasterFields := Value
  else if Index = 'TABLENAME' then
  begin
    FTable.Close;
    FTable.TableName := Value;
  end
  else if index = 'DATABASE' then
  begin
    FTable.Close;
    d := RMFindComponent(FTable.Owner, Value);
    FTable.Database := TDAODatabase(d);
  end
end;

function TRMDDiamondTable.GetPropValue(Index: string): Variant;

  function GetDataBase(Owner: TComponent; d: TDAODatabase): string;
  begin
    Result := '';
    if d <> nil then
    begin
      Result := d.Name;
      if d.Owner <> Owner then
        Result := d.Owner.Name + '.' + Result;
    end;
  end;

begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
  if Index = 'INDEXNAME' then
    Result := FTable.IndexFieldNames //Result := FTable.IndexName
  else if Index = 'MASTERSOURCE' then
    Result := RMGetDataSetName(FTable.Owner, FTable.MasterSource)
  else if Index = 'MASTERFIELDS' then
    Result := FTable.MasterFields
  else if Index = 'TABLENAME' then
    Result := FTable.TableName
  else if Index = 'DATABASE' then
    Result := GetDataBase(FTable.Owner, FTable.Database)
end;

procedure TRMDDiamondTable.LoadFromStream(Stream: TStream);
begin
  inherited LoadFromStream(Stream);
end;

procedure TRMDDiamondTable.SaveToStream(Stream: TStream);
begin
	LVersion := 0;
  inherited SaveToStream(Stream);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMDDiamondQuery}

constructor TRMDDiamondQuery.Create;
begin
  inherited Create;
  FQuery := TDAOQuery.Create(RMDialogForm);
  DataSet := FQuery;

  Component := FQuery;
  BaseName := 'DAOQuery';
  Bmp.LoadFromResourceName(hInstance, 'RMD_DiamondQUERY');
end;

procedure TRMDDiamondQuery.DefineProperties;
begin
  inherited DefineProperties;
end;

procedure TRMDDiamondQuery.SetPropValue(Index: string; Value: Variant);
var
  d: TComponent;
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if index = 'DATABASE' then
  begin
    FQuery.Close;
    d := RMFindComponent(FQuery.Owner, Value);
    FQuery.Database := TDAODatabase(d);
  end
  else if Index = 'DATASOURCE' then
  begin
    d := RMFindComponent(FQuery.Owner, Value);
    FQuery.DataSource := RMGetDataSource(FQuery.Owner, TDataSet(d));
  end
  else if index = 'PARAMS.COUNT' then
  begin
  end
  else if Index = 'SQL' then
  begin
    FQuery.Close;
    FQuery.SQL.Text := Value;
  end
end;

function TRMDDiamondQuery.GetPropValue(Index: string): Variant;

  function GetDataBase(Owner: TComponent; d: TDAODatabase): string;
  begin
    Result := '';
    if d <> nil then
    begin
      Result := d.Name;
      if d.Owner <> Owner then
        Result := d.Owner.Name + '.' + Result;
    end;
  end;

begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
  if Index = 'DATABASE' then
    Result := GetDataBase(FQuery.Owner, FQuery.Database)
  else if Index = 'DATASOURCE' then
    Result := RMGetDataSetName(FQuery.Owner, FQuery.DataSource)
  else if Index = 'PARAMS.COUNT' then
    Result := FQuery.Params.Count
  else if Index = 'SQL' then
    Result := FQuery.SQL.Text
  else if Index = 'SQL.COUNT' then
    Result := FQuery.SQL.Count
end;

function TRMDDiamondQuery.DoMethod(const MethodName: string; Par1, Par2, Par3: Variant): Variant;
begin
  Result := inherited DoMethod(MethodName, Par1, Par2, Par3);
  if Result = Null then
    Result := LinesMethod(FQuery.SQL, MethodName, 'SQL', Par1, Par2, Par3);
  if MethodName = 'EXECSQL' then
  begin
  	OnBeforeOpenQueryEvent(FQuery);
    FQuery.Execute(dbFailOnError);
  end;
end;

procedure TRMDDiamondQuery.LoadFromStream(Stream: TStream);
begin
  inherited LoadFromStream(Stream);
end;

procedure TRMDDiamondQuery.SaveToStream(Stream: TStream);
begin
	LVersion := 0;
  inherited SaveToStream(Stream);
end;

function TRMDDiamondQuery.GetDatabases: string;
var
  i: integer;
  sl: TStringList;
begin
  Result := '';
  sl := TStringList.Create;
  RMGetComponents(RMDialogForm, TDAODatabase, sl, nil);
  sl.Sort;
  for i := 0 to sl.Count - 1 do
    Result := Result + sl[i] + ';';
  sl.Free;
end;

procedure TRMDDiamondQuery.GetTableNames(DB: string; Strings: TStrings);
var
  sl: TStringList;
  lDatabase: TDAODatabase;
begin
  Strings.Clear;
  sl := TStringList.Create;
  try
    try
      lDatabase := RMFindComponent(FQuery.Owner, DB) as TDAODatabase;
      if lDatabase = nil then exit;
      if not lDatabase.Connected then
        lDatabase.Connected := True;
      if lDatabase.Connected then
        lDatabase.GetTableNames(sl);
      sl.Sort;
      Strings.Assign(sl);
    except
    end;
  finally
    sl.Free;
  end;
end;

procedure TRMDDiamondQuery.GetTableFieldNames(const DB, TName: string; sl: TStrings);
var
  i: Integer;
  lStrings: TStringList;
  t: TDAOTable;
begin
  lStrings := TStringList.Create;
  t := TDAOTable.Create(RMDialogForm);
  try
    t.Database := RMFindComponent(FQuery.Owner, DB) as TDAODatabase;
    t.TableName := tName;
    try
      t.FieldDefs.UpDate;
      for i := 0 to t.FieldDefs.Count - 1 do
        lStrings.Add(t.FieldDefs.Items[i].Name);
      lStrings.Sort;
      sl.Assign(lStrings);
    except;
    end;
  finally
    lStrings.Free;
    t.Free;
  end;
end;

function TRMDDiamondQuery.GetParamName(Index: Integer): string;
begin
  Result := FQuery.Params[Index].Name;
end;

function TRMDDiamondQuery.GetParamType(Index: Integer): TFieldType;
begin
  Result := FQuery.Params[Index].DataType;
end;

procedure TRMDDiamondQuery.SetParamType(Index: Integer; Value: TFieldType);
begin
  FQuery.Params[Index].DataType := Value;
end;

function TRMDDiamondQuery.GetParamKind(Index: Integer): TRMParamKind;
begin
  Result := rmpkValue;
  if not FQuery.Params[Index].Bound then
    Result := rmpkAssignFromMaster;
end;

procedure TRMDDiamondQuery.SetParamKind(Index: Integer; Value: TRMParamKind);
begin
  if Value = rmpkAssignFromMaster then
  begin
    FQuery.Params[Index].Bound := False;
    FParams.Delete(FParams.IndexOf(FQuery.Params[Index].Name));
  end
  else
  begin
    FQuery.Params[Index].Clear;
    FQuery.Params[Index].Bound := True;
    FParams[FQuery.Params[Index].Name] := '';
  end;
end;

function TRMDDiamondQuery.GetParamText(Index: Integer): string;
begin
  Result := '';
  if ParamKind[Index] = rmpkValue then
    Result := FParams[FQuery.Params[Index].Name];
end;

procedure TRMDDiamondQuery.SetParamText(Index: Integer; Value: string);
begin
  if ParamKind[Index] = rmpkValue then
    FParams[FQuery.Params[Index].Name] := Value;
end;

function TRMDDiamondQuery.GetParamValue(Index: Integer): Variant;
begin
  Result := FQuery.Params[Index].Value;
end;

procedure TRMDDiamondQuery.SetParamValue(Index: Integer; Value: Variant);
begin
  FQuery.Params[Index].Value := Value;
end;


initialization
  RMRegisterControl(TRMDDiamondDatabase, 'RMD_DiamondDB', RMLoadStr(SInsertDB));
  RMRegisterControl(TRMDDiamondTable, 'RMD_DiamondTABLE', RMLoadStr(SInsertTable));
  RMRegisterControl(TRMDDiamondQuery, 'RMD_DiamondQUERY', RMLoadStr(SInsertQuery));

finalization

{$ENDIF}
end.