Boa tarde, meu problema é o seguinte, tenho as classes logo abaixo.
Na função CreateSQLInsert eu crio o script da tabela. (Aqui tudo OK)
a procedure SetParam funciona certo desde que não tenha itens (1:1) como faria nessa procedure para setar os valores no padrão (1:N) ?
// Classe que controla os valores armazenados nos itens
TItensNF = class(TObjectList)
private
FCount: Integer;
procedure SetCount(const Value: Integer);
protected
{protected declarations}
function GetItemNF(Index: Integer): TNFEmissaoDet;
procedure SetItemNF(Index: Integer; aItemNF: TNFEmissaoDet);
public
{public declarations}
function Add(aNotaFiscal: TNotaFiscal; aItemNF: TNFEmissaoDet): Integer;
function Remove(aItemNF: TNFEmissaoDet): Integer;
function IndexOf(aItemNF: TNFEmissaoDet): Integer;
procedure Insert(Index: Integer; aItemNF: TNFEmissaoDet);
property Items[Index: Integer]: TNFEmissaoDet read GetItemNF write SetItemNF; default;
property Count: Integer read FCount write SetCount;
end;
// Função que monta o Script do SQL
function CreateSQLInsert(aObject: TObject; aNameTable: string): string;
var
IndexFildList: Integer;
Separador: string;
Filds,
aSql : TStringList;
begin
Filds := TStringList.Create;
aSql := TStringList.Create;
GetObjectProperties(aObject, Filds); // Pega os fields da Tabela
try
aSql.Add('insert into ' + aNameTable + '(');
Separador := '';
for IndexFildList := 0 to Filds.Count-1 do
begin
aSql.Add(Separador + Filds[IndexFildList]);
Separador := ',';
end;
aSql.Add(')');
aSql.Add('values(');
Separador := '';
for IndexFildList := 0 to Filds.Count-1 do
begin
aSql.Add(Separador + ':' + Filds[IndexFildList]);
Separador := ',';
end;
aSql.Add(')');
Result := aSql.Text;
except
raise Exception.Create('Erro ao gerar script SQL');
end;
Filds.Free;
aSql.Free;
end;
// Rotina para popular os valores. (Quando não tem itens funciona certinho. Tipo TClientes)
{Problema agora como pegar aqui os valores dos Itens ?}
procedure SetParam(aObject: TObject; aQry: TQuery);
var
PropCount,
PropIndex: Integer;
PropList: PPropList;
PropInfo: PPropInfo;
sValue: Variant;
begin
PropCount := GetPropList(aObject.ClassInfo, tkAny, nil);
GetMem(PropList, PropCount * SizeOf(Pointer));
try
PropCount := GetPropList(aObject.ClassInfo, tkAny, PropList);
for PropIndex := 0 to PropCount - 1 do
begin
PropInfo := PropList^[PropIndex];
if not(PropInfo^.PropType^.Kind in tkMethods) then
begin
sValue := GetPropValue(aObject, PropInfo^.Name, True);
case PropInfo^.PropType^.Kind of
tkInt64, tkInteger:
begin
begin
if ValidateInteger(sValue) then
SetParamValueQuery(PropInfo,PropInfo^.Name, AQry, sValue);
end;
end;
tkChar, tkString, tkLString{, tkUString}: // Para versões superiores ao Delphi 7 acrescentar tkUString
begin
begin
if ValidateString(sValue) then
SetParamValueQuery(PropInfo,PropInfo^.Name, AQry, sValue);
end;
end;
tkFloat:
begin
begin
if CompareText(PropInfo^.PropType^.Name, 'TDateTime') = 0 then
begin
if ValidateDate(sValue) then
SetParamValueQuery(PropInfo,PropInfo^.Name, AQry, sValue);
end
else
begin
if ValidateFloat(sValue) then
SetParamValueQuery(PropInfo,PropInfo^.Name, AQry, sValue);
end;
end;
end;
end;
end;
end;
finally
FreeMem(PropList);
end;
end;
Pergunta
araujolops
Boa tarde, meu problema é o seguinte, tenho as classes logo abaixo.
Na função CreateSQLInsert eu crio o script da tabela. (Aqui tudo OK)
a procedure SetParam funciona certo desde que não tenha itens (1:1) como faria nessa procedure para setar os valores no padrão (1:N) ?
// Campos da Tabela no banco de Dados
TNFEmissaoDet = class(TComponent)
private
FPRODUTO_ID: string;
FSEQUENCIA: Integer;
FDESCRICAO: string;
//
procedure setPRODUTO_ID(const Value: string);
procedure setSEQUENCIA(const Value: Integer);
procedure setDESCRICAO(const Value: string);
protected
public
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
published
property PRODUTO_ID: string read FPRODUTO_ID write setPRODUTO_ID;
property SEQUENCIA: Integer read FSEQUENCIA write setSEQUENCIA;
property DESCRICAO: string read FDESCRICAO write setDESCRICAO;
end;
// Classe que controla os valores armazenados nos itens
TItensNF = class(TObjectList)
private
FCount: Integer;
procedure SetCount(const Value: Integer);
protected
{protected declarations}
function GetItemNF(Index: Integer): TNFEmissaoDet;
procedure SetItemNF(Index: Integer; aItemNF: TNFEmissaoDet);
public
{public declarations}
function Add(aNotaFiscal: TNotaFiscal; aItemNF: TNFEmissaoDet): Integer;
function Remove(aItemNF: TNFEmissaoDet): Integer;
function IndexOf(aItemNF: TNFEmissaoDet): Integer;
procedure Insert(Index: Integer; aItemNF: TNFEmissaoDet);
property Items[Index: Integer]: TNFEmissaoDet read GetItemNF write SetItemNF; default;
property Count: Integer read FCount write SetCount;
end;
// Função que monta o Script do SQL
function CreateSQLInsert(aObject: TObject; aNameTable: string): string;
var
IndexFildList: Integer;
Separador: string;
Filds,
aSql : TStringList;
begin
Filds := TStringList.Create;
aSql := TStringList.Create;
GetObjectProperties(aObject, Filds); // Pega os fields da Tabela
try
aSql.Add('insert into ' + aNameTable + '(');
Separador := '';
for IndexFildList := 0 to Filds.Count-1 do
begin
aSql.Add(Separador + Filds[IndexFildList]);
Separador := ',';
end;
aSql.Add(')');
aSql.Add('values(');
Separador := '';
for IndexFildList := 0 to Filds.Count-1 do
begin
aSql.Add(Separador + ':' + Filds[IndexFildList]);
Separador := ',';
end;
aSql.Add(')');
Result := aSql.Text;
except
raise Exception.Create('Erro ao gerar script SQL');
end;
Filds.Free;
aSql.Free;
end;
// Rotina para popular os valores. (Quando não tem itens funciona certinho. Tipo TClientes)
{Problema agora como pegar aqui os valores dos Itens ?}
procedure SetParam(aObject: TObject; aQry: TQuery);
var
PropCount,
PropIndex: Integer;
PropList: PPropList;
PropInfo: PPropInfo;
sValue: Variant;
begin
PropCount := GetPropList(aObject.ClassInfo, tkAny, nil);
GetMem(PropList, PropCount * SizeOf(Pointer));
try
PropCount := GetPropList(aObject.ClassInfo, tkAny, PropList);
for PropIndex := 0 to PropCount - 1 do
begin
PropInfo := PropList^[PropIndex];
if not(PropInfo^.PropType^.Kind in tkMethods) then
begin
sValue := GetPropValue(aObject, PropInfo^.Name, True);
case PropInfo^.PropType^.Kind of
tkInt64, tkInteger:
begin
begin
if ValidateInteger(sValue) then
SetParamValueQuery(PropInfo,PropInfo^.Name, AQry, sValue);
end;
end;
tkChar, tkString, tkLString{, tkUString}: // Para versões superiores ao Delphi 7 acrescentar tkUString
begin
begin
if ValidateString(sValue) then
SetParamValueQuery(PropInfo,PropInfo^.Name, AQry, sValue);
end;
end;
tkFloat:
begin
begin
if CompareText(PropInfo^.PropType^.Name, 'TDateTime') = 0 then
begin
if ValidateDate(sValue) then
SetParamValueQuery(PropInfo,PropInfo^.Name, AQry, sValue);
end
else
begin
if ValidateFloat(sValue) then
SetParamValueQuery(PropInfo,PropInfo^.Name, AQry, sValue);
end;
end;
end;
end;
end;
end;
finally
FreeMem(PropList);
end;
end;
Link para o comentário
Compartilhar em outros sites
0 respostass a esta questão
Posts Recomendados
Participe da discussão
Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.