⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 rmd_dbx.pas

📁 进销存·完整的·有数据库的·非常完整·只得参考
💻 PAS
📖 第 1 页 / 共 2 页
字号:
🔍
12 
var
 sl: TStringList;
begin
  if FQuery.SQLConnection <> nil then
  begin
    sl := TStringList.Create;
    try
      try
        FQuery.SQLConnection.GetTableNames(sl);
        sl.Sort;
        Strings.Assign(sl);
      except
      end;
    finally
      sl.Free;
    end;
  end;
end;

procedure TRMDDBXQuery.GetTableFieldNames(const DB, TName: string; sl: TStrings);
var
  i: Integer;
  lStrings: TStringList;
  t: TSQLTable;
begin
  lStrings := TStringList.Create;
  t := TSQLTable.Create(RMDialogForm);
  try
    t.SQLConnection := FQuery.SQLConnection;
    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;

procedure TRMDDBXQuery.SetPropValue(Index: string; Value: Variant);
var
  d: TComponent;
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'DATABASE' then
  begin
    d := RMFindComponent(FQuery.Owner, Value) as TSQLConnection;
    FQuery.SQLConnection := TSQLConnection(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 TRMDDBXQuery.GetPropValue(Index: string): Variant;

  function _GetDataBase(Owner: TComponent; d: TSQLConnection): 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.SQLConnection)
  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 TRMDDBXQuery.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.ExecSQL;
  end;
end;

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

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

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

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

procedure TRMDDBXQuery.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 TRMDDBXQuery.GetParamText(Index: Integer): string;
begin
  Result := '';
  if ParamKind[Index] = rmpkValue then
    Result := FParams[FQuery.Params[Index].Name];
end;

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

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

procedure TRMDDBXQuery.SetParamValue(Index: Integer; Value: Variant);
begin
  FQuery.Params[Index].Value := Value;
end;
}
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMDDBXQuery}

type
{$IFDEF Delphi7}
  THackClientDataSet = class(TSimpleDataSet)
{$ELSE}
  THackClientDataSet = class(TSQLClientDataSet)
{$ENDIF}
  end;

constructor TRMDDBXQuery.Create;
begin
  inherited Create;
{$IFDEF Delphi7}
  FQuery := TSimpleDataSet.Create(RMDialogForm);
  FQuery.DataSet.CommandType := ctQuery;
{$ELSE}
  FQuery := TSQLClientDataSet.Create(RMDialogForm);
  FQuery.CommandType := ctQuery;
{$ENDIF}
  OnSQLTextChanged := OnSQLTextChangedEvent;
  THackClientDataSet(FQuery).SetDesigning(True, False);
  DataSet := FQuery;

  Component := FQuery;
  BaseName := 'DBXQuery';
  BmpRes := 'RMD_DBXQUERY';
end;

procedure TRMDDBXQuery.DefineProperties;
begin
  inherited DefineProperties;
end;

procedure TRMDDBXQuery.GetDatabases(sl: TStrings);
var
  liStringList: TStringList;
begin
  liStringList := TStringList.Create;
  try
    RMGetComponents(RMDialogForm, TSQLConnection, liStringList, nil);
    liStringList.Sort;
    sl.Assign(liStringList);
  finally
    liStringList.Free;
  end;
end;

procedure TRMDDBXQuery.GetTableNames(DB: string; Strings: TStrings);
var
  sl: TStringList;
begin
{$IFDEF Delphi7}
  if FQuery.Connection <> nil then
{$ELSE}
  if FQuery.DBConnection <> nil then
{$ENDIF}
  begin
    sl := TStringList.Create;
    try
      try
{$IFDEF Delphi7}
        FQuery.Connection.GetTableNames(sl);
{$ELSE}
        FQuery.DBConnection.GetTableNames(sl);
{$ENDIF}
        sl.Sort;
        Strings.Assign(sl);
      except
      end;
    finally
      sl.Free;
    end;
  end;
end;

procedure TRMDDBXQuery.GetTableFieldNames(const DB, TName: string; sl: TStrings);
var
  i: Integer;
  lStrings: TStringList;
  t: TSQLTable;
begin
  lStrings := TStringList.Create;
  t := TSQLTable.Create(RMDialogForm);
  try
{$IFDEF Delphi7}
    t.SQLConnection := FQuery.Connection;
{$ELSE}
    t.SQLConnection := FQuery.DBConnection;
{$ENDIF}
    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;

