Dicas de Delphi - Banco de Dados


Solucionando problemas de arredondamentos

Como sempre observo longas discussões sobre este tema, resolvi apresentar minha experiência nesta área.

Eu tive muitos problemas com arredondamentos há muito tempo, especialmente quando comecei a implantar sistemas para uso com ECF (emissor de cupom fiscal). Acontecia do programa apresentar um total de venda diferente do valor impresso pelo ECF. Então fui estudando a questão com carinho e cheguei a algumas conclusões que resolveram meus problemas.

O modo de arredondamento do Firebird é igual ao modo das calculadoras financeiras. Já no Delphi o arredondamento leva em consideração se a parte inteira é par ou ímpar quando a parte decimal termina em 5. Os ECFs também calculam como no Firebird. Para resolver as diferenças entre Delphi e Firebird escrevi a função abaixo (a conversão para string resolve alguns problemas de arredondamento do Delphi):

function ExRound(Value: Extended; Decimals: Integer): Extended;
var
  Factor, Fraction: Extended;
begin
  Factor := IntPower(10, Decimals);
  Value := StrToFloat(FloatToStr(Value * Factor));
  Result := Int(Value);
  Fraction := Frac(Value);
  if Fraction >= 0.5 then
    Result := Result + 1
  else if Fraction <= -0.5 then
    Result := Result - 1;
  Result := Result / Factor;
end;

Algumas vezes o Delphi gera uns problemas de arredondamento quando você faz vários cálculos (especialmente multiplicação e divisão) sem aplicar o arredondamento em cada etapa do cálculo. Isto ocorre devido ao modo que o Delphi armazena um valor de ponto flutuante numa variável. Procure fazer o arredondamento a cada etapa do cálculo, exceto se este arredondamento passo-a-passo for prejudicar o resultado do cálculo.

Sempre que possível use o tipo Currency para variáveis que receberão números reais com até 4 casas decimais. Lembre-se também de usar AsCurrency ao acessar valores de campos de DataSets.

Use no Firebird campos do tipo NUMERIC(x,y) para armazenar valores financeiros e quantidades, mas tome o cuidado de criar o banco de dados com o dialeto 3, pois no dialeto 1 o tipo NUMERIC poderá ser convertido para DOUBLE PRECISION internamente.

Exemplos:
Quantidade NUMERIC(9,3)
Quantidade NUMERIC(18,3)
Preco      NUMERIC(9,2)
Preco      NUMERIC(18,2)
Preco      NUMERIC(18,4)
Desconto   NUMERIC(4,2)

Crie campos calculados no banco (COMPUTED BY) já com os devidos ajustes de arredondamento. No Firebird existem alguns problemas de arredondamento também, mas geralmente se resolve com CASTs. Veja alguns exemplos:

Itens de venda:
ValorDescto   NUMERIC(9,2) COMPUTED(CAST(Qtd * PrecoVenda * Descto / 100 AS NUMERIC(9,2))),
Total         NUMERIC(9,2) COMPUTED(CAST(Qtd * PrecoVenda - ValorDescto AS NUMERIC(9,2))),
ValorComissao NUMERIC(9,2) COMPUTED(CAST(Total * Comissao / 100 AS NUMERIC(9,2)))
Contas a receber/recebidas:
Atraso INTEGER COMPUTED(
  CASE
    WHEN Recda = 'N' AND Vencto < CURRENT_DATE THEN
     CURRENT_DATE - Vencto
    WHEN Recda = 'S' AND Vencto < DataRecto THEN
     DataRecto - Vencto
   ELSE
    0
  END), 
ValorJuro  NUMERIC(9,2) COMPUTED(CAST(Valor * Juro * Atraso / 100 / 30 AS NUMERIC(9,2))), 
Total      NUMERIC(9,2) COMPUTED(CAST(Valor + ValorJuro AS NUMERIC(9,2))), 
TotalRecdo NUMERIC(9,2) COMPUTED(CAST(CapitalRecdo + JuroRecdo AS NUMERIC(9,2)))

Enfim, use CASTs no Firebird sempre que fizer cálculos envolvendo multiplicação e divisão para que o resultado tenha de fato as casas decimais desejadas.

Com estas técnicas acima resolvi completamente os problemas que eu tinha com relação aos arredondamentos, tanto no Delphi quanto no Interbase ou Firebird.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início


Criando tabelas via SQL

Inclua na seção uses: dbTables
- Coloque um TButton no form;
- Escreve no OnClick do Button como abaixo:

procedure TForm1.Button1Click(Sender: TObject);
var
  Q: TQuery;
