tcf
Algumas Dicas Interessantes
Procedimentos com parâmetros opcionais
Como usar a cláusula UNION em um query
Cuidados ao usar o OnExit (Parte I)
Cuidados ao usar o OnExit (Parte II)
Queries e campos com valores NULL
Querie de uma query?
Nomes dos arquivos que estão sendo executados
Alterando o NetDir via programação
Conversão de tipo de imagem (BMP para JPEG)
Visualizando senhas ocultas
Como associar tipos de arquivos a programas
Função para retornar nome de arquivo temporário
SQL para retornar registros em um intervalo de data e hora 
Como colorir a linha do DBGrid quando o saldo for negativo
Copiar o conteúdo da área de trabalho
Enviar e-mail através do Delphi (Parte I)
Enviar e-mail através do Delph (Parte II)
Deletar o próprio executável


Procedimentos com parâmetros opcionais

Quando você declara o procedimento:

procedure Esperar(Segundos: Byte);

você está determinando que todas as vezes que o procedimento Esperar for chamado, deverá ser passado um valor do tipo Byte. No entanto, esse tipo de declaração exige que em todas as chamadas ao procedimento Esperar seja especificado um parâmetro. Se você fizer uma chamada do tipo:

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

será gerado um erro do tipo: Not enough actual parameters. Mas você pode declarar e implementar o procedimento da seguinte forma:

procedure Esperar(Segundos: Byte = 1);
begin
  Sleep(Segundos * 1000);
end;

A declaração acima faz com que o procedimento Esperar assuma o valor 1 caso nenhum parâmetro seja passado. Assim você poderá fazer uma chamada ao procedimento em qualquer das situações abaixo:

procedure TForm1.Button1Click(Sender: TObject);
begin
  Esperar();   // nenhum parâmetro, será assumido o valor 1
  Esperar(1);
  Esperar      // nenhum parâmetro, será assumido o valor 1
end;




Como usar a cláusula UNION em um query

O uso do componente TQuery gera muitas vantagens e economiza muitas linhas de programação. Mas muitas vezes nos deparamos com situações que parecem não ser resolvidas com sentenças SQL. Vejamos um exemplo:

Você possui 2 tabelas (VendasExternas e VendasInternas) e deseja fazer um resumo de todas as vendas de um vendedor chamado Marcos. Se você usar a sentença

SELECT Nome, Valor FROM VendasExternas, VendasInternas
WHERE Nome = 'Marcos'

você vai obter como resultado uma query com 4 campos (Nome, Valor, Nome_1 e Valor_1) e um resultado bem confuso para ser manipulado.

Para resolver o problema, você poderá usar a sentença

SELECT Nome, Valor FROM VendasExternas
WHERE Nome = 'Marcos'
UNION ALL
SELECT Nome, Valor FROM VendasInternas
WHERE Nome = 'Marcos'

A sentença acima pede para que sejam identificados as vendas de Marcos na tabela VendasExternas, as vendas de Marcos na tabela VendasInternas e que o resultado da primeira seja unido com o resultado da segunda produzindo uma query com apenas 2 colunas.



Cuidados ao usar o OnExit (Parte I)

É comum fazermos uso do evento OnExit quando queremos validar o conteúdo de um Edit. E essa pode ser uma boa prática quando necessitamos verificar o que foi digitado apenas quando o usuário terminar de fazer a entrada de dados, como, por exemplo, um Edit que vai receber o CPF ou CNPJ.

Ao colocarmos um código qualquer no evento OnExit ele sempre será executado quando o usuário sair do Edit, o que acontece quando ele pressiona a tecla TAB, clica com o mouse em um outro Edit ou pressiona um botão OK, por exemplo.

No entanto, existem algumas situações especiais em que o evento OnExit não é gerado. Quer um exemplo? Você está no Edit e, ao invés de clicar no botão OK, você pressiona as teclas ALT + O (considerando que o botão OK tem a tecla O como atalho). É como se você tivesse pressionado o botão OK, porém, sem perder o foco que está no Edit. Só mais um exemplo: Os botões do tipo SpeedButton não recebem foco, então, mesmo que clique com o mouse sobre um SpeedButton, o foco continuará no Edit e, conseqüentemente, o evento OnExit não será gerado.

E a solução?

A solução para esse pequeno inconveniente é simples. Basta você colocar o seguinte código no evento OnClick do botão.

procedure TForm1.Button1Click(Sender: TObject);
begin
  ActiveControl := nil;
  ...
end;

Com isso você força a saída de qualquer Edit ou outro componente que esteja com o foco, gerando assim o evento OnExit.

Na semana que vem, veja a parte II do problemas com o evento OnExit.



Cuidados ao usar o OnExit (Parte II)

Dando continuidade aos problemas enfrentados quando se usa o evento OnExit, vamos ver outro caso onde pode acontecer um pequeno problema:

Suponhamos que você possua 2 Edits em um formulário. Supondo também que você queira dar alguma informação ao usuário da aplicação logo depois que ele sair do Edit1 você faz:

procedure TForm1.Edit1Exit(Sender: TObject);
begin
  MessageDlg('Mensagem...', mtInformation, [mbOk], 0);
end;

A princípio está tudo ok, ou melhor, parece estar tudo ok.

Se você altera o foco para o outro Edit através do pressionamento da tecla TAB, tudo bem. Mas experimente alterar o foco clicando com o mouse sobre o Edit2. Neste segundo caso a mensagem será exibida normalmente. Mas ao fechar o dialogo onde aparece a mensagem, o foco simplesmente se perde. Para setar o foco no Edit2 é necessário clicar novamente sobre ele.

Isso poderia não problema nenhum até que seu usuário experimente esta situação. Nada que ele digitar será acatado.

Mas existe uma maneira fácil de resolver o problema. Basta você cancelar o foco e forçar uma reentrada no componente Edit2. Como fazer isso? Veja o código:

procedure TForm1.Edit1Exit(Sender: TObject);
begin
  MessageDlg('Mensagem...', mtInformation, [mbOk], 0);
  // cancela o foco e força novamente a entrada
  ActiveControl := nil;
  PostMessage(Edit2.Handle, WM_SETFOCUS, 0, 0);
  Edit2.SetFocus;
end;

Porém, você nunca terá certeza se o usuário clicou foi no Edit2. Então temos que criar uma rotina genérica que leva o foco para qualquer outro controle:

procedure TForm1.Edit1Exit(Sender: TObject);
var
  Ctrl: TWinControl;
begin
  MessageDlg('Mensagem...', mtInformation, [mbOk], 0);
  // cancela o foco e força novamente a entrada
  Ctrl := ActiveControl;
  ActiveControl := nil;
  PostMessage(TWinControl(Ctrl).Handle, WM_SETFOCUS, 0, 0);
  TWinControl(Ctrl).SetFocus;
end;

Observe que antes de cancelar o foco com ActiveControl := nil, salvamos qual é o controle que detém o foco fazendo Ctrl := ActiveControl.

Depois enviamos uma mensagem ao controle que detinha o foco, forçando-o a receber o foco novamente.



Queries e campos com valores NULL

Quando você adiciona registros em uma tabela através do método Append, o valor NULL é atribuído todos os campos dessa tabela, a menos que você especifique um valor diferente. Exemplo: se uma tabela possui apenas os campos Nome e Salario e você usa o código

Table1.Append;
Table1Nome.AsString := 'José';
Table1.Post;

então o campo Salario ficará com o valor igual a NULL. Isso acontece porque você não atribuiu nenhum valor a esse campo.

Seguindo este raciocínio, imagine a tabela Vendas.db com os seguintes dados:

Nome VendInt VendExt
José 10 8
Maria   12
José   15
José 16  
Maria   19
Os campos em branco não tiveram valores atribuídos, e seus valores são iguais a NULL.

 

Com esta tabela, vamos executar uma query para selecionar todos os registros onde o nome do vendedor seja o José. O código da query então será:

SELECT Nome, VendInt, VendExt
FROM vendas
WHERE Nome = 'José'

Executada a query teremos, de fato, o resultado que você espera. Veja:

Nome VendInt VendExt
José 10 8
José   15
José 16  

Mas se você executa uma query onde deseja somar as vendas internas e externas (aqui representadas pelos campos VendInt e VendExt) você deve executar a seguinte query: 

SELECT Nome, SUM(VendInt + VendExt) as Total
FROM vendas
WHERE Nome = 'José'
GROUP BY Nome

e surpreendentemente o resultado NÃO será o esperado. Ao invés de termos um total igual a 49 (que é a soma de todas as vendas internas e externas) teremos o seguinte resultado:

Nome Total
José 18

Observe que houve a soma apenas dos registros onde não existem o valor NULL.

Veja agora como evitar o problema. Abra a tabela Vendas.db e onde não existe valores definidos para os campos VendInt e VendExt, entre com 0 (zero). A tabela deverá ficar assim:

Nome VendInt VendExt
José 10 8
Maria  0 12
José  0 15
José 16
Maria  0 19

E agora, executando aquela última query você terá o resultado correto. Veja:

Nome Total
José 49



Query de uma query?

Normalmente a linguagem SQL possui flexibilidade o bastante para você obter os mais variados resultados de seleção de registros.

Acontece que eventualmente você pode chegar a uma situação onde precisaria construir uma query com base no resultado de outra query. Aí complica, certo?

Mas nestes caso você vai usar algumas API's do BDE e o problema se tornará uma tarefa bem simples. Veja como:

Vamos imaginar uma query simples, apenas para efeito de entendimento desta questão: Você possui uma tabela chamada vendas.db com os campos DataVenda e Valor.

A nossa primeira query vai extrair o mes do campo DataVenda juntamente com o campo Valor. A sentença seria então a seguinte:

SELECT
  EXTRACT(MONTH FROM datavenda) AS mes, valor
  FROM vendas

Agora precisamos salvar o resultado dessa query em uma tabela. Mas como fazer? Vamos utilizar a API DbiSaveChanges para salvar a query e a API DbiGetCursorProps para obter o nome que o BDE utilizou para salvar a query. O código é o seguinte:

var
  QrName: string;
begin
  // salva a query em um arquivo temporário
  DbiSaveChanges(Query1.Handle);
  // obtém o nome do arquivo temporário e fecha a primeira query
  DbiGetCursorProps(Query1.Handle, Props);
  QrName := Props.szName;
end;

Feito isso basta fazer a segunda query com base no arquivo que acabamos de salvar. Veja como fica um código completo usando este recurso:

procedure TForm1.Button1Click(Sender: TObject);
var
  Props: CURProps;
  QrName: string;
begin
  // abre a primeira query
  Query1.SQL.Text :=
    'SELECT EXTRACT(MONTH FROM datavenda) AS mes, valor FROM vendas';
  Query1.Open;
  // salva a query em um arquivo temporário
  DbiSaveChanges(Query1.Handle);
  // obtém o nome do arquivo temporário e fecha a primeira query
  DbiGetCursorProps(Query1.Handle, Props);
  QrName := Props.szName;
  Query1.Close;

  // abre a segunda query pegando o resultado da primeira
  // que está salva no arquivo S
  Query2.SQL.Text := 'SELECT mes, SUM(valor) FROM "' +
    QrName + '" GROUP BY mes';
  Query2.Open;
  ...
  // apaga o arquivo temporário da primeira query
  DeleteFile(QrName + '.db');
end;




Nomes dos arquivos que estão sendo executados

É comum e até relativamente fácil encontrarmos rotinas para listar todas as janelas abertas. Mas muitas vezes não é apenas o caption das janelas que queremos listar e sim o nome do arquivo executável.

Veja então uma rotina que cria uma lista de strings com esses nomes:

uses TLHelp32;  // não esqueça de incluir esta unit

procedure ListProcess(List: TStrings); var ProcEntry: TProcessEntry32; Hnd: THandle; Fnd: Boolean; begin List.Clear; Hnd := CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0); if Hnd <> -1 then begin ProcEntry.dwSize := SizeOf(TProcessEntry32); Fnd := Process32First(Hnd, ProcEntry); while Fnd do begin List.Add(ProcEntry.szExeFile); Fnd := Process32Next(Hnd, ProcEntry); end; CloseHandle(Hnd); end; end;

E para utilizar esta rotina é muito simples, veja:

procedure TForm1.Button1Click(Sender: TObject);
begin
  ListProcess(ListBox1.Items);
end;



Alterando o NetDir via programação

Muitas vezes precisamos alterar o NetDir do BDE para que nossas aplicações funcionem corretamente. E com poucas linhas de código você poderá deixar para que sua própria aplicação faça isso.

Abaixo está uma rotina para alterar o NetDir de acordo com o drive informado como parâmetro:

uses BDE;  // não esqueça de incluir esta unit

// ChangeNetDir procedure ChangeNetDir(Drive: Char); var hCur: hDBICur; Config: CFGDesc; Cont: Boolean; begin if DbiInit(nil) = DBIERR_NONE then begin hCur := nil; if DbiOpenCfgInfoList(nil, dbiREADWRITE, cfgPersistent, '\DRIVERS\PARADOX\INIT', hCur) = DBIERR_NONE then begin if DbiSetToBegin(hCur) = DBIERR_NONE then begin Cont := True; while Cont do begin if (DbiGetNextRecord(hCur, dbiWRITELOCK, @Config, nil) <> DBIERR_NONE) then Cont := False else if StrIComp(Config.szNodeName, 'NET DIR') = 0 then begin StrPCopy(Config.szValue, Drive + ':\'); DbiModifyRecord(hCur, @Config, True); Cont := False end; end; end; end; DbiExit(); end; end;

O uso deste procedimento pode ser assim:

procedure TForm1.Button1Click(Sender: TObject);
begin
  ChangeNetDir('H');
end;



Conversão de tipo de imagem (BMP para JPEG)

Se você precisa armazenar imagens em seu banco de dados talvez seja interessante usar formatos que ocupam menos espaço. E o que fazer com aquelas imagens todas em formato bmp? Bom, use a rotina abaixo e faça a conversão:

uses Jpeg;  // não esqueça de incluir esta unit

// BmpToJpg procedure BmpToJpg(FileName: string); var Jpg: TJpegImage; Stm: TMemoryStream; Bmp: TBitmap; begin if FileExists(FileName) then begin Bmp := TBitmap.Create; Bmp.LoadFromFile(FileName); Jpg := TJpegImage.Create; Jpg.Assign(Bmp); Jpg.Compress; Stm := TMemoryStream.Create; Jpg.SaveToStream(Stm); Stm.Position := 0; Stm.SaveToFile(ChangeFileExt(FileName, '.jpg')); Stm.Free; Jpg.Free; Bmp.Free; end; end;

O uso deste procedimento pode ser assim:

procedure TForm1.Button1Click(Sender: TObject);
begin
  // após a conversão será criado o arquivo Egito.jpg no mesmo diretório
  BmpToJpg('C:\Windows\Egito.bmp');  
end;

Visualizando senhas ocultas

De repente acontece e você está lá: de frente para o computador. E na tela do computador apenas a misteriosa seqüencia "********". Então você se pergunta: que senha será esta que está digitada? Bom, antes de você optar pelo método de tentativa e erro, crie uma aplicação nova no Delphi e coloque no formulário um componente TTimer. No evento OnTimer deste componente coloque o seguinte código:

var
  WndHint: THintWindow = nil;  // declare a variável fora da procedure

procedure TForm1.Timer1Timer(Sender: TObject);
var
  Pos: TPoint;
  HWin: THandle;
  Paswd: array[0..63] of Char;
  R: TRect;
begin
  GetCursorPos(Pos);
  HWin := WindowFromPoint(Pos);
  if SendMessage(HWin, EM_GETPASSWORDCHAR, 0, 0) <> 0 then
    begin
      if WndHint = nil then
        begin
          WndHint := THintWindow.Create(Self);
          WndHint.Color := clInfoBk;
          SendMessage(HWin, WM_GETTEXT, 64, Longint(@Paswd));
          R := Rect(Pos.X, Pos.Y + 18, Pos.X +
            WndHint.Canvas.TextWidth(Paswd) + 8,
            Pos.Y + 18 + WndHint.Canvas.TextHeight(Paswd));
          WndHint.ActivateHint(R, Paswd);
        end;
    end
  else if
WndHint <> nil then
    begin
      WndHint.ReleaseHandle;
      WndHint := nil;
    end;
end;

Está pronto! Agora basta você executar a aplicação e mante-la minimizada. Quando parar o ponteiro do mouse sobre o Edit que contém o misterioso "********" você verá um Hint informando qual é a senha que foi digitada.

Obs.: Esta dica não funciona para versões mais novas do Windows.



Como associar tipos de arquivos a programas

Depois de construir sua aplicação você pode precisar associar determinado tipo de arquivo a ela. Exemplo: você cria um editor de arquivos texto e necessita associar os arquivos com a extensão .txt ao seu editor.

Para executar esta tarefa você poderá usar o procedimento abaixo (que na verdade foi divido em dois procedimentos). Veja o código:

uses Registry;  // não esqueça de incluir esta unit
procedure WriteRegistry(Reg: TRegistry; Key, Value: string);
begin
  if Reg.OpenKey(Key, True) then
    Reg.WriteString('', Value);
  Reg.CloseKey;
end;

procedure FileAssociate(FileExt, Desc, PrgName: string);
var
  ExtKey: string;
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  ExtKey := Copy(FileExt, 2, Length(FileExt)) + '_auto_file';
  Reg.RootKey := HKEY_CLASSES_ROOT;
  WriteRegistry(Reg, FileExt, ExtKey);
  WriteRegistry(Reg, ExtKey, Desc);
  WriteRegistry(Reg, ExtKey + '\Shell\Open\Command',
    '"' + PrgName + '" "%1"');
  WriteRegistry(Reg, ExtKey + '\DefaultIcon', PrgName);
  Reg.Free;
end;

Para usar esta rotina você deve fazer uma chamada ao procedimento FileAssociate, da seguinte forma:

procedure TForm1.Button1Click(Sender: TObject);
begin
  FileAssociate('.txt', 'Arquivo texto', 'C:\Windows\Editor.exe');
end;

Agora falta apenas um pequeno detalhe: você precisa identificar quando sua aplicação foi aberta porque o usuário clicou em um arquivo .txt no Windows Explorer. Esta identificação é necessária, pois se o usuário clicou em um arquivo .txt então você deve carregar este arquivo.

Você pode, então, fazer isso da seguinte forma:

procedure TForm1.FormCreate(Sender: TObject);
begin
  if ParamCount = 1 then
    MemoEditor.Lines.LoadFromFile(ParamStr(1))
  else
    MemoEditor.Clear;
end;

Observe que a expressão ParamStr(1) corresponde, neste caso, ao nome do arquivo que o usuário clicou.



Função para retornar nome de arquivo temporário

Durante o desenvolvimento de sua aplicação você pode precisar de uma rotina para criar facilmente nomes de arquivos para serem usados temporariamente. A função abaixo tem justamente esse propósito. Veja o código:

// GetTemporaryFile
function GetTemporaryFile(Dir, Prefixo, Ext: string): string;
var
  Name: array[0..255] of Char;
begin
  if (Dir = '') or not DirectoryExists(Dir) then
    begin
      GetTempPath(256, Name);
      Dir := Name;
    end;
  GetTempFileName(PChar(Dir), PChar(Prefixo), 0, @Name);
  if Ext <> '' then
    Result := ChangeFileExt(Name, Ext)
  else
    Result := Name;
end;

Os parâmetros que você poderá usar são:

Parâmetro Descrição
Dir Diretório onde o arquivo deve ser criado. Se for informado uma string nula será adotado o diretório temporário do Windows, geralmente 'C:\Windows\Temp'.
Prefixo Você pode informar os caracteres iniciais do nome do arquivo temporário.
Dir Diretório onde o arquivo deve ser criado. Se for informado uma string nula será adotado o diretório temporário do Windows, geralmente 'C:\Windows\Temp'.

E para usar esta rotina você deve fazer uma chamada ao procedimento GetTemporaryFile, da seguinte forma:

procedure TForm1.Button1Click(Sender: TObject);
var
  FileName: string;
begin
  FileName := GetTemporaryFile('C:\MeuSistema', 'Tab', '.db');
  ...
end;

 

SQL para retornar registros em um intervalo de data e hora
Construir uma sentença SQL que retorne os registros que correspondam a um determinado dia ou horário é relativamente simples. Porém as coisas começam a se complicar quando você precisa especificar o dia e hora inicial e também o dia e hora final.

Com a rotina abaixo você poderá obter facilmente o resultado, veja:
procedure TForm1.Button1Click(Sender: TObject);
var
  DI, DF: string; // armazenar as datas inicial e final
  HI, HF: string; // armazenar as horas inicial e final
  SQL: string;    // armazenar a sentença SQL
begin
  // nos edits EdtDataInicio e EdtDataFim o usuário entra com
  // as datas de início e fim e as variáveis DI e DF recebem
  // as datas convertidas para o formato mm/dd/yyyy
  DI := FormatDateTime('mm/dd/yyyy', StrToDate(EdtDataInicio.Text));
  DF := FormatDateTime('mm/dd/yyyy', StrToDate(EdtDataFim.Text));

  // nos edits EdtHoraInicio e EdtHoraFim o usuário entra com
  // as horas de início e fim e as variáveis HI e HF recebem
  // as horas convertidas para o formato hh:mm:ss
  HI := FormatDateTime('hh:nn:ss', StrToTime(EdtHoraInicio.Text));
  HF := FormatDateTime('hh:nn:ss', StrToTime(EdtHoraFim.Text));

  // ao criar a senteça, verifica primeiro se a data inicial
  // é igual a data final, pois neste caso a setença
  // será mais simples
  if DI = DF then
    begin
      // sentença mais simples, pois data incial igual a data final
      SQL := 'SELECT * FROM tabela WHERE' +
        '( (data = CAST("' + DI + '" AS DATE)) AND' +
        '  (tempo >= CAST("' + HI + '" AS TIME)) AND' +
        '  (tempo <= CAST("' + HF + '" AS TIME))  )';
    end
  else
    begin
      // sentença mais trabalhada, pois a data incial é diferente
      // da data final
      SQL := 'SELECT * FROM tabela WHERE' +
        '( (data = CAST("' + DI + '" AS DATE)) AND' +
        '  (tempo >= CAST("' + HI + '" AS TIME))  ) OR' +
        '( (data > CAST("' + DI + '" AS DATE)) AND' +
        '  (data < CAST("' + DF + '" AS DATE))    ) OR' +
        '( (data = CAST("' + DF + '" AS DATE)) AND' +
        '  (tempo <= CAST("' + HF + '" AS TIME))  )';
    end;

  // abre a query
  Query1.Close;
  Query1.SQL.Text := SQL;
  Query1.Open;
end;

Como colorir a linha do DBGrid quando o saldo for negativo

Adaptação da colaboração de José Sousa
Aplicação da observação de Jeferson Araújo

Normalmente optamos por destacar a linha de um DBGrid quando um campo assume valores críticos. É o que acontece quando temos um DBGrid e um campo que assume valor negativo.

Neste caso, precisaremos apenas manipular o evento OnDrawColumnCell. Mas como fazer? É simples, veja:
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
  if not (gdSelected in State) and
    (Table1.FieldByName('Valor').AsFloat < 0) then
    DBGrid1.Canvas.Brush.Color := clRed;
  DBGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, State);
end;

Outras vezes precisamos destacar apenas a célula que contém o valor crítico. Então basta avaliar o parâmetro DataCol que o evento OnDrawColumnCell recebe. Veja a alteração:

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
  if not (gdSelected in State) and
    (Table1.FieldByName('Valor').AsFloat < 0) and (DataCol = 2) then
    DBGrid1.Canvas.Brush.Color := clRed;
  DBGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, State);
end;

 

Adaptação da colaboração de Celso Rodrigues

