Hola amigos , ¿cómo estás?,espero que bien. He estado tratando de aprender el concepto de programación orientada a objetos en Delphi o mas bien el manejo de este he leído bastante, sin embargo no logro asimilarlo si alguno de ustedes puede darme una pequeña explicación o por lo menos hacer una aplicación normal para ver el código y ver como se usa porque en verdad no entiendo el uso de este paradigma ya que en el curso que hice hace tiempo solo aprendí en programación modular y estructurada,espero me puedan ayudar gracias de antemano.
Hola, amigos necesito ayuda con programación orientada a objetos?
Comenzado por
Master23
, dic 03 2010 05:04
6 respuestas en este tema
#1
Escrito 03 diciembre 2010 - 05:04
#2
Escrito 03 diciembre 2010 - 07:04
Hola amigo, me gustaría poder ayudar a más ...
Pero programación orientada a objetos implica muchas cosas, herencia, polimorfismo, encapsulación, etc ..
Por lo que he leído, usted desea aprender programación orientada a objetos, muestro mi clase de la persistencia de la creación de selección, inserción, eliminación y actualización genérica, en este ejemplo estoy usando la tecnología con dbExpress SQLDataSet, ClientDataSet DataSetProvider. Yo solía ir DELPHI XE este ejemplo.
continua...
Pero programación orientada a objetos implica muchas cosas, herencia, polimorfismo, encapsulación, etc ..
Por lo que he leído, usted desea aprender programación orientada a objetos, muestro mi clase de la persistencia de la creación de selección, inserción, eliminación y actualización genérica, en este ejemplo estoy usando la tecnología con dbExpress SQLDataSet, ClientDataSet DataSetProvider. Yo solía ir DELPHI XE este ejemplo.
delphi
unit IPersist; interface uses variants, classes, db, dbtables, sysutils, SqlExpr, uConexao, uDMBase, DBClient, Provider, midaslib; type TTableEvent = procedure(Sender: TObject; var CanExecute: Boolean) of object; TMyFieldType = (ftString, ftMemo, ftFloat, ftInteger, ftDate, ftUnknown); TPk = Array of string; IField = interface ['{B0E0C59D-0857-473A-9D93-1EEA0D00B128}'] function get_Name: string; procedure set_Name(Value: string); function get_FieldType: TMyFieldType; procedure set_FieldType(Value: TMyFieldType); function get_IsPk: Boolean; procedure set_IsPk(Value: Boolean); function get_String: string; procedure set_String(Value: String); function get_Float: Double; procedure set_Float(Value: Double); function get_Integer: Integer; procedure set_Integer(Value: Integer); function get_Date: TDateTime; procedure set_Date(Value: TDateTime); function get_Value: Variant; procedure set_Value(Value: Variant); function get_IsModified: boolean; property Name: string read get_Name write set_Name; property FieldType: TMyFieldType read get_FieldType write set_FieldType; property IsPk: Boolean read get_IsPk write set_IsPk; property IsModified: Boolean read get_IsModified; property AsString: String read get_String write set_String; property AsFloat: Double read get_Float write set_Float; property AsInteger: Integer read get_Integer write set_Integer; property AsDate: TDateTime read get_Date write set_Date; property AsValue: Variant read get_Value write set_Value; end; ITable = interface ['{7D561737-BD28-4AA4-9D52-AE18FCB2E395}'] function get_TableName: String; function get_IFields(Index: Integer): IField; function FieldCount: Integer; function FieldByName(lcField: String): IField; procedure AssignByIndex(loSource: ITable); procedure AssignByName(loSource: ITable); function get_Log: Boolean; procedure set_Log(Value: Boolean); function get_FileLog: String; procedure set_FileLog(Value: String); function getBeforeInsert: TTableEvent; procedure setBeforeInsert(Value: TTableEvent); function getBeforeUpdate: TTableEvent; procedure setBeforeUpdate(Value: TTableEvent); function getBeforeDelete: TTableEvent; procedure setBeforeDelete(Value: TTableEvent); function get_cdsDataSet: TClientDataSet; procedure set_cdsDataSet(Value: TClientDataSet); function Insert: Integer; function Update: Integer; function Delete: Integer; function Select(lcFields: String): Boolean; procedure AtualizarDataSet; property TableName: string read get_TableName; property Fields[Index: Integer]: IField read get_IFields; property UseLog: Boolean read get_Log write set_Log; property FileLog: String read get_FileLog write set_FileLog; property TcdsDataSet: TClientDataSet read get_cdsDataSet write set_cdsDataSet; //Eventos property OnBeforeInsert: TTableEvent read getBeforeInsert write setBeforeInsert; property OnBeforeUpdate: TTableEvent read getBeforeUpdate write setBeforeUpdate; property OnBeforeDelete: TTableEvent read getBeforeDelete write setBeforeDelete; end; // **************** class auxiliar ******************************************* TUtil = class class function VarToDateTime(Value: Variant): TDateTime; class function VarToInteger(Value: Variant): Integer; class function VarToDouble(Value: Variant): Integer; class function FieldTypeToMyFieldType(Value: TFieldType): TMyFieldType; class function MyFieldTypeToString(Value: TMyFieldType): String; class function GetInterfaceByPointer(I: IUnknown): Pointer; class procedure ReleaseInterfaceByPointer(P: Pointer); end; // **************** classes ************************************************** TField = class(TInterfacedObject, IField) private FName: string; FFieldType: TMyFieldType; FIsPk: Boolean; FValue: Variant; FIsModified: Boolean; protected function get_Name: string; virtual; procedure set_Name(Value: string); virtual; function get_FieldType: TMyFieldType; virtual; procedure set_FieldType(Value: TMyFieldType); virtual; function get_IsPk: Boolean; virtual; procedure set_IsPk(Value: Boolean); virtual; function get_String: string; virtual; procedure set_String(Value: String); virtual; function get_Float: Double; virtual; procedure set_Float(Value: Double); virtual; function get_Integer: Integer; virtual; procedure set_Integer(Value: Integer); virtual; function get_Date: TDateTime; virtual; procedure set_Date(Value: TDateTime); virtual; function get_Value: Variant; virtual; procedure set_Value(Value: Variant); virtual; function get_IsModified: Boolean; virtual; public constructor Create(lcName: String; lTMyFieldType: TMyFieldType; llPK: Boolean); end; TTable = class(TInterfacedObject, ITable) private //Autor: Adriano - Para usar com DBX chamando a uses do DM aonde esta� FConection: TdmBase; loQuery: TSQLDataSet; //Compoente DBX pProvider: TDataSetProvider; loCDSLocal: TClientDataSet; dsBase: TDataSource; // FDataBaseName: String; FTableName: String; FList: TList; FPk: TPk; FLog: Boolean; FFileLog: string; FOnBeforeInsert: TTableEvent; FOnBeforeUpdate: TTableEvent; FOnBeforeDelete: TTableEvent; FOnAfterPost: TDataSetNotifyEvent; procedure doAfterPost(aSender: TObject); procedure doFreeList; function hasFieldModified: boolean; protected function get_TableName: String; virtual; function get_IFields(Index: Integer): IField; virtual; function FieldCount: Integer; virtual; function FieldByName(lcField: String): IField; virtual; function get_Log: Boolean; procedure set_Log(Value: Boolean); function get_FileLog: String; procedure set_FileLog(Value: String); function Insert: Integer; virtual; function Update: Integer; virtual; function Delete: Integer; virtual; function Select(lcFields: String): Boolean; virtual; procedure AssignByIndex(loSource: ITable); virtual; procedure AssignByName(loSource: ITable); virtual; function getBeforeInsert: TTableEvent; virtual; procedure setBeforeInsert(Value: TTableEvent); virtual; function getBeforeUpdate: TTableEvent; virtual; procedure setBeforeUpdate(Value: TTableEvent); virtual; function getBeforeDelete: TTableEvent; virtual; procedure setBeforeDelete(Value: TTableEvent); virtual; function get_cdsDataSet: TClientDataSet; virtual; procedure set_cdsDataSet(Value: TClientDataSet); virtual; // método para carregar os campos procedure doLoadFields; virtual; // método para copiar a pk procedure doCopyPk(laPk: Array of String); function isPk(lcField: String): Boolean; procedure AtualizarDataSet; //Parametros procedure passToParams; public constructor Create(lcDataBaseName, lcTableName: String; laPK: Array of String); destructor Destroy; override; //Eventos property OnAfterPost: TDataSetNotifyEvent read FOnAfterPost write FOnAfterPost; end; var //Variaveis Globais lnCont, i : Integer; sSQL, lcNome, lcSep: string; lvValue: variant; llCanExecute: boolean;
continua...
#3
Escrito 03 diciembre 2010 - 07:06
delphi
implementation { TField } constructor TField.Create(lcName: String; lTMyFieldType: TMyFieldType; llPK: Boolean); begin inherited Create; if lTMyFieldType = IPersist.ftUnknown then raise Exception.Create('Tipo de Campo[' + lcName + '] inválido'); FName := lcName; FFieldType := lTMyFieldType; FIsPk := llPk; FValue := null; FIsModified := False; end; function TField.get_Date: TDateTime; begin result := TUtil.VarToDateTime(FValue); end; function TField.get_FieldType: TMyFieldType; begin result := FFieldType; end; function TField.get_Float: Double; begin result := TUtil.VarToDouble(FValue); end; function TField.get_Integer: Integer; begin result := TUtil.VarToInteger(FValue); end; function TField.get_IsPk: Boolean; begin result := FIsPk; end; function TField.get_IsModified: Boolean; begin result := FIsModified; end; function TField.get_Name: string; begin result := UpperCase(FName); end; function TField.get_String: string; begin result := variants.VarToStr(FValue); end; function TField.get_Value: Variant; begin result := FValue; end; procedure TField.set_Date(Value: TDateTime); begin if (Value <> FValue) then begin FValue := Value; FIsModified := True; end; end; procedure TField.set_FieldType(Value: TMyFieldType); begin FFieldType := Value; end; procedure TField.set_Float(Value: Double); begin if (Value <> FValue) then begin FValue := Value; FIsModified := True; end; end; procedure TField.set_Integer(Value: Integer); begin if (Value <> FValue) then begin FValue := Value; FIsModified := True; end; end; procedure TField.set_IsPk(Value: Boolean); begin FIsPk := Value; end; procedure TField.set_Name(Value: string); begin FName := UpperCase(Value); end; procedure TField.set_String(Value: String); begin if (Value <> FValue) then begin FValue := Value; FIsModified := True; end; end; procedure TField.set_Value(Value: Variant); begin if (Value <> FValue) then begin FValue := Value; FIsModified := True; end; end; { TUtil } class function TUtil.FieldTypeToMyFieldType(Value: TFieldType): TMyFieldType; begin case Value of db.ftString: result := IPersist.ftString; db.ftSmallint, db.ftInteger, db.ftWord, db.ftLargeint: result := IPersist.ftInteger; db.ftFloat, db.ftCurrency, db.ftBCD: result := IPersist.ftFloat; db.ftDate, db.ftTime, db.ftDateTime, db.ftTimeStamp: result := IPersist.ftDate; db.ftBlob, db.ftMemo, db.ftFmtMemo: result := IPersist.ftMemo; else result := IPersist.ftUnknown; end; end; class function TUtil.GetInterfaceByPointer(I: IUnknown): Pointer; begin I._AddRef; result := Pointer(I); end; class function TUtil.MyFieldTypeToString(Value: TMyFieldType): String; const ccFieldType: array[TMyFieldType] of String = ('ftString', 'ftMemo', 'ftFloat', 'ftInteger', 'ftDate', 'ftUnknown'); begin result := ccFieldType[Value]; end; class procedure TUtil.ReleaseInterfaceByPointer(P: Pointer); var I: IUnknown; begin Pointer(I) := P; // a interface vai ser liberada ao sair do escopo end; class function TUtil.VarToDateTime(Value: Variant): TDateTime; begin try result := variants.VarToDateTime(Value); except result := 0; end; end; class function TUtil.VarToDouble(Value: Variant): Integer; begin try result := Value; except result := 0; end; end; class function TUtil.VarToInteger(Value: Variant): Integer; begin try result := Value; except result := 0; end; end; { TTable } constructor TTable.Create(lcDataBaseName, lcTableName: String; laPK: Array of String); begin inherited Create; //Autor: Adriano - Para usar com DBX chamando a uses do DM aonde esta� FConection := TdmBase.Create(nil); //Incluido para DBX Componente de conexao loQuery := TSQLDataSet.Create(nil); //SQLDataSet loCDSLocal := TClientDataSet.Create(nil); //DataSet pProvider := TDataSetProvider.Create(nil); //Provider dsBase := TDataSource.Create(nil); //Datasource // dsBase.DataSet := loCDSLocal; //Seta o datasource ao dataset FDataBaseName := lcDataBaseName; FTableName := lcTableName; FList := TList.Create; FLog := False; doCopyPk(laPk); doLoadFields; end; destructor TTable.Destroy; begin doFreeList; //Desalocar da memoria FConection.Free; loQuery.Free; loQuery.Close; // loCDSLocal.Free; // loCDSLocal.Close; pProvider.Free; dsBase.Free; inherited; end; function TTable.isPk(lcField: String): Boolean; var lnCont: Integer; begin lcField := UpperCase(lcField); result := false; for lnCont := Low(FPk) to High(FPk) do if UpperCase(FPk[lnCont]) = lcField then begin result := true; break; end; end; function TTable.getBeforeInsert: TTableEvent; begin result := FOnBeforeInsert; end; procedure TTable.setBeforeInsert(Value: TTableEvent); begin FOnBeforeInsert := Value; end; function TTable.getBeforeUpdate: TTableEvent; begin result := FOnBeforeUpdate; end; procedure TTable.setBeforeUpdate(Value: TTableEvent); begin FOnBeforeUpdate := Value; end; function TTable.getBeforeDelete: TTableEvent; begin result := FOnBeforeDelete; end; procedure TTable.setBeforeDelete(Value: TTableEvent); begin FOnBeforeDelete := Value; end; procedure TTable.AssignByIndex(loSource: ITable); var lnCont: Integer; begin for lnCont := 0 to loSource.FieldCount - 1 do ITable(Self).Fields[lnCont].AsValue := loSource.Fields[lnCont].AsValue; end; procedure TTable.AssignByName(loSource: ITable); var lnCont : Integer; lcField: String; begin for lnCont := 0 to loSource.FieldCount - 1 do begin // nome do campo do objeto origem lcField := loSource.Fields[lnCont].Name; // associo pelo nome ITable(Self).FieldByName(lcField).AsValue := loSource.FieldByName(lcField).AsValue; end; end; procedure TTable.AtualizarDataSet; begin loCDSLocal.Close; loCDSLocal.CommandText := 'SELECT * FROM ' + get_TableName; loCDSLocal.Open; end; function TTable.FieldByName(lcField: String): IField; var lnCont: Integer; begin result := nil; lcField := UpperCase(lcField); for lnCont := 0 to FieldCount - 1 do if ITable(Self).Fields[lnCont].Name = lcField then begin result := ITable(Self).Fields[lnCont]; break; end; end; function TTable.FieldCount: Integer; begin result := FList.Count; end; function TTable.get_cdsDataSet: TClientDataSet; begin Result := loCDSLocal; end; function TTable.get_FileLog: String; begin result := FFileLog; end; function TTable.get_IFields(Index: Integer): IField; begin if Index < 0 then raise Exception.Create('Índice ' + inttostr(Index) + ' fora da lista'); if Index > (FList.Count - 1) then raise Exception.Create('Índice ' + inttostr(Index) + ' fora da lista'); result := IUnknown(FList.Items[Index]) as IField; end;
continua..
#4
Escrito 03 diciembre 2010 - 07:07
delphi
function TTable.get_Log: Boolean; begin result := FLog; end; function TTable.get_TableName: String; begin result := FTableName; end; function TTable.hasFieldModified: boolean; var lnCont: Integer; begin result := false; for lnCont := 0 to FieldCount - 1 do if get_IFields(lnCont).IsModified then begin result := true; break; end; end; procedure TTable.doAfterPost(aSender: TObject); begin if loCDSLocal.Active = False then loCDSLocal.Active := True; loCDSLocal.ApplyUpdates(0); end; procedure TTable.doCopyPk(laPk: array of String); var lnTam: Integer; lnCont: Integer; begin lnTam := High(laPk); SetLength(FPk, lnTam + 1); for lnCont := low(laPk) to lnTam do FPk[lnCont] := laPk[lnCont]; end; procedure TTable.doFreeList; var lnCont: Integer; begin for lnCont := FieldCount - 1 downto 0 do begin // FList[lnCont] eh um ponteiro que aponta para uma interface TUtil.ReleaseInterfaceByPointer(FList[lnCont]); FList[lnCont] := nil; end; FList.Pack; FList.Free; end; procedure TTable.doLoadFields; var loQuery : TSQLQuery; lnCont : Integer; loField : IField; begin loQuery := TSQLQuery.Create(nil); try loQuery.SQLConnection := FConection.Conexao;//FDataBaseName; loQuery.SQL.Clear; loQuery.SQL.Add('SELECT * FROM ' + ITable(Self).TableName + ' WHERE 1=2'); loQuery.Open; for lnCont := 0 to loQuery.FieldCount - 1 do begin loField := TField.Create(loQuery.Fields[lnCont].FieldName, TUtil.FieldTypeToMyFieldType(loQuery.Fields[lnCont].DataType), isPk(loQuery.Fields[lnCont].FieldName)); // lista de ponteiros para interface FList.Add(TUtil.GetInterfaceByPointer(loField)); end; finally loQuery.Close; loQuery.Free; end; end; procedure TTable.set_cdsDataSet(Value: TClientDataSet); begin loCDSLocal := Value; end; procedure TTable.set_FileLog(Value: String); begin FFileLog := Value; end; procedure TTable.set_Log(Value: Boolean); begin FLog := Value; end; //***************************************************************************** //CliendDataSet function TTable.Insert: Integer; begin result := 0; // se não há modificação, então não há inclusão if not hasFieldModified then exit; try // Nomes loCDSLocal.Name := 'loCDSLocal'; pProvider.Name := 'pProvider'; loQuery.Name := 'loQuery'; {Comando criado para conectar do DBX} loQuery.SQLConnection := FConection.Conexao;//FDataBaseName; loQuery.CommandType := ctQuery; //Modo query // Configs de Criação loCDSLocal.StoreDefs := True; pProvider.Options:=[poAllowCommandText]; // Configs loCDSLocal.SetProvider(pProvider); //Tem que setar o provider no dataset desta forma pProvider.DataSet := loQuery; //O dsprovider recebe o sqldataset do dbx // ******************************************* //Foi alterado do original agora uso como string e não ADD para usar no CDS sSQL := 'INSERT INTO ' + FTableName + '('; // field list lcSep := ''; for lnCont := 0 to FieldCount - 1 do if get_IFields(lnCont).IsModified then begin lcNome := get_IFields(lnCont).Name; sSQL := sSQL + lcSep + lcNome ; lcSep := ','; end; sSQL := sSQL + ')'; //Passando os values sSQL := sSQL + ' Values ( '; // value list lcSep := ''; for lnCont := 0 to FieldCount - 1 do if get_IFields(lnCont).IsModified then begin lcNome := get_IFields(lnCont).Name; sSQL := sSQL + lcSep + ':' + lcNome; lcSep := ','; end; sSQL := sSQL + ')'; //Passando o SQL no dataset loCDSLocal.CommandText := sSQL; //Chamando a procedure params passToParams; // retorna o valor da função if ITable(Self).UseLog then begin if Trim(ITable(Self).FileLog) = EmptyStr then raise Exception.Create('FileLog não pode ser vazio!'); loCDSLocal.SaveToFile(ITable(Self).FileLog); end; // verifico se o evento foi programado llCanExecute := true; if Assigned(FOnBeforeInsert) then FOnBeforeInsert(self, llCanExecute); // testo a variavel if not llCanExecute then raise Exception.Create('Processo interrompido pelo usuário!'); //Executa o dataset loCDSLocal.Execute; //Atualizar Dataset AtualizarDataSet; Result := 1; //loCDSLocal.RowsAffected; //Autor: Adriano Não funciona except on e: exception do raise Exception.Create(E.Message + ' on TTable.Insert '); end; end; function TTable.Delete: Integer; begin result := 0; // se não há modificação, então não há inclusão if not hasFieldModified then exit; try // Nomes loCDSLocal.Name := 'loCDSLocal'; pProvider.Name := 'pProvider'; loQuery.Name := 'loQuery'; {Comando criado para conectar do DBX} loQuery.SQLConnection := FConection.Conexao;//FDataBaseName; loQuery.CommandType := ctQuery; //Modo query // Configs de Criação loCDSLocal.StoreDefs := True; pProvider.Options:=[poAllowCommandText]; // Configs loCDSLocal.SetProvider(pProvider); //Tem que setar o provider no dataset desta forma pProvider.DataSet := loQuery; //O dsprovider recebe o sqldataset do dbx // ******************************************* //Foi alterado do original agora uso como string e não ADD para usar no CDS sSQL := 'DELETE FROM ' + FTableName +' WHERE '; // value list lcSep := ''; for lnCont := 0 to FieldCount - 1 do if get_IFields(lnCont).IsPk then begin lcNome := get_IFields(lnCont).Name; sSQL := sSQL + lcSep + lcNome + ' = ' + ':' + lcNome; lcSep := ' AND '; end; //Passando o SQL no dataset loCDSLocal.CommandText := sSQL; //Chamando a procedure params passToParams; // retorna o valor da função if ITable(Self).UseLog then begin if Trim(ITable(Self).FileLog) = EmptyStr then raise Exception.Create('FileLog não pode ser vazio!'); loCDSLocal.SaveToFile(ITable(Self).FileLog); end; // verifico se o evento foi programado llCanExecute := true; if Assigned(FOnBeforeDelete) then FOnBeforeDelete(self, llCanExecute); // testo a variavel if not llCanExecute then raise Exception.Create('Processo interrompido pelo usuário!'); loCDSLocal.Execute; //Atualizar Dataset AtualizarDataSet; Result := 1; //loCDSLocal.RowsAffected; except on e: exception do raise Exception.Create(E.Message + ' on TTable.Delete '); end; end; function TTable.Update: Integer; begin result := 0; // se não há modificação, então não há inclusão if not hasFieldModified then exit; try // Nomes loCDSLocal.Name := 'loCDSLocal'; pProvider.Name := 'pProvider'; loQuery.Name := 'loQuery'; {Comando criado para conectar do DBX} loQuery.SQLConnection := FConection.Conexao;//FDataBaseName; loQuery.CommandType := ctQuery; //Modo query // Configs de Criação loCDSLocal.StoreDefs := True; pProvider.Options:=[poAllowCommandText]; // Configs loCDSLocal.SetProvider(pProvider); //Tem que setar o provider no dataset desta forma pProvider.DataSet := loQuery; //O dsprovider recebe o sqldataset do dbx // ******************************************* //Foi alterado do original agora uso como string e não ADD para usar no CDS sSQL := 'UPDATE ' + FTableName +' SET '; // field list lcSep := ''; for lnCont := 0 to FieldCount - 1 do if get_IFields(lnCont).IsModified then if not get_IFields(lnCont).IsPk then begin lcNome := get_IFields(lnCont).Name; sSQL := sSQL + lcSep + lcNome + ' = ' + ':' + lcNome; lcSep := ','; end; sSQL := sSQL + ' WHERE '; // value list lcSep := ''; for lnCont := 0 to FieldCount - 1 do if get_IFields(lnCont).IsPk then begin lcNome := get_IFields(lnCont).Name; sSQL := sSQL + lcSep + lcNome + ' = ' + ':' + lcNome; lcSep := ' AND '; end; //Passando o SQL no dataset loCDSLocal.CommandText := sSQL; //Chamando a procedure params passToParams; // retorna o valor da função if ITable(Self).UseLog then begin if Trim(ITable(Self).FileLog) = EmptyStr then raise Exception.Create('FileLog não pode ser vazio!'); loCDSLocal.SaveToFile(ITable(Self).FileLog); end; // verifico se o evento foi programado llCanExecute := true; if Assigned(FOnBeforeUpdate) then FOnBeforeUpdate(self, llCanExecute); // testo a variavel if not llCanExecute then raise Exception.Create('Processo interrompido pelo usuário!'); loCDSLocal.Execute; //Atualizar Dataset AtualizarDataSet; Result := 1; //loQuery.RowsAffected; except on e: exception do raise Exception.Create(E.Message + ' on TTable.Update '); end; end; function TTable.Select(lcFields: String): Boolean; begin result := false; try // Nomes loCDSLocal.Name := 'loCDSLocal'; pProvider.Name := 'pProvider'; loQuery.Name := 'loQuery'; {Comando criado para conectar do DBX} loQuery.SQLConnection := FConection.Conexao;//FDataBaseName; loQuery.CommandType := ctQuery; //Modo query // Configs de Criação loCDSLocal.StoreDefs := True; // pProvider.Options:=[poAllowCommandText]; // Configs loCDSLocal.SetProvider(pProvider); //Tem que setar o provider no dataset desta forma pProvider.DataSet := loQuery; //O dsprovider recebe o sqldataset do dbx // ******************************************* // preparar o dataset sSQL := 'SELECT ' + lcFields + ' FROM ' + get_TableName + ' WHERE '; // value list lcSep := ''; for lnCont := 0 to FieldCount - 1 do if get_IFields(lnCont).IsPk then begin lcNome := get_IFields(lnCont).Name; sSQL := sSQL + lcSep + lcNome + ' LIKE ' + ':' + lcNome ; lcSep := ' AND '; end; //Passando o SQL no dataset loCDSLocal.CommandText := sSQL; //Chamando a procedure params passToParams; // retorna o valor da função if ITable(Self).UseLog then begin if Trim(ITable(Self).FileLog) = EmptyStr then raise Exception.Create('FileLog não pode ser vazio!'); loCDSLocal.SaveToFile(ITable(Self).FileLog); end; loCDSLocal.Open; result := not loCDSLocal.IsEmpty; for lnCont := 0 to loCDSLocal.FieldCount - 1 do begin // inicializo todos como NULL Self.FieldByName(loCDSLocal.Fields[lnCont].FieldName).AsValue := null; // se alguma linha foi retornada // atualiza o valor do campo I da lista if result then Self.FieldByName(loCDSLocal.Fields[lnCont].FieldName).AsValue := loCDSLocal.Fields[lnCont].Value; end; except on e: exception do raise Exception.Create(E.Message + ' on TTable.Select '); end; end; //Exclusivo para uso do clientdataset procedure TTable.passToParams; begin // param list for lnCont := 0 to FieldCount - 1 do if get_IFields(lnCont).IsModified then begin lcNome := get_IFields(lnCont).Name; lvValue := get_IFields(lnCont).AsValue; case get_IFields(lnCont).FieldType of ftString: begin loCDSLocal.Params.ParamByName(lcNome).DataType := db.ftString; loCDSLocal.Params.ParamByName(lcNome).Value := lvValue; end; ftMemo: begin loCDSLocal.Params.ParamByName(lcNome).DataType := db.ftString; loCDSLocal.Params.ParamByName(lcNome).Value := lvValue; end; ftFloat: begin loCDSLocal.Params.ParamByName(lcNome).DataType := db.ftFloat; loCDSLocal.Params.ParamByName(lcNome).Value := lvValue; end; ftInteger: begin loCDSLocal.Params.ParamByName(lcNome).DataType := db.ftInteger; loCDSLocal.Params.ParamByName(lcNome).Value := lvValue; end; ftDate: begin loCDSLocal.Params.ParamByName(lcNome).DataType := db.ftDateTime; if get_IFields(lnCont).AsDate = 0 then lvValue := null else lvValue := get_IFields(lnCont).AsDate; loCDSLocal.Params.ParamByName(lcNome).Value := lvValue; end; else raise Exception.Create('Campo ' + lcNome + ' com tipo de dados não esperado!'); end; end; end; end.
Hago un llamamiento a la persistencia de la clase, así
#5
Escrito 03 diciembre 2010 - 07:10
delphi
{Autor: Adriano Data da criação: 30/10/2010} unit uCadastroBase; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, XPMan, StdCtrls, Buttons, ExtCtrls, ComCtrls, JvExComCtrls, JvComCtrls, JvExControls, JvNavigationPane, unTEditExitEnterColor, ImgList, JvXPBar, jpeg, JvXPCore, JvXPContainer, Grids, DBGrids, DB, Mask, JvExMask, JvToolEdit, JvDBControls, unTJvDBDateEditExitEnterColor, DBCtrls, unTdbComboBoxExitEnterColor, uValidaEdtCmbEstadual, JvBaseEdits, unTJvDBCalcEditExitEnterColor, unTdbMemoExitEnterColor, unTdbEditExitEnterColor, uDsLocate, JvMaskEdit, JvArrowButton, JvColorBox, JvColorButton, UnitButtonMenu, Menus, DBTables, SqlExpr, DBClient, UxTheme, Themes; //Classes Adriano type TInfStateForm = class function SetStateForm: string; virtual; abstract; end; TListagem = class(TInfStateForm) function SetStateForm: string; override; end; TCadastro = class(TInfStateForm) function SetStateForm: string; override; end; // type PtForm = ^TfrmCadastroBase; //Tratando com ponteiro TfrmCadastroBase = class(TForm) Label50: TLabel; StatusBar1: TStatusBar; JvNavPanelHeader1: TJvNavPanelHeader; Label1: TLabel; PaginaPrincipal: TJvPageControl; ModoListagem: TTabSheet; ModoCadastro: TTabSheet; GroupBox2: TGroupBox; PanelTop: TPanel; PanelButton: TPanel; btInsert: TBitBtn; btCancel: TBitBtn; btEdit: TBitBtn; btDelete: TBitBtn; btLocate: TBitBtn; btPost: TBitBtn; PanelInformation: TPanel; GroupBox9: TGroupBox; Label51: TLabel; cbtipo: TComboBox; cbtodos: TCheckBox; cbclientes: TComboBox; EdtLocalizar: TEdtExitEnterColor; Splitter2: TSplitter; Panel2: TPanel; JvXPContainer1: TJvXPContainer; ImgLateral: TImage; ImgMenuLateral: TImageList; GroupBox1: TGroupBox; dsLocal: TDataSource; RadioButton1: TRadioButton; RadioButton2: TRadioButton; Label5: TLabel; JvXPBar6: TJvXPBar; JvXPBar8: TJvXPBar; JvXPBar7: TJvXPBar; PaginaExtra: TPageControl; TabSheet7: TTabSheet; TabSheet8: TTabSheet; Panel1: TPanel; TabSheet9: TTabSheet; Panel3: TPanel; GroupBox11: TGroupBox; CheckBox1: TCheckBox; CheckBox2: TCheckBox; CheckBox3: TCheckBox; CheckBox4: TCheckBox; RadioGroup1: TRadioGroup; GroupBox12: TGroupBox; CheckBox9: TCheckBox; CheckBox10: TCheckBox; CheckBox5: TCheckBox; CheckBox6: TCheckBox; CheckBox7: TCheckBox; CheckBox8: TCheckBox; RadioGroup2: TRadioGroup; GridBase: TDBGrid; RadioGroup3: TRadioGroup; GroupBox13: TGroupBox; Label7: TLabel; DateTimePicker1: TDateTimePicker; DateTimePicker2: TDateTimePicker; Label8: TLabel; Localizar: TDataSetLocate; ButtonMenu1: TButtonMenu; ppImpressora: TPopupMenu; Imprimir1: TMenuItem; N1: TMenuItem; CONFIGURARPGINA1: TMenuItem; N2: TMenuItem; IMPORTARPARAEXCEL1: TMenuItem; N3: TMenuItem; CONFIGURARPGINA2: TMenuItem; JvXPBar1: TJvXPBar; btClose: TBitBtn; procedure ModoCadastroShow(Sender: TObject); procedure ModoListagemShow(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure btCloseClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormShow(Sender: TObject); procedure RadioGroup2Click(Sender: TObject); procedure btInsertClick(Sender: TObject); procedure ButtonMenu1Click(Sender: TObject); procedure btLocateClick(Sender: TObject); procedure EdtLocalizarChange(Sender: TObject); procedure btDeleteClick(Sender: TObject); procedure btEditClick(Sender: TObject); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); private procedure TrataAlgunsButtons(OK: Boolean); procedure MyOnBeforeInsert(aSender: TObject; var PodeExecutar: Boolean); public Ponteiro : PtForm; Destructor Destroy(); end; var frmCadastroBase: TForm; implementation uses uPrincipal, uFuncoesUniversais, uFuncForm, uDMBase, IPersist, uConexao; {$R *.dfm} { TfrmCadastroBase } procedure TfrmCadastroBase.btCloseClick(Sender: TObject); begin Self.Close; end; procedure TfrmCadastroBase.btDeleteClick(Sender: TObject); var loTable : IPersist.ITable; i: Integer; iInc: Double; nDataSet: IPersist.TTable; begin loTable := IPersist.TTable.Create(dmBase.Conexao.Name, 'USUARIOS', ['ID_USUARIO']); loTable.UseLog := true; loTable.FileLog := 'c:\filelog.log'; if GridBase.SelectedRows.Count > 1 then //Se o select for maior que um então é multselect begin //DeleteMultSelect(GridBase); with GridBase.DataSource.DataSet do begin //for i := GridBase.SelectedRows.Count - 1 downto 0 do for i := 0 to GridBase.SelectedRows.Count - 1 do begin GotoBookmark(Pointer(GridBase.SelectedRows.Items[i])); loTable.FieldByName('ID_USUARIO').AsInteger := GridBase.DataSource.DataSet.FieldByName('ID_USUARIO').AsInteger; loTable.Delete; end; end; //GridBase.SelectedRows.Delete; dsLocal.DataSet := loTable.TcdsDataSet; end else begin loTable.FieldByName('ID_USUARIO').AsInteger := GridBase.DataSource.DataSet.FieldByName('ID_USUARIO').AsInteger; loTable.Delete; dsLocal.DataSet := loTable.TcdsDataSet; end; GridBase.Refresh; end; procedure TfrmCadastroBase.btEditClick(Sender: TObject); var loTable : IPersist.ITable; iInc: Double; nDataSet: IPersist.TTable; begin loTable := IPersist.TTable.Create(dmBase.Conexao.Name, 'USUARIOS', ['ID_USUARIO']); loTable.UseLog := true; loTable.FileLog := 'c:\filelog.log'; loTable.FieldByName('ID_USUARIO').AsInteger := GridBase.DataSource.DataSet.FieldByName('ID_USUARIO').AsInteger; loTable.FieldByName('USUARIO').AsString := 'SUPER'; loTable.FieldByName('SENHA').AsString := 'UP0014'; loTable.FieldByName('CONFSENHA').AsString := 'UP0014'; loTable.FieldByName('NIVEL').AsString := '2'; loTable.Update; dsLocal.DataSet := loTable.TcdsDataSet; GridBase.Refresh; end; procedure TfrmCadastroBase.btInsertClick(Sender: TObject); var loTable : IPersist.ITable; iInc: Double; nDataSet: IPersist.TTable; begin //Comentario: Os parametros DBX são: O nome do SQLConnection, a Tabela e a Chave Primaria loTable := IPersist.TTable.Create(dmBase.Conexao.Name, 'USUARIOS', ['ID_USUARIO']); loTable.UseLog := true; loTable.FileLog := 'c:\filelog.log'; loTable.OnBeforeInsert := MyOnBeforeInsert; // iInc := dmBase.RetornaID('2'); with dmBase.cdsControle do begin Close; CommandText := ' SELECT * FROM CONTROLE '; Open; end; // loTable.FieldByName('ID_USUARIO').AsInteger := dmBase.cdsControleVALOR.AsInteger; loTable.FieldByName('USUARIO').AsString := 'GENERICO'; loTable.FieldByName('SENHA').AsString := 'XBS111'; loTable.FieldByName('CONFSENHA').AsString := 'XBS111'; loTable.FieldByName('NIVEL').AsString := '1'; //Table.FieldByName('DATACRIACAO').AsString := ''; //Table.FieldByName('EXPIRAEM').AsString := ''; {loTable.FieldByName('GRUPO').AsString := ''; loTable.FieldByName('ADM').AsString := ''; loTable.FieldByName('ALTERARSENHA').AsString := 'N'; loTable.FieldByName('NAOEXPIRA').AsString := 'N'; loTable.FieldByName('IDEMPRESAS').AsString := ''; loTable.FieldByName('CRIAR_LOG_USUARIO').AsString := 'N'; loTable.FieldByName('EXIBIRHISTORICOAUDIT').AsString := 'N'; loTable.FieldByName('CHECARCONTROLES').AsString := 'N'; loTable.FieldByName('PRIVILEGIOADMIN').AsString := 'S'; loTable.FieldByName('PERMISSAOALTSENHA').AsString := 'S'; } loTable.Insert; dsLocal.DataSet := loTable.TcdsDataSet; //ShowMessage('Registros Incluidos ' + inttostr(loTable.Insert)); end; procedure TfrmCadastroBase.btLocateClick(Sender: TObject); var qryLocal: TSQLDataSet; begin qryLocal := TSQLDataSet.Create(nil); try (* realiza a conexão com o banco *) dsLocal.DataSet := qryLocal; qryLocal.SQLConnection := TConexao.GetIntance(FIREBIRD); qryLocal.CommandText := 'SELECT * FROM usuarios'; qryLocal.Open; finally FreeAndNil(qryLocal); end; end; procedure TfrmCadastroBase.ButtonMenu1Click(Sender: TObject); begin ButtonMenu1.MenuButtonClick(Sender); end; destructor TfrmCadastroBase.Destroy; var PtAux: PtForm; begin PtAux := Ponteiro; inherited Destroy(); If ( PtAux^ <> Nil ) Then PtAux^ := Nil; end; procedure TfrmCadastroBase.EdtLocalizarChange(Sender: TObject); var loTable : IPersist.ITable; iInc: Double; nDataSet: IPersist.TTable; begin //Comentario: Os parametros DBX são: O nome do SQLConnection, a Tabela e a Chave Primaria loTable := IPersist.TTable.Create(dmBase.Conexao.Name, 'USUARIOS', ['USUARIO']); loTable.UseLog := true; loTable.FileLog := 'c:\filelog.log'; dsLocal.DataSet := loTable.TcdsDataSet; loTable.FieldByName('USUARIO').AsString := AnsiUpperCase(EdtLocalizar.Text)+'%'; if loTable.Select('*') then end; procedure TfrmCadastroBase.FormClose(Sender: TObject; var Action: TCloseAction); begin Action := caFree; end; procedure TfrmCadastroBase.FormCreate(Sender: TObject); var CPanel : Integer; begin //Este bloco serve para o panel não ficar na cor branca for CPanel := 0 to Self.ComponentCount - 1 do if (Self.Components[CPanel]) is TPanel then with (Self.Components[CPanel] as TPanel) do ParentBackground := False; // //centraliza o form Left := (Screen.Width - Width ) div 2; Top := 0; //Ao iniciar o form, deixar sempre com foco na primeira pagina PaginaPrincipal.ActivePageIndex := 0; PaginaExtra.ActivePageIndex := 0; end; procedure TfrmCadastroBase.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin case key of {avança com enter} vk_return : SendMessage(Self.Handle, WM_NEXTDLGCTL, 0, 0); {retorna com esc} vk_escape : SendMessage(Self.Handle, WM_NEXTDLGCTL, 1 ,0); end; end; procedure TfrmCadastroBase.FormShow(Sender: TObject); var i, iIdentificacaoForm: Integer; begin //Variavel recebe a numeração da Tag para saber qual é o form iIdentificacaoForm := Tag; Caption := '[ Identificação do Formulário ] - TAG - ' + IntToStr(iIdentificacaoForm); //Verificando as Tag do JvXPBar1 for i := 0 to JvXPBar1.Items.Count-1 do begin if JvXPBar1.Items[i].Tag = Tag then JvXPBar1.Items[i].Enabled := False else JvXPBar1.Items[i].Enabled := True; end; //Desabilitando tema XPManifest if ThemeServices.ThemesEnabled then SetWindowTheme(PaginaPrincipal.Handle, '', ''); SetWindowTheme( PaginaExtra.Handle, nil, '' ); end; procedure TfrmCadastroBase.ModoCadastroShow(Sender: TObject); begin TrataAlgunsButtons(False); end; procedure TfrmCadastroBase.ModoListagemShow(Sender: TObject); begin TrataAlgunsButtons(True); end; procedure TfrmCadastroBase.MyOnBeforeInsert(aSender: TObject; var PodeExecutar: Boolean); begin PodeExecutar := Pt_MessageDlgXe('Continua com a execução do método?','Mensagem do Sistema', mtConfirmation, [mbYes, mbNO], 0) = mrYes; end; procedure TfrmCadastroBase.RadioGroup2Click(Sender: TObject); begin case RadioGroup2.ItemIndex of 0: PaginaExtra.TabPosition := tpTop; 1: PaginaExtra.TabPosition := tpLeft; 2: PaginaExtra.TabPosition := tpBottom; 3: PaginaExtra.TabPosition := tpRight; end; end; procedure TfrmCadastroBase.TrataAlgunsButtons(OK: Boolean); var obj: TInfStateForm; //Chamo o metodo da classe pai e os filhos dentro //não preciso neste caso chamar as classes filhos uma a uma. begin if Ok = True then begin btLocate.Enabled := True; ButtonMenu1.MainButton.Enabled := True; ButtonMenu1.MenuButton.Enabled := True; obj := TListagem.Create; //Então aqui eu instancio na classe filho pq herda da classe pai PanelInformation.Caption := obj.SetStateForm; obj.Free; end else if Ok = False then begin btLocate.Enabled := False; ButtonMenu1.MainButton.Enabled := False; ButtonMenu1.MenuButton.Enabled := False; obj := TCadastro.Create; //Então aqui eu instancio na classe filho pq herda da classe pai PanelInformation.Caption := obj.SetStateForm; obj.Free; end; end; { TListagem } function TListagem.SetStateForm: string; begin Result := 'Listagem'; end; { TCadastro } function TCadastro.SetStateForm: string; begin Result := 'Cadastro'; end; end.
No completar la clase, más están haciendo lo que fue diseñado, todo en programación orientada a objetos OOP
Espero que ayuda.
#6
Escrito 03 diciembre 2010 - 08:04
Hola Master23, ¡Tanto tiempo!
Bueno, la verdad es que explicar el paradigma OO no es algo que sea tan fácil, tampoco es que sea complicado; es tedioso... demanda mucho tiempo. En una cátedra de Lenguajes demandaría un semestre dar los conceptos, interpretarlos, fomentarlos, y luego todo un año para llegar a potenciarlos.
Aprender OO no es leer y ya está, el seguir los ejemplos de manuales y tutoriales puede ayudar a comprenderlos, pero extraer su mayor potencial es algo que se va cultivando...
No desesperes si te cuesta captar la onda.
Te recomiendo la lectura del capítulo dedicado a POO del libro La Cara Oculta. Te guiará. Luego te puedo recomendar los manuales sobre POO que escribí hace un tiempo. Son bastantes simples y se basan en ejemplos al estilo perro-gato y de ese modo evitar ofrecer mayores formalismos.
Para más adelante, cuando ya le hayas agarrado el gusto al paradigma puedes dar el salto y leer a Craig Larman en su libro UML y Patrones... Creeme que ese libro te cambiará radicalmente tu concepción OO y te fortalecerá enormemente... Además el que a lo largo de todo el libro de ejemplos basado en un único escenario y válido para la vida real: un sistema PDV ya no piensas en perros y gatos sino que descubres y ves a todo como potenciales clases.
El mayor problema y es lo que cuesta realmente a los estudiantes no es comprender sus conceptos como clase, herencia, objeto, etc... su problema radica en una falta de potenciar y enseñar a hacer análisis OO y trasladar las entidades de un contexto a un plano OO... Eso muy lamentablemente Master23 es algo que se aprende con la práctica; Craig ayuda mucho en el sentido del análisis OO pero luego está en dar el salto nosotros.
No temas preguntar a medida que te asaltan las dudas. Admito que tengo bastante pendiente elaborar un artículo que explique como dar el paso del pensamiento estructurado hacia el orientado a objetos... Cuando empieces a comprenderlo notarás que la diferencia entre ellos no es tan abrumadora... es más, es posible que hasta le encuentres ciertos parecidos.
Saludos,
Bueno, la verdad es que explicar el paradigma OO no es algo que sea tan fácil, tampoco es que sea complicado; es tedioso... demanda mucho tiempo. En una cátedra de Lenguajes demandaría un semestre dar los conceptos, interpretarlos, fomentarlos, y luego todo un año para llegar a potenciarlos.
Aprender OO no es leer y ya está, el seguir los ejemplos de manuales y tutoriales puede ayudar a comprenderlos, pero extraer su mayor potencial es algo que se va cultivando...
No desesperes si te cuesta captar la onda.
Te recomiendo la lectura del capítulo dedicado a POO del libro La Cara Oculta. Te guiará. Luego te puedo recomendar los manuales sobre POO que escribí hace un tiempo. Son bastantes simples y se basan en ejemplos al estilo perro-gato y de ese modo evitar ofrecer mayores formalismos.
Para más adelante, cuando ya le hayas agarrado el gusto al paradigma puedes dar el salto y leer a Craig Larman en su libro UML y Patrones... Creeme que ese libro te cambiará radicalmente tu concepción OO y te fortalecerá enormemente... Además el que a lo largo de todo el libro de ejemplos basado en un único escenario y válido para la vida real: un sistema PDV ya no piensas en perros y gatos sino que descubres y ves a todo como potenciales clases.
El mayor problema y es lo que cuesta realmente a los estudiantes no es comprender sus conceptos como clase, herencia, objeto, etc... su problema radica en una falta de potenciar y enseñar a hacer análisis OO y trasladar las entidades de un contexto a un plano OO... Eso muy lamentablemente Master23 es algo que se aprende con la práctica; Craig ayuda mucho en el sentido del análisis OO pero luego está en dar el salto nosotros.
No temas preguntar a medida que te asaltan las dudas. Admito que tengo bastante pendiente elaborar un artículo que explique como dar el paso del pensamiento estructurado hacia el orientado a objetos... Cuando empieces a comprenderlo notarás que la diferencia entre ellos no es tan abrumadora... es más, es posible que hasta le encuentres ciertos parecidos.
Saludos,
#7
Escrito 05 diciembre 2010 - 11:50
Hola,
¿Alguna novedad Master23?
Espero que no pienses que soy vago y no quiero dar explicaciones bien profundas... es que es tedioso. Y el mayor peligro es dar un ejemplo como el que ha mostrado adriano puesto que existe la posibilidad de que te resulte chinesco si aún no le agarras la mano a los conceptos. Por ello es que es más fácil comprenderlo, inicialmente, en base a los ejemplos simples y no intentar demasiado a que la cabeza absorva un ejemplo real y tan completo como el que se muestra aquí.
Nos sería de utilidad el que nos comentes tus dudas a medida que vas estudiando y de allí vemos como irte guiando.
¿Alguna novedad Master23?
Espero que no pienses que soy vago y no quiero dar explicaciones bien profundas... es que es tedioso. Y el mayor peligro es dar un ejemplo como el que ha mostrado adriano puesto que existe la posibilidad de que te resulte chinesco si aún no le agarras la mano a los conceptos. Por ello es que es más fácil comprenderlo, inicialmente, en base a los ejemplos simples y no intentar demasiado a que la cabeza absorva un ejemplo real y tan completo como el que se muestra aquí.
Nos sería de utilidad el que nos comentes tus dudas a medida que vas estudiando y de allí vemos como irte guiando.