ActiveControl mais esperto

A propriedade ActiveControl de TForm indica o controle visual que está atualmente com foco no form, mas existem controles que usam componentes internos que mascaram a real identidade do componente, quando se usa ActiveControl.

Por exemplo, o controle de edição TcxTextEdit da DevExpress usa um controle interno da classe TcxCustomInnerTextEdit para fazer a edição propriamente dita. O problema é que se você precisar identificar o tipo de componente atualmente em foco não poderá fazer “ActiveControl is TcxTextEdit”, porque quem tem o foco realmente é o controle interno, não o TcxTextEdit que você colocou no form. Você poderia checar pela classe interna, mas o seu código vai ficando mais e mais confuso ao citar nomes de classes que você nunca usa, além do que é difícil dizer qual é a classe interna de cada componente sem fazer muitos testes.

Eu desenvolvi a função ActiveControlAs para tratar essas condições. A função simplesmente returna o controle em foco da classe esperada usando a cadeia de relacionamento “Parent” para verificar seus “pais” ou retorna nil, caso nem o controle, nem nenhum dos seus pais seja da classe solicitada. Veja o código abaixo para entender melhor como funciona.

function ActiveControlAs(Form: TCustomForm;
  AClass: TWinControlClass): TWinControl;
 
  function CheckControl(var C: TWinControl;
    ControlClass: TWinControlClass): Boolean;
  var
    Parent: TWinControl;
  begin
    Result := (C is ControlClass);
    if (Result = False) and (C <> nil) and (C.Parent <> nil) then
    begin
      Parent := C.Parent;
      Result := CheckControl(Parent, ControlClass);
      if Result then
        C := Parent;
    end;
  end;
var
  C: TWinControl;
begin
  C := Form.ActiveControl;
  if CheckControl(C, AClass) then
    Result := C
  else
    Result := nil;
end;

Como você pode perceber, a função local CheckControl é usada recursivamente para encontrar e devolver um possível “Parent” que seja do tipo esperado, começando pelo valor da propriedade ActiveControl do TForm passado como parâmetro.

Você pode usar assim:

procedure TMainForm.Test1Click(Sender: TObject);
var
  Edit: TcxTextEdit;
begin
  ShowMessage(ActiveControl.ClassName);
  if ActiveControlAs(Self, TcxTextEdit) <> nil then
  begin
    ShowMessage('Is a TcxTextEdit');
    Edit := ActiveControlAs(Self, TcxTextEdit) as TcxTextEdit;
  end;
end;

March 30, 2008 | Filed Under Delphi | 1 Comment 

Download via HTTP com Synapse

Synapse é uma excelente biblioteca de comunicação TCP/IP síncrona freeware e open-source para Delphi. Com ela é fácil fazer downloads de qualquer tipo de arquivo via HTTP. Vou mostrar rapidamente como baixar e gravar arquivos, obter imagens JPEG e strings. De quebra, uma função para obter seu endereço IP externo.

Synapse é puro código. Não tem componentes visuais e não precisa ser instalada. Tudo o que você precisa fazer para usar as funções abaixo é incluir a unit “httpsend” na cláusula uses e começar a usar as suas classes e rotinas (não deixe de incluir o caminho para “synapse\source” no seu “Search Path”).

A classe THTTPSend usa apenas o método HTTPMethod para fazer conexões GET e POST no protocolo HTTP. Mais simples ainda é usar as procedures HttpGetText e HttpGetBinary. HttpGetText traz o conteúdo de uma URL em formato texto através de um objeto TStrings. Você pode usar qualquer descendente, como um TStringList ou a propriedade Lines de um objeto TMemo.

function HttpGetText(const URL: string;
  const Response: TStrings): Boolean;

Já HttpGetBinary retorna o conteúdo binário de uma URL em um objeto TStream. Por conteúdo binário entenda qualquer tipo de arquivo: JPG, TXT, WMV, CSS, PDF, ZIP… Você pode usar qualquer tipo de objeto descendente de TStream, como TFileStream ou TMemoryStream, ou mesmo o stream de um campo TBlobField.

function HttpGetBinary(const URL: string;
  const Response: TStream): Boolean;

GetFile, GetImage e GetString

Eu tenho algumas próprias rotinas que facilitam ainda mais a vida. Nessas rotinas você pode observar exemplos de uso das funções nativas da Synapse.

A primeira é HttpGetFile, que salva um arquivo dada a sua URL:

uses httpsend;
 
function HttpGetFile(const URL: String; const FileName: String): Boolean;
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate);
  try
    Result := HttpGetBinary(URL, Stream);
  finally
    Stream.Free;
  end;
end;

Simples, não é?

Outra legal é HttpGetImage, que retorna um objeto TPicture contendo um arquivo de imagem JPEG baixado direto da Internet

uses httpsend, jpeg;
 
function HttpGetImage(const URL: String; Graphic: TPicture): Boolean;
var
  Stream: TMemoryStream;
  Image: TJPEGImage;
begin
  Stream := TMemoryStream.Create;
  try
    if HttpGetBinary(URL, Stream) then
    begin
      Image := TJPEGImage.Create;
      try
        Stream.Seek(0, soFromBeginning);
        Image.LoadFromStream(Stream);
        Graphic.Assign(Image);
      finally
        Image.Free;
      end;
    end;
  finally
    Stream.Free;
  end;
end;

Experimente usar direto em um componente visual TImage:

HttpGetImage(URL, Image1.Picture);

