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