Dicas de Delphi - Banco de Dados
Solucionando problemas de arredondamentosComo 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 Criando tabelas via SQLInclua 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 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 Evitar a biblioteca midas.dllAté 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 Copiar qualquer texto para o ClipboardInclua na seção uses: ClipbrdO 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 Avaliar de expressão matemáticaMuitas 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 Rolagem automática em ListBoxInclua na seção uses: Windows, MessagesPara 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 Obter data/hora do próprio EXEInclua na seção uses: SysUtilsEis 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 Mostrar aviso em forma de hintInclua 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 Sons no alto-falante do microInclua 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 Acessar tabela DB/DBF no diretório do EXEInclua 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 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 Excluir todas as ocorrências de um caractere de uma stringInclua 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 Fazer pesquisa incremental apenas com DBGridProblema: 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 = 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 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 Obter nomes dos campos de uma tabelaInclua 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 Obter path de um Alias do BDEInclua 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 Copiar todos os registros de uma tabela para o ClipboardInclua 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 Copiar um registro de uma tabela para o ClipboardInclua 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 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 Fazer pesquisa incremental com DBGrid e EditProblema: 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 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 Implementar um campo auto-incremental via programaçãoInclua 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 Exibir a caixa de diálogo padrão de solicitação de senha do banco de dadosInclua 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 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 Verificar, via programação, se Local Share do BDE está TRUEInclua 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 Resolver "Internal error near: IBCheck" do Interbase 5.1.1 Server no NTRecebi 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 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 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 Obter o número do registro atualTable1.RecNo() Autor: Daniel P. Guimarães Trabalhar com Filter de forma mais práticaSe 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 Obter a quantidade de registros total e visível de uma tabelaInclua 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 Gravar fisicamente com ParadoxInclua 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 Criar uma tabela (DB, DBF) através do seu programaInclua 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 Criar um Alias temporário através do seu programaInclua 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 Página atualizada em 23 de janeiro de 2012 |