Rotinas de arredondamento
Solucionando problemas de arredondamentos
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. Para resolver as diferenças entre Delphi e Firebird tem 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
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.
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
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:
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:
Contas a receber/recebidas:
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.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)))
Com estas técnicas acima resolvi completamente os problemas que eu tinha com relação aos arredondamentos, tanto no Delphi quanto no Interbase ouFirebird.
Criando tabelas via SQL
- Escreve no OnClick do Button como abaixo:
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.
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:
Para mostrar no form a imagem que foi salva na tabela
siga o exemplo:
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.
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.
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.
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.
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.
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.
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.
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.
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;
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.
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.
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.
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
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.
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.
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.
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;
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.
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.
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).
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).
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.
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.
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.
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.
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.
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 }
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).
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.
Obter o número do registro atual
Table1.RecNo()
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.
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.
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);
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.
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');
0 comentários:
Postar um comentário