Durante o desenvolvimento da sua aplicação você poderá optar por incluir um recurso interessante, que é o de copiar o conteúdo da área de trabalho. Isso pode ser muito útil quando, durante uma manutenção, você precisa saber como estava a tela do seu cliente ao ocorrer determinada situação.

Então você pode incluir a seguinte rotina em sua aplicação:
procedure TForm1.Button1Click(Sender: TObject);
var
  R: TRect;
  DC: HDc;
  DeskCanvas: TCanvas;
  Bmp: TBitmap;
begin
  // cria o bitmap que vai receber a imagem
  Bmp := TBitmap.Create;
  Bmp.Height := Screen.Height;
  Bmp.Width := Screen.Width;
  // copia o conteúdo da área de trabalho para o bitmap
  R := Rect(0, 0, Screen.Width, Screen.Height);
  DC := GetWindowDC(GetDeskTopWindow);
  DeskCanvas := TCanvas.Create;
  DeskCanvas.Handle := DC;
  Bmp.Canvas.CopyRect(R, DeskCanvas, R);
  ReleaseDC(GetDeskTopWindow, DC);
  // salva o conteúdo do bitmap para um arquivo
  Bmp.SaveToFile('C:\Sistema\Log\Erro.bmp');
end;

 

 

Adaptação da colaboração de José Salomão

Um recurso que pode tornar sua aplicação muito interessante é a possibilidade do usuário enviar um e-mail de dentro da própria aplicação.

Para fazer isso você tem duas possibilidades. A primeira alternativa é a utilização da API ShellExecute:
uses ShellAPI;

procedure TForm1.Button1Click(Sender: TObject);
var
  sEmail: string;
begin
  sEmail := 'mailto:falecom@elivaldo.com.br' +
            '?Subject=Teste' +
            '&Body=Enviando email pelo Delphi';
  ShellExecute(Handle, 'open', PChar(sEmail), nil, nil, SW_SHOW);
end;

Mas para que esta opção possa ser utilizada você precisará ter certeza que o Outlook está instalado na máquina do usuário. Para evitar que problemas de incompatibilidade você poderá usar recursos do próprio Delphi (versão 5 e 6):

Primeiramente você deve adicionar um componente TNMSMTP da paleta FastNet e depois fazer a implementação da rotina que enviará o e-mail:

// o parâmetro Login é o nome de usuário
// que você usa para conectar-se. Exemplo: "elivaldo"
// o parâmetro Servidor é o nome do servidor SMTP
// usado para enviar os e-mails. Exemplo: "smtp.uol.com.br"
procedure TForm1.EnviarEmail(De, Para, Assunto, Texto,
  Arquivo, Login, Servidor: string);
begin
  // faz a conexão com o servidor
  NMSMTP1.Host := Servidor;
  NMSMTP1.Port := 25;
  NMSMTP1.UserID := Login;
  if not NMSMTP1.Connected then
    NMSMTP1.Connect;
  if not NMSMTP1.Connected then
    begin
      ShowMessage('Não foi possível conectar-se ao servidor ' + Servidor);
      Exit;
    end;
  // dados da mensagem
  NMSMTP1.PostMessage.FromAddress := De;
  NMSMTP1.PostMessage.ToAddress.Text := Para;
  NMSMTP1.PostMessage.Subject := Assunto;
  NMSMTP1.PostMessage.Body.Text := Texto;
  NMSMTP1.PostMessage.Attachments.Text := Arquivo;
  // envia a mensagem e finaliza
  NMSMTP1.SendMail;
  NMSMTP1.Disconnect;
  ShowMessage('Mensagem enviada.');
end;

E para usar esta rotina, apenas faça:

procedure TForm1.Button1Click(Sender: TObject);
begin
  EnviarEmail('falecom@elivaldo.com.br', 'jose@uol.com.br',
    'Teste', 'Enviando e-mail pelo Delphi', '', 'elivaldo', 'utranet.com.br');
end;

        

 

Adaptação da colaboração de Cristiano Techio

Uma outra forma de se usar o Outlook para enviar e-mails é usar os recursos da MAPI (Messaging Applications Programming Interface).

Veja a rotina abaixo. Nela você poderá inclusive determinar se deve aguardar a confirmação do usuário para o envio da mensagem.
uses MAPI;

function EnviarEMail(const De, Para, Assunto, Texto,
  Arquivo: string; Confirma: Boolean): Integer;
var
  Msg: TMapiMessage;
  lpSender, lpRecepient: TMapiRecipDesc;
  FileAttach: TMapiFileDesc;
  SM: TFNMapiSendMail;
  MAPIModule: HModule;
  Flags: Cardinal;
begin
  // cria propriedades da mensagem
  FillChar(Msg, SizeOf(Msg), 0);
  with Msg do
    begin
      if (Assunto <> '') then
        lpszSubject := PChar(Assunto);

      if (Texto <> '') then
        lpszNoteText := PChar(Texto);

      // remetente
      if (De <> '') then
        begin
          lpSender.ulRecipClass := MAPI_ORIG;
          lpSender.lpszName := PChar(De);
          lpSender.lpszAddress := PChar(De);
          lpSender.ulReserved := 0;
          lpSender.ulEIDSize := 0;
          lpSender.lpEntryID := nil;
          lpOriginator := @lpSender;
        end;

      // destinatário
      if (Para <> '') then
        begin
          lpRecepient.ulRecipClass := MAPI_TO;
          lpRecepient.lpszName := PChar(Para);
          lpRecepient.lpszAddress := PChar(Para);
          lpRecepient.ulReserved := 0;
          lpRecepient.ulEIDSize := 0;
          lpRecepient.lpEntryID := nil;
          nRecipCount := 1;
          lpRecips := @lpRecepient;
        end
      else
        lpRecips := nil;

      // arquivo anexo
      if (Arquivo = '') then
        begin
          nFileCount := 0;
          lpFiles := nil;
        end
      else
        begin
          FillChar(FileAttach, SizeOf(FileAttach), 0);
          FileAttach.nPosition := Cardinal($FFFFFFFF);
          FileAttach.lpszPathName := PChar(Arquivo);
          nFileCount := 1;
          lpFiles := @FileAttach;
        end;
    end;

  // carrega dll e o método para envio do email
  MAPIModule := LoadLibrary(PChar(MAPIDLL));
  if MAPIModule = 0 then
    Result := -1
  else
    try
      if Confirma then
        Flags := MAPI_DIALOG or MAPI_LOGON_UI
      else
        Flags := 0;
      @SM := GetProcAddress(MAPIModule, 'MAPISendMail');
      if @SM <> nil then
        Result := SM(0, Application.Handle, Msg, Flags, 0)
      else
        Result := 1;
    finally
      FreeLibrary(MAPIModule);
    end;
end;

A forma de de usar esta rotina é muito simples, veja um exemplo:

procedure TForm1.Button1Click(Sender: TObject);
begin
  // enviar e-mail do elivaldo para um cliente
  EnviarEMail('falecom@elivaldo.com.br', 'user@hotname.com.br',
    'Nova dica', 'Foi adicionada uma nova dica na página...', '', True);
end;
        

 

 

Muitas vezes você precisa apagar o próprio arquivo da aplicação. Mas como a aplicação está rodando, normalmente esta operação não seria possível.

Mas você poderá usar o recusro de criar um arquivo BAT e, dentro dele, incluir os comandos para deleção do aplicativo.

Veja um exemplo:

procedure  TForm1.Button1Click(Sender: TObject);
var
  F: TextFile;
  Bat: string;
begin
  Bat := ChangeFileExt(Application.ExeName,'.bat');
  AssignFile(F, Bat);
  Rewrite(F);
  WriteLn(F, Format('DEL "%s"', [Application.ExeName]));
  WriteLn(F, Format('DEL "%s"', [Bat]));
  CloseFile(F);
  WinExec(PChar(Bat), SW_HIDE);
  Application.Terminate;
end;
       



TCF Library, Copyright © 1997-2024, Odisseia Tecnologia da Informação Ltda. Todos os direitos reservados