Quando você quiser ler uma página como uma String, use HttpGetString:

uses httpsend;
 
function HttpGetString(const URL: String): String;
var
  Strings: TStringList;
begin
  Strings := TStringList.Create;
  try
    if HttpGetText(URL, Strings) then
      Result := Strings.Text
    else
      Result := '';
  finally
    Strings.Free;
  end;
end;

Uma aplicação interessante dessa última rotina é pegar o seu endereço IP externo (fora da rede local, com seu NAT) através do serviço CheckIP da DynDNS.com. Tudo que eu faço é pegar o output HTML da página e deixar apenas o valor do IP.

function ExternalIP: String;
var
  Response: String;
  Start, Finish: Integer;
begin
  Response := HttpGetString('http://checkip.dyndns.com/');
  Start := Pos(': ', Response) + 2;
  Finish := Pos('</body>', Response);
  Result := Copy(Response, Start, Finish - Start);
end;
March 27, 2008 | Filed Under Delphi | Leave a Comment 

Compilação Condicional

DecisãoDiretivas de compilação condicional podem facilitar bastante a vida do desenvolvedor. Pacotes grandes de componentes as utilizam para customizar a sua instalação, configurando preferências do usuário e adaptando-se à versão do Delphi em uso. Eu uso compilação condicional no dia-a-dia para lidar com tarefas rotineiras de desenvolvimento. As que eu uso mais frequentemente são NOLOGIN, LOCALHOST e DEBUG.

{$IFDEF NOLOGIN}

Sabe quando você precisa passar sucessivamente vezes pelo ciclo “editar-compilar-executar” e é obrigado a passar toda hora pela chateação de fazer login na sua própria aplicação? Você não sente que é um abuso isso? Afinal, você é o pai, o criador, o gênio por traz daquele sistema que tem a desfaçatez de exigir a sua identificação! Logo você, que ensinou tudo que ele sabe. É uma falta de respeito.

Você pode resgatar a sua autoridade de Criador perante a sua aplicação desabilitando o login no código com uma simples diretiva condicional que indique você quer fazer um login automático com o seu (todo-poderoso) usuário de desenvolvedor e pular a caixa de diálogo de login. Você só precisa escrever uma vez algo como:

{$IFDEF NOLOGIN}
    CodigoUsuario := 1;
    NomeUsuario := 'Meu Nome';
{$ELSE}
    if not Login(CodigoUsuario, NomeUsuario) then
    begin
      ShowMessage('Usuario inválido');
      Application.Terminate;
    end;
{$ENDIF}

A princípio, o código entre {$IFDEF} e {$ELSE} será simplesmente ignorado pelo compilador, porque a diretiva NOLOGIN não existe ainda. Somente o código entre {$ELSE} e {$ENDIF} será executado, que seria o código regular para ambiente de produção.

Basta escrever NOLOGIN no campo “Conditional defines” de “Project | Options…”, dar um Build no seu projeto (importante!) e a diretiva {$IFDEF NOLOGIN} será avaliada como verdadeira pelo compilador. Aí o código entre {$IFDEF} e {$ELSE} será compilado e o código entre {$ELSE} e {$ENDIF} é que será ignorado. Dessa forma podemos configurar o programa sem alterar o código e sem deixar vestígios do código de testes no executável de produção.

É importante entender que as diretivas de compilação são interpretadas em tempo de compilação, não de execução. As diretivas de compilação condicional só podem ser definidas nas opções do projeto (”Conditional defines”) ou no próprio código, através da diretiva {$DEFINE xxx} e serão avaliadas uma única vez durante o build do projeto. Nenhum código adicional é gerado para a interpretação de diretivas de compilação.

{$IFDEF LOCALHOST}

Você já precisou ficar alternando a configuração do componente de conexão de banco de dados (ou de servidor de aplicação) entre o endereço do servidor local e do servidor de produção? Alguma vez já esqueceu de reconfigurar para produção o projeto e mandou para os usuários por engano um executável que procurava o servidor na máquina do próprio usuário? Uma boa idéia é definir uma diretiva de compilação condicional para indicar que está em fase de desenvolvimento e quer usar uma conexão local.

No evento OnCreate do data module onde estão os componentes de conexão, adicione um código como esse:

{$IFDEF LOCALHOST}
    Connection.Host := 'localhost';
{$ELSE}
    Connection.Host := 'myserver';
{$ENDIF}

Este exemplo supõe uma propriedade Host no componente de conexão, mas pode ser adaptada facilmente para qualquer tipo de conectividade com o servidor de banco de dados ou servidor de aplicação. A idéia é sempre a mesma: configurar por código o componente para conectar na máquina do desenvolvedor ou no servidor de produção, conforme o caso.

{$IFDEF DEBUG}

DEBUG é uma diretiva condicional bem comum. Geralmente é usada pra escrever em logs, mostrar mensagens de debug e qualquer outra medida de apoio a testes. É bem mais prático e seguro que ficar colocando e retirando comentários em torno do código de debug toda hora.

Por exemplo:

{$IFDEF DEBUG}
    ShowMessage('Passei por aqui');
    Log('O valor da variável ''x'' era ' + IntToStr(x));
{$ENDIF}

Conclusão

Faz sentido usar uma diretiva de compilação quando você precisa frequentemente ativar e desativar blocos de código. Seja criativo e invente novas aplicações úteis à sua rotina de trabalho.

March 26, 2008 | Filed Under Delphi | 1 Comment 

Next Page →