Validando endereços de e-mail

Fonte: www.activedelphi.com.br

Veja nesta dica uma função que apresenta como validar um endereço de e-mail, evitando que sejam informados dados incorretos nos cadastros.

Segue a implementação:

function ValidaEmail(sEmail: string): boolean;
const
  // Caracteres válidos
  ATOM_CHARS = [#33..#255] - ['(', ')', '<', '>', \@\, ',', ';', ':',
                              '\', '/', '"', '.', '[', ']', #127];

  // Caracteres válidos em uma cadeia
  QUOTED_STRING_CHARS = [#0..#255] - ['"', #13, '\'];

  // Caracteres válidos em um subdominio
  LETTERS = ['A'..'Z', 'a'..'z'];
  LETTERS_DIGITS = ['0'..'9', 'A'..'Z', 'a'..'z'];
  SUBDOMAIN_CHARS = ['-', '0'..'9', 'A'..'Z', 'a'..'z'];

type
  States = (STATE_BEGIN, STATE_ATOM, STATE_QTEXT, STATE_QCHAR,
    STATE_QUOTE, STATE_LOCAL_PERIOD, STATE_EXPECTING_SUBDOMAIN,
    STATE_SUBDOMAIN, STATE_HYPHEN);
var
  State: States;
  i, n, iSubdomains: integer;
  c: char;
begin
  State := STATE_BEGIN;
  n := Length(sEmail);
  i := 1;
  iSubdomains := 1;
  while (i <= n) do
  begin
    c := sEmail[i];
    case State of
      STATE_BEGIN:
        if c in atom_chars then
          State := STATE_ATOM
        else if c = '"' then
          State := STATE_QTEXT
        else
          break;
      STATE_ATOM:
        if c = \@\ then
          State := STATE_EXPECTING_SUBDOMAIN
        else if c = '.' then
          State := STATE_LOCAL_PERIOD
        else if not (c in atom_chars) then
          break;
      STATE_QTEXT:
        if c = '\' then
          State := STATE_QCHAR
        else if c = '"' then
          State := STATE_QUOTE
        else if not (c in quoted_string_chars) then
          break;
      STATE_QCHAR:
        State := STATE_QTEXT;
      STATE_QUOTE:
        if c = \@\ then
          State := STATE_EXPECTING_SUBDOMAIN
        else if c = '.' then
          State := STATE_LOCAL_PERIOD
        else
          break;
      STATE_LOCAL_PERIOD:
        if c in atom_chars then
          State := STATE_ATOM
        else if c = '"' then
          State := STATE_QTEXT
        else
          break;
      STATE_EXPECTING_SUBDOMAIN:
        if c in letters then
          State := STATE_SUBDOMAIN
        else
          break;
      STATE_SUBDOMAIN:
        if c = '.' then
        begin
          Inc(iSubdomains);
          State := STATE_EXPECTING_SUBDOMAIN
        end
        else if c = '-' then
          State := STATE_HYPHEN
        else if not (c in letters_digits) then
          break;
      STATE_HYPHEN:
        if c in letters_digits then
          State := STATE_SUBDOMAIN
        else if c <> '-' then
          break;
    end;
    Inc(i);
  end;

  if i <= n then
    Result := False
  else
    Result := (State = STATE_SUBDOMAIN) and (iSubdomains >= 2);

  //se sEmail esta vazio retorna true
  if sEmail = '' then
    Result := true;
end;

Para testar, adicione a um novo formulário um Edit e um Button, programando no evento onClick deste último:

procedure TForm1.Button1Click(Sender: TObject);
begin
  if ValidaEmail(Edit1.Text) then
    ShowMessage('Ok! E-mail válido!')
  else
    ShowMessage('E-mail inválido!');
end;

Agora rode o programa e faça os testes digitando vários endereços de e-mail do Edit1 e clicando sobre o botão.

Automação de Queries

Fonte: www.activedelphi.com.br

Desenvolvendo um sistema para uma clínica escola de psicologia, identifiquei que, apesar de o sistema estar bem avançado, estava cheio de códigos de manipulação de query repetidos, e por isso resolvi mudar esta situação. A solução, você confere abaixo

Os códigos eram todos parecidos, como abaixo:

  with dm.query do

  begin

    close;

    sql.Clear;

    sql.Add('select * from tabela where campo = valor');

    open;

  end;

Então fiz uma procedure que com uma linha faz tudo isso:

class procedure Tdm.qrcon(componente: Tadoquery; tabela, campo, valor: string; 

  operacao: integer);

begin

  case operacao of

    //seleciona tudo

    1: with componente do

      begin

        close;

        sql.Clear;

        sql.Add('select * from ' + tabela);

        open;

      end;

    2: with componente do

      begin

        close;

        sql.Clear;

        sql.Add('select * from ' + tabela + ' where ' + campo + 

                ' = ' + quotedstr(valor));

        open;

      end;

    3: with componente do

       begin

        close;

        sql.Clear;

        sql.Add('delete from ' + tabela + ' where ' + campo + ' = ' + valor);

        execsql;

       end;

  else

    MessageBox(0, 'Erro de parametro de consulta.' + #13#10 + 

                  '          Contate o CPD.', 

                  'Erro de parametro de consulta.', MB_ICONSTOP or MB_OK);

  end;

end;

Converter Minutos Para Horas

Fonte: www.activedelphi.com.br

Veja nesta dica uma simples função que retorna a quantidade de horas a partir de uma quantidade de minutos.

function MinutosEmHoras(Minutos: Integer): String;

var

  HoraDecimal, HH, MM: String;

begin

  if Minutos > 1440  then

    Minutos := Minutos - 1440;

  HoraDecimal := FormatFloat( '00.00', Minutos / 60 );

  HH := Copy( HoraDecimal, 1 , 2 );

  if Copy( HoraDecimal, 4, 5 )[1] = '0' then

    MM := '0' + IntToStr( Round( ( StrToInt( Copy( HoraDecimal, 4, 5 ) ) * 60 ) /100 ) )

  else

    MM := IntToStr( Round( ( StrToInt( Copy( HoraDecimal, 4, 5 ) ) * 60 ) /100 ) );

  Result :=  HH+ ':' + MM ;

end;

Para utilizá-la, faça:

  ShowMessage( MinutosEmHoras(480) );

  //retornará: '08:00'

Abrindo arquivos com os aplicativos associados e tratando exceções

Fonte: www.activedelphi.com.br


Você já deve ter ouvido falar no comando ShellExecute da unit ShellApi, certo? Se não ouviu, conheça-o agora. Para quem já conhece e o utiliza, costuma tratar os possíveis retornos desta função? Não? Então veja nesta dica como fazer o tratamento!


// Esta procedure requer a unit ShellApi declarada na cláusula Uses da unit.
// Declare a procedure na cláusula private da unit e coloque-a após a cláusula
// implementation, assim: procedure Tform1.ExecFile(F: String);
// use-a assim: ExecFile('c:\windows\Ladrilhos.bmp')
procedure ExecFile(F: String);
var
  r: String;
begin
  case ShellExecute(Handle, nil, PChar(F), nil, nil, SW_SHOWNORMAL) of
    ERROR_FILE_NOT_FOUND:   r := 'O arquivo especificado não foi encontrado ' +
                                 'ou não existe!';
    ERROR_PATH_NOT_FOUND:   r := 'O Caminho é inválido ou não existe!';

    ERROR_BAD_FORMAT:       r := 'O Aplicativo está corrompido ou não é um ' +
                                 'Aplicativo Win32 valido!';
    SE_ERR_ACCESSDENIED:    r := 'O sistema negou acesso a este arquivo por ' +
                                 'algum motivo desconhecido!';
    SE_ERR_ASSOCINCOMPLETE: r := 'Este arquivo tem uma associação inválida ' +
                                 'ou incompleta a ele!';
    SE_ERR_DDEBUSY:         r := 'A transação DDE não pode ser efetuada por ' +
                                 'já haver outra Transação DDE em andamento';
    SE_ERR_DDEFAIL:         r := 'Não foi possível efetuar a transação DDE!';

    SE_ERR_DDETIMEOUT:      r := 'A transação DDE não pode ser efetuada ' +
                                 'porque o tempo requerido expirou!';
    SE_ERR_DLLNOTFOUND:     r := 'Uma Biblioteca DLL necessária ao ' +
                                 'aplicativo associado não foi encontrada!';
    SE_ERR_NOASSOC:         r := 'Este arquivo não tem nenhum aplicativo ' +
                                 'associado à ele!';
    SE_ERR_OOM:             r := 'memória insuficiente para prosseguir com' +
                                 'esta operação!';
    SE_ERR_SHARE:           r := 'Ocorreu uma violação de compartilhamento ' +
                                 'ao efetuar esta operação!';
  else
    exit;
  end;
 
  ShowMessage(r);
end;
Este comando também pode ser utilizado para abrir páginas da Web com o navegador padrão, passando no lugar do caminho do arquivo, um endereço de um site iniciado com "http://", ex:


  ExecFile('http://www.activedelphi.com.br')

Convertendo BMP em JPG

Fonte: www.activedelphi.com.br

Esta dica mostra uma função que converte um arquivo BMP em um arquivo JPG, mostrando também como fazer a compacatação do arquivo ajustando o nível de qualidade da imagem. Primeiro, vamos adicionar a unit JPEG ao uses do formulário.
Agora, façamos a seguinte função:

function BmpToJpg(cImage: String): Boolean;
var
  MyJPEG: TJPEGImage;
  MyBMP : TBitmap;
begin
  Result := False;
  if fileExists(cImage + '.bmp') then
  begin
    MyBMP := TBitmap.Create;
    with MyBMP do
      try
        LoadFromFile(cImage + '.bmp');
        MyJPEG := TJPEGImage.Create;
        with MyJPEG do
        begin
          Assign(MyBMP);
          //"Descomente" e ajuste as linhas abaixo para compactar a imagem, o que
          //poderá perder qualidade mas ajudará a diminuir o tamanho do arquivo
          //CompressionQuality := 75; //min. 1 - max. 100
          //Compress;
          SaveToFile(cImage + '.jpeg');
          Free;
          Result := True;
        end;
      finally
        Free;
      end;
  end;
end;
E para testar, supondo que haja um arquivo chamado ImagemTeste.BMP no diretório raiz C:\, basta fazer:

procedure TForm1.Button1Click(Sender: TObject);
begin
  BmpToJpg('C:\ImagemTeste');
end;

Desenvolvendo um Navegador

Fonte: www.activedelphi.com.br

istemas que não permitem ao usuário utilizar outros programas do computador enquanto estão sendo usados, e este precisa consultar algo na web, por exemplo
Obs.: É bom lembrar que sempre vale a pena salvar o projeto várias vezes durante o seu desenvolvimento.

Primeiro vamos criar a interface do navegador.

Inicie um novo projeto no delphi e altere as seguintes propriedades do formulário:
Caption: Navegador
Name: frmNavega
Width: 770

Insira um panel presente na guia Standard, alterando as propriedades:
Caption: apague todo o seu conteúdo
Align: AlTop

Insira no panel dois BitBtn presente na guia Addtional, e da mesma forma altere as suas seguintes propriedades:
BitBtn 1
Caption: apague todo o seu conteúdo
Name: btVoltar
Height: 25
Left: 8
Top: 8
Width: 33
Glyph: esta propriedade define a imagem de exibição do bitbtn. Geralmente ao instalar o delphi, ele copia uma serie de imagens para utilizarmos em nossas aplicações. Provavelmente elas estão instaladas no diretório: C:\Arquivos de programas\Arquivos comuns\Borland Shared\Images\Buttons. Neste exemplo, utilizaremos duas imagens presente nesta pasta, para isto selecione o botão [...]. Será exibida a caixa Picture Editor. Nela, clique em load e acesse a pasta Buttons do diretório acima. Nesta pasta selecione o item ARROW1L.

BitBtn 2
Caption: apague todo o seu conteúdo
Name: btAvancar (na propriedade name, não use caracteres de pontuação como o ‘ç’, o ‘´’)
Height: 25
Left: 48
Top: 8
Width: 33
Glyph: na mesma pasta usada para o botão anterior, selecione o item ARROW1R.

Insira no panel uma edit
Name: Endereco
Height: 21
Left: 88
Top: 10
Width: 505
Text: apague o seu conteúdo.

Insira mais dois BitBtn:
BitBtn 3
Caption: Parar
Name: btParar
Height: 25
Left: 600
Top: 8
Width: 75
Kind: esta propriedade tem uma função parecida com a Glyph, porém possui imagens pré-definidas. Selecione o item bkAbort.

BitBtn 4
Caption: Atualizar
Name: btAtualizar
Height: 25
Left: 680
Top: 8
Width: 75
Kind: bkRetry

Obs.: Ao utilizar a propriedade kind, o Delphi automaticamente altera o caption do BitBtn para o valor padrão do kind.

Por ultimo insira no form um componente WebBrowser, presente na guia Internet:
Align: alClient
Name: WebAgora vamos começar a codificar nosso navegador.

Primeiro, dê um duplo clique sobre o botão voltar e insira o seguinte código no evento:

  Web.GoBack;
Faça o mesmo para o botão avançar, só que agora com o código:

  Web.GoForward;
Para o botão parar:

  Web.Stop;
E para o botão atualizar:

  Web.Refresh;
No evento onTitleChange do componente web, insira o código:

  Caption := Text + ' - Navegador';
Esta linha define que, toda vez que o título da página for alterado, a propriedade caption do formulário será igual à propriedade text do componente web, mais ' - Navegador'.

No evento onDownloadComplete do componente web insira o código:

  Endereco.Text := web.LocationURL;
Este código faz com que o valor da edit endereco assuma o endereço da página atual. Caso não for usado, ao utilizar os botões voltar e avançar o endereço continuaria o mesmo do site que estava aberto.

No evento onkeyPress da edit endereco insira o código:

  if Key = #13 then
  begin
    Key := #0;
    web.Navigate(Endereco.Text);
  end;
Neste bloco de comandos verificamos se a variável Key possui valor igual a “#13” (código do ENTER). Em caso afirmativo, mudamos seu valor para “#0” a fim de evitar um bip desagradável e informamos à aplicação que o endereço de navegação está na propriedade text da edit endereco.

Obs.: O componente WebBrowser utiliza a mesma estrutura do internet explorer.

Retornando o Idioma Padrão do Sistema Operacional

Fonte: www.activedelphi.com.br

Você já precisou saber qual o idioma padrão do Windows em que seu programa está sendo executado? Se ainda não precisou, provavelmente precisará e esta dica vai lhe ajudar

function IdiomaPadrao: string;
var
  WinLanguage: array [0..50] of char;
begin
  VerLanguageName(GetSystemDefaultLangID, WinLanguage, 50);
  Result := StrPas(WinLanguage);
end;

Esta simples função faz chamada à respectiva função na API do Windows que retorna o idioma padrão configurado no computador. Para testá-la, basta colocar esta função na sua unit e no evento onClick de um botão, por exemplo, fazer:

procedure TForm1.Button1Click(Sender: TObject);
begin
  Showmessage( IdiomaPadrao );
end;