rmd_diamond.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 711 行 · 第 1/2 页

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

procedure TRMDDiamondQuery.SaveToStream(aStream: TStream);
begin
  inherited SaveToStream(aStream);
  RMWriteWord(aStream);
end;

function TRMDDiamondQuery.GetParamCount: Integer;
begin
  Result := FQuery.Params.Count;
end;

function TRMDDiamondQuery.GetSQL: string;
begin
  Result := FQuery.SQL.Text;
end;

procedure TRMDDiamondQuery.SetSQL(Value: string);
begin
  FQuery.SQL.Text := Value;
end;

function TRMDDiamondQuery.GetDatabaseName: string;
begin
  Result := '';
  if FQuery.Database <> nil then
  begin
    Result := FQuery.Database.Name;
    if (FQuery.Database.Owner <> nil) and (FQuery.Database.Owner <> FQuery.Owner) then
      Result := FQuery.Database.Owner.Name + '.' + Result;
  end;
end;

procedure TRMDDiamondQuery.SetDatabaseName(const Value: string);
var
  liComponent: TComponent;
begin
  FQuery.Close;
  liComponent := RMFindComponent(FQuery.Owner, Value);
  if (liComponent <> nil) and (liComponent is TDAODatabase) then
    FQuery.Database := TDAODatabase(liComponent)
  else
    FQuery.Database := nil;
end;

function TRMDDiamondQuery.GetFilter: string;
begin
  Result := FQuery.Filter;
end;

procedure TRMDDiamondQuery.SetFilter(Value: string);
begin
  FQuery.Active := False;
  FQuery.Filter := Value;
  FQuery.Filtered := Value <> '';
end;

function TRMDDiamondQuery.GetDataSource: string;
begin
  Result := RMGetDataSetName(FQuery.Owner, FQuery.DataSource)
end;

procedure TRMDDiamondQuery.SetDataSource(Value: string);
var
  liComponent: TComponent;
begin
  liComponent := RMFindComponent(FQuery.Owner, Value);
  if (liComponent <> nil) and (liComponent is TDataSet) then
    FQuery.DataSource := RMGetDataSource(FQuery.Owner, TDataSet(liComponent))
  else
    FQuery.DataSource := nil;
end;

procedure TRMDDiamondQuery.GetDatabases(sl: TStrings);
var
  liStringList: TStringList;
begin
  liStringList := TStringList.Create;
  try
    RMGetComponents(RMDialogForm, TDAODatabase, liStringList, nil);
    liStringList.Sort;
    sl.Assign(liStringList);
  finally
    liStringList.Free;
  end;
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;


{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
type
  TDatabaseEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure Edit; override;
  end;

  TGetDatabaseEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure GetValues(AValues: TStrings); override;
  end;

  TIndexNameEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure GetValues(AValues: TStrings); override;
  end;

  TTableNameEditor = class(TELStringPropEditor)
  protected
    function GetAttrs: TELPropAttrs; override;
    procedure GetValues(AValues: TStrings); override;
  end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TDatabaseEditor }

function TDatabaseEditor.GetAttrs: TELPropAttrs;
begin
  Result := [praDialog];
end;

procedure TDatabaseEditor.Edit;
var
  lDatabase: TRMDDiamondDatabase;
begin
  lDatabase := TRMDDiamondDatabase(GetInstance(0));
  lDatabase.PropEditor(lDatabase);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TGetDatabaseEditor }

function TGetDatabaseEditor.GetAttrs: TELPropAttrs;
begin
  Result := [praValueList, praSortList];
end;

procedure TGetDatabaseEditor.GetValues(AValues: TStrings);
var
  liStringList: TStringList;
begin
  liStringList := TStringList.Create;
  try
    RMGetComponents(RMDialogForm, TDAODatabase, liStringList, nil);
    liStringList.Sort;
    aValues.Assign(liStringList);
  finally
    liStringList.Free;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TIndexNameEditor }

function TIndexNameEditor.GetAttrs: TELPropAttrs;
begin
  Result := [praValueList, praSortList];
end;

procedure TIndexNameEditor.GetValues(AValues: TStrings);
var
  lTable: TRMDDiamondTable;
begin
  lTable := TRMDDiamondTable(GetInstance(0));
  lTable.GetIndexNames(aValues);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TTableNameEditor }

function TTableNameEditor.GetAttrs: TELPropAttrs;
begin
  Result := [praValueList, praSortList];
end;

procedure TTableNameEditor.GetValues(AValues: TStrings);
var
  lTable: TDAOMasterDetailTable;
  liStringList: TStringList;
begin
  lTable := TRMDDiamondTable(GetInstance(0)).FTable;
  if lTable.Database <> nil then
  begin
    liStringList := TStringList.Create;
    try
      lTable.Database.GetTableNames(liStringList);
      liStringList.Sort;
      aValues.Assign(liStringList);
    finally
      liStringList.Free;
    end;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
procedure TRMDDiamondQuery_ExecSql(var Value: Variant; Args: TJvInterpreterArgs);
begin
  TRMDDiamondQuery(Args.Obj).OnBeforeOpenQueryEvent(TRMDDiamondQuery(Args.Obj).FQuery);
  TRMDDiamondQuery(Args.Obj).FQuery.Execute(Value);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
procedure RM_RegisterRAI2Adapter(RAI2Adapter: TJvInterpreterAdapter);
begin
  with RAI2Adapter do
  begin
    AddClass('ReportMachine', TRMDDiamondDatabase, 'TRMDDiamondDatabase');
    AddClass('ReportMachine', TRMDDiamondTable, 'TRMDDiamondTable');
    AddClass('ReportMachine', TRMDDiamondQuery, 'TRMDDiamondQuery');

    AddGet(TRMDDataset, 'ExecSql', TRMDDiamondQuery_ExecSql, 0, [0], varEmpty);
  end;
end;

initialization
  RMRegisterControl(TRMDDiamondDatabase, 'RMD_DiamondDBControl', RMLoadStr(SInsertDB) + '(DiamondDao)');
  RMRegisterControl(TRMDDiamondTable, 'RMD_DiamondTABLEControl', RMLoadStr(SInsertTable) + '(DiamondDao)');
  RMRegisterControl(TRMDDiamondQuery, 'RMD_DiamondQUERYControl', RMLoadStr(SInsertQuery) + '(DiamondDao)');

  RMRegisterPropEditor(TypeInfo(string), TRMDDiamondDatabase, 'DatabaseName', TDatabaseEditor);

  RMRegisterPropEditor(TypeInfo(string), TRMDDiamondTable, 'DatabaseName', TGetDatabaseEditor);
  RMRegisterPropEditor(TypeInfo(string), TRMDDiamondTable, 'IndexName', TIndexNameEditor);
  RMRegisterPropEditor(TypeInfo(string), TRMDDiamondTable, 'TableName', TTableNameEditor);

  RMRegisterPropEditor(TypeInfo(string), TRMDDiamondQuery, 'DatabaseName', TGetDatabaseEditor);

  RM_RegisterRAI2Adapter(GlobalJvInterpreterAdapter);

end.