procedure TRMDDBXQuery.SetPropValue(Index: string; Value: Variant);
var
  d: TComponent;
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'DATABASE' then
  begin
    d := RMFindComponent(FQuery.Owner, Value) as TSQLConnection;
{$IFDEF Delphi7}
    FQuery.Connection := TSQLConnection(d);
{$ELSE}
    FQuery.DBConnection := TSQLConnection(d);
{$ENDIF}
  end
  else if Index = 'DATASOURCE' then
  begin
    d := RMFindComponent(FQuery.Owner, Value);
    FQuery.MasterSource := RMGetDataSource(FQuery.Owner, TDataSet(d));
  end
  else if index = 'PARAMS.COUNT' then
  begin
  end
  else if Index = 'SQL' then
  begin
    FQuery.Close;
{$IFDEF Delphi7}
    FQuery.DataSet.CommandText := Value;
{$ELSE}
    FQuery.CommandText := Value;
{$ENDIF}
  end
end;

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

  function _GetDataBase(Owner: TComponent; d: TSQLConnection): 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
{$IFDEF Delphi7}
    Result := _GetDataBase(FQuery.Owner, FQuery.Connection)
{$ELSE}
    Result := _GetDataBase(FQuery.Owner, FQuery.DBConnection)
{$ENDIF}
  else if Index = 'DATASOURCE' then
    Result := RMGetDataSetName(FQuery.Owner, FQuery.MasterSource)
  else if Index = 'PARAMS.COUNT' then
    Result := FQuery.Params.Count
  else if Index = 'SQL' then
{$IFDEF Delphi7}
    Result := FQuery.DataSet.CommandText
{$ELSE}
    Result := FQuery.CommandText
{$ENDIF}
  else if Index = 'SQL.COUNT' then
    Result := 1;
end;

function TRMDDBXQuery.DoMethod(const MethodName: string; Pars: array of Variant): Variant;
begin
  Result := inherited DoMethod(MethodName, Pars);
end;

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

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

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

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

procedure TRMDDBXQuery.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 TRMDDBXQuery.GetParamText(Index: Integer): string;
begin
  Result := '';
  if ParamKind[Index] = rmpkValue then
    Result := FParams[FQuery.Params[Index].Name];
end;

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

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

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

procedure TRMDDBXQuery.OnSQLTextChangedEvent(Sender: TObject);
begin
  try
    FQuery.Open;
    FQuery.Close;
  except
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TDBEditForm}

procedure TRMDFormDbxDBProp.Localize;
begin
  Font.Name := RMLoadStr(SRMDefaultFontName);
  Font.Size := StrToInt(RMLoadStr(SRMDefaultFontSize));
  Font.Charset := StrToInt(RMLoadStr(SCharset));

  btnOK.Caption := RMLoadStr(SOK);
  btnCancel.Caption := RMLoadStr(SCancel);
end;

procedure TRMDFormDbxDBProp.btnOKClick(Sender: TObject);
begin
  ModalResult := mrNone;
  try
  except
    raise;
  end;
  ModalResult := mrOk;
end;

procedure TRMDFormDbxDBProp.FormCreate(Sender: TObject);
begin
  FValueListEditor := TValueListEditor.Create(Self);
  with FValueListEditor do
  begin
    Parent := Self;
    Left := 8;
    Top := 7;
    Width := 412;
    Height := 233;
    KeyOptions := [keyEdit, keyAdd, keyDelete];
    PopupMenu := StringEditorMenu;
  end;

  Localize;
end;

procedure TRMDFormDbxDBProp.LoadItemClick(Sender: TObject);
begin
  with OpenDialog do
  begin
    if Execute then
      FValueListEditor.Strings.LoadFromFile(FileName);
  end;
end;

procedure TRMDFormDbxDBProp.SaveItemClick(Sender: TObject);
begin
  SaveDialog.FileName := OpenDialog.FileName;
  with SaveDialog do
  begin
    if Execute then
      FValueListEditor.Strings.SaveToFile(FileName);
  end;
end;

initialization
  RMRegisterControl(TRMDDBXDatabase, 'RMD_DBXDBCONTROL', RMLoadStr(SInsertDB) + '(DBX)');
  RMRegisterControl(TRMDDBXTable, 'RMD_DBXTableCONTROL', RMLoadStr(SInsertTable) + '(DBX)');
  RMRegisterControl(TRMDDBXQuery, 'RMD_DBXQUERYCONTROL', RMLoadStr(SInsertQuery) + '(DBX)');

finalization

{$ENDIF}
end.
12

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -