Delphi 7.0 - ( 
)
DB Snippets
*** Página melhor visualizada no " navegador Chrome "
---------------------------------------------------------------------------------------
Muda de cor ao entrar e ao sair
private
{ private declarations }
Procedure Entra_Cor(Sender : TObject);
Procedure Sai_Cor(Sender : TObject);
:
procedure TClientes_Frm.Entra_Cor(Sender: TObject);
begin
With TDBEdit(Sender) do
Begin
Color := clInfoBk;
Font.Color := clBlue;
Font.Style := [fsBold];
end;
end;
procedure TClientes_Frm.Sai_Cor(Sender: TObject);
begin
With TDBEdit(Sender) do
Begin
Color := clWindow;
Font.Color := clBlack;
end;
end;
---------------------------------------------------------------------------------------
if Application.MessageBox('Salvar alteração ?','ATENÇÃO !', Mb_YesNo+Mb_IconQuestion)
= idyes then
Table1.Post
Else
Table1.Cancel;
---------------------------------------------------------------------------------------
Evento: onkeydown
Case Key Of
Vk_Return, Vk_Down : Perform(Wm_NextDlgCtl, 0 , 0);
Vk_Up : Perform(Wm_NextDlgCtl, 1 , 0);
end
---------------------------------------------------------------------------------------
Evento: onclose ( do form )
begin
if Table1.State in [dsEdit,dsInsert] then
Begin
if Application.MessageBox('Salvar alteração ?','ATENÇÃO !',
Mb_YesNo+Mb_IconQuestion) = idyes then
Table1.Post
Else
Table1.Cancel;
end;
---------------------------------------------------------------------------------------
Evento: beforeaction ( do dbnavigator )
begin
if Button = nbDelete then begin
if Application.MessageBox('Apagar registro', 'CONFIME', MB_OKCANCEL) =
MrCancel then
SysUtils.Abort;
end;
end;
---------------------------------------------------------------------------------------
Var
Fornecedor : String;
begin
Fornecedor :=InputBox('Consulta de Fornecedores por código','Informe o Código','');
if Fornecedor <> '' then
begin
if Fornec.FindKey([fornecedor])=False then
application.MessageBox('Fornecedor não Encontrado...','erro',+Mb_OK);
end;
---------------------------------------------------------------------------------------
Var
Fornecedor : String;
begin
Fornecedor :=InputBox('Consulta por nome','Informe o nome ','');
if Fornecedor <> '' then
begin
if Fornec.locate('for_nome', fornecedor,[loPartialKey])= False then
application.MessageBox('Nome não Localizado','erro',+Mb_OK);
end;
---------------------------------------------------------------------------------------
Evento: onkedown
Var
Tabela : TTable;
begin
If Key = Vk_F1 Then Tabela.Prior;
If Key = Vk_F2 Then Tabela.Next;
If Key = Vk_F3 Then Tabela.First;
If Key = Vk_F4 Then Tabela.Last;
If Key = Vk_F5 Then
Begin
Tabela.Insert;
//DBEdit5.SetFocus;
end;
If Key = Vk_F6 Then
begin
If Application.MessageBox('Excluir registro ?','Confirmação !',
Mb_YesNo+Mb_IconQuestion) = idYes then
Tabela.Delete;
end;
If Key = Vk_F7 Then Tabela.Edit;
If Key = Vk_F8 Then Tabela.Post;
If Key = Vk_F9 Then Tabela.Cancel;
If Key = Vk_F10 Then
WinExec('C:\Arquivos de programas\Outlook Express\MSIMN.EXE',SW_SHOWMAXIMIZED);
If Key = Vk_F11 Then WinExec('C:\Windows\Calc.exe',SW_SHOWMAXIMIZED);
If Key = Vk_Escape Then Close;
end;
---------------------------------------------------------------------------------------
Evento: onkeypress
Key := UpCase(Key);
If key = 'A' then Bit_Cad_Defeitos.Click;
If key = 'B' then Bit_Cad_Grupos.Click;
If key = 'C' then Bit_Relogios.Click;
If key = 'D' then Bit_Lotes.Click;
If key = 'E' then
Begin
With TSel_Relatorio_frm.Create(self) do begin
Try
ShowModal;
Finally
Free;
end;
end;
end;
---------------------------------------------------------------------------------------
with TForm1.Create(self) do
begin
Try
ShowModal;
Finally
Free;
end;
end;
---------------------------------------------------------------------------------------
Evento: OnKeyDown ( ctrl a )
if (ssCtrl in Shift) and (chr(Key) in ['A', 'a']) then
Edit5.SetFocus;
---------------------------------------------------------------------------------------
Botoes do navegadore de dados
Inclua linha TYPE antes do TYPE do Delphi
type
Navegador_com_botoes = class( TDbNavigator ); // Novo Navegador
:
OnShow
Var
Icone : TBitMap;
Data : TDate;
Begin
Icone:= TBitmap.Create;
// Altera registro
Icone.LoadFromFile ('editar.bmp');
Navegador_com_botoes( DbNavigator1 ).Buttons[nbEdit].Glyph := icone;
// Grava registro
Icone.LoadFromFile ('gravar.bmp');
Navegador_com_botoes( DbNavigator1 ).Buttons[nbPost].Glyph := icone;
// Apaga registro
Icone.LoadFromFile ('apagar.bmp');
Navegador_com_botoes( DbNavigator1 ).Buttons[nbDelete].Glyph := icone;
// Insere NOVO
Icone.LoadFromFile ('novo.bmp');
Navegador_com_botoes( DbNavigator1 ).Buttons[nbInsert].Glyph := icone;
// CANCELA
Icone.LoadFromFile ('cancelar.bmp');
Navegador_com_botoes( DbNavigator1 ).Buttons[nbCancel].Glyph := icone;
end;
---------------------------------------------------------------------------------------
type
TDBNewNavigator = class(TDBNavigator);
procedure TForm1.FormCreate(Sender: TObject);
var B: TNavigateBtn;
begin
for B := Low(TNavigateBtn) to High(TNavigateBtn) do
with TDBNewNavigator(DBNavigator1).Buttons[B] do begin
Case Index of
nbFirst : Caption := 'Inicio';
nbPrior : Caption := 'Anterior';
nbNext : Caption := 'Próximo';
nbLast : Caption := 'Último';
nbInsert : Caption := 'Novo';
nbDelete : Caption := 'Apagar';
nbEdit : Caption := 'Alterar';
nbPost : Caption := 'Gravar';
nbCancel : Caption := 'Cancelar';
nbRefresh: Caption := 'Atualizar';
End;
Layout := blGlyphTop; { uses Buttons}
Hint := Caption;
ShowHint := True;
end;
---------------------------------------------------------------------------------------
Instalando componente do Quick Report no Delphi 7
O Delphi 7 usa componentes Rave para criar relatórios, se preferir usar o Quick Report
- Feche todos os projetos abertos.
- Component - Install Packages - Add
- Abra o diretório \bin (a localização padrão é
c:\Arquivos de Programas\Borland\Delphi7\bin).
- Selecione o arquivo dclqrt70.bpl
- Clique em Abrir.
- De volta à janela Project Options, clique no botão OK.
---------------------------------------------------------------------------------------
begin
if Table1.IsEmpty then
Application.MessageBox('Não há registro para ser removido ...',
'A T E N Ç Ã O!', Mb_ok)
else
If Application.MessageBox('Excluir registro ?','Confirmação !',
Mb_YesNo+Mb_IconQuestion) = idYes then
Table1.Delete;
end;
---------------------------------------------------------------------------------------
procedure TPilotos_Frm.Pilotos_TBBeforeDelete(DataSet: TDataSet);
begin
If Application.MessageBox('Confirme a exclusão ? ', 'Apagando registro',
Mb_YesNo + Mb_IconQuestion) = IdNo Then
Raise EAbort.Create('');
end;
---------------------------------------------------------------------------------------
Evento: onkeypress
If Key in ['a' .. 'z'] then Key :=UpCase(Key); // so aceita letras
if not (Key in['0'..'9',Chr(8)]) then Key:= #0; // so aceita numeros
Key := UpCase(Key);
if not (Key in ['A'..'Z','0'..'9','-','+']) then
Key := #0;
---------------------------------------------------------------------------------------
Opcoes1_Frm.Caption := FormatDateTime('""dddd", " dd" de "mmmm" de " yyyy "Hora: " '
+ TimeToStr(Time),Now);
LblHora.Caption := FormatDateTime('hh:nn:ss:zzz',Now);
---------------------------------------------------------------------------------------
Label7.Caption := Format('Há %d registros na tabela', [Func_TB.RecordCount]);
---------------------------------------------------------------------------------------
Var
Cliente : String; // Definindo variável
begin
Cliente := InputBox( ' Digite um CÓDIGO de Cliente válido ' , ' Procura ' , ' ' );
If Cliente <> '' then // se for digitado algo
Begin
Clientes_TB.FindKey([Cliente]); // procura pela índice primário
If Clientes_TB.FindKey([Cliente]) = False then
Application.MessageBox( ' CÓDIGO não existe ' , ' Erro ' ,Mb_IconWarning
+ Mb_Ok);
end;
end;
---------------------------------------------------------------------------------------
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
Case MessageBox (Application.Handle, Pchar ('Deseja excluir o arquivo'
+ #13 + Label1.caption + #13 + Label2.caption),
'Exclusao de arquivo', MB_YESNO + MB_DEFBUTTON2) of
idYes : Table1.Delete;
idCancel : Table1.Cancel;
end;
end;
---------------------------------------------------------------------------------------
Procedure Apaga_Todos_Regs(Origem:TDataSet);
Begin
With Origem do
While RecordCount > 0 do
Delete;
end;
procedure TTestes_Frm.BitBtn1Click(Sender: TObject);
begin
Apaga_Todos_Regs(Table1);
end;
---------------------------------------------------------------------------------------
Evento: onCreate
var // Cria alias
Dir_Atual : String;
Const
Nome_Alias = 'Sindicato';
begin
if not Session.IsAlias(Nome_Alias) then
begin
Dir_Atual := ExtractFilePath(Application.ExeName);
Session.AddStandardAlias(Nome_Alias,Dir_Atual+'Dados\','PARADOX');
Session.SaveConfigFile;
end;
Socios_TB . Open;
Dependentes_TB . Open;
Empresas_TB . Open;
DataEncostado_TB . Open;
End;
---------------------------------------------------------------------------------------
ShortDateFormat := 'dddd, dd/mm/yyyy';
Label2.Caption := DateToStr(Date);
ShortDateFormat := 'dd/mmm/yyyy ';
Label3.Caption := DateToStr(Date);
ShortDateFormat := 'dddd, dd" de "mmmm" de "yyyy ';
Label4.Caption := DateToStr(Date);
ShortDateFormat := 'dd" de "mmmm" de "yyyy, dddd ';
Label5.Caption := DateToStr(Date);
---------------------------------------------------------------------------------------
Var
Nr1, Nr2, Resultado : Real;
begin
Nr1 := StrTofloat(Edit1.text);
Nr2 := StrTofloat(Edit2.text);
Resultado := (Nr1 * (Nr2/100));
Nr1 := Nr1 + Resultado;
Edit1.Text := FormatFloat('#,##0.000;(#,##0.000)' , Nr1);
Edit2.Text := FloatToStr(Nr1);
end;
---------------------------------------------------------------------------------------
Abertura com gauge
1) Criar uma tela e por o componente Gauge
2) Código abaixo
program Projeto_Exemplos;
uses
Forms,
Dica1 in 'Dica1.pas' {Dicas1_Frm},
abertura in 'abertura.pas' {Abertura_Frm},
Cad_Alunos1 in 'Cad_Alunos1.pas' {Alunos_Frm},
dm_table in 'dm_table.pas' {DM_Tables: TDataModule},
Cad_Clientes in 'Cad_Clientes.pas' {Clientes_Frm},
Menu_Principal in 'Menu_Principal.pas' {Modulo_Frm};
{$R *.res}
var
i : Shortint;
maximo : Shortint = 0;
divisor : Shortint = 19;
begin
Application.Initialize;
With TAbertura_Frm.Create(nil) do
Try
Gauge1.MaxValue:=100;
Show;
Update;
Panel1.Repaint;
Application.CreateForm(TModulo_Frm, Modulo_Frm);
Application.CreateForm(TAlunos_Frm, Alunos_Frm);
Application.CreateForm(TDicas1_Frm, Dicas1_Frm);
Application.CreateForm(TDM_Tables, DM_Tables);
Application.CreateForm(TClientes_Frm, Clientes_Frm);
For i := 1 To (Maximo + (1800 div divisor)) do
Begin
Gauge1.Progress:=i;
Maximo:=i;
end;
Panel1.Repaint;
Finally
Free;
end;
Application.Run;
end.
---------------------------------------------------------------------------------------
Var
BookMark : TBookMark;
Total : Real;
Total_Qtdes : Integer;
begin
BookMark := Table1.GetBookmark;
Table1.DisableControls;
Total := 0;
Total_Qtdes := 0;
Try
Table1.First;
While not Table1.Eof do
Begin
Total := Total + Table1Temp_Total.Value;
Total_Qtdes := Total_Qtdes + Table1Prod_Qtde.Value;
Table1.Next; // posiciona no próximo registro
end;
Finally
Table1.GotoBookMark (BookMark);
Table1.FreeBookMark (BookMark);
Table1.EnableControls;
end;
Label2.Caption := IntTOStr(Total_Qtdes);
Label4.Caption := Format('%m', [Total]); // %m = money
end;
---------------------------------------------------------------------------------------
PESQUISA POR DIA - MES - ANO
****************************
- Grid + Radiogroup + Edit
procedure TData_Filter_Frm.Table1FilterRecord(DataSet: TDataSet;
var Accept: Boolean);
Var
Dia, Mes, Ano : Word;
begin
Accept := True;
DecodeDate(Table1['Func_Data_Admissao'], Ano, Mes, Dia);
// If Edit1.Text <> EmptyStr then
Case RadioGroup1.ItemIndex of
0 : Begin
Edit1.Setfocus;
Dia := StrToInt(Edit1.Text);
Accept := ???(Dia);
end;
1 : Accept := Mes StrToInt(Edit1.Text);
2 : Accept := Ano StrToInt(Edit1.Text);
end;
end;
---------------------------------------------------------------------------------------
- Radiogroup ( com 2 opcoes ) - Editbox - Grid
Evento: OnShow
begin
Edit_Procura.SetFocus; // Posiciona cursor no campo de pesquisa
RG_Ordem.ItemIndex := 1; // posiciona no botão do radio NOME
Label_Texto.Caption := 'Informe a Descrição';
Query1.Close;
Query1.SQL.Clear;
Query1.SQL.Add('SELECT Clie_Codigo, Clie_Nome FROM Clientes');
Query1.SQL.Add('ORDER BY Clie_Nome');
Query1.Open;
end;
Evento: OnClick
begin
if RG_Ordem.ItemIndex = 0 then // ao clicar no primeiro botão do rádio
begin
Label_Texto.Caption := 'Informe o Código';
Query1.Close;
Query1.SQL.Clear;
Query1.SQL.Add('SELECT Clie_Codigo, Clie_Nome FROM Clientes');
Query1.SQL.Add('ORDER BY Clie_Codigo');
Query1.Open;
end
else
begin
if RG_Ordem.ItemIndex = 1 then // ao clicar no segundo botão do rádio
begin
Label_Texto.Caption := 'Informe a Descrição';
Query1.Close;
Query1.SQL.Clear;
Query1.SQL.Add('Select Clie_Codigo, Clie_Nome FROM Clientes');
Query1.SQL.Add('ORDER BY Clie_Nome');
Query1.Open; // SQL acima lista NOMES em ordem alfabetica
end
end;
end;
Evento: OnChange
var
Codigo : Integer;
begin
if RG_Ordem.ItemIndex = 0 then
begin
if Length (Edit_Procura.Text) > 0 then
Codigo := StrToInt(Edit_Procura.Text)
else
Codigo := 0;
Query1.Locate('Clie_Codigo',Codigo,[loCaseInsensitive, loPartialkey])
end
else
Query1.Locate('Clie_Nome',Edit_Procura.Text,[loCaseInsensitive, loPartialKey]);
end;
procedure TConsulta_Frm.DBGrid1DblClick(Sender: TObject);
begin
Consulta_Frm.ModalResult := MrOk;
end;
procedure TConsulta_Frm.Bit_CancelarClick(Sender: TObject);
begin
Edit_Procura.Text := '';
Edit_Procura.SetFocus;
end;
---------------------------------------------------------------------------------------
procedure TProdutos_FRM.FormClose(Sender: TObject;var Action: TCloseAction);
var
resposta : Integer;
begin
if DM1.produtos_TB.State in [dsEdit, dsInsert] Then
begin
Resposta := Application.MessageBox('Deseja gravar o registro atual',
'Aviso', MB_YESNOCANCEL + MB_ICONQUESTION);
If Resposta = idYes then DM1.produtos_TB.post;
If Resposta = idNo then Action := caFree;
If Resposta = idCancel then Action := caNone;
end;
end;
---------------------------------------------------------------------------------------
OnCaclFields - Calcular
Table1Total_Cal.Value := Table1Qtde.Value * Table1Preco.Value;
---------------------------------------------------------------------------------------
Procura registro no combobox
procedure TForm1.FormShow(Sender: TObject);
begin
comboBox1.Items.clear;
table1.First;
While not table1.Eof do begin
ComboBox1.Items.add(Table1.Fieldbyname('Name').asstring);
Table1.Next;
End;
end;
procedure TForm1.ComboBox1KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
l:Integer;
begin
IF (key=VK_BACK) or (key=VK_DELETE) OR (key=VK_LEFT) or (key=VK_RIGHT)
OR (KEY=vk_home) OR (key=VK_END) or (key=VK_SHIFT) or (key=VK_TAB) then exit;
ComboBox1.DroppedDown:=true;
l:=Length(combobox1.text);
table1.FindNearEst([combobox1.Text]);
if Copy(table1.fieldbyname('name').asString,1,L)=
Copy(ComboBox1.Text,1,L) then begin
combobox1.Text:=table1.Fieldbyname('Name').asString;
combobox1.SelStart:=l;
ComboBox1.SelLength:=Length(ComboBox1.Text)-l;
End;
end;
---------------------------------------------------------------------------------------
procedure TDM_Modelo.TabCategorSig_CategValidate(Sender: TField);
begin
if DSCategorState in [dsEdit, dsInsert] then
if TabCategorConf.FindKey([TabCategorSIG_CATEG]) then
begin
F_Categ.EditSIG_CATEG.SetFocus;
raise Exception.Create('Sigla da categoria duplicado' #10 +
'Click no botão "Localiza" em caso de dúvida');
end;
end
---------------------------------------------------------------------------------------
Procura por código
if Length(Edit1_Localiza.Text) = 0 then Exit;
Try
StrToInt(Edit1_Localiza.Text);
Vendedores_TB.FindNearest([Edit1.Text]);
Except
Vendedores_TB.IndexName := 'Inome_forn';
Vendedores_TB.FindNearest([Edit1.Text]);
Vendedores_TB.IndexName := '';
end;
---------------------------------------------------------------------------------------
Pesquisa por intervalo
Table1.SetRange ([DbEdit2.Text],[DbEdit2.Text]);
Table1.SetRange ([Table2.FieldByName('Nome').AsString],
[Table2.FieldByName('Nome').AsString] );
---------------------------------------------------------------------------------------
procedure TFormIPMF.BitBtn1Click(Sender: TObject);
begin
Table1.Edit;
Table1.FieldByName('Valor').AsString := Edit1.Text;
Table1.Post;
end;
---------------------------------------------------------------------------------------
Pesquisando registros
If not Clientes_TB.Locate(' Clie_Nome ' , Edit1.text, [loPartialKey] ) then
Application.MessageBox('Nome não existe',' Erro ! ' , Mb_IconWarning + Mb_Ok );
---------------------------------------------------------------------------------------
Pesquisando registros
Var
Cliente : String; // Definindo variável
begin
Cliente := InputBox( ' Digite um NOME válido ' , ' Procura ' , ' ' );
If Cliente <> '' then // se for digitado algo
Begin
If not Clientes_TB.Locate( ' Clie_Nome ' , Cliente, [loPartialKey]) then
Application.MessageBox( ' NOME inválido',' Erro ! ' , Mb_IconWarning + Mb_Ok );
end;
---------------------------------------------------------------------------------------
Pesquisando registros
Var // Declaração das variáveis
Cliente : String; // Definindo variável
begin
Cliente := InputBox( ' Digite um CÓDIGO de Cliente válido ' , ' Procura ' , '2' );
If Cliente <> '' then // se for digitado algo
Begin
With Clientes_TB do begin
SetKey;
FieldByName('Clie_Codigo').AsString:= Cliente;
If Not Clientes_TB.GotoKey then
Begin
Application.MessageBox( 'Código não existe ' , ' Erro 3 ', + Mb_Ok );
IndexName := ''; // cancela o índice
end;
end;
end;
end;
---------------------------------------------------------------------------------------
Pesquisando registros
var
DataI, DataF : TDatetime;
begin
Try
DataI := StrToDate(MaskEdit1.text); // data inicial
Except
Showmessage('Data inicial inválida.');
MaskEdit1.SetFocus;
exit;
end;
Try
DataF := StrToDate(MaskEdit2.text); // data final
Except
Showmessage('Data final inválida.');
MaskEdit2.SetFocus;
Exit;
end;
with Filter_Frm.table1 do // filtro e visualização de dados
begin
Close;
Filter := 'Clie_Data_Nasc >=' + #39 + FormatDateTime('dd/mm/yyyy' , DataI)
+ #39 +
' and Clie_Data_Nasc <=' + #39 + FormatDateTime('dd/mm/yyyy' ,
DataF + 1) + #39;
Filtered := True;
Open;
end;
end;
---------------------------------------------------------------------------------------
Ao pressionar enter pula de campo
If (Key = #13) or (EditNome.Text = '') then
Begin
Application.MessageBox('Digite um nome', 'Erro',mb_Ok);
EditNome.SetFocus;
end;
---------------------------------------------------------------------------------------
Inserir um edit + radiogroup - dbgrid
OnClick
Table1.Filtered := False;
if RadioGroup1.ItemIndex = 0 then
Table1.Filter := 'Nome ='+ ''''+ Edit1.Text + '''';
if RadioGroup1.ItemIndex = 1 then
Table1.Filter := 'Endereco ='+ ''''+ Edit1.Text + '''';
if RadioGroup1.ItemIndex = 2 then
Table1.Filter := 'Cidade ='+ ''''+ Edit1.Text + '''';
if RadioGroup1.ItemIndex = 3 then
Table1.Filter := 'Uf ='+ ''''+ Edit1.Text + '''';
if Edit1.Text <> 'Todos' then Table1.Filtered := True;
Table1.Open;
if Table1.IsEmpty then
ShowMessage ('Não Encontrado!!!');
--- OU ---
{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));
{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. }
---------------------------------------------------------------------------------------
var
Total : Currency;
PosAtual : TBookmark;
begin
if not Active then exit;
Total := 0;
with DM.ConsultaReciboTB,DM do
begin
if Not Active then open;
PosAtual := GetBookmark;
DisableControls;
First;
while not Eof do begin
Total := ConsultaReciboTBValor.Value + Total;
Next;
end;
GotoBookmark(PosAtual);
FreeBookmark(PosAtual);
EnableControls;
end;
Label1.Caption := FormatCurr('###,##0.00',Total);
end;
---------------------------------------------------------------------------------------
procedure TForm1.Table1BeforePost(DataSet: TDataSet);
begin // 1
if Table1Clie_Nome.Value = '' then // Valida campo DATA
Try // Try ... Finally ... End
begin // 2
Application.MessageBox('Favor digitar um NOME!' , 'ATENÇÃO!',
Mb_Ok + Mb_IconWarning);
Raise EAbort.Create('');
end; // 2
Finally // Try ... Finally ... End
Edit2.Clear; // Limpa campo
Edit2.SetFocus; // Volta para Edit1 digitar - campo Nome
end; // Try ... Finally ... End
end; // 1
---------------------------------------------------------------------------------------
If RadioGroup1.ItemIndex = 0 Then
Begin
Edit_Localiza.SetFocus;
Data_Modulo.Clientes_TB.Indexname := 'Inome';
end;
If RadioGroup1.ItemIndex = 1 Then
Begin
Edit_Localiza.SetFocus;
Data_Modulo.Clientes_TB.Indexname := 'Iendereco';
end;
If RadioGroup1.ItemIndex = 2 Then
Begin
Edit_Localiza.SetFocus;
Data_Modulo.Clientes_TB.Indexname := 'Icidade';
end;
---------------------------------------------------------------------------------------
Grava registro ao sair
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin // 1
if Table1.State in [dsEdit,dsInsert] then
begin // 2
if Length(Table1Nome_Comprador.Value) = 0 then
begin // 3
Table1.Cancel;
Exit;
end; // 3
if Application.MessageBox('Salvar alteração ?','ATENÇÃO!',
Mb_YesNo + Mb_IconQuestion) = idyes then
Table1.Post
else
Table1.Cancel;
end; // 2
end; // 1
---------------------------------------------------------------------------------------
Somar salários
Var
BookMark : TBookMark;
Total : Real;
begin
BookMark := Table1.GetBookmark;
Table1.DisableControls;
Total := 0;
Try
Table1.First;
While not Table1.Eof do
Begin
Total := Total + Table1Salario.Value;
Table1.Next;
end;
Finally
Table1.GotoBookMark (BookMark);
Table1.FreeBookMark (BookMark);
Table1.EnableControls;
end;
MessageDlg ('A soma dos salários é ' + Format('%m', [Total]), mtinformation, [MbOk], 0);
end;
---------------------------------------------------------------------------------------
Atualiza percentual na tabela
Var
BookMark : TBookMark;
Total : Real;
begin
BookMark := Table1.GetBookmark;
Table1.DisableControls;
Total := 0;
Try
Table1.First;
While not Table1.Eof do
Begin
Table1.Edit;
Total := Round (Table1Salario.Value * StrToInt(Edit1.Text) / 100);
Table1Salario.Value := Total + Table1Salario.Value;
Table1.Next;
end;
Finally
Table1.GotoBookMark (BookMark);
Table1.FreeBookMark (BookMark);
Table1.EnableControls;
end;
end;
---------------------------------------------------------------------------------------
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));
---------------------------------------------------------------------------------------
Excluir registro
if Clientes_TB.IsEmpty then
Application.MessageBox('Não há registro para ser removido ...',
'A T E N Ç Ã O!', Mb_ok)
else
If Application.MessageBox('Excluir registro ?','Confirmação !',
Mb_YesNo+Mb_IconQuestion) = idYes then
Clientes_TB.Delete;
---------------------------------------------------------------------------------------
Carrega lista no combobox no onshow
begin
DM_dat.Clientes_TB.Open;
DM_dat.Clientes_TB.DisableControls;
Try
ComboBox1.Items.Clear;
With DM_dat, DM_dat.Clientes_TB do
begin
First;
While not eof do begin
ComboBox1.Items.Add(Clientes_TBClie_nome.Value);
Next;
end;
end;
ComboBox1.Sorted := True;
Edit1.Setfocus;
Finally
DM_dat.Clientes_TB.EnableControls;
end;
---------------------------------------------------------------------------------------
Codifica senha
procedure TForm1.Bit_Decodifica_SenhaClick(Sender: TObject);
var
s : String[255];
c : Array[0..255] of Byte absolute s;
i : Integer;
begin
s := Edit2.Text;
for i := 1 to Length(s) do s[i] := Char(23 xor Ord(c[i]));
Edit3.Text := s;
end;
procedure TForm1.Edit1Change(Sender: TObject);
var
s : String[255];
c : Array[0..255] of Byte absolute s;
i : Integer;
begin
s := Edit1.Text;
for i := 1 to Ord(s[0]) do c[i] := 23 xor c[i];
Edit2.Text := s;
end;
---------------------------------------------------------------------------------------
Status bar
procedure TSimula_Barra_Status_Frm.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
// Ativa tecla CAPSLOCK
If Odd(GetKeyState (VK_CAPITAL)) Then
Barra_Status.Panels[1].Text := 'Caps'
else
Barra_Status.Panels[1].Text := '';
// Ativa tecla DELETE
If Odd (GetKeyState(VK_DELETE)) then
Barra_Status.Panels[2].Text := 'Del'
Else
Barra_Status.Panels[2].Text := '';
// Ativa tecla NUMLOCK
If Odd (GetKeyState(VK_NUMLOCK)) then
Barra_Status.Panels[3].Text := 'NumLock'
Else
Barra_Status.Panels[3].Text := '';
end;
procedure TSimula_Barra_Status_Frm.Timer1Timer(Sender: TObject);
begin
// Desativa tecla CAPSLOCK
If Odd(GetKeyState (VK_CAPITAL)) Then
Barra_Status.Panels[1].Text := 'Caps'
else
Barra_Status.Panels[1].Text := '';
// Desativa tecla DELETE
If Odd (GetKeyState(VK_DELETE)) then
Barra_Status.Panels[2].Text := 'Del'
Else
Barra_Status.Panels[2].Text := '';
// Desativa tecla NUMLOCK
If Odd (GetKeyState(VK_NUMLOCK)) then
Barra_Status.Panels[3].Text := 'NumLock'
else
Barra_Status.Panels[3].Text := '';
Barra_Status.Panels[4].Text := TimeToStr (Time);
end;
---------------------------------------------------------------------------------------
Localizando registro
Try
Produtos_TB.FindNearest([Edit1.Text]);
except
on exception do
MessageDlg('Erro inválida!',mtError, [mbOK], 0);
end;
---------------------------------------------------------------------------------------
Entere no dbgrid
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then begin
Key := #0;
if (Sender is TDBGrid) then
TDBGrid(Sender).Perform(WM_KeyDown,VK_Tab,0)
else
Perform(Wm_NextDlgCtl,0,0);
end;
end;
---------------------------------------------------------------------------------------
Evento: OnCloseQuery
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose:=False;
if messagebox(handle,'Deseja realmente fechar esta janela ?',
'Aviso', mb_IconInformation + mb_YesNo + mb_DefButton2 ) = idYes then
CanClose := True;
end;
---------------------------------------------------------------------------------------
Aumento com progress bar %
Var
BookMark : TBookMark;
Total : Real;
Cont : Integer;
Begin
Cont := 0;
BookMark := Table1.GetBookmark;
Table1.DisableControls;
Total := 0;
Try
Table1.Active := True;
Table1.First;
With Progress_Bar_Frm.ProgressBar1 do
begin
Min := 1;
Max := Table1.RecordCount;
Position := 1;
end;
While not Table1.Eof do Begin
Table1.Edit;
Total := (Table1Preco.Value * StrToInt(Edit1.Text) / 100);
// Total := ROUND(Table1Preco.Value * StrToInt(Edit1.Text) / 100);
Table1Preco.Value := Total + Table1Preco.Value;
Table1.Next;
Progress_Bar_Frm.ProgressBar1.Position :=
Progress_Bar_Frm.ProgressBar1.Position + 1;
end;
Finally
Table1.GotoBookMark (BookMark);
Table1.FreeBookMark (BookMark);
Table1.EnableControls;
end;
ShowMessage('Aumento concluído');
Progress_Bar_Frm.ProgressBar1.Position := 1;
---------------------------------------------------------------------------------------
Localizando registro
Var
Resp1, Resp2 : Integer;
begin
Clientes_TB.CancelRange;
// Clientes_TB.IndexName := 'Indice_X'; // se precisar definir índice ?
Try
Begin
Resp1 := StrToInt(InputBox('Código Inicial', 'Código Inicial',''));
Resp2 := StrToInt(InputBox('Código Final', 'Código Final' ,''));
end;
Except
Begin
Beep;
Application.MessageBox('Idade inválida ' , 'Aviso ',
Mb_YesNoCancel + Mb_IconQuestion);
end;
end;
Clientes_TB.SetRangeStart;
Clientes_TB.FieldByName('Clie_Codigo').Value := Resp1;
Clientes_TB.SetRangeEnd;
Clientes_TB.FieldByName('Clie_Codigo').Value := Resp2;
Clientes_TB.ApplyRange;
end;
---------------------------------------------------------------------------------------
Pesquisando registro
procedure TForm1.Bit_OkClick(Sender: TObject);
Var
Resp1, Resp2 : Integer; // define duas variáveis
begin // 1
Table1.CancelRange; // cancela faixa
Resp1 := 0; // limpa - zera variaveis
Resp2 := 0;
Try
begin // 2
Resp1 := StrToInt(InputBox('Código inicial' , 'Código inicial' , '0'));
Resp2 := StrToInt(InputBox('Código final ' , 'Código final ' , '0'));
end; // 2
Except
begin // 3
Beep;
Application.MessageBox('Faixa Inválida!', 'ATENÇÃO!', Mb_Ok);
end; // 3
end; // fim do Try
Table1.SetRangeStart; // inicia faixa de nr digitada
Table1.FieldByName('Clie_Codigo').Value := Resp1; // aramazena primeiro valor
Table1.FieldByName('Clie_Codigo').Value := Resp2; // armazena segundo valor
Table1.SetRangeEnd; // termina faixa de nr digitada
Table1.ApplyRange; // aplica / executa faixa
if Table1.RecordCount = 0 then // verifica se tem registro
Application.MessageBox('Registro(s) não encontrados(s)' + #13 +
'na faixa informada!' , 'ATENÇÃO!', Mb_Ok);
end; // 1
---------------------------------------------------------------------------------------
Pesquisando registro
var
Codigo : Integer;
begin
//Clientes_TB.IndexName:= 'iNumero';
Try
Codigo := StrToInt(InputBox('Digite um CÓDIGO', 'Código', ' '));
Except
Beep;
ShowMessage('CÓDIGO inválido! Tente novamente.');
end;
Clientes_TB.Findkey([Codigo]);
---------------------------------------------------------------------------------------
Pesquisando registro
If not Table1.Locate('Com_Nome_Vendor', Edit1.text, [loPartialKey]) then
Begin
Application.MessageBox('Registro Não encontrado',
'ATENÇÃO' , Mb_IconInformation);
Exit;
end;
If Table1Com_Pago.Value = True then
Application.MessageBox('Comissão JÁ foi paga.' , 'ATENÇÃO',
Mb_IconInformation)
Else
Application.MessageBox('Comissão NÃO foi paga.' , 'ATENÇÃO',
Mb_IconInformation);
---------------------------------------------------------------------------------------
Var
Datax : TDateTime;
begin
DM.Produtos_TB.CancelRange;
DM.Produtos_TB.IndexName := 'IData';
Try
Datax := StrToDate(InputBox('Pesquisa de DATAS', 'Informe uma DATA',''));
Except
Begin
Beep;
ShowMessage('Data inválida ! Tente novamente');
end;
end;
DM.Produtos_TB.CancelRange;
DM.Produtos_TB.First;
DM.Produtos_TB.SetRangeStart;
DM.Produtos_TB.FieldByName('Prod_Data').Value := Datax;
DM.Produtos_TB.SetRangeEnd;
DM.Produtos_TB.FieldByName('Prod_Data').Value := Datax;
DM.Produtos_TB.ApplyRange;
end;
---------------------------------------------------------------------------------------
Var
Codigo : Integer;
begin
DM.Produtos_TB.CancelRange;
DM.Produtos_TB.IndexName := '';
Try
Codigo := StrToInt(InputBox('Pesquisa de Cód.', 'Digite',''));
Except
Begin
Beep;
ShowMessage('Código Inválido ! Tente novamente');
end;
end;
DM.Produtos_TB.FindKey([Codigo]);
end;
---------------------------------------------------------------------------------------
Var
Descricao_Prod : String;
begin
DM.Produtos_TB.IndexName := 'IDescricao';
DM.Produtos_TB.CancelRange;
Descricao_Prod := InputBox('Pesquisa Descrição do Produto',
'Informe uma Descrição de um Produto','');
If Descricao_Prod = '' then
Application.MessageBox('Digite uma Descrição','Erro', MB_OK);
If Descricao_Prod <> '' Then
DM.Produtos_TB.FindKey([Descricao_Prod]);
DM.Produtos_TB.GotoNearest;
end;
---------------------------------------------------------------------------------------
Somando horas
var
hora1, hora2, Total: TDateTime;
begin
hora1 := StrToTime(Edit1.Text);
hora2 := StrToTime(Edit2.Text);
Total := Hora2 - Hora1;
Label5.Caption := FormatDateTime('hh:nn:ss', Total);
---------------------------------------------------------------------------------------
Duas cores no grid
Clique no DbGrid, escolha o evento DBGrid1DrawColumnCell
begin
if not odd(Query1.RecNo) then
if not (gdSelected in State) then
begin
DBGrid1.Canvas.Brush.Color := clMoneyGreen;
DBGrid1.Canvas.FillRect(Rect);
DBGrid1.DefaultDrawDataCell(rect,Column.Field,state);
end;
end;
---------------------------------------------------------------------------------------
Pinta celula atual do grid
Evento: ONDrawDataCell
begin
if gdFocused in State then
with (Sender as TDBGrid).Canvas do
begin
Brush.Color := clRed;
FillRect(Rect);
TextOut(Rect.Left, Rect.Top, Field.AsString);
end;
end;
---------------------------------------------------------------------------------------
Senha 3 tentativas
Var
Resp : Integer;
begin
if (MaskEdit_Senha.Text = '123') then
Begin
Menu_Principal_Frm.ShowModal;
Senha_Frm.Close;
end
else
Resp := Application.MessageBox('Senha incorreta ! ','Acesso negado', Mb_Ok +
Mb_IconQuestion);
MaskEdit_Senha.Clear;
Abort;
Cont := Cont + 1;
if Cont >= 3 then
Begin
if Resp = idOk then
Application.MessageBox(' Suas 3 tentativas terminaram. ' + #13 +
'Este programa será fechado.',
'Acesso negado',
Mb_Ok + Mb_IconQuestion);
Application.Terminate;
end;
end;
ou
var
Senha : String;
OK : Boolean;
Tentativa : integer;
begin
Tentativa := 0;
OK := False;
while (Tentativa < 3) do
begin
InputQuery('Digite a sua senha', 'Você tem '
+ IntToStr(3 - Tentativa) + ' tentativas', senha);
if (senha = 'Senha') then
begin
OK := True;
Break;
end;
Inc(Tentativa);
end;
if not OK then
begin
ShowMessage('Tentativas excedidas. Pressione OK para terminar.');
Application.Terminate;
end;
end;
ou
... OnClick ...
private
Cont : Integer; // variável do contador
procedure TForm1.BitBtn1Click(Sender: TObject);
Var
Resp : Integer;
begin
if (Edit1.Text = '123') then
Begin
Form2.ShowModal; // abre Menu
Form1.Close; // fecha Form da Senha
end
else
Begin
Cont := Cont + 1; // Contador da senha
Resp := Application.MessageBox(' Senha incorreta ! ',
'Acesso negado', Mb_Ok + Mb_IconQuestion);
Edit1.Clear;
if Cont >= 3 then // se for maior que 3 bie bie ...
Begin
if Resp = idOk then
Application.MessageBox(' Suas 3 tentativas terminaram. ' +
'Este programa será fechado.',
'Asta la vista - Adios - Auvidazem - Goodbye - Arividertchi',
Mb_Ok + Mb_IconQuestion);
Application.Terminate; // fecha programa
end;
end;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
Cont := 0; // zera contador
end;
---------------------------------------------------------------------------------------
Edit1.Text := FormatDateTime('dd', Now);
Edit2.Text := FormatDateTime('MM', Now);
Edit3.Text := FormatDateTime('YYYY',Now);
---------------------------------------------------------------------------------------
Confirmacao ao gravar o registro
Var
Resposta : Integer;
begin
If DM.Produtos_TB.State In [dsEdit, dsInsert] Then
Begin
Resposta := Application.MessageBox('Deseja gravar o registro atual ' ,
'Aviso', MB_YESNOCANCEL + MB_ICONQUESTION);
If Resposta = idYes then DM.Produtos_TB.Post;
If Resposta = idNo then Action := caFree;
If Resposta = idCancel then Action := caNone;
end;
---------------------------------------------------------------------------------------
Pesquisando registro
table5.CancelRange;
table5.IndexName:= 'iNumero';
try
resposta:= StrToInt(Inputbox('Pesquisa Número de Usuário',
'Entre com o número do usuário:',''));
except
Beep;
showMessage('Valor inválido! Tente novamente.');
end;
Table5.SetRangeStart;
Table5.FieldByName('Numero').Value:= resposta;
Table5.SetRangeEnd;
Table5.FieldByName('Numero').Value:= resposta;
Table5.ApplyRange;
or
Table1.SetRange ([Table2.FieldByName('Nome').AsString],
[Table2.FieldByName('Nome').AsString]);
---------------------------------------------------------------------------------------
procedure TProdutos_Frm.BitBtn2Click(Sender: TObject);
Var
Data1, Data2 : String;
begin
Rel_Prod_Frm.Table1.CancelRange;
Rel_Prod_Frm.Table1.IndexName:= 'Idata';
Data1 := Edit2.Text;
Data2 := Edit3.text;
Rel_Prod_Frm.Table1.SetRangeStart;
Rel_Prod_Frm.Table1.FieldByName('Prod_Data_Cadastro').Value := Data1;
Rel_Prod_Frm.Table1.SetRangeEnd;
Rel_Prod_Frm.Table1.FieldByName('Prod_Data_Cadastro').Value := Data2;
Rel_Prod_Frm.Table1.ApplyRange;
If Rel_Prod_Frm.Table1.RecordCount = 0 then
Begin
Application.MessageBox('Registro(s) não encontrado(s) na faixa informada',
'ATENÇÃO', MB_OK);
Edit2.SetFocus;
end
else
Rel_Prod_Frm.QuickRep1.Preview;
end;
---------------------------------------------------------------------------------------
var
num: Integer;
begin
Table4.CancelRange;
Table4.IndexName:= 'iNumero';
try
num := StrToInt(InputBox('Ir Para', 'Número do Usuário: ', ' '));
except
Beep;
showMessage('Valor inválido! Tente novamente.');
end;
Table4.Findkey([num]);
---------------------------------------------------------------------------------------
Soma
****
var
Marcador: TBookmark;
Total: tdatetime;
begin
{armazena a posição corrente, criando um novo marcador}
Marcador := Table5.GetBookmark;
Table5.DisableControls;
Total := 0;
try
Table5.First;
while not Table5.EOF do
begin
Total := Total + Table5Tempo.Value;
Table5.Next;
end;
finally
{volta ao marcador e o destrói}
Table5.GotoBookmark (Marcador);
Table5.FreeBookmark (Marcador);
Table5.EnableControls;
end;
MessageDlg ('Tempo total de acesso é ' +
FormatDateTime ('hh:mm:ss', Total) + ' horas.', mtInformation, [mbOk], 0);
end;
---------------------------------------------------------------------------------------
Confirma antes de apagar o registro
Var
Resp : Integer;
begin
Resp := Application.MessageBox('Confirme', 'Apagar registro ?',
Mb_YesNo + Mb_IconQuestion);
If Resp = IdNo then
Abort;
While Etapas_TB.RecordCount > 0 do
Etapas_TB.Delete;
---------------------------------------------------------------------------------------
Calcula percentual
Var
V1, V2, V3 : Real;
begin
If Edit1.Text = '' then
Begin
Application.MessageBox('Informe um valor.','Entrada inválida' , + Mb_ok);
Edit1.SetFocus;
end
Else
begin
V1 := StrToFloat(Edit1.Text);
V2 := StrToFloat(Edit2.Text) / 100;
V3 := (V1 * V2 + V1);
Edit3.Text := FormatFloat('###,####0.00' , V3/100);
end;
end;
ou
Var
V1, V2, V3 : Real;
Function RetiraPontos(s : String) : String;
var i : integer;
begin
i := pos('.' , s);
While i > 0 do begin
Delete(s , i , 1);
i := Pos('.' , s);
end;
Result := s;
end;
begin
If Edit1.Text = '' then
Begin
Application.MessageBox('Informe um valor.','Entrada inválida' , + Mb_ok);
Edit1.SetFocus;
end
Else
begin
V1 := StrToFloat(RetiraPontos(Edit1.Text));
V2 := StrToFloat(RetiraPontos(Edit2.Text)) / 100;
V3 := (V1 * V2 + V1);
Edit3.Text := FormatFloat('###,####0.00' , V3/100);
end;
end;
--- arredondando
Var
BookMark : TBookMark;
Total : Real;
begin
BookMark := Table1.GetBookmark;
Table1.DisableControls;
Total := 0;
Try
Table1.First;
While not Table1.Eof do
Begin
Table1.Edit;
Total := Round (Table1Salario.Value * StrToInt(Edit1.Text) / 100);
Table1Salario.Value := Total + Table1Salario.Value;
Table1.Next;
end;
Finally
Table1.GotoBookMark (BookMark);
Table1.FreeBookMark (BookMark);
Table1.EnableControls;
end;
---------------------------------------------------------------------------------------
Var
Frase, Parte : String;
begin
Frase := 'Você está aprendendo';
Parte := Copy(Frase,1,4);
Edit1.Text := Parte;
Parte := Copy(Frase,6,4);
Edit2.Text := Parte;
Parte := Copy(Frase,11,10);
Edit3.Text := Parte;
end;
ou ---
Var
Frase, Parte : String;
begin
Frase := 'Você está aprendendo';
Edit4.Text := Frase;
If Pos('está', Frase) > 0 then
Showmessage('Existe a palavra : ' + Copy(Frase,6,4));
end;
---
vAR
S : string;
X : Integer;
begin
X := 10 * 20;
S := Format('Resultado é: %d', [X]);
Label3.Caption := S;
end;
---
var
S1 : string;
S2 : string;
begin
S1 := 'Mike Allan';
S2 := 'Pellin';
Label4.Caption := S1 + ' ' + S2;
end;
---
Var
X : Integer;
Y : Integer;
begin
X := 20;
Y := 5;
Label6.Caption := Format('%d + %d = %d', [X, Y, X + Y]);
---
var
Nr1, Nr2, Resultado : Real;
begin
Nr1 := StrTofloat(Edit7.text);
Nr2 := StrTofloat(Edit8.text);
Resultado := (Nr1 * (Nr2/100));
Nr1 := Nr1 + Resultado;
Edit9.text := FormatFloat('#,##0.00;(#,##0.00)',Nr1);
Edit10.Text := FloatToStr(Nr1);
end;
---
Var
Total1, Total2, Total_Final : Integer;
begin
Total1 := StrToInt(Edit1.Text);
Total2 := StrToInt(Edit2.Text);
Total_Final := (Total1 + Total2);
Edit3.Text := IntToStr(Total_Final);
Edit3.Text := FormatFloat('##,#',Total_Final);
end;
---------------------------------------------------------------------------------------
Calculando
var
A, B, R: Integer;
begin
A := StrToInt(Edit1.Text);
B := StrToInt(Edit2.Text);
R := A + B;
if (R >= 10) then
ShowMessage('Resultado = ' + IntToStr(R + 5))
else
ShowMessage('Resultado = ' + IntToStr(R - 10));
---------------------------------------------------------------------------------------
Somando
var
Tabela : TTable; // variável Tabela
Total_Pecas : Integer; // varável
Total_Valor : Currency;
begin
// Pega o ponteiro para a Tquery atual;
Tabela := TTable(DBNavigator1.DataSource.DataSet);
Total_Pecas := 0;
Total_Valor := 0;
Tabela.First; // Primeiro registro
While not Tabela.Eof do // enquanto não for FIM DO ARQUIVO (eof)
Begin
// Qtde = é o nome do campo definido na TABELA
// Total_Cal = é um campo Criado somente para fazer o calculo, não é campo de tabela
Total_Pecas := Total_Pecas + Tabela['Qtde'];
Total_Valor := Total_Valor + Tabela['Total_Cal'];
Tabela.Next; // lê o próximo registro
End;
Label1.Caption := 'Qtde : ' + FormatFloat('', Total_Pecas);
Label2.Caption := FormatCurr('#,##0.00',Total_Valor);
Label2.Caption := 'Total : ' + CurrencyString + ' ' + Label2.Caption;
// Conta registros na tabela
Label3.Caption := 'Total de regs: ' + IntToStr(Tabela.RecordCount);
end;
---------------------------------------------------------------------------------------
Var
Valor1, Valor2 : Real;
begin
Valor1 := StrToFloat(Edit1.Text);
Valor2 := StrToFloat(Edit2.Text);
Edit3.Text := FormatFloat('###.00', (Valor1 - Valor2));
end;
---------------------------------------------------------------------------------------
Informações da memória - hd
const
cBytesPorMb = 1024 * 1024;
var
M: TMemoryStatus;
begin
M.dwLength := SizeOf(M);
GlobalMemoryStatus(M);
Memo1.Clear;
with Memo1.Lines do begin
Add(Format('Memória em uso: %d%%', [M.dwMemoryLoad]));
Add(Format('Total de memória física: %f MB', [M.dwTotalPhys / cBytesPorMb]));
Add(Format('Memória física disponível: %f MB', [M.dwAvailPhys / cBytesPorMb]));
Add(Format('Tamanho máximo do arquivo de paginação: %f MB', [M.dwTotalPageFile / cBytesPorMb]));
Add(Format('Disponível no arquivo de paginação: %f MB', [M.dwAvailPageFile / cBytesPorMb]));
Add(Format('Total de memória virtual: %f MB', [M.dwTotalVirtual / cBytesPorMb]));
Add(Format('Memória virtual disponível: %f MB', [M.dwAvailVirtual / cBytesPorMb]));
end;
end;
---------------------------------------------------------------------------------------
Splash screen
{$R *.RES}
begin
Application.Initialize;
//-------------------------------------------------
Application.Title := 'Objetivos';
Form_Abertura := TForm_Abertura.Create(nil);
Form_Abertura.Show;
Form_Abertura.Update;
//-------------------------------------------------
Application.CreateForm(TPrincipalForm, PrincipalForm);
Application.CreateForm(TObjetivoForm, ObjetivoForm);
Application.CreateForm(TDM, DM);
Application.CreateForm(TEtapasForm, EtapasForm);
Application.CreateForm(TSelRelForm, SelRelForm);
Application.CreateForm(TTudoRelQrpt, TudoRelQrpt);
Application.CreateForm(TDataConcRelQrpt, DataConcRelQrpt);
Application.CreateForm(TSituacaoDataConQrpt, SituacaoDataConQrpt);
Application.CreateForm(TResponsaveisForm, ResponsaveisForm);
Application.CreateForm(TPorRespRelQrpt, PorRespRelQrpt);
Application.CreateForm(TForm_Abertura, Form_Abertura);
//-------------------------------------------------
Form_Abertura.Hide;
Form_Abertura.Free;
//-------------------------------------------------
Application.Run;
end.
---------------------------------------------------------------------------------------
Liga e desliga o monitor
SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 0);
Sleep(5000);
SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 1);
Sleep(5000);
---------------------------------------------------------------------------------------
Se algum registro foi alterado e se tentar fechar o formulário
será pedido confirmação
procedure TfmProdutos.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Clientes_TB.State in [dsEdit, dsInsert] then begin
ShowMessage('Salve o Registro para poder sair');
Action := caNone;
end
else
Action := caFree;
end;
---------------------------------------------------------------------------------------
procedure TfmProdutos.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
(* Quando a tecla enter for pressionada, o próximo controle receberá o Foco *)
Case key Of
13 : Begin
Key := 0;
SelectNext(ActiveControl,True,True);
end;
end;
end;
---------------------------------------------------------------------------------------
Pesquisando registro
procedure TfmClientes.SpeedButton1Click(Sender: TObject);
begin
(* FindKey -> Procurar pela Chave Primária, Código do Cliente *)
if Not Clientes_TB.FindKey([Edit1.Text]) then
ShowMessage('Registro não Encontrado');
end;
---------------------------------------------------------------------------------------
Pesquisando registro
procedure TfmClientes.SpeedButton2Click(Sender: TObject);
begin
(* Locate -> Procurar por qualquer campo string, Nome *)
Clientes_TB.IndexName := 'NomeCliente';
(* NomeCliente -> Índice Secundário da tabela clientes *)
(* Utilizado para ordenar a tabela Clietes por Nome, para agilizar a consulta *)
(* porque o metodo locate realiza uma busca sequencial *)
if Not Clientes_TB.Locate('Nome', Edit1.Text, [loPartialkey, loCaseInsensitive]) then
ShowMessage('Registro não Encontrado');
Clientes_TB.IndexName := '';
end;
---------------------------------------------------------------------------------------
Crianco função de data e hora
implementation
{$R *.DFM}
function MostraHora: string;
begin
MostraHora := TimeToStr(Time);
end;
function MostraData: string;
var
dtHoje: TDateTime;
intDiaSemana: integer;
strDiaSemana: string;
begin
dtHoje := Date;
intDiaSemana := DayOfWeek(dtHoje);
case intDiaSemana of
1: strDiaSemana := 'Domingo - ';
2: strDiaSemana := 'Segunda-feira - ';
3: strDiaSemana := 'Terça-feira - ';
4: strDiaSemana := 'Quarta-feira - ';
5: strDiaSemana := 'Quinta-feira - ';
6: strDiaSemana := 'Sexta-feira - ';
7: strDiaSemana := 'Sábado - ';
end;
MostraData := strDiaSemana+DateToStr(dtHoje);
end;
procedure TformRelogio.tmrRelogioTimer(Sender: TObject);
begin
lblHora.Caption := MostraHora();
lblData.Caption := MostraData();
end;
procedure TformRelogio.btnOKClick(Sender: TObject);
begin
Close;
end;
procedure TformRelogio.FormShow(Sender: TObject);
begin
lblHora.Caption := '';
lblData.Caption := '';
end;
---------------------------------------------------------------------------------------
procedure TForm1.Table1CalcFields(DataSet: TDataSet);
begin
Table1Prod_Total.Value := (Table1Prod_Qtde.Value * Table1Prod_Preco.Value);
Table1Prod_Percentual.Value := Trunc((Table1Prod_Qtde.Value / 100 ) +
Table1Prod_Preco.Value);
// Trunc - arredonda percentual
end;
---------------------------------------------------------------------------------------
Apagando todos os registros da tabela
procedure TForm1.Button2Click(Sender: TObject);
begin
{Abrir a tabela em modo exclusivo}
Try
With Table1 Do
Begin
Active :=False;
Exclusive:=True;
Active :=True;
Try
EmptyTable;
Except
ShowMessage( 'Não é possível limpar a tabela');
End;
End
Except
ShowMessage('Não é possível abrir a tabela em modo exclusivo');
End
end;
---------------------------------------------------------------------------------------
procedure TForm1.BitBtn1Click(Sender: TObject);
Var
x : string ;
begin
x := 'Jurandir';
edit1.text := Format( 'My name is %s and I am %d years old', [ x, 36 ] )
end;
Resultado: My name is Jurandir and I am 36 years old
---------------------------------------------------------------------------------------
Resultado de uma soma num campo
var
x: real;
begin
table1.open;
table1.first;
while not table1.eof do
begin
x:= x + table1Salario.asfloat; // salario é o campo da tabela
table1.next;
end;
label1.caption:=trim(format('%7.2f',[x]));
table1.close;
end;
---------------------------------------------------------------------------------------
Verificando estado da tabela
Function CheckState(ATable: TTable): String;
// Checa o estado de uma tabela
var
strMessage : String[48];
wrdMessageResult : word;
begin
ATable.UpdateRecord;
if ( ATable.Modified ) and ( ATable.State <> dsSetKey ) then
begin
if ATable.State = dsEdit then
begin
strMessage := 'Editando registro, ';
end;
if ATable.State = dsInsert then
begin
strMessage := 'Inserindo registro, ';
end;
if ATable.State = dsFilter then
begin
strMessage := 'Filtrando registros, ';
end;
if ATable.State = dsInactive then
begin
strMessage := 'Ociosa ';
end;
end
else
begin
strMessage := 'Tabela não está em modo de Atualização de dados';
ATable.Cancel;
end;
Result := strMessage;
end;
---------------------------------------------------------------------------------------
Colorindo linha no grid
Put the code in the onDrawColumnCell event and watch it happen
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
if (gdSelected in State) then
begin
DBGrid1.Canvas.Font.Color := clPurple;
DBGrid1.Canvas.Brush.Color := clLime;
DBGrid1.Canvas.FillRect(Rect);
DBGrid1.Canvas.TextOut(Rect.Left, Rect.Top,Column.Field.AsString);
end
else
begin
DBGrid1.Canvas.Font.Color := clBlue;
DBGrid1.Canvas.Brush.Color := clAqua;
DBGrid1.Canvas.FillRect(Rect);
DBGrid1.Canvas.TextOut(Rect.Left, Rect.Top,Column.Field.AsString);
end;
end;
---------------------------------------------------------------------------------------
Sair do sistema ?
procedure TFrmPrincipal.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := False;
With Application do
if MessageBox('Sair do Sistema?','Aviso',Mb_OkCancel) = IDOk then
CanClose := True;
end;
---------------------------------------------------------------------------------------
Formatando um Currency
var
soma : Currency;
begin
soma := 1234.567;
// Mostrando um Currency formatado
CurrencyString := 'R$ ';
ShowMessage('Usando 4 digitos = '+CurrToStrF(soma, ffCurrency, 4));
ShowMessage('Usando 2 digitos = '+CurrToStrF(soma, ffCurrency, 2));
ShowMessage('Usando 0 digitos = '+CurrToStrF(soma, ffCurrency, 0));
end;
Serão mostradas as seguintes Messages
Usando 4 digitos = R$ 1.234,5670
Usando 2 digitos = R$ 1.234,57
Usando 0 digitos = R$ 1.235
---------------------------------------------------------------------------------------
Exluir este registro?
procedure TF_Cheque_S.BitBtn4Click(Sender: TObject);
var
opc:integer;
begin
opc := application.MessageBox('Deseja Realmente Excluir?','Excluir Registro'
,mb_yesno+mb_iconquestion);
if opc = idyes then
f_dados.T_Cheque_s.Delete;
end;
---------------------------------------------------------------------------------------
procedure TF_Cheque_S.Combo1Exit(Sender: TObject);
begin
if combo1.text <> '' then
begin
F_Dados.T_Banco.Open;
If not F_Dados.T_Banco.FindKey([Combo1.Text]) Then
begin
application.MessageBox('O Banco Solicitado Não Está Cadastrado',
'Informação do Sistema',mb_iconinformation);
Combo1.SetFocus;
end
Else
begin
Edit1.text := F_dados.t_bancoNome.Value;
Edit5.Setfocus;
end;
end
else
edit1.text := '';
end;
---------------------------------------------------------------------------------------
procedure TfrmIncBanco.btnIncluirClick(Sender: TObject);
begin
{Será mostrada uma mensagem pedindo a confirmação da inclusão}
If Application.MessageBox('Confirma a Inclusão deste Banco?',
'Confirmação',mb_YesNo + mb_IconQuestion) = idYes then
try
{Caso a inclusão seja confirmada, então será gravada um novo Banco}
frmBanco.tblBanco.Post;
except
on EDBEngineError do
begin
Application.MessageBox('Já existe um Banco cadastrado com este número' +
Chr(13) + 'Não é possível incluir este Banco.', 'Erro', mb_Ok + mb_IconError);
frmBanco.Close;
end;
end;
{Fecha o Formulário}
Self.Close;
end;
---------------------------------------------------------------------------------------
Evento: OnValidate
procedure TForm1.Table1CompanyValidate(Sender: TField);
begin
if Sender.AsString='' then
Raise EDatabaseError.Create('Preencha os campos Obrigatorios');
end;
---------------------------------------------------------------------------------------
OnKeyPress
if not (key in ['0'..'9',char(VK_BACK),char(VK_RETURN)]) then
key := #0;
---------------------------------------------------------------------------------------
Apagando todos os registros
procedure TDM.Socios_TBBeforeDelete(DataSet: TDataSet);
begin
{ If Application.MessageBox('Confirme a exclusão ? ', 'Apagando registro',
Mb_YesNo + Mb_IconQuestion) = IdNo Then
Raise EAbort.Create(''); // aborta operacao }
While Dependentes_TB.RecordCount > 0 do
Dependentes_TB.Delete; // apaga Dependentes
While DataEncostado_TB.RecordCount > 0 do
DataEncostado_TB.Delete; // apaga Encostados
---------------------------------------------------------------------------------------
Criando alias
procedure TDM_Dados.DataModuleCreate(Sender: TObject);
var // Cria alias
Dir_Atual : String;
Const
Nome_Alias = 'Defeitos';
begin
if not Session.IsAlias(Nome_Alias) then
begin
Dir_Atual := ExtractFilePath(Application.ExeName);
Session.AddStandardAlias(Nome_Alias,Dir_Atual+'Dados\','PARADOX');
Session.SaveConfigFile;
end;
Defeitos_TB . Open;
Grupos_TB . Open;
Relogios_TB . Open;
Lotes_TB . Open;
Revisoes_TB . Open;
end;
---------------------------------------------------------------------------------------
Filtrando data no grid
procedure TFilter_Frm.Ok_BitClick(Sender: TObject);
var
DataI, DataF : TDatetime;
begin
Try
DataI := StrToDate(MaskEdit1.text); // data inicial
Except
Showmessage('Data inicial inválida.');
MaskEdit1.SetFocus;
exit;
end;
Try
DataF := StrToDate(MaskEdit2.text); // data final
Except
Showmessage('Data final inválida.');
MaskEdit2.SetFocus;
Exit;
end;
with Filter_Frm.table1 do // filtro e visualização de dados
begin
Close;
Filter := 'Clie_Data_Nasc >=' + #39 + FormatDateTime('dd/mm/yyyy' , DataI)
+ #39 +
' and Clie_Data_Nasc <=' + #39 + FormatDateTime('dd/mm/yyyy' ,
DataF + 1) + #39;
Filtered := True;
Open;
end;
end;
---------------------------------------------------------------------------------------
Evita perda de dados
Uses BDE
procedure TForm1.Table1AfterPost(DataSet: TDataSet);
begin
DbiSaveChanges(Table1.Handle);
end;
---------------------------------------------------------------------------------------
Valida antes de gravar reg
if Func_TBFunc_Data_Nasc.IsNull then
Try
Begin
Application.MessageBox('Digite um DATA válida !' , 'A T E N Ç Ã O !' ,
Mb_OK+Mb_IconWarning);
Raise EAbort.Create('');
end;
Finally
EditFunc_Data_Nasc.SetFocus;
End;
---------------------------------------------------------------------------------------
Limpando todos os campos
var i : integer;
begin
for i := 0 to ComponentCount-1 do
begin
If Components[i].ClassName = 'TEdit' then
//Tedit(Components[i]).clear;
TEdit(components[i]).text:= ''
end;
end;
---------------------------------------------------------------------------------------
Evento: onvalidate
if DSBasico.State in [dsEdit, dsInsert] then
if TabBasicoConf.FindKey([TabBasicoNOM_DISCO]) then
begin
F_Basico.EditNOM_DISCO.SetFocus;
raise Exception.Create('Nome do CD duplicado'#10+
'Click no botão "Localiza" em caso de dúvida');
end;
---------------------------------------------------------------------------------------
Validando campo no evento onkeydown
begin
If Key = Vk_Return then
If Edit.Text = '' then
Begin
Application.MessageBox('Informe o nome de uma empresa', 'Erro', Mb_ok);
Edit.Setfocus
end
else
Perform(Wm_NextDlgCtl,0,0);
end;
---------------------------------------------------------------------------------------
Data no statusbar
procedure TfrmPrincipal.Timer1Timer(Sender: TObject);
begin
StatusBar1.Panels[2].Text:=FormatDateTime('dddd ", " dd " de " mmmm " de " yyyy',Now());
//StatusBar1.Panels[1].Text:= TimeToStr(Time);
StatusBar1.Panels[1].Text:=FormatDateTime('hh":"nn":"ss"',Now());
end;
---------------------------------------------------------------------------------------
Relatorio
Var
Resp : Integer; a
Data1, Data2 : Tdate;
begin
If (Edit5.Text = '') or (Edit6.Text = '') then
Begin
Application.MessageBox('Digite uma data ...',
'Previsualizar', Mb_Ok + Mb_IconError);
if Edit5.Text = '' then
Edit5.SetFocus // retorna ao campo data inicial
else
Edit6.SetFocus;
Exit;
end;
Data1 := StrToDate(Edit5.Text);
Data2 := StrToDate(Edit6.Text);
Clientes_TB.Open; // abre tabela
Clientes_TB.IndexName := 'Idata_Nasc'; // índice secundário
Clientes_TB.SetRange([Data1],[Data2]);
QReport_Clientes_Todos.ReportTitle := 'Cadastro de Clientes';
if Clientes_TB.RecordCount > 0 then
Begin
Resp := Application.MessageBox('Deseja previsualizar impressão ?',
'Previsualizar', Mb_YesNo+Mb_IconQuestion);
if Resp = idyes then
QReport_Clientes_Todos.Preview;
if Resp = idNo then
QReport_Clientes_Todos.Print;
end
else
Begin
Application.MessageBox('Não há registros ! ','Erro !',
Mb_Ok + Mb_IconQuestion);
Exit;
end;
end;
---------------------------------------------------------------------------------------
Relatório
Var
Resp : Integer;
Data1, Data2 : Tdate;
begin
If (Edit5.Text = '') or (Edit6.Text = '') then
Begin
Application.MessageBox('Digite uma data ...',
'Previsualizar', Mb_Ok + Mb_IconError);
if Edit5.Text = '' then
Edit5.SetFocus
else
Edit6.SetFocus;
Exit;
end;
Data1 := StrToDate(Edit5.Text);
Data2 := StrToDate(Edit6.Text);
Clientes_TB.Open;
Clientes_TB.IndexName := 'Idata_Nasc';
Clientes_TB.SetRange([Data1],[Data2]);
QReport_Clientes_Todos.ReportTitle := 'Cadastro de Clientes';
if Clientes_TB.RecordCount > 0 then
Begin
Resp := Application.MessageBox('Deseja previsualizar impressão ?',
'Previsualizar', Mb_YesNo+Mb_IconQuestion);
if Resp = idyes then
QReport_Clientes_Todos.Preview;
if Resp = idNo then
QReport_Clientes_Todos.Print;
end
else
Begin
Application.MessageBox('Não há registros ! ','Erro !',
Mb_Ok + Mb_IconQuestion);
Exit;
end;
end;
---------------------------------------------------------------------------------------
Formatando data e hora
unit Unit1;
interface
uses
SysUtils, // Unit containing the FormatDateTime command
DateUtils,
Forms, Dialogs;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm} // Include form definitions
procedure TForm1.FormCreate(Sender: TObject);
var
myDate : TDateTime;
begin
// Set up our TDateTime variable with a full date and time
myDate := StrToDateTime('09/02/49 01:02:03.004');
// Demonstrate default locale settings
// Use the DateSeparator and TimeSeparator values
ShowMessage('dd/mm/yy hh:mm:ss = '+
FormatDateTime('dd/mm/yy hh:mm:ss', myDate));
// Use ShortMonthNames
ShowMessage(' mmm = '+FormatDateTime('mmm', myDate));
// Use LongMonthNames
ShowMessage(' mmmm = '+FormatDateTime('mmmm', myDate));
// Use ShortDayNames
ShowMessage(' ddd = '+FormatDateTime('ddd', myDate));
// Use LongDayNames
ShowMessage(' dddd = '+FormatDateTime('dddd', myDate));
// Use the ShortDateFormat string
ShowMessage(' ddddd = '+FormatDateTime('ddddd', myDate));
// Use the LongDateFormat string
ShowMessage(' dddddd = '+FormatDateTime('dddddd', myDate));
// Use the TimeAmString
ShowMessage(' hhampm = '+FormatDateTime('hhampm', myDate));
// Use the ShortTimeFormat string
ShowMessage(' t = '+FormatDateTime('t', myDate));
// Use the LongTimeFormat string
ShowMessage(' tt = '+FormatDateTime('tt', myDate));
// Use the TwoDigitCenturyWindow
ShowMessage(' dd/mm/yyyy = '+FormatDateTime('dd/mm/yyyy', myDate));
ShowMessage('');
// Now change the defaults
DateSeparator := '-';
TimeSeparator := '_';
ShortDateFormat := 'dd/mmm/yy';
LongDateFormat := 'dddd dd of mmmm of yyyy';
TimeAMString := 'morning';
TimePMString := 'afternoon';
ShortTimeFormat := 'hh:mm:ss';
LongTimeFormat := 'hh : mm : ss . zzz';
ShortMonthNames[2] := 'FEB';
LongMonthNames[2] := 'FEBRUARY';
ShortDayNames[4] := 'WED';
LongDayNames[4] := 'WEDNESDAY';
TwoDigitYearCenturyWindow := 75;
// Use the DateSeparator and TimeSeparator values
ShowMessage('dd/mm/yy hh:mm:ss = '+FormatDateTime('dd/mm/yy hh:mm:ss', myDate));
// Use ShortMonthNames
ShowMessage(' mmm = '+FormatDateTime('mmm', myDate));
// Use LongMonthNames
ShowMessage(' mmmm = '+FormatDateTime('mmmm', myDate));
// Use ShortDayNames
ShowMessage(' ddd = '+FormatDateTime('ddd', myDate));
// Use LongDayNames
ShowMessage(' dddd = '+FormatDateTime('dddd', myDate));
// Use the ShortDateFormat string
ShowMessage(' ddddd = '+FormatDateTime('ddddd', myDate));
// Use the LongDateFormat string
ShowMessage(' dddddd = '+FormatDateTime('dddddd', myDate));
// Use the TimeAmString
ShowMessage(' hhampm = '+FormatDateTime('hhampm', myDate));
// Use the ShortTimeFormat string
ShowMessage(' t = '+FormatDateTime('t', myDate));
// Use the LongTimeFormat string
ShowMessage(' tt = '+FormatDateTime('tt', myDate));
// Use the TwoDigitCenturyWindow
ShowMessage(' dd/mm/yyyy = '+
FormatDateTime('dd/mm/yyyy', myDate));
end;
end.
Hide full unit code
dd/mm/yy hh:mm:ss = 09/02/49 01:02:03
mmm = Feb
mmmm = February
ddd = Tue
dddd = Tuesday
ddddd = 09/02/2049
dddddd = 09 February 2049
hhampm = 01AM
t = 01:02
tt = 01:02:03
dd/mm/yyyy = 09/02/2049
dd/mm/yy hh:mm:ss = 09-02-49 01_02_03
mmm = FEB
mmmm = FEBRUARY
ddd = WED
dddd = WEDNESDAY
ddddd = 09-FEB-49
dddddd = WEDNESDAY 09 of FEBRUARY of 1949
hhampm = 01morning
t = 01_02_03
tt = 01 _ 02 _ 03 . 004
dd/mm/yyyy = 09-02-1949
---------------------------------------------------------------------------------------
Pula de campo se estiver vazio
If Key = Vk_Return then
If EditNome_Empresa.Text = '' then
Begin
Application.MessageBox('Informe o nome de uma empresa',
'Erro: Empresa', Mb_ok);
EditNome_Empresa.Setfocus
end
else
Perform(Wm_NextDlgCtl,0,0);
---------------------------------------------------------------------------------------
Validando campo
If Pedido_Desligamento_Frm.DBLookupComboBox1.Text = '' then
begin
Application.MessageBox('Favor informar um sócio ',
' Erro ', Mb_Ok + Mb_IconQuestion);
Pedido_Desligamento_Frm.DBLookupComboBox1.Setfocus;
Exit;
end
---------------------------------------------------------------------------------------
Aceita somente numero e backspace
procedure TSocios_Frm.Edit_LocalizaKeyPress(Sender: TObject;
var Key: Char);
begin
if not (Key in [#8, '0'..'9']) then
begin
Application.MessageBox('Caracter inválido, só aceito números',
'Entrada inválida' , + Mb_ok);
Key := #0;
Edit_Localiza.SetFocus;
end;
end;
---------------------------------------------------------------------------------------
Aceita numeros e letras
Evento: OnKeyPress
begin
Key := UpCase(Key) ;
if not (Key in [#8, 'A'..'Z','0'..'9','-']) then
begin
Application.MessageBox('Caracter inválido', 'Erro' , + Mb_ok);
Key := #0;
end;
end;
---------------------------------------------------------------------------------------
Formatando
Var
V1, V2, T1 : Real; // variáveis
begin
Entra_Cor(Sender);
V1 := StrToFloat(Das_Terras1_Edit.Text); // converte texto para flutuante
V2 := StrToFloat(Das_Terras2_Edit.Text);
T1 := (V1 + V2);
Das_Terras3_Edit.Text := FormatFloat('#,##0.00;(#,##0.000)' , T1);
Das_Terras1_Edit.Text := FormatFloat('#,##0.00;(#,##0.000)' , V1);
end;
---------------------------------------------------------------------------------------
Pesquisa por data
var
resposta: tdatetime;
begin
table1.CancelRange;
table1.IndexName:= 'iData';
Try
resposta := StrToDate(InputBox('Pesquisa Data de Admissão',
'Entre com a data de adminissão do Funcionário: ', ' '));
Except
Beep;
showMessage('Data inválida! Tente novamente.');
end;
Table1.SetRangeStart;
Table1.FieldByName('Data').Value:= resposta;
Table1.SetRangeEnd;
Table1.FieldByName('Data').Value:= resposta;
Table1.ApplyRange;
end;
---------------------------------------------------------------------------------------
Status bar
begin
If dmDados.tabGrupo.State in [ dsEdit ] then
Statusbar1.panels[0].text := 'Alterando' else
If dmDados.tabGrupo.State in [ dsInsert ] then
Statusbar1.panels[0].text := 'Incluindo'
Else
Statusbar1.panels[0].text := 'Consultando';
end;
---------------------------------------------------------------------------------------
S Q L
Retorna data do dia
Query.Close;
Query.SQL.Text := 'select * from Tabela where CampoData <= :Hoje';
Query.ParamByName('Hoje').AsDate := Date;
Query.Open;
---------------------------------------------------------------------------------------
Procura pelo nome
if Edit2.Text <> '' then
begin
QrEmp.Close;
QrEmp.SQL.Clear;
QrEmp.SQL.Add('SELECT EmpNo,FirstName,LastName,Salary FROM employee');
QrEmp.SQL.Add('WHERE UPPER(FirstName) LIKE :Nome');
QrEmp.ParamByName('Nome').AsString := UpperCase(Edit2.Text) + '%';
QrEmp.Open;
end
---------------------------------------------------------------------------------------
Filtrando datas
If DateTimePicker2.Date < DateTimePicker1.Date Then
begin
ShowMessage('Intervalo de datas inválido, a data inicial é maior que a data final!');
DateTimePicker2.Date := DateTimePicker1.Date;
end
Else
begin
Inicio := DateToStr(DateTimePicker1.Date);
Final := DateToStr(DateTimePicker2.Date);
Query1.Close;
Query1.SQL.Clear;
Query1.SQL.Text := 'SELECT Nome,Empresa,FoneRes,FoneCom,Mala FROM Contatos WHERE Data >=:pInicial and Data<=:pFinal ORDER BY Nome';
Query1.ParamByName('pInicial').AsDateTime := StrToDate(Inicio);
Query1.ParamByName('pFinal').AsDateTime := StrToDate(Final);
Query1.Prepare;
Query1.Open;
DBGrid3D1.SetFocus
end;
Label3.Caption := 'Total de contatos: ' + IntToStr(Query1.RecordCount)
---------------------------------------------------------------------------------------
Procura pelo mes
Query1.Close;
Query1.SQL.Clear;
Query1.SQL.Add('select * from dCli');
Query1.SQL.Add('where extract(month from DataNasc) = :Mes');
Query1.ParamByName('Mes').AsInteger := StrToInt(Edit1.Text);
Query1.Open;
---------------------------------------------------------------------------------------
Procura por qualquer letra digitada
Query1.Close;
Query1.Sql.Clear;
Query1.Sql.Add('Select Clie_Codigo, Clie_Nome From Clientes ');
Query1.Sql.Add('Where Clie_Nome Like ' + '''' + '%' + Edit1.Text + '%'+'''');
Query1.Open;
---------------------------------------------------------------------------------------
Somando salários
Query1.Close;
Query1.SQL.Clear;
Query1.SQL.Add('Select Sum(Clie_Salario) AS Total_Salario From Clientes');
Query1.Open;
Edit4.Text := Query1.FieldByName('Total_Salario').AsString;
---------------------------------------------------------------------------------------
Procura por qualquer letra digitado no Edit1
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
Query1.Close;
Query1.Sql.Add('Select Teste1.Codigo, Teste1.Nome');
Query1.Sql.Add('From Teste1 ');
Query1.Sql.Add('Where ');
Query1.Sql.Add('(Teste1.Nome like :Nome1) ');
Query1.Params[0].AsString := ‘%’+Edit1.Text+’%’;
query1.Open;
end;
---------------------------------------------------------------------------------------
Lista intervalo de datas
begin
With Query1 do
Begin
Close;
ParamByName('VarDataI').AsDate:=Data1.Date;
ParamByName('VarDataF').AsDate:=Data2.Date;
Prepare;
Open;
End;
If (Query1.RecordCount=1) and (Query1total.Value=0) then
ShowMessage('Não Existe Vendas Neste Período Informado!');
end;
---
Select
i.descricao, sum(valor_total) as total
From
db_itens as i
Where
data between :VarDataI and :VarDataF
Group by
i.descricao
---------------------------------------------------------------------------------------
Comandos em SQL, para localizar um Fornecedor que tenha pelo menos em uma parte
do seu nome, o conteúdo do objeto txtLocalizar.Text
Close;
SQL.Clear;
SQL.Add('Select * from Fornecedor Where UPPER(Fornecedor) LIKE UPPER(''%'' + :1 + ''%'')');
Params[0].AsString := Self.Edit1.Text;
Open;
---------------------------------------------------------------------------------------
If DateTimePicker2.Date < DateTimePicker1.Date Then
begin
ShowMessage('Intervalo de datas inválido, a data inicial é maior que a data final!');
DateTimePicker2.Date := DateTimePicker1.Date;
end
Else
begin
Inicio := DateToStr(DateTimePicker1.Date);
Final := DateToStr(DateTimePicker2.Date);
Query1.Close;
Query1.SQL.Clear;
Query1.SQL.Text := 'SELECT Nome,Empresa,FoneRes,FoneCom,Mala FROM Contatos WHERE Data >=:pInicial and Data<=:pFinal ORDER BY Nome';
Query1.ParamByName('pInicial').AsDateTime := StrToDate(Inicio);
Query1.ParamByName('pFinal').AsDateTime := StrToDate(Final);
Query1.Prepare;
Query1.Open;
DBGrid3D1.SetFocus
end;
Label3.Caption := 'Total de contatos: ' + IntToStr(Query1.RecordCount)
---------------------------------------------------------------------------------------
With Query1 do
Begin
Close;
ParamByName('Dta_Inicial').AsDate := DateTimePicker1.Date;
ParamByName('Dta_Final').AsDate := DateTimePicker1.Date;
Prepare;
Open;
End;
If (Query1.RecordCount = 0) then
ShowMessage('Não existe registros neste período');
---------------------------------------------------------------------------------------
Deletar/ Del com QUERY
QExclui.Close;
QExclui.Sql.Clear;
QExclui.SQL.Add('DELETE FROM TBEXEMPLO WHERE (TBEXEMPLO.CodigoP = :EdCodigoP) AND ' +
'(TBEXEMPLO.CodigoS = :EdCodigoS) ');
QExclui.PARAMBYNAME('EdCodigo').AsInteger := 1;
QExclui.PARAMBYNAME('EdCodigoS').AsInteger := 5;
QExclui.ExecSQL;
---------------------------------------------------------------------------------------
Procura por letras e data
With Query1 do
Begin
Close;
ParamByName('NomeX').AsString := '%' + Edit1.Text + '%';
ParamByName('Dta_Inicial').AsDate := DateTimePicker1.Date ;
ParamByName('Dta_Final').AsDate := DateTimePicker2.Date;
Prepare;
Open;
end;
If Query1.RecordCount = 0 then
Begin
Application.MessageBox('Favor informar um CÓDIGO', 'Erro',
+ Mb_ok + Mb_IconWarning);
end;
---------------------------------------------------------------------------------------
Begin
Query1.Close;
Query1.SQL.Clear;
Query1.SQL.Add('SELECT * FROM Clientes');
Query1.SQL.Add('WHERE Upper(Clientes.Clie_Nome) LIKE Upper(:Xnome)');
Query1.ParamByName('Xnome').AsString := Edit1.Text;
Query1.Open;
end;
---------------------------------------------------------------------------------------
begin
Query1.Close;
Query1.SQL.Clear;
Query1.SQL.Add('SELECT * FROM Clientes WHERE Clie_Nome = ' + QuotedStr(Edit1.Text));
Query1.Open;
end;
---------------------------------------------------------------------------------------
Soma salario
procedure TForm1.Bit_OkClick(Sender: TObject);
begin
Query1.Close;
Query1.SQL.Clear;
Query1.SQL.Add('SELECT Sum(Clie_Salario) Soma_Total FROM Clientes.db');
Query1.Open;
Edit1.Text := Query1.FieldByName('Soma_Total').AsString;
Label1.Caption := Query1.FieldByName('Soma_Total').AsString;
end;
---------------------------------------------------------------------------------------
var
Resposta : String;
ClickedOK : Boolean;
// InputQuery - Usado para saber o qual botão foi pressionado.
// Resposta Boleana V ou Falsa para ClickedOk, ClickedCancel.
begin
ClickedOK := InputQuery('Digite um código','Código', Resposta);
if ClickedOK then
begin
if Resposta = '' then
begin
Application.MessageBox('Nenhum valor foi digitado...','Atenção',+ Mb_OK);
DM_Qr.Query4.Active := False;
Exit;
end
end
else
begin
Application.MessageBox('A procura foi Cancelada..','Atenção',+ Mb_OK);
DM_Qr.Query4.Active := False;
Exit;
end;
if Resposta <> '' then
begin
DM_Qr.Query4.DatabaseName := '07_maio_marcos';
DBGrid1.DataSource := DataSource4;
DataSource4.DataSet := DM_Qr.Query4;
DM_Qr.Query4.Active := False;
DM_Qr.Query4.Close;
DM_Qr.Query4.SQL.Clear;
DM_Qr.Query4.SQL.Add('Select * from Produtos ');
DM_Qr.Query4.SQL.Add('where Prod_codigo = :Xcodigo');
DM_Qr.Query4.ParamByName('Xcodigo').AsInteger := StrtoInt(Resposta);
DM_Qr.Query4.Active :=True;
end;
end;
---------------------------------------------------------------------------------------
begin
DBGrid1.DataSource := DataSource3;
DM_Qr.Query3.Active :=False;
DM_Qr.Query3.Close;
DM_Qr.Query3.SQL.Clear;
Edit6.Text := Inttostr(DM_Qr.Query3.SQL.Add('Select count (Prod_codigo) From Produtos'));
//DM_Qr.Query3.SQL.Add('From Produtos');
DM_Qr.Query3.Active :=True;
end;
---------------------------------------------------------------------------------------
begin
With Query1 do
Begin
Close;
ParamByName('NomeX').AsString := '%' + Edit1.Text + '%';
ParamByName('Dta_Inicial').AsDate := DateTimePicker1.Date ;
ParamByName('Dta_Final').AsDate := DateTimePicker2.Date;
Prepare;
Open;
end;
If Query1.RecordCount = 0 then
Begin
Application.MessageBox('Favor informar um CÓDIGO', 'Erro',
+ Mb_ok + Mb_IconWarning);
end;
end;
SQL
***
SELECT
Clie_Codigo,
Clie_Nome,
Clie_Data_Nas
FROM
"Clientes.DB" Clientes
WHERE
Clie_Nome LIKE :NomeX AND
( Clie_Data_Nas >= :Dta_Inicial ) AND
( Clie_Data_Nas <= :Dta_Final )
ORDER BY
Clie_Nome
Implementando...
procedure TNome_Datas_Frm.Bit_OKClick(Sender: TObject);
begin
With Query1 do
Begin
if Edit1.Text = '' then // Verifica se algo for digitado
Begin
Application.MessageBox('Digite algo no campo NOME!', 'ATENÇÃO',
+ Mb_ok + Mb_IconWarning);
Edit1.Clear;
Edit1.SetFocus;
Raise EAbort.Create('');
end;
Close;
ParamByName('NomeX').AsString := Edit1.Text + '%';
// O '%' no lado direito do Edit1.Text significa que serão
// localizadas TODOS OS NOMES com as LETRAS INICIAIS digitadas
ParamByName('Dta_Inicial').AsDate := DateTimePicker1.Date;
ParamByName('Dta_Final').AsDate := DateTimePicker2.Date;
Prepare;
Open;
end;
If Query1.RecordCount = 0 then
Application.MessageBox('NADA foi encontrado!', 'ATTENÇÃO',
+ Mb_ok + Mb_IconWarning)
else
ShowMessage('Total registros encontrados : '
+ IntToStr(Query1.RecordCount));
end;
End;
---------------------------------------------------------------------------------------
//Var
//Cliente : String;
begin
//Cliente := InputBox( ' Digite um NOME ' , ' Procura ' , '' );
Query1.Close;
Query1.SQL.Clear;
Query1.SQL.Add('SELECT * FROM Clientes');
Query1.SQL.Add('WHERE Upper(Clientes.Clie_Nome) LIKE Upper(:Xnome)');
//Query1.ParamByName('Xnome').AsString := Edit1.Text;
Query1.Open;
end;
SQL
***
SELECT
Clie_Nome, Clie_Cidade
FROM
"Clientes.DB" Clientes
---------------------------------------------------------------------------------------
Query1.Close;
Query1.SQL.Clear;
Query1.SQL.Add ('SELECT Cli_Nome FROM Clientes');
Query1.SQL.Add ('WHERE Cli_Nome = :XNome');
// Query1.SQL.Add ('or Cli_Salario > :xSalario');
Query1.SQL.Add ('or Cli_Idade = :XCidade');
Query1.ParamByName('XNome').AsString := '%' + Edit1.Text + '%';
// Query1.ParamByName('XSalario').AsString := Edit2.Text;
Query1.ParamByName('XCidade').AsString := Edit1.Text;
Query1.ExecSQL;
SELECT Cli_Nome, Cli_Data_Nasc, Cli_Idade, Cli_Salario
FROM "Clientes.DB" Clientes
---------------------------------------------------------------------------------------
Procura no combobox
begin
Try
Application.CreateForm(TFrmRelComisao, FrmRelComisao);
With FrmRelComisao do
Begin
QryComisao.ParamByName('VarDataI').AsDate :=Data1.Date;
QryComisao.ParamByName('VarDataF').AsDate :=Data2.Date;
QryComisao.ParamByName('VarVendedor').AsString:=DbLookUpComboBox1.Text+'%';
QryComisao.Prepare;
QryComisao.Open;
QuickRep1 .Preview;
QryComisao.Close;
end;
Finally
FrmRelComisao.Free;
End;
end;
Select
Codigo,Vendedor From Vendedor
Order by 2
---------------------------------------------------------------------------------------
Neste exemplo há um: ComboBox - Grid - 2 Comp. SQL
procedure TMultiplas_Frm.RadioGroup1Click(Sender: TObject);
begin
Case RadioGroup1.ItemIndex of
0 : begin
DBGrid1.DataSource := Func_Sql_DS;
Func_Sql.Close;
Func_Sql.Sql.Clear;
Func_Sql.Sql.Add('Select Func_Nome ');
Func_Sql.Sql.Add('From funcionarios Order by Func_Nome');
Func_Sql.Open;
end;
1 : begin
DBGrid1.DataSource := Func_Sql_DS;
Func_Sql.Close;
Func_Sql.Sql.Clear;
Func_Sql.Sql.Add('Select Func_Nome ');
Func_Sql.Sql.Add('From funcionarios Order by Func_Nome DESC');
Func_Sql.Open;
end;
2 : begin
DBGrid1.DataSource := Cidades_Sql_DS;
Cidades_Sql.Close;
Cidades_Sql.Sql.Clear;
Cidades_Sql.Sql.Add('Select * From Cidades ');
Cidades_Sql.Sql.Add('Order by Cid_Cidade');
Cidades_Sql.Open;
end;
3 : begin
DBGrid1.DataSource := Cidades_Sql_DS;
Cidades_Sql.Close;
Cidades_Sql.Sql.Clear;
Cidades_Sql.Sql.Add('Select * From Cidades ');
Cidades_Sql.Sql.Add('Order by Cid_Cidade DESC');
Cidades_Sql.Open;
end;
4 : begin
DBGrid1.DataSource := UFs_Sql_DS;
UFs_Sql.Close;
UFs_Sql.Sql.Clear;
UFs_Sql.Sql.Add('Select * From UFs ');
UFs_Sql.Sql.Add('Order by Ufs_Sigla');
UFs_Sql.Open;
end;
end;
end;
procedure TMultiplas_Frm.FormShow(Sender: TObject);
begin
With ComboBox1.Items do begin
UF_Sql.open;
UF_Sql.First;
Clear;
While not UF_Sql.Eof do begin
Add(UF_SqlUfs_Sigla.Value);
UF_Sql.Next;
end;
end;
end;
procedure TMultiplas_Frm.ComboBox1Click(Sender: TObject);
var
s : String;
i : integer;
begin
i := ComboBox1.ItemIndex;
s := ComboBox1.Items.Strings[i];
DBGrid1.DataSource := UF_Combo_DS;
UF_Combo_Sql.Close;
UF_Combo_Sql.Sql.Clear;
UF_Combo_Sql.Sql.Add('Select UFs_Descricao ');
UF_Combo_Sql.Sql.Add('From UFs Where Ufs_Sigla = '+ QuotedStr(s));
UF_Combo_Sql.Open;
end;
---------------------------------------------------------------------------------------
Var
Resp : String;
begin
Resp := InputBox('Digite um código','Código','');
If Length(Resp) = 0 Then
else
Begin
Query1.Close;
Query1.Sql.Clear;
Query1.Sql.Add('SELECT * From "Socios.db" Where Nome_Socio = :Cod') ;
Query1.ParamByName('Cod').AsString := Resp;
Query1.Open;
end;
end;
---------------------------------------------------------------------------------------
begin
DM_Qr.Produtos_Todos_Qr.Active :=true;
DBGrid1.DataSource := Produtos_Todos_DS;
with edit3 do
if text <> '' then
DM_Qr.Produtos_Todos_Qr.lOCATE('Prod_Codigo', Edit3.text, [LoPartialKey]);
end;
---------------------------------------------------------------------------------------
begin
DM_Qr.Produtos_Todos_Qr.Active :=true;
DBGrid1.DataSource := Produtos_Todos_DS;
with edit4 do
if text <> '' then
DM_Qr.Produtos_Todos_Qr.Filter:='Prod_Codigo = ''' + Edit4.text + '''';
DM_Qr.Produtos_Todos_Qr.FindFirst;
end;
---------------------------------------------------------------------------------------
begin
Query1.Close;
Query1.SQL.Clear;
Query1.SQL.Add('SELECT Com_Nome_Vendor, Com_Data_Vencto,' +
'Com_Data_Pagto,Com_Valor');
Query1.SQL.Add('FROM Comissao');
Query1.SQL.Add('WHERE Com_Data_Pagto is null'); // IS NUL - IS NOT NULL
Query1.Open;
end;
---------------------------------------------------------------------------------------
begin
Query1.Close;
Query1.SQL.Clear;
Query1.SQL.Add('SELECT Sum(Com_Valor) FROM Comissao');
Query1.SQL.Add('WHERE Com_Data_Pagto > Com_Data_Vencto');
Query1.Open;
end;
---------------------------------------------------------------------------------------
begin
Query1.Close;
Query1.SQL.Clear;
Query1.SQL.Add('SELECT Sum(Com_Valor) FROM Comissao');
Query1.SQL.Add('WHERE Com_Data_Pagto <> Is Null');
Query1.Open;
end;
---------------------------------------------------------------------------------------
begin
Query1.Close;{close the query}
Query1.SQL.Clear;
Query1.SQL.Add ('Select EmpNo, FirstName, LastName');
Query1.SQL.Add ('FROM Employee.db');
Query1.SQL.Add ('WHERE Salary > ' + Edit1.Text);
Query1.Open;
end;
---------------------------------------------------------------------------------------
with dados.Qsaida do
begin
close;
sql.clear;
sql.add('SELECT * FROM "Consulta.db"');
sql.add('WHERE (Mov_datas >= :pdatai) and (Mov_datas <= :pdataf) and (Sai_codigo = 1)');
sql.add('ORDER BY Mov_datas');
parambyname('pdatai').asdate := StrToDate(maskedit1.text);
parambyname('pdataf').asdate := StrToDate(maskedit2.text);
open;
end;
---------------------------------------------------------------------------------------
OnClick - tela com dois ComboBox e dois edits data_ini e data_fim
With FormQuickVendedor4 Do Begin
If (Trim(DataIni.Text) <> '/ /') Or
(Trim(DataFim.Text) <> '/ /') Then Begin
Query2.Close;
Query2.ParamByName('Descricao').Value := DBLookupComboBox1.Text;
Query2.ParamByName('NomeI').Value := DBLookupComboBox2.Text;
Query2.ParamByName('NomeF').Value := DBLookupComboBox3.Text;
Query2.ParamByName('DataI').Value := StrToDate(DataIni.Text);
Query2.ParamByName('DataF').Value := StrToDate(DataFim.Text);
QRLabel7.Caption := 'Relatório do Vendedor ' + DBLookupComboBox2.Text +
'ao Vendedor '+ DBLookupComboBox3.Text;
Qrlabel1.caption := 'Produto Vendido ' + DBLookupComboBox1.Text;
QRLabel13.Caption := 'Período de: ' + DataIni.Text + ' até ' + DataFim.Text;
Query2.Prepare;
Query2.Open;
QuickRep1.Preview;
//Close;
End ;
---------------------------------------------------------------------------------------
procedure TFornec_FRM.BitBtn12Click(Sender: TObject);
Var
Fornecedor : String;
begin
Fornecedor :=InputBox('Consulta de Fornecedores por código','Informe o Código','');
if Fornecedor <> '' then
begin
if Fornec.FindKey([fornecedor])=False then
application.MessageBox('Fornecedor não Encontrado...','erro',+ Mb_OK);
// Showmessage('registro não existe');
end;
end;
procedure TFornec_FRM.BitBtn13Click(Sender: TObject);
Var
Fornecedor : String;
begin
Fornecedor :=InputBox('Consulta por nome','Informe o nome ','');
if Fornecedor <> '' then
begin
if Fornec.locate('for_nome', fornecedor,[loPartialKey])= False then
Application.MessageBox('Nome não Localizado','erro',+Mb_OK);
end;
end;
procedure TFornec_FRM.Ed_procura2Change(Sender: TObject);
begin
With Fornec do // para não repetir toda vez o Fornec
begin
IndexName:='Inome'; // Indice secundário
Fornec.open;
SetKey;
FornecFor_nome.AsString:=Ed_procura2.text;
GotoNearest;
end;
end;
---------------------------------------------------------------------------------------
var
Data : TDateTime;
begin
Try
Data := StrToDate(maskedit1.Text);
with query1 do begin
Close;
ParambyName('Data').AsDateTime := Data;
Open;
end;
Except
On EConvertError do
MessageDlg('Data Inválida', mtError, [mbOk], 0);
end;
---------------------------------------------------------------------------------------
procedure TSql_10_Frm.Bit_ProcuraClick(Sender: TObject);
begin
Query1.Close;
Query1.SQL.Text := 'SELECT * FROM Clientes WHER EClie_Data_Aniver >= :Hoje';
Query1.ParamByName('Hoje').AsDate := Date;
Query1.Open;
end;
procedure TSql_10_Frm.Bit_Procura_MesClick(Sender: TObject);
begin
Query1.Close;
Query1.SQL.Clear;
Query1.SQL.Add('SELECT * FROM Clientes');
Query1.SQL.Add('WHERE EXTRACT(YEAR FROM Clie_Data_Aniver) = :Mes');
Query1.ParamByName('Mes').AsInteger := StrToInt(Edit1.Text);
Query1.Open;
end;
SELECT Clie_Nome, Clie_Cidade, Clie_Data_Aniver
FROM "Clientes.DB" Clientes
---------------------------------------------------------------------------------------
begin
Query1.SQL.Clear;
Query1.SQL.Add('SELECT * FROM Clientes ORDER BY Clie_Nome ASC' );
Query1.Open;
end;
begin
Query1.SQL.Clear;
Query1.SQL.Add('SELECT * FROM Clientes ORDER BY Clie_Codigo DESC' );
Query1.Open;
end;
begin
Query1.SQL.Clear;
Query1.SQL.Add('SELECT * FROM Clientes WHERE Clie_Codigo = 3' );
Query1.Open;
end;
begin
Query1.Close;
Query1.SQL.Clear;
Query1.SQL.Add('SELECT * FROM Clientes WHERE Clie_Nome = ' + QuotedStr(Edit1.Text));
Query1.Open;
end;
Begin
Query1.Close;
Query1.SQL.Clear;
Query1.SQL.Add('SELECT * FROM Clientes');
Query1.SQL.Add('WHERE Upper(Clientes.Clie_Nome) LIKE Upper(:Xnome)');
Query1.ParamByName('Xnome').AsString := Edit1.Text;
Query1.Open;
end;
begin
Query1.Close;
Query1.SQL.Clear;
Query1.SQL.Add('SELECT * FROM Clientes WHERE Clie_Nome = ' + Edit1.Text);
Query1.Open;
end;
---------------------------------------------------------------------------------------
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
Query1.close;
if not Query1.prepared
then
Query1.prepare;
if edit1.text <> ''
then
Query1.ParamByName('DEPT_NO').AsString := edit1.text
else
Begin
Query1.ParamByName('DEPT_NO').AsInteger := 0;
edit1.text := '0';
end;
try {trap errors}
Query1.Open; {Execute the statement and open the dataset}
except {error handling section}
On e : EDatabaseError do {e is the new handle for the error}
messageDlg(e.message,
mtError, [mbOK],0);
end;
end;
---------------------------------------------------------------------------------------
var
Resp : Integer;
begin
if DM_Qr.Socios_Sintese_Rel_Qr.Active then
DM_Qr.Socios_Sintese_Rel_Qr.Close;
Edit2.SelectAll;
if Edit2.SelLength = 0 then
Edit2.Text := Edit1.text;
if DM_Qr.Socios_Sintese_Rel_Qr.Active then
DM_Qr.Socios_Sintese_Rel_Qr.Close;
DM_Qr.Socios_Sintese_Rel_Qr.ParamByName('Cod_Inicial').AsInteger := StrToInt(Edit1.text);
DM_Qr.Socios_Sintese_Rel_Qr.ParamByName('Cod_Final').AsInteger := StrToInt(Edit2.text);
DM_Qr.Socios_Sintese_Rel_Qr.Open;
if DM_Qr.Socios_Sintese_Rel_Qr.RecordCount > 0 then
begin
Resp := Application.MessageBox('Deseja previsulizar impressão ?',
'Previsualizar', Mb_YesNoCancel+Mb_IconQuestion);
if Resp = idCancel then Exit;
if Resp = idyes then
QReport_Socios_Sintese .Preview
else
QReport_Socios_Sintese.Print;
end
else
Application.MessageBox('Não há registros ! ','Erro !', Mb_Ok + Mb_IconQuestion)
---------------------------------------------------------------------------------------
procedure TFrmConsVendedor.BtConsultarClick(Sender: TObject);
begin
With QryVendedor do
Begin
Close;
ParamByName('VarVendedor').AsString := Edit1.Text+'%';
Prepare;
Open;
end;
if QryVendedor.RecordCount=0 then
Begin
ShowMessage('Vendedor não encontrado!');
End;
end;
SQL
***
Select
Vendedor.Codigo,Vendedor.Vendedor
From
Vendedor
Where
Upper(Vendedor) Like Upper(:VarVendedor)
Order by
Vendedor.Vendedor
---------------------------------------------------------------------------------------
ListBox - Radiogroup - Edit - DataModule - Query - ListBox
procedure TFrmLike.BtnSelecionarClick(Sender: TObject);
begin
With DmLike.QryCountry do
begin
Close;
case RadioGroup1.ItemIndex of
0: Params[0].AsString := UpperCase(Edit1.Text + '%');
1: Params[0].AsString := UpperCase('%' + Edit1.Text);
2: Params[0].AsString := UpperCase('%' + Edit1.Text + '%');
end;
Open;
// preencher a listbox
ListBox1.Items.Clear;
While not EOF do
begin
ListBox1.Items.Add(Fields[0].AsString);
Next;
end;
end;
end;
SELECT * FROM COUNTRY
WHERE UPPER(NAME) LIKE :NomePais
---------------------------------------------------------------------------------------
procedure TFrmConsPedidos.BtConsultarClick(Sender: TObject);
begin
With QryPedidos Do
Begin
Close;
ParamByName('VarCliente').AsString:=Edit1.Text+'%';
ParamByName('VarDataI').AsDate:=Data1.Date;
ParamByName('VarDataF').AsDate:=Data2.Date;
Prepare;
Open;
End;
if QryPedidos.RecordCount=0 then
Begin
ShowMessage('Nenhum Pedido foi Encontrado com esses Dados!');
End;
end;
SQL
***
Select Pedidos.Numero, Pedidos.DataPed,Clientes.Nome From Pedidos,Clientes,Vendedor
Where Pedidos.CodCliente=Clientes.Codigo and Pedidos.CodVendedor=Vendedor.Codigo and
Upper(Clientes.Nome) Like Upper(:VarCliente) and
Pedidos.DataPed Between :VarDataI and :VarDataF
Order by
Pedidos.DataPed, Clientes.Nome
---------------------------------------------------------------------------------------
begin
//Var
//Cliente : String; // Definindo variável
begin
//Cliente := InputBox( ' Digite um NOME ' , ' Procura ' , '' );
Query1.Close;
Query1.SQL.Clear;
Query1.SQL.Add('SELECT * FROM Clientes');
Query1.SQL.Add('WHERE Upper(Clientes.Clie_Nome) LIKE Upper(:Xnome)');
//Query1.ParamByName('Xnome').AsString := Edit1.Text;
Query1.Open;
end;
---------------------------------------------------------------------------------------
begin
With Grafico_Qr do
Begin
Close;
ParamByName('Dta_Inicial').AsDate := Data1.Date;
ParamByName('Dta_Final').AsDate := Data2.Date;
Prepare;
Open;
End;
If (Grafico_Qr.RecordCount=1) then // and (QryGraficoTotal.Value=0) then
ShowMessage('Não existe registros neste período');
end;
SELECT
Func_Nome,
Func_Cargo,
Func_Data_Admissao,
Func_Salario
FROM
"Funcionarios.db" Funcionarios
WHERE
(Func_Data_Nasc >= :Dta_Inicial)
and
(Func_Data_Nasc <= :Dta_Final)
Order by
Func_Data_Nasc
---------------------------------------------------------------------------------------
Var
Resposta : String;
Begin
Resposta := InputBox('Digite um código','Código', Resposta);
if Resposta = '' then
begin
Application.MessageBox('Nada foi digitado...' ,
'ATENÇÃO', + Mb_OK);
Query1.Active := False;
Exit;
end
else
begin
Query1.Active := False;
Query1.Close;
Query1.SQL.Clear;
Query1.SQL.Add('SELECT * FROM Clientes ');
Query1.SQL.Add('WHERE Clie_Cod = :Xcod');
Query1.ParamByName('Xcod').AsInteger := StrtoInt(Resposta);
Query1.Active := True; // mostra registros no grid
end;
If Query1.RecordCount = 0 then // se registro não existir
Begin
Application.MessageBox('Nenhum registro foi encontrado...' , 'Erro',
+ Mb_ok + Mb_IconWarning);
end;
end;
---------------------------------------------------------------------------------------
With Query1 do
Begin
Close;
ParamByName('NomeX').AsString := '%' + Edit1.Text + '%';
ParamByName('Dta_Inicial').AsDate := DateTimePicker1.Date ;
ParamByName('Dta_Final').AsDate := DateTimePicker2.Date;
Prepare;
Open;
end;
If Query1.RecordCount = 0 then
Begin
Application.MessageBox('Favor informar um CÓDIGO', 'Erro',
+ Mb_ok + Mb_IconWarning);
end;
end;
---------------------------------------------------------------------------------------
Var
Cliente : String; // Definindo variável
begin
Cliente := InputBox( ' Digite um NOME ' , ' Procura ' , '' );
If Cliente <> '' then // se for digitado algo
Begin
With Query1 do
begin
ParamByName('Xnome').AsString := '%' + Cliente + '%' ;
Open;
If isEmpty then
begin
Application.MessageBox('Não existe NOME ' , 'Erro', + Mb_Ok );
end;
end;
end;
end;
-----
SELECT
Clie_Codigo,
Clie_Nome,
Clie_Cidade
FROM
"Clientes.DB" Clientes
WHERE
Upper(Clie_Nome) LIKE Upper(:Xnome)
ORDER BY
Clie_Nome
---------------------------------------------------------------------------------------
Query1.Close;
Query1.ParamByName('Xnome').AsString := '%' + Edit1.Text + '%' ;
Query1.Open;
Label2.Caption := IntToStr(Query1.RecordCount);
---
SELECT
Clie_Nome, Clie_Cidade, Clie_Fone, Clie_Data_Aniver
FROM
"Clientes.DB" Clientes
WHERE
Upper(Clie_Nome) LIKE Upper(:Xnome)
ORDER BY
Clie_Nome
---------------------------------------------------------------------------------------
var
InstrucSQL: String;
procedure TForm1.SQLBtnClick(Sender: TObject);
var
Ok : Boolean;
begin
InstrucSQL:=' ';
Ok:= InputQuery ('SQL','Entre com uma isntrução SQL',InstrucSQL);
if Ok then
begin
Query1.Close;
Query1.SQL.Clear;
Query1.SQL.Add (InstrucSQL);
Query1.Open;
end;
end;
---------------------------------------------------------------------------------------
Botao para relatório
var
Resp : Integer;
begin
if DM_Qr.Clientes_Alfabetica_Qr.Active then
DM_Qr.Clientes_Alfabetica_Qr.ParamByName('Cod_Inicial').AsInteger := StrToInt(Edit1.text);
DM_Qr.Clientes_Alfabetica_Qr.ParamByName('Cod_Final').AsInteger := StrToInt(Edit2.text);
DM_Qr.Clientes_Alfabetica_Qr.Open;
if DM_Qr.Clientes_Alfabetica_Qr.RecordCount > 0 then
begin
Resp := Application.MessageBox('Deseja previsulizar impressão ?',
'Previsualizar', Mb_YesNoCancel+Mb_IconQuestion);
if Resp = idCancel then Exit;
if Resp = idyes then
QReport_Clientes.Preview
else
QReport_Clientes.Print;
end
else
Application.MessageBox('Não há registros ! ','Erro !',
Mb_Ok + Mb_IconQuestion)
end;
No evento OnShow do formulário da seleção do relatório
begin
Dm.Clientes_TB.Open;
Dm.Clientes_TB.DisableControls;
Try
ComboBox1.Items.Clear;
With DM, DM.Clientes_TB do
begin
First;
While not eof do begin
ComboBox1.Items.Add(Clientes_TBCli_Nome.Value);
Next;
end;
end;
ComboBox1.Sorted := True;
Edit1.Setfocus;
Finally
DM.Clientes_TB.EnableControls;
end;
end;
---------------------------------------------------------------------------------------
Var
Resp : Integer;
ind : integer;
dado : TDados;
begin
ind := cbFornecedores.ItemIndex;
QReport_Pagar_Forn_Rel.dtIni := Dtp_dta_ini.date; //Now-300
QReport_Pagar_Forn_Rel.dtFim := Dtp_dta_final.date; //Now+300;
if ind >= 0 then begin
dado := TDados(cbFornecedores.Items.Objects[ind]);
QReport_Pagar_Forn_Rel.cdForn := dado.Cod;
end
else
QReport_Pagar_Forn_Rel.cdForn := -1;
if QReport_Pagar_Forn_Rel.parcelas_sql.Active then
QReport_Pagar_Forn_Rel.parcelas_sql.Close;
QReport_Pagar_Forn_Rel.parcelas_sql.Open;
QReport_Pagar_Forn_Rel.ReportTitle := 'Pagar - Fornecedores';
if QReport_Pagar_Forn_Rel.parcelas_sql.RecordCount > 0 then
Begin
Resp := Application.MessageBox('Deseja previsualizar impressão ?',
'Previsualizar', Mb_YesNo+Mb_IconQuestion);
if Resp = idyes then
QReport_Pagar_Forn_Rel.Preview;
if Resp = idNo then
QReport_Pagar_Forn_Rel.Print;
// Exit;
end
else
Begin
Application.MessageBox('Não há registros ! ','Erro !',
Mb_Ok + Mb_IconQuestion);
exit;
end;
end;
---------------------------------------------------------------------------------------
QRLabel8.Caption := FormatDateTime('"Timbó, "dd" de "mmmm" de " yyyy',Now);
QRExpr1.Mask := CurrencyString + '##,##0.00';
---------------------------------------------------------------------------------------
If (Edit_Cod_Inicial.Text = '') or (Edit_Cod_Final.Text = '') then
Begin
Application.MessageBox('Informe um CÓDIGO INICIAL e FINAL',
'Erro ! - Clique OK',mb_Ok + MB_ICONERROR);
if Edit_Cod_Inicial.Text = '' then
Edit_Cod_Inicial.SetFocus
else
Edit_Cod_Final.SetFocus;
Exit;
end;
Rel_Contas_Pagar2.Contas_Pagar_TB.Open;
Rel_Contas_Pagar2.Contas_Pagar_TB.IndexName := 'INr_Cheque';
Rel_Contas_Pagar2.Contas_Pagar_TB.SetRange([Edit_Cod_Inicial.Text],
[Edit_Cod_Final.Text]);
Try // Try ... Finally ... End
if Rel_Contas_Pagar2.RecordCount = 0 then
begin
Application.MessageBox('Não há registros neste intervalo !',
'Erro ! - Clique OK',Mb_Ok + Mb_IconError);
Exit;
end;
Rel_Contas_Pagar2.Preview; // Mostra relatório
Finally
Rel_Contas_Pagar2.Contas_Pagar_TB.CancelRange;
End; // Try ... Finally ... End
end;
---------------------------------------------------------------------------------------
Var
Resp : Integer;
begin
Resp := Application.MessageBox('Deseja previsulizar impressão ?',
'Previsualizar', Mb_YesNo + Mb_IconQuestion);
if Resp = idNo then Exit;
if Resp = idyes then
Begin
DM_Qr.Mensalidades_Rel_Qr.Open;
QReport_Mensalidades.Preview;
end
else
Begin
QReport_Mensalidades.Print;
DM_Qr.Mensalidades_Rel_Qr.Close ;
end;
end;
---------------------------------------------------------------------------------------
var
Resp : Integer;
begin
if DM_Qr.Mensalidades_Cara_Rel_Qr.Active then
DM_Qr.Mensalidades_Cara_Rel_Qr.Close;
DM_Qr.Mensalidades_Cara_Rel_Qr.ParamByName('Cod_Inicial').AsInteger := StrToInt(DBEdit5.Text);
DM_Qr.Mensalidades_Cara_Rel_Qr.ParamByName('Cod_Final').AsInteger := StrToInt(DBEdit5.Text);
DM_Qr.Mensalidades_Cara_Rel_Qr.ParamByName('Cod_Inicial_Emp').AsInteger := StrToInt(DBEdit1.Text);
DM_Qr.Mensalidades_Cara_Rel_Qr.ParamByName('Cod_Final_Emp').AsInteger := StrToInt(DBEdit1.Text);
DM_Qr.Mensalidades_Cara_Rel_Qr.Open;
if DM_Qr.Mensalidades_Cara_Rel_Qr.RecordCount > 0 then
begin
Resp := Application.MessageBox('Deseja previsualizar impressão ?',
'Previsualizar', Mb_YesNoCancel+Mb_IconQuestion);
if Resp = idCancel then Exit;
if Resp = idyes then
QReport_Mensalidades_Cara_Rel.Preview
else
QReport_Mensalidades_Cara_Rel.Print;
end
else
Application.MessageBox('Não há registros ! ','Erro !', Mb_Ok + Mb_IconQuestion)
end;
SELECT
Mensalidades.Nr_Mensalidade,
Mensalidades.Data_Pagto,
Mensalidades.Valor,
Mensalidades.Mes,
Empresas.Nome_Empresa,
Socios.Nome_Socio,
Socios.Cod_Socio,
Empresas.Cod_Empresa
From
"Mensalidades.DB" Mensalidades,
"Empresas.DB" Empresas,
"Socios.DB" Socios
Where
(Mensalidades.Nr_Mensalidade >= :Cod_Inicial) and
(Mensalidades.Nr_Mensalidade <= :Cod_Final) and
(Empresas.Cod_Empresa >= :Cod_Inicial_Emp) and
(Empresas.Cod_Empresa <= :Cod_Final_Emp)
---------------------------------------------------------------------------------------
Var
Resp : Integer;
begin
with DM.Assessoria_Qr,DM do begin
if Active then Close;
ParamByName('Data_Ini').AsDate := Int(DTPDataInicial.Date);
ParamByName('Data_Fim').AsDate := Int(DTPDataFinal.Date);
Open;
if RecordCount = 0 then
begin
Application.MessageBox('Não há registros ! ', 'Erro !!!', Mb_Ok + Mb_IconQuestion);
Exit;
end;
end;
QReport_Assessoria := TQReport_Assessoria.Create(self);
Try
Resp := Application.MessageBox('Deseja previsualizar impressão ?',
'Previsualizar', Mb_YesNoCancel+Mb_IconQuestion);
if Resp = idCancel then Exit;
if Resp = idyes then
QReport_Assessoria.Preview
else
QReport_Assessoria.Print;
Finally
QReport_Assessoria.Free;
end;
end;
Afim de aprender mais? Fale comigo:
linux1.noip@gmail.com
