SetFocus no Firemonkey Delphi.

O Firemonkey do Delphi proíbe a mudança de foco em alguns eventos. Para conseguir contornar a situação do SetFocus dos campos, precisamos mandar um mensagem atrasada para o form.

Como mandar esta mensagem. Simples vamos usar uma Thread Anonima. Pois é depois de muita procura achei um paliativo.

Vamos a Função:

procedure TfrmTelaPadrao.ForceFocus(Obj: TControl);
begin
  TThread.CreateAnonymousThread(
    procedure
    begin
      TThread.Synchronize( nil,
         procedure
         begin
           Obj.SetFocus;
         end
      );
    end
  ).Start;
end;

Espero que tenha ajudado a quem procura.

MySQL: Somando datas corretamente com CURDATE

A função CURDATE não funciona corretamente para a adição de dias que extrapolam o calendário. Como exemplo, a instrução a seguir retornar uma data inexistente:

// acrescentando 120 dias a data atual
 > SELECT CURDATE()+120;
 > 20071325

Para resolver isso é usada uma outra função chamada DATE_ADD, responsável pela soma correta de dias em uma determinada data:

// acrescentando 120 dias a data atual
 > SELECT DATE_ADD(CURDATE(), INTERVAL 120 DAY);
 > 2008-04-03

O mesmo pode ser feito para subtrair dias de uma data com a função DATE_SUB.

Fonte: http://codare.net/2008/02/01/mysql-somando-datas-corretamente-com-curdate/

Bloquear mouse e tecla

Olá pessoal,

Segue um dica bem lega e simples para bloquear teclado e mouse. Nesta dica, o CTRL + ALT + DEL não fica travado.

function BlockInput(fbLookIt:Boolean):Integer; stdcall; external 'user32.dll';

Para bloquear, chame a função da seguinte forma:
BlockInput (true)

Para desbloquear, chame a função da seguinte forma:
BlockInput (false);

Grande abraço!

EXECUTAR APLICATIVOS COM PERMISSÃO DE ADMINISTRADOR

Nas propriedades do atalho do aplicativo antes do destino coloca isso:

runas /savecred /user:administrador “C:\Windows\System32\cmd.exe”

Posicionar o cursor no próximo campo

Boa Noite pessoal.

Para posicionar o cursor no próximo campo pode se usar o seguinte comando:

declare a unit Controls, se não estiver já declarada.

SelectNext(Self.ActiveControl, True, True);

Onde:

O primeiro parâmetro e controle ativo.

Segundo parâmetro (Com valor True) informa que a procura é pra frente. Se quiser fazer o contrário é so informar false que ele procura o campo anterior.

Terceiro é pra verificar se ele vai obedeçer o TabStop do campo.

Programação Orientada a Objeto

Segue um link muito bom com conceitos de POO, na prática e com exemplo:
http://www.luizsistemas.com.br/tag/crud/

Créditos: Luiz Carlos Alves

Como usar a nova RTTI no Delphi

Segue um link com exemplo de como usar a nova RTTI no Delphi, este link explica com exemplo a funções da classe:
http://edn.embarcadero.com/br/article/41728

Em breve vou colocar uma serie de como usar esta RTTI na prática em OOP (Programação Orientada a Objeto ) no delphi.

ATT: Volnei;

Função pra limpar os campos de um Object

Boa Noite pessoal.

Na rotina de programar sempre encontramos campos que precisam ser limpados antes de qualquer outro processo, mas sempre é uma função chata de fazer e sempre da um monte de programação.

Abaixo seque uma função que achei,não me lembro o autor da mesma que faz este serviços pra vocês.
Esta procedure usa informações em RunTime com auxilio da unit TypeInfo verificando uma propriedade em comum em todos os componentes que a TAG;

Por favor declarar as seguintes units: TypeInfo, StrUtils, WideStrings;


procedure LimparCampos(Controle: TWincontrol; const cTag: Integer);
  //procedure interna ao metodo
   procedure SetPropStr(Instance: TObject; const PropName:string; const Value: Variant);
   var P:Pointer;
       E:String;
   begin
      E:=VarToWideStr(GetPropValue(Instance,PropName));
      p:=Pointer(strtoint(E));
      TStringList(TObject(P)).Text:=Value;
    end;
   //fim de procedure Interna
const
   Propriedade:Array[0..4] of String =('Text','ItemIndex','Checked','Lines','Items');
var index,i:Integer;
    prop:PPropInfo;
begin
   for index:=0 to Controle.ControlCount -1 do begin
      if Controle.Controls[index].tag = cTag then begin
         for i := 0 to High( Propriedade)  do begin
            if isPublishedProp(controle.Controls[index],Propriedade[i]) then begin
               case i of
                  0:SetPropValue(Controle.Controls[index],Propriedade[0],'');
                  1:SetPropValue(Controle.Controls[index],Propriedade[1],-1);
                  2:SetPropValue(Controle.Controls[index],Propriedade[2],false);
                  3:SetPropStr(Controle.Controls[index],Propriedade[3],'');
                  4:SetPropStr(Controle.Controls[index],Propriedade[4],'');
               end;
               Break;
            end;
         end;
      end;
   end;
 end;


Como Usar:
    LimparCampos(Form1, 0);
    LimparCampos(Panel1, 0);

 Se tiver um campo que vocês não querem limpar e so informar a TAG com valor diferente a usada na procedure.

Criando gráficos em Delphi

Olá pessoal,

Precisei recentemente criar gráficos em delphi, mas não queria utilizar um ClientDataSet, no meu caso precisava criar 6 gráficos cada um com 2 séries, seria um trabalho muito grande, então encontrei o link que segue abaixo e por ser simples e objetivo, estou compartilhando com vocês, espero que seja útil como foi para mim.

http://www.andreanolanusse.com/pt/criando-graficos-em-sua-aplicacao-delphi-com-teechart/

Sucesso!

Impressora Fiscal Elgin ZPM e Elgin X5

Para usuário que precisam configurar impressoras fiscal em seu aplicativo a Impressora Fiscal Elgin ZPM e a Impressora Elgin X5 funciona com os drives da Urano também.

Listar arquivos de diretórios

Boa Tarde .
Esta dica abaixo serve pra listar os arquivos de um determinado diretório, e seu sub diretórios.
Eu usei um ListBox pra listar os arquivos, mas fica a critério de cada um.

procedure TForm1.ListarArquivos(Diretorio: string; Sub:Boolean);

function TemAtributo(Attr, Val: Integer): Boolean;
begin
   Result := Attr and Val = Val;
end;

var
  F: TSearchRec;
  Ret: Integer;
  TempNome: string;
begin
   Ret := FindFirst(Diretorio+'\*.*', faAnyFile, F);
   try
      while Ret = 0 do begin
         if TemAtributo(F.Attr, faDirectory) then begin
            if (F.Name <> '.') and (F.Name <> '..') then
               if Sub = True then begin
                  TempNome := Diretorio+'\' + F.Name;
                  ListarArquivos(TempNome, True);
               end;
         end else begin
         ListBox1.Items.Add(Diretorio+'\'+F.Name);
      end;
      Ret := FindNext(F);
   end;
   finally
      FindClose(F);
   end;
end;

Atualizações de sistemas

A atualização de aplicativos sempre causa um pouco de dor de cabeça especialmente se você possui um parque grande de clientes instalados.

O quanto mais fácil seria este processo se ao invés de ir máquina a máquina trocando os arquivos você pudesse disponibilizar os arquivos em uma pasta compartilhada e ao abrir sua aplicação ela automaticamente se atualizasse.

Passo 0 – Sempre antes de realizar qualquer alteração em suas aplicações crie uma cópia de backup para sua própria segurança.

Passo 1 – Abra sua aplicação e no menu “Project>>Options” abra as opções do seu projeto. Na aba “Version Info” habilite as opções “include version information in project” e “Auto-increment buid number”.

Ao habilitar estas duas opções sua aplicação passará a ser versionada e número será automaticamente incrementado toda vez que você fizer um novo build no seu projeto. Estas opções serão úteis mais adiante no nosso projeto.

Passo 2 – Vamos incluir duas functions a sua aplicação:

//Retorna o build de um arquivo
function GetBuildInfo(prog: String): String;
var
   VerInfoSize: DWORD;
   VerInfo: Pointer;
   VerValueSize: DWORD;
   VerValue: PVSFixedFileInfo;
   Dummy: DWORD;
   V1, V2, V3, V4: Word;
begin
   VerInfoSize := GetFileVersionInfoSize(PChar(prog),Dummy);
   GetMem(VerInfo,VerInfoSize);
   GetFileVersionInfo(PChar(prog),0,VerInfoSize,VerInfo);
   VerQueryValue(VerInfo,'',Pointer(VerValue),VerValueSize);
   with VerValue^ do begin
      V1 := dwFileVersionMS shr 16;
      V2 := dwFileVersionMS and $FFFF;
      V3 := dwFileVersionLS shr 16;
      V4 := dwFileVersionLS and $FFFF;
   end;
   FreeMem(VerInfo,VerInfoSize);
   result := Copy(IntToStr(100 + v1),3,2) + '.' + Copy(IntToStr(100 + V2),3,2) + '.' + Copy(IntToStr(100 + V3),3,2) + '.' + Copy(IntToStr(100 + V4),3,2);
end;

//Retorna o tamanho de um arquivo em bytes
function DSiFileSize(const fileName: string): int64;
var
   fHandle: DWORD;
begin
   fHandle := CreateFile(PChar(fileName), 0, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
   if fHandle = INVALID_HANDLE_VALUE then
      Result := -1
   else try
      Int64Rec(Result).Lo := GetFileSize(fHandle, @Int64Rec(Result).Hi);
   finally
      CloseHandle(fHandle);
   end;
end;

Passo 3 – Vamos declarar em uses ShellAPI

Passo 4 – Vamos precisar armazenar o local onde o arquivo atualizado estará disponível. Neste exemplo estaremos salvando a informação em um arquivo de configuração (arquivo ini). Mas você pode salvar esta informação no registro do Windows ou onde achar mais apropriado.

Passo 5 – Agora vamos criar a procedure que vai realmente atualizar a aplicação:

procedure Atualiza_Versao_Aplicacao;
var
   versao_local, versao_servidor : string;
   tamanho_original, tamanho_recebido : integer;
   local_arquivo_servidor : string;
   iArq : Tinifile;
begin
   //Verifico onde esta armazenado o arquivo a ser atualizado
   if FileExists(GetCurrentDir + '\CONFIG.INI') then begin
      try
         iArq := TInifile.Create(GetCurrentDir + '\CONFIG.INI');
         local_arquivo_servidor := iArq.ReadString('UPDATE','LOCAL','\\SERVIDOR\PASTA\ARQUIVO.EXE');
      finally
         iArq.Free;
      end;
   end;
   //Armazeno a versão da aplicação atualmente em uso
   versao_local := GetBuildInfo(GetCurrentDir + '\ARQUIVO.EXE');
   //Armazeno a versão do aplicação que esta disponivel no servidor
   versao_servidor := GetBuildInfo(local_arquivo_servidor);
   //Comparo as versões
   if versao_local <> versao_servidor then begin
      //Guardo na váriavel o tamanho do arquivo que esta no servidor
      tamanho_original := DSiFileSize(local_arquivo_servidor);
      //Copio a versão que esta no servidor para o computador atual
      CopyFile(PChar(local_arquivo_servidor),PChar(GetCurrentDir+'\ARQUIVO.NEW'),False);
      //Guardo na váriavel o tamanho do arquivo copiado
      tamanho_recebido := DSiFileSize(GetCurrentDir+'\ARQUIVO.NEW');
      //Verifico se o arquivo copiado chegou intacto
      if tamanho_original = tamanho_recebido then begin
         //Apago se existir versão antiga
         DeleteFile('ARQUIVO.OLD');
         //Renomeio o arquivo atual
         RenameFile('ARQUIVO.EXE', 'ARQUIVO.OLD');
         //Renomeio o arquivo novo para poder usa-lo
         RenameFile('ARQUIVO.NEW', 'ARQUIVO.EXE');
         //Informo que a aplicação foi atualizado com sucesso
         ShowMessage('Aplicação atualizada com sucesso!');
         //Mando abrir a nova versão do teclado
         ShellExecute(0,Nil,PChar(GetCurrentDir+'\ARQUIVO.EXE'),'', Nil, SW_SHOWNORMAL);
         //Fecho a aberta
         Close;
      end else begin
         //Caso o arquivo copiado não seja copiado com sucesso
         ShowMessage('Copia de arquivo falhou! Tente novamente!');
      end;
   end else begin
      //Se a aplicação já estiver atualizada
      ShowMessage('Aplicativo já possui a ultima atualização disponível!');
   end;
end;

Passo 6 – Você pode chamar a procedure de atualização no onClick de um Botão, criar uma tecla de atalho, adiciona-la no activate do form. Na maneira que lhe for mais conveniente.

Passo 7 – Lembre-se de que o usuário que estiver logado no computador na hora em que for ser atualizada a aplicação deve ter permissões administrativas na pasta onde a aplicação esta instalada e que também ter permissões de acesso a pasta onde a nova versão foi armazenada.

Com esta rotina você pode atualizar não só o executável da sua aplicação, mas todos os arquivos que precisar. Basta usar sua imaginação.

Gerenciador de MySQL

Pra aqueles que utilizam o MySQL com Base de Dados, e tem algumas dificuldades em  achar um front-end pro mesmo ai vai um link pra um gerenciador leve e eficiente.
http://www.heidisql.com/download.php na pagina que se abre clica em Installer(Mirror).
Façam um bom proveito.

Como utilizar const em functions e procedures.

Neste artigo do Vale do Delphi, quero compartilhar com as pessoas que acessam nosso blog este facilitador na hora de passar parâmetros para funções e procedures chamado de const.

Exemplos de funções e parâmetros:

procedure Passa_Parametros(Parm1, Param2, Param3: variant); (tradicional)

Neste exemplo (tradicional) preciso sempre informar os três parâmetros independente de sua necessidade em determinados momentos, utilizando const, você poderá definir os valores padrões dos parâmetros e ocultar sua instrução quando desejar, veja no exemplo abaixo:

procedure Passa_Parametros(const Param1: Integer = 0; const Param2: String = ‘VALE DO DELPHI’; const Param3: Double = 0);

Na hora de chamar a procedure posso chamar assim: Passa_Parametros ou Passa_Parametros (1) ou Passa_Parametros(1, ‘TESTE’) ou Passa_Parametros(1, ‘TESTE’, 2).

Espero que tenham gostado a aprendido com a matéria.

Atenciosamente,

Cléber.

Função pra compactar e descompactar arquivos em delphi

Boa tarde amigos delphianos.

Estou publicando duas procedures que serve pra compactar e descompactar vários arquivos em Delphi usando a lib.  zlib do próprio Delphi.

Só se deve ter o cuidado que o arquivo compactado só se consegue descompactar usando a função de descomprimir que abaixo estou publicando, isso porque a compactação é feita em modo de stream e função própria. Talvez tenha algum programa que consiga descompactar mas não foi testado.

Mas vamos as procedure.

procedure Comprimir(ArquivoCompacto: TFileName; Arquivos: array of TFileName);

var

  FileInName: TFileName;

  FileEntrada, FileSaida: TFileStream;

  Compressor: TCompressionStream;

  NumArq, I, Len, Size: Integer;

  Fim: Byte;

begin

  FileSaida := TFileStream.Create(ArquivoCompacto, fmCreate or fmShareExclusive);

  Compressor := TCompressionStream.Create(clMax, FileSaida);

  NumArq := Length(Arquivos);

  Compressor.Write(NumArq, SizeOf(Integer));

  try

    for I := Low(Arquivos) to High(Arquivos) do begin

      FileEntrada := TFileStream.Create(Arquivos[I], fmOpenRead and fmShareExclusive);

      try

        FileInName := ExtractFileName(Arquivos[I]);

        Len := Length(FileInName);

        Compressor.Write(Len, SizeOf(Integer));

        Compressor.Write(FileInName[1], Len);

        Size := FileEntrada.Size;

        Compressor.Write(Size, SizeOf(Integer));

        Compressor.CopyFrom(FileEntrada, FileEntrada.Size);

        Fim := 0;

        Compressor.Write(Fim, SizeOf(Byte));

      finally

        FileEntrada.Free;

      end;

    end;

  finally

    FreeAndNil(Compressor);

    FreeAndNil(FileSaida);

  end;

end;

procedure Descomprimir(ArquivoZip: TFileName; DiretorioDestino: string);

var

  NomeSaida: string;

  FileEntrada, FileOut: TFileStream;

  Descompressor: TDecompressionStream;

  NumArq, I, Len, Size: Integer;

  Fim: Byte;

begin

  FileEntrada := TFileStream.Create(ArquivoZip, fmOpenRead and fmShareExclusive);

  Descompressor := TDecompressionStream.Create(FileEntrada);

  Descompressor.Read(NumArq, SizeOf(Integer));

  try

    I := 0;

    while I < NumArq do begin

      Descompressor.Read(Len, SizeOf(Integer));

      SetLength(NomeSaida, Len);

      Descompressor.Read(NomeSaida[1], Len);

      Descompressor.Read(Size, SizeOf(Integer));

      FileOut := TFileStream.Create(

        IncludeTrailingBackslash(DiretorioDestino) + NomeSaida, 

        fmCreate or fmShareExclusive);

      try

        FileOut.CopyFrom(Descompressor, Size);

      finally

        FileOut.Free;

      end;

      Descompressor.Read(Fim, SizeOf(Byte));

      Inc(I);

    end;

  finally

    FreeAndNil(Descompressor);

    FreeAndNil(FileEntrada);

  end;

end;

Um exemplo de uso, seria:

var

  //vetor para guardar os nomes dos arquivos a ser compactados

  ListaArquivos: Array of TFileName;

begin

  //define o tamanho do vetor (qtde. de arquivos)

  SetLength(ListaArquivos, 2);

  //preenche a lista com os arquivos

  ListaArquivos[0] := 'C:\Windows\Bruma.bmp';

  ListaArquivos[1] := 'C:\Windows\Cafezinho.bmp';

  //executa a compactação, gerando o arquivo C:\Compactado.xxx

  Comprimir('C:\Compactado.xxx', ListaArquivos);

  //cria um diretório de teste para descompactarmos

  MkDir('C:\Descompactado');

  //executa a descompactação no diretório criado

  Descomprimir('C:\Compactado.xxx', 'C:\Descompactado');

end;

Função pra preencher string

function Preenche(Campo, Letra, Alinhamento: String; Tamanho: Integer): String;
var i00 : Integer;
begin
    // Campo = Passar campo a ser preenchido
    // Letra    = Caracter pra ser prenchido
    // Alinhamento = Preencher a esquerda("E") ou direita ("D")

    Campo := Trim(Campo);

     Result := '';
     for i00:=1 to Tamanho - Length(Campo) do Result := Result + Letra;

     if Alinhamento = 'E' then
        Result := Result + Campo
    else
         Result := Campo + Result;
   end;
end;


EX:  edit1.Text := Preenche(edit1.Text, '0', 'E', 10);

DATA DE CRIACAO DE UM ARQUIVo

Boa Tarde.
As vezes a gente se depara com alguns problemas como saber a data de criação de um arquivo ou .exe, por isso abaixo vou colocar uma função que faz este processo pra vcs. Claro que esta função é bem simples podendo ser melhorar a gosto pessoal de cada um, mas segue a que uso normalmente em questão simples.


function TForm1.DATADECRIACAO(Arq: string): TDateTime;
var ffd:TWin32FindData;
    dft :DWORD;
    lft :TFileTime;
    h   :THandle;
begin
   h:= Windows.FindFirstFile(PChar(Arq), ffd);
   try
      if (INVALID_HANDLE_VALUE <> h) then begin
         FileTimeToLocalFileTime(ffd.ftCreationTime,lft);
         FileTimeToDosDateTime(lft, LongRec(dft).Hi, LongRec(dft).Lo);
         Result := FileDateToDateTime(dft);
      end
   finally
      Windows.FindClose(h);
   end;
end;

Exemplo de uso da  função.
procedure TForm1.Button1Click(Sender: TObject);
begin
   edit1.Text := DateToStr(DATADECRIACAO('C:\DATA.txt'));
end;

Dicas

Gente, achei este site: http://www.tecnobyte.com.br/dica7.html com dicas para Delphi 7, vale a pena conferir.

Cléber

RETORNO AS ATIVIDADES

Bom dia .
Depois de um longo tempo sem atualizar o Blog ,por motivos de excesso de serviço, a partir desta semana voltarei a atualizar o Blog.

Desculpa a aquele que postarem comentários e eu não consegui responder.

NF-e: Inativo ou Inoperante

Bom dia Pessoal!

Enfrentamos semana passada um problema em dois clientes que utilizam a NF-e. Ao verificar o status do serviço, o mesmo sempre retornou "Inativou ou Inoperante... ". Para resolver o problema, restauramos as configurações padrões do IE e excluimos os certificados que se encontravam na aba "Fornecedores não confiáveis"