begin
  Q := TQuery.Create(Application);
  try
    Q.DatabaseName := 'SF';
    with Q.SQL do begin
      Add('Create Table Funcionarios');
      Add('( Codigo  AutoInc,');
      Add('  Nome    Char(30),');
      Add('  Salario Money,');
      Add('  Depto   SmallInt,');
      Add('  Primary Key (Codigo) )');
    end;
    Q.ExecSQL;
  finally
    Q.Free;
  end;
end;

Observações

Este exemplo foi testado com banco de dados Paradox, porém deverá funcionar em vários outros bancos de dados com pouca ou nenhuma alteração.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início


Salvar imagem em tabela Paradox

O exemplo abaixo demonstra como salvar imagens Bitmap em 
tabelas Paradox.

1. Crie uma tabela Paradox com um campo do tipo Binary (B).

2. Coloque no form um Table e ligue-o com a tabela Paradox 
recém criada.

3. Coloque também um OpenDialog.

4. Para carregar a imagem de um arquivo bitmap para a tabela
faça assim:

procedure TForm1.Button1Click(Sender: TObject);
var
  Bmp: TBitmap;
begin
  if not OpenDialog1.Execute then
    Exit;

  Bmp := TBitmap.Create;
  try
    Bmp.LoadFromFile(OpenDialog1.FileName);

    Table1.Insert;
    Table1.FieldByName('Imagem').Assign(Bmp);
    Table1.Post;

  finally
    Bmp.Free;
  end;
end;

Para mostrar no form a imagem que foi salva na tabela
siga o exemplo:

procedure TForm1.Button2Click(Sender: TObject);
var
  Bmp: TBitmap;
begin
  Bmp := TBitmap.Create;
  try
    Bmp.Assign(Table1.FieldByName('Imagem'));
    Form1.Canvas.Draw(0, 0, Bmp);
  finally
    Bmp.Free;
  end;
end;

Observações

O exemplo acima pinta a imagem diretamente no Canvas do Form1. Uma alternativa mais elegante seria usar um objeto TImage para mostrar a imagem. Para salvar em outros bancos de dados a técnica usava será semelhante.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início


Evitar a biblioteca midas.dll

Até a versão 5 do Delphi, se usarmos o componente 
TClientDataSet teremos, invariavelmente, que distribuir
juntamente com nosso aplicativo, a biblioteca midas.dll. 

Porém a partir do Delphi 6 este inconveniente pode ser
evitado. Para isto adicione no uses de seu aplicativo a
unit MidasLib. Pode fazer isto na seção uses do form 
principal ou em qualquer outra unit.

Observações

É importante lembrar que a distribuição do arquivo midas.dll está sugeito ao pagamento de licenças para a Borland. Entre em contato com a Borland para saber mais detalhes.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início


Copiar qualquer texto para o Clipboard

Inclua na seção uses: Clipbrd
O objeto global Clipboard pode ser usado para fazer a 
transferência de dados entre a Área de Transferência e seu
aplicativo. Veja o exemplo:

procedure TForm1.Button2Click(Sender: TObject);
begin
  Clipboard.AsText := Edit1.Text;
end;

Observações

Alguns componentes possuem métodos tais como CopyToClipboard() que podem ser usados para copiar dados para a área de transferência de forma bastante simples.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início


Avaliar de expressão matemática

Muitas pessoas procuram um parser (avaliador) de expressões
matemática. Em resposta a tanta procura estou colocando abaixo
duas possíveis soluções:

1. Pegue em nosso download o arquivo Formula.zip. Ele contém 
   um componente (não profissional) que fiz para avaliar
   fórmulas matemáticas simples.

2. Pegue o componente TMathParser no endereço:
   www.bitsoft.com

Observações

Se você conhece outro componente queira por gentileza nos informar o endereço da página para download.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início


Rolagem automática em ListBox

Inclua na seção uses: Windows, Messages
Para rolar o conteúdo de um ListBox automaticamente basta 
enviar uma mensagem WM_VSCROLL para a janela do componente.
No primeiro parâmetro da mensagem devemos passar o tipo de
rolagem que deverá ser feita, ou seja:

SB_LINEDOWN - Uma linha para baixo.
SB_LINEUP - Uma linha para cima.
SB_PAGEDOWN - Uma página para baixo.
SB_PAGEUP - Uma página para cima.
SB_TOP - Topo da lista.
SB_BOTTOM - Fim da lista.

SendMessage(ListBox1.Handle, WM_VSCROLL, SB_LINEDOWN, 0);

Observações

A mensagem WM_VSCROLL aceita outros parâmetros. Pesquise no Help da API do Windows por WM_VSCROLL para obter mais informações.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início


Obter data/hora do próprio EXE

Inclua na seção uses: SysUtils
Eis uma função que pega a data e hora do próprio EXE.

function ExeDateTime: TDateTime;
begin
  Result := FileDateToDateTime(FileAge(ParamStr(0)));
end;

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início


Mostrar aviso em forma de hint

Inclua na seção uses: Controls
Nos tempos do Clipper era comum mostrar uma mensagem, 
aguardar alguns segundos e depois ocultá-la. Para quem ainda
gosta deste estilo apresento uma dica interessante. A rotina
abaixo mostra a mensagem de aviso em forma de "Hint", aguarda
o tempo especificado e finalmente retira a mensagem da tela.

procedure Aviso(const Msg: string; const Tempo: Cardinal);
var
  R: TRect;
  X: integer;
begin
  with THintWindow.Create(Application) do
  try
    { Calcula o retângulo }
    R := CalcHintRect(Screen.Width, Msg, nil);

    { Centraliza horizontalmente }
    X := R.Right - R.Left + 1;
    R.Left := (Screen.Width - X) div 2;
    R.Right := R.Left + X;

    { Centraliza verticalmente }
    X := R.Bottom - R.Top + 1;
    R.Top := (Screen.Height - X) div 2;
    R.Bottom := R.Top + X;

    { Mostra }
    ActivateHint(R, Msg);
    Update;

    { Aguarda }
    Sleep(Tempo);
  finally
    Free;
  end;
end;

Exemplo de uso:
Aviso('Mensagem de aviso', 5000); { Aguarda 5 segundos }

Observações

Usei este recurso por dois motivos. Primeiro para lembrar os velhos tempos do Clipper (legal!) e em segundo lugar para mostrar um breve exemplo que pode ser ampliado para melhorar as mensagens de dicas (hint) de aplicações feitas em Delphi.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início


Sons no alto-falante do micro

Inclua na seção uses: Windows
Desde que migrei de Clipper para Delphi não uso este recurso 
em minhas aplicações. Primeiro porque o Windows oferece sons
mais sofisticados e em segundo lugar porque eu realmente não
sabia como fazer (verdade!). Recentemente, em uma visita ao 
news da borland encontrei as rotinas abaixo e achei muito
interessantes. Então resolvi disponibilizá-las aqui.

procedure Sound(Freq: Word);
asm
  MOV DX, AX
  IN AL, $61
  MOV AH, AL
  AND AL, 3
  JNE @@1
  MOV AL, AH
  OR AL, 3
  OUT $61, AL
  MOV AL, $B6
  OUT $43, AL
@@1:
  MOV AX, DX
  OUT $42, AL
  MOV AL, AH
  OUT $42, AL
end;

procedure NoSound;
asm
  IN AL, $61
  AND AL, $FC
  OUT $61, AL
end;

procedure DoBeep(Freq, Duration: LongWord);
begin
  if Win32Platform = VER_PLATFORM_WIN32_NT then
    Windows.Beep(Freq, Duration)
  else begin
    Sound(1193181 div Freq);
    Sleep(Duration);
    NoSound;
  end;
end;

Se você não entendeu as rotinas, eis um resumo:

Sound:
  Inicia um som com uma determinada freqüência (hertz).

NoSound:
  Interrompe o som iniciado por Sound.

DoBeep:
  Esta rotina verifica se o sistema operacional é o Windows NT. 
  Se for, chama a API Windows.Beep. Caso contrário chama Sound, 
  aguarda e, chama NoSound.

Observações

Pelo menos no meu caso, a maioria dos usuários não possuem computadores munidos de caixas de som. Para estes casos as rotinas acima seriam a solução se o som for indispensável.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início


Acessar tabela DB/DBF no diretório do EXE

Inclua na seção uses: SysUtils
Problema:

Gostaria de acessar tabelas DB/DBF que estão no diretório do 
EXE sem ter que criar um alias no BDE. Como fazer?

Solução:
No evento BeforeOpen do Table coloque o código abaixo:

procedure TForm1.Table1BeforeOpen(DataSet: TDataSet);
begin
  Table1.DatabaseName :=
    ExtractFilePath(ParamStr(0));
end;

Observações

Este procedimento não dispensa o BDE, mas apenas a criação do Alias.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início


Ordenar datas pelo mês em Paradox?

Problema:

Gostaria de organizar uma lista dos clientes ordenados
por mês a partir da data de nascimento.

Solução:

Use o componente TQuery com a instrução SQL abaixo:

select 
  Codigo, 
  Nome, 
  DataNasc,
  extract(month from DataNasc) as Mes
from Cliente
order by Mes

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início


Excluir todas as ocorrências de um caractere de uma string

Inclua na seção uses: SysUtils
Problema:

Em determinados casos gostaria de poder eliminar alguns 
caracteres indesejados que os usuários podem digitar, tais
como pontos, aspas, etc. Como fazer isto?

Solução:

Na função abaixo, o primeiro parâmetro é o caractere a ser
eliminado e o segundo parâmetro é a string, donde o caractere
será eliminado. 

function DeleteChar(const Ch: Char; const S: string): string;
var
  Posicao: integer;
begin
  Result := S;
  Posicao := Pos(Ch, Result);
  while Posicao > 0 do begin
    Delete(Result, Posicao, 1);
    Posicao := Pos(Ch, Result);
  end;
end;

=== Exemplo de uso ===

- Coloque um Edit e um Button.
- Programe o OnClick do botão conforme abaixo:

procedure TForm1.Button1Click(Sender: TObject);
begin
  Edit1.Text := DeleteChar('"', Edit1.Text); { Exclui aspas }
  Edit1.Text := DeleteChar('.', Edit1.Text); { Exclui pontos }
end;

Observações

Para eliminar vários caracteres poderíamos escrever uma função que fizesse toda a tarefa numa única chamada.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início


Fazer pesquisa incremental apenas com DBGrid

Problema:

Gostaria de fazer um formulário de pesquisa que, ao digitar
algo sobre o DBGrid, o registro correspondendo fosse 
localizado.

Solução:

- Coloque no form: TTable, TDataSource, TDBGrid e TLabel.

- Ajuste as propriedades do Table1:
  DatabaseName = 
  TableName = 
  Active = true

- Ajuste as propriedades do DataSource1:
  DataSet = Table1

- Ajuste as propriedades do DBGrid1:
  DataSource = DataSource1
  Options -> dgEditing = false
  ReadOnly = true
  
  * Pode também ajustar a propriedades Columns para escolher
    as colunas que serão exibidas.

- Na seção private da unit declare:
  private
    FTexto: string;

- No evento OnCreate do form coloque:
  FTexto := '';
  Label1.Caption := '';

- No evento OnKeyPress do DBGrid1:

procedure TForm1.DBGrid1KeyPress(Sender: TObject; var Key: Char);
begin
  if Key in [#8, #32..#255] then begin

    if Key = #8 then { BackSpace }
      FTexto := Copy(FTexto, 1, Length(FTexto)-1)
    else
      FTexto := FTexto + Key;

    { Posiciona na coluna Nome }
    Table1.FieldByName('Nome').FocusControl;

    { Escolhe o índice e procura }
    Table1.IndexFieldNames := 'Nome';
    Table1.FindNearest([FTexto]);

    { Mostra o texto procurado }
    Label1.Caption := FTexto;
  end;
end;

Observações

No nosso exemplo estamos pesquisando através do campo "Nome". Para esta pesquisa precisamos de um índice com este campo.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início


Consulta SQL que usa a data do sistema

Problema:

Preciso fazer uma consulta com SQL que me retorne todos
os registros em que o valor de um campo do tipo data seja
igual ou anterior à dada do sistema. Como fazer?

Solução:

Query.Close;
Query.SQL.Text := 'select * from Tabela where CampoData <= :Hoje';
Query.ParamByName('Hoje').AsDate := Date;
Query.Open;

Observações

Este exemplo foi testado com tabelas Paradox, mas deve funcionar na maioria dos bancos de dados com pouca ou nenhuma alteração.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início


Obter nomes dos campos de uma tabela

Inclua na seção uses: dbTables, Classes, Forms
A função abaixo obtém os nomes de todos os campos de uma
tabela do banco de dados.

procedure tbGetFieldNames(const DBName, TblName: string;
  List: TStringList);
var
  I: integer;
begin
  List.Clear;
  with TTable.Create(Application) do
  try
    DatabaseName := DBName;
    TableName := TblName;
    with FieldDefs do begin
      Update;
      for I := 0 to Count -1 do
        List.Add(Items[I].Name);
    end;
  finally
    Free;
  end;
end;

=== Exemplo de uso ===

- Coloque um TMemo e um TButton no Form;
- Coloque o código abaixo no evento OnClick do Button:

procedure TForm1.Button1Click(Sender: TObject);
var
  List: TStringList;
begin
  List := TStringList.Create;
  try
    tbGetFieldNames(Edit1.Text, Edit2.Text, List);
    Memo1.Lines.Assign(List);
  finally
    List.Free;
  end;
end;

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início


Obter path de um Alias do BDE

Inclua na seção uses: BDE
{ A função abaixo retorna o path (caminho) de um Alias do
  BDE }

function GetAliasPath(AliasName: String):String;
var
  dbDes: DBDesc;
begin
  Result:='';
  DBiInit(Nil);// invoca o BDE , se não inicializado
  If DbiGetDatabaseDesc(PChar(AliasName), @dbDes)= DBIERR_NONE then
  with dbDes do
    Result:=StrPas(szPhyName);
  DBiExit;// Libera o BDE
end;

Dica enviada por: Angelo Ricardo Miquelin Neto.

Observações

Se a unit em que essa rotina for colocada utilizar as units DB e DBTABLES, as chamadas a DbiInit() e DbiExit() poderão ser omitidas.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início


Copiar todos os registros de uma tabela para o Clipboard

Inclua na seção uses: Clipbrd
Problema:

Gostaria de colocar em minha aplicação o recurso de copiar 
todos os registros de uma tabela para a área de transferência,
permitindo ao usuário colar estes dados em outro 
aplicativo (ex: MS-Word). Isto é possível?

Solução:

Sim. Siga os passos abaixo:

- Crie seu form normalmente, colocando DataSource, Table e
  demais componentes;
- Coloque um botão e no evento OnClick deste botão coloque
  o código abaixo:

procedure TForm1.Button1Click(Sender: TObject);
const
  SeparadorCampoValor = ': ';
  SeparadorCampo      = #13#10; { Quebra de linha }
  SeparadorRegistro   = '===========' + #13#10;
var
  S: string;
  I: integer;
begin
  S := '';
  Table1.First;
  while not Table1.EOF do begin
    for I := 0 to Table1.FieldCount -1 do
      S := S + Table1.Fields[I].FieldName + SeparadorCampoValor +
               Table1.Fields[I].AsString + SeparadorCampo;
    S := S + SeparadorRegistro;
    Table1.Next;
  end;
  Clipboard.AsText := S;
end;

Para testar:
- Execute este aplicativo;
- Clique no botão;
- Vá em outro aplicativo (ex: MS-Word) e mande colar (Ctrl+V).

Observações

CUIDADO! Não use este recurso com tabelas grandes, pois poderá usar memória demasiadamente. No teste que fiz, o tamanho da string S atingiu 20K e funcionou normalmente. Mas isto pode variar de uma máquina para outra.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início


Copiar um registro de uma tabela para o Clipboard

Inclua na seção uses: Clipbrd
Problema:

Gostaria de colocar em minha aplicação o recurso de copiar 
um registro de uma tabela para a área de transferência,
permitindo ao usuário colar estes dados em outro 
aplicativo (ex: MS-Word). Isto é possível?

Solução:

Sim. Siga os passos abaixo:

- Crie seu form normalmente, colocando DataSource, Table e
  demais componentes;
- Coloque um botão e no evento OnClick deste botão coloque
  o código abaixo:

procedure TForm1.Button1Click(Sender: TObject);
const
  SeparadorCampoValor = ': ';
  SeparadorCampo      = #13#10; { Quebra de linha }
var
  S: string;
  I: integer;
begin
  S := '';
  for I := 0 to Table1.FieldCount -1 do
    S := S + Table1.Fields[I].FieldName + SeparadorCampoValor +
             Table1.Fields[I].AsString + SeparadorCampo;

  Clipboard.AsText := S;
end;

Para testar:
- Execute este aplicativo;
- Clique no botão;
- Vá em outro aplicativo (ex: MS-Word) e mande colar (Ctrl+V).

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início


Mudar a cor de um DBEdit dentro de um DBCtrlGrid de acordo com uma condição

Problema:

Uso um DBCtrlGrid e gostaria que, quando o valor de um 
determinado campo for negativo, o DBEdit ligado a este 
campo seja exibido em vermelho e, caso contrário, 
em azul. Isto é possível?

Solução:

- Monte o form normalmente colocando DataSource, Table, 
  DBCtrlGrid e os DBEdit's, DBText's, etc.

- Escreva no manipulador do evento OnPaintPanel do 
  DBCtrlGrid conforme abaixo:

procedure TForm1.DBCtrlGrid1PaintPanel(DBCtrlGrid: TDBCtrlGrid;
  Index: Integer);
begin
  if Table.FieldByName('NomeDoCampo').AsFloat < 0 then
    DBEdit1.Font.Color := clRed
  else
    DBEdit1.Font.Color := clBlue;
end;

Observações

Neste exemplo mudamos a cor da fonte do componente DBEdit, Porém, pode-se também mudar a cor do próprio componente (DBEdit1.Color).

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início


Fazer pesquisa incremental com DBGrid e Edit

Problema:

Gostaria de montar um formulário de pesquisa com um DBGrid e
um Edit de modo que, enquanto o usuário digita um nome do
Edit, o registro vai sendo localizado no DBGrid. Como fazer?

- Crie um índice na tabela com campo a ser usado na pesquisa.

Coloque no Form:

- Um DataSource
- Um Table
- Um DBGrid
- Um Edit

Altere as seguintes propriedades:

- DataSource1.DataSet = Table1
- Table1.DatabaseName = 'NomeDoAlias'
- Table1.TableName = 'NomeDaTabela'
- Table1.IndexFieldNames = 'NomeDoCampo'
- Table1.Active = true
- DBGrid1.DataSource = DataSource1

Escreva a instrução abaixo no evento OnChange do Edit:

Table1.FindNearest([Edit1.Text]);

Observações

Este exemplo considera que o campo seja tipo string. Para outros tipos de campos pode ocorrer erro dependendo dos valores digitados no Edit1.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início


Limpar um campo tipo data via programação

Table1.FieldByName('Data').Clear;

{ ou }

Table1.FieldByName('Data').AsString := '';

Observações

Podemos usar este recurso para limpar também campos numéricos, string, etc.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início


Implementar um campo auto-incremental via programação

Inclua na seção uses: dbTables
procedure tbAutoInc(Table: TTable; const FieldName: string);
var
  Q: TQuery;
begin
  if not Table.FieldByName(FieldName).IsNull then
    Exit;

  Q := TQuery.Create(nil);
  try
    Q.DatabaseName := Table.DatabaseName;
    Q.SQL.Add('select max(' + FieldName + ') from ' + Table.TableName);
    Q.Open;
    try
      Table.FieldByName(FieldName).AsInteger := Q.Fields[0].AsInteger +1;
    finally
      Q.Close;
    end;
  finally
    Q.Free;
  end;
end;

{ Chame esta procedure no evento BeforePost de um Table: }
procedure TForm1.Table1BeforePost(DataSet: TDataSet);
begin
  tbAutoInc(Table1, 'Codigo');
end;

Observações

A função acima incrementa o campo somente se estiver vazio. Assim podemos dar ao usuário a opção de digitar neste campo ou deixá-lo vazio para que seja auto-incrementado. Existem várias outras formas de implementar este recurso.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início


Exibir a caixa de diálogo padrão de solicitação de senha do banco de dados

Inclua na seção uses: DbPwDlg
{ Coloque um botão no form e escreve seu evento OnClick
  como abaixo }

procedure TForm1.Button1Click(Sender: TObject);
var
  pw: TPasswordDialog;
begin
  pw := TPasswordDialog.Create(Self);
  try
    pw.Caption := 'Banco de Dados';
    pw.GroupBox1.Caption := 'Senha';
    pw.AddButton.Caption := '&Adicionar';
    pw.RemoveButton.Caption := '&Remover';
    pw.RemoveAllButton.Caption := 'Remover &Tudo';
    pw.OKButton.Caption := '&OK';
    pw.CancelButton.Caption := '&Cancelar';
    pw.ShowModal;
  finally
    pw.Free;
  end;
end;

Observações

As senhas adicionadas nesta caixa de diálogo são adicionadas na sessão (TSession) atual. Isto é útil quando colocamos senha em tabelas Paradox, ou mesmo quando trabalhamos com banco de dados Client Servidor, e queremos que o usuário digite a senha de acesso. Se não fizermos desta forma, nem adicionarmos via programação as senhas necessárias, esta caixa de diálogo será mostrada quando o programa tentar abrir uma tabela com senha. A grande vantagem aqui é que podemos traduzir os Caption's dos componentes.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início


Usar o evento OnGetText de um TField

{ Problema:
  
  Tenho um sistema de contas a receber, onde um campo chamado
  "Tipo" contém um número inteiro que indica o tipo do 
  documento conforme abaixo:

  1 - Promissória
  2 - Duplicata
  3 - Boleto

  Gostaria que, ao exibir os dados (num DBGrid por exemplo),
  fosse exibido o nome e não o número, ou seja, "Promissória"
  em vez de "1". 

  Solução:

  Isto pode ser feito de várias formas, mas aqui vou mostrar
  como resolver usando o evento OnGetText do TField. Vejamos:

  - Adicione todos os campos no Field Editor;
  - Clique no campo "Tipo";
  - Vá ao Object Inspector e dê um duplo-click 
    no evento OnGetText;
  - Neste evento, digite o código abaixo:
}

procedure TForm1.Table1TipoGetText(Sender: TField; var Text: String;
  DisplayText: Boolean);
begin
  if DisplayText then begin
    case Table1Tipo.AsInteger of
      1: Text := 'Promissória';
      2: Text := 'Duplicata';
      3: Text := 'Boleto';
    else
      Text := 'Desconhecido';
    end;
  end else
    Text := Table1Tipo.AsString;
end;

Observações

Ao exibir será exibido os nomes. Mas ao digitar continue com os 1, 2, 3, etc. Para usar este recurso em relatórios, acesse a propriedade DisplayText em vez de AsString para obter o valor do campo.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início


Verificar, via programação, se Local Share do BDE está TRUE

Inclua na seção uses: Registry, SysUtils, Windows
{ Esta função retorna true se Local Share estiver "TRUE".
  Caso contrário, retorna false. }

function TBBDELocalShare: boolean;
const
  BdeKey = 'SOFTWARE\Borland\Database Engine\Settings\SYSTEM\INIT';
  Ident = 'LOCAL SHARE';
var
  Reg: TRegistry;
begin
  Result := false;
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.OpenKey(BdeKey, False) then
      if Reg.ValueExists(Ident) then
        Result := UpperCase(Reg.ReadString(Ident)) = 'TRUE';
  finally
    Reg.Free;
  end;
end;

{ Use-a como abaixo: }
if TBBDELocalShare then
  { Local Share está TRUE }
else
  { Local Share está FALSE }

Observações

A função acima faz a verificação no registro do Windows. Por isto está sujeita a falha caso o BDE coloque as configurações em outro local (é o caso do BDE salvar as configurações no formato do Windows 3.x). O ideal seria usar uma API do BDE, mas até o momento não conheço uma que retorne esta informação. Caso alguém saiba, queira por gentileza nos informar.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início


Resolver "Internal error near: IBCheck" do Interbase 5.1.1 Server no NT

Recebi esta mensagem do desenvolvedor Alexsando S. Pimenta.
Como deve ser do interesse de outros desenvolvedores, 
coloquei-a aqui:
==== Mensagem original ====
Olá Daniel,
 
Anote está solução, muitos tem o mesmo problema mas não 
conseguem a solução tão facilmente como eu.
 
Look:
 
Problema:
Estou com um problemão. Trabalho com o NT 4 workstation 
Service Pack 3, Delphi 3 e Interbase 4.2.xxx. E instalei o
Interbase 5.1.1 Server nesta máquina. Até aí tudo bem. Quando
fui rodar a aplicação deram alguns problemas de conversão do
tipo de Dado. Analisando o problema percebi que havia
esquecido de instalar o Client do Interbase. Foi aí que 
começaram os problemas. Tentei instalar o client, porém o
instalador após preparar os arquivos de instalação mostrava
a seguinte mensagem e parava : Titulo da janela = "Severe",
mensagem = "Internal error near: IBCheck"; comecei a ler os
manuais, em certo ponto aconselhava desinstalar qualquer
versão posterior do Interbase da minha máquina. Foi então que
desinstalei o Interbase 4.2.xxx  (através do "Control Panel",
"Add/Remove Programs"). Nova tentativa de instalar o client,
o erro persistia. Resolvi desinstalar (através do "Control
Panel", "Add/Remove Programs") todo o Interbase da minha
máquina e começar tudo de novo. Porém quando tentei instalar
novamente o Interbase Server, surpresa, o erro apareceu 
novamente. Mas agora não havia interbase instalado. Fui
desinstalando Delphi, BDE, ... e nada. Entrei no Regedit,
pois o desinstalador, normalmente, faz o trabalho incompleto
e é necessário excluir um monte de lixo do Registry. 
Deparei com a seguintes chaves: 

hkey_local_machine\system\controlset001\enum\root\legacy_interbase_guard
hkey_local_machine\system\controlset001\enum\root\legacy_interbase

Tentei excluí-las, porém são chaves protegidas, e o regedit
não permitiu que eu excluísse-as. 
 
Poderiam me dar uma solução para eu poder instalar o Interbase
em minha máquina? 

Preciso disto com urgência.
 
Obrigado,
Alexsandro Pimenta
Xenon Software Comércio e Serviços Ltda
apepper@uol.com.br

 
Solução:
Sr. Alexsandro,
 
Esse erro: 'Internal error near: IBCheck' acontece apenas
em algumas máquinas NT 4.
 
Na hora da instalação, é criada uma chave com valor errado.
 
Entre no registry do Windows e altere a opção, PATH de binário
para string, da chave:
 
HKEY_CURRENT_USER\Environment

Renata Oliva
Inprise Support Center

Autor: Renata Oliva - Inprise Support Center

Início


Excluir todos os registros de uma tabela

procedure tbDBDeleteAll(const DataSet: TDataSet);
begin
  with DataSet do
    while RecordCount > 0 do
      Delete;
end;

{ Chame-a como nos exemplos abaixo: }
tbDBDeleteAll(Table1);
ou
tbDBDeleteAll(Query1);

Observações

Se houver um filtro ou range ativo, somente os registros filtrados serão excluídos. Portanto é diferente de Table1.EmptyTable. Esta função poderá ser chamada no evento BeforeDelete do Table (ou Query) principal em um formulário mestre-detalhe para excluir os itens (da parte detalhe).

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início


Mudar a coluna ativa em um DBGrid via programação

{ Usando número da coluna (zero é a primeira coluna): }
DBGrid1.SelectedIndex := 0;

{ Usando o nome do campo }
DBGrid1.SelectedField := Table1.FieldByName(Edit2.Text);

Observações

Aconselho usar o nome do campo quando o que importa é o campo e não a posição. Use o número da coluna somente quando o que importa é a posição, e não o campo.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início


Obter o número do registro atual

Table1.RecNo()

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início


Trabalhar com Filter de forma mais prática

Se você está habituado a usar este código no filter...

Table1.Filter := 'Nome = '''+ Edit1.Text + '''';
ou
Table1.Filter := 'Data = ''' + DateToStr(Date) + '''';

Tente usar este:

Table1.Filter := 'Nome = ' + QuotedStr(Edit1.Text);
ou
Table1.Filter := 'Data = ' + QuotedStr(DateToStr(Date));

Observações

A função QuitedStr() coloca apóstrofos envolvendo a string. Se houver um apóstrofo como parte da string, ela o subtitui por dois apóstrofos, para que seja corretamente interpretado.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início


Obter a quantidade de registros total e visível de uma tabela

Inclua na seção uses: DbiProcs
Os componentes TTable e TQuery possuem a propriedade
RecordCount que indicam a quantidade de registros da tabela.
No entanto esta propriedade é dependente de filtros, ou 
seja, se tivermos uma tabela com dez registros com campo 
"Codigo" de 1 a 10 e aplicarmos o filtro mostrado a seguir,
a propriedade RecordCount retornará 5 e não 10.

Table1.Filter := 'Codigo <= 5';
Table1.Filtered := true;

Se quizermos obter a quantidade total de registros,
independentemente de filtros, devemos usar uma API do BDE
conforme abaixo:

var
  Total: integer;
begin
  Check(DbiGetRecordCount(Table1.Handle, Total));
  ShowMessage('Total de registros: ' + IntToStr(Total));
end;  

Observações

Para testar o exemplo acima, o Table1 precisa estar aberto.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início


Gravar fisicamente com Paradox

Inclua na seção uses: DbiProcs
{ Se estiver usando TTable, coloque nos eventos
  AfterPost e AfterDelete a seguinte linha: }

  dbiSaveChanges(Table1.Handle);

{ Para TQuery, a instrução é semelhante: }

  dbiSaveChanges(Query1.Handle);

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início


Criar uma tabela (DB, DBF) através do seu programa

Inclua na seção uses: dbTables, DB
procedure CriaTabelaClientes;
var
  Tabela: TTable;
begin
  Tabela := TTable.Create(Application);
  try
    Tabela.DatabaseName := 'C:\';
    { ou Tabela.DatabaseName := 'NomeAlias'; }

    Tabela.TableName := 'Clientes.DB';
    Tabela.TableType := ttParadox; { ou ttDBase }

    { Somente Delphi4 }
    if Tabela.Exists then { Se a tabela já existe... }
      Exit;
    {***}

    { Cria a tabela }
    Tabela.FieldDefs.Add('Codigo', ftInteger, 0, true);
    Tabela.FieldDefs.Add('Nome', ftString, 30, true);
    Tabela.FieldDefs.Add('DataNasc', ftDate, 0, false);
    Tabela.FieldDefs.Add('RendaMes', ftCurrency, 0, false);
    Tabela.FieldDefs.Add('Ativo', ftBoolean, 0, true);
    { etc, etc, etc }
    Tabela.CreateTable;

    { Cria os Índices }
    Tabela.AddIndex('ICodigo', 'Codigo', [ixPrimary, ixUnique]);
    Tabela.AddIndex('INome', 'Nome', [ixCaseInsensitive]);
    { etc, etc, etc }
  finally
    Tabela.Free;
  end;
end;

Observações

Para verificar se o arquivo já existe na versão 3 ou anterior do Delphi, você deverá usar a função "FileExists" do Delphi.

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início


Criar um Alias temporário através do seu programa

Inclua na seção uses: DB
{ Enxergar somente configurações da sessão atual }
Session.ConfigMode := cmSession;
{ Adicionar o Alias }
Session.AddStandardAlias('MeuAlias', 'C:\DirProg', 'PARADOX');

Observações

Autor: Daniel P. Guimarães
Home-page: www.tecnobyte.com.br

Início


Página atualizada em 18 de setembro de 2014
Todos os direitos reservados
www.tecnobyte.com.br