Buscar por:
Dicas gerais sobre delphi

Código
Segue algumas dicas:

{Esta dica é muito simples sobre progressbar

primeiro - coloque no form um progressbar

segundo - coloque também um timer

terceiro - clique duas vezes no timer e digite o seguinte código:}

progressbar:=progressbar+1;

if (progressbar>99) then

begin

progressbar:=0;{faz o progressbar entrar em looping e iniciar novamente}

end;

{Se você quizesse que ao concluir o carregamento ele abrisse um form era só colocar assim:

primeiro - coloque no form1 um progressbar

segundo - coloque no form1também um timer

terceiro - crie um novo form que se chamará (Form2)

quarto - clique duas vezes no timer e digite o seguinte código:

}

if (progressbar>99) then

begin

form2.show;

progressbar.visible:=false;

end;

------------------------------------------------------------------------------------

//Coloque um componente TTimer e dentro dele coloque os codigos

//a primeira linha faz o menu piscar e a segunda faz piscar na barra de tarefas

FlashWindow(Handle, true);

FlashWindow(Application.Handle, true);

-------------------------------------------------------------------------------------

Para deixar sua aplicação com o estilo do windows xp, basta adicionar 

no seu projeto o componente XP MANIFEST, localizado na guia Win32. 

--------------------------------------------------------------------------------------

Label2.Caption:=formatdatetime('dddd,d "de" mmmm "de" yyyy',date);;

Você pode colocar no evento do componente -" Timer" 

---------------------------------------------------------------------------------------

Segue dica de como fazer login de usuario utilizando sql.

Rotina universal para qualquer tipo de banco de dados.

A variavel tentativas é disparada quando for criado o formulario de login,deve ser declara como inteira na seção var.

procedure tf_login.create(sender :tobject);

begin

tentativas := 0;

end;

procedure TF_login.validausuario(Sender: TObject);

var

senha:string;

begin

if (Edit1.Text='') then

begin

Application.MessageBox('Ficou faltando senha do usuario, tente novamente!'#13

+'','Sistema de Cartório de Registro de Imoveis',MB_ICONERROR+MB_OK);

tentativas := tentativas + 1;

if tentativas > 3 then

begin

Application.MessageBox('O sistema será encerrado por motivo de'#13

+'segurança, entre em contato com o administrador'#13

+'do sistema!','Sistema de Cartório de Registro de Imóveis',MB_ICONERROR+MB_OK);

Application.Terminate;

end

else

begin

Edit1.Text :='';

Edit2.Text :='';

Edit2.SetFocus;

Abort;

end;

end;

if (Edit2.Text ='') then

begin

Application.MessageBox('Ficou faltando nome do usuario, tente novamente!'#13

+'','Sistema de Cartório de Registro de Imoveis',MB_ICONERROR+MB_OK);

tentativas := tentativas + 1;

if tentativas > 3 then

begin

Application.MessageBox('O sistema será encerrado por motivo de'#13

+'segurança, entre em contato com o administrador'#13

+'do sistema!','Sistema de Cartório de Registro de Imóveis',MB_ICONERROR+MB_OK);

Application.Terminate;

end

else

begin

Edit1.Text :='';

Edit2.Text :='';

Edit2.SetFocus;

Abort;

end;

end;

nome := Edit2.Text;

with dm.IBconsulta do

begin

close;

sql.Clear;

sql.Add('select nome_usuario, senha_usuario from usuario where nome_usuario ='''+Edit2.Text+'''');

Open;

if IsEmpty then

begin

Application.MessageBox('Favor entrar em contato com o administrador'#13

+'do sistema pois este nome de usuário não está'#13

+'devidamente cadastrado!','Sistema de Cartório de Registro de Imóveis',MB_ICONWARNING+MB_OK);

tentativas := tentativas + 1;

if tentativas > 3 then

begin

Application.MessageBox('O sistema será encerrado por motivo de'#13

+'segurança, entre em contato com o administrador'#13

+'do sistema!','Sistema de Cartório de Registro de Imóveis',MB_ICONERROR+MB_OK);

Application.Terminate;

end

else

begin

Edit2.Text := '';

Edit1.Text := '';

Edit2.SetFocus;

Abort;

end;

end

else

senha := fieldbyname('senha_usuario').AsString;

end;

if senha <> Edit1.Text then

begin

Application.MessageBox('Favor entrar em contato com o administrador'#13

+'do sistema pois esta senha de usuário não está'#13

+'devidamente cadastrada!','Sistema de Cartório de Registro de Imóveis',MB_ICONWARNING+MB_OK);

tentativas := tentativas + 1;

if tentativas > 3 then

begin

Application.MessageBox('O sistema será encerrado por motivo de'#13

+'segurança, entre em contato com o administrador'#13

+'do sistema!','Sistema de Cartório de Registro de Imóveis',MB_ICONERROR+MB_OK);

Application.Terminate;

end

else

begin

Edit2.Text :='';

Edit1.Text :='';

Edit2.SetFocus;

Abort;

end;

end

else

begin

Application.MessageBox('Seja bem vindo ao sistema!','Sistema de Cartório de Registro de Imoveis',MB_OK+MB_ICONINFORMATION);

F_principal.Show;

F_principal.Enabled := true;

end;

end;

---------------------------------------------------------------------------------------------------------

BARRA DE PROGRESSO NA INICIALIZAÇÃO DO SISTEMA

{É bem simples, trata-se de abrir por código todas as tabelas na entrada do programa,

portanto deixe todas as tabelas fechadas no datamodule.}

procedure DataModule.OnCreate;

var Tabela, i: Integer;

begin

Tabela := 0;

for I := 0 to ComponentCount -1 do

if Components[I] is TTable then

with TTable(Components[I]) do

if (Tag = 9) and not Active then // Tag = 9 identifica as tabelas à serem

abertas

try

Inc(Tabela); // contador das tabelas q já foram abertas.

lblInfo.Caption := Format('Abrindo as Tabelas (%d/%d)', [Tabela, Total]);

{aqui, eu informo à uma label o andamento do processo, usei o formato

TotalTabelasAbertas/TotalàAbrir,

pode-se trocar para porcentagem ou até usar o ProgressBar.}

lblInfo.Refresh; // vital para atualizar a tela durante o processo.

Application.ProcessMessages;

Open;

except

Raise; // quem estiver a fim, pode-se colocar aqui uma verificação, se

deu zebra e a zebra é indice corrompido, rodar rotina de recriação de indice da

tabela.

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

-------------------------------------------------------------------------------------------------

Coloque a propriedade defaultdrawdata do dbgrid em FALSE

No evento onDrawColumnCell do seu grid coloque o seguinte:

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject;

const Rect: TRect; DataCol: Integer; Column: TColumn;

State: TGridDrawState);

begin

If table1PRAZO.Value > DATE then // condição

Dbgrid1.Canvas.Font.Color:= clFuchsia; // coloque aqui a cor desejada

Dbgrid1.DefaultDrawDataCell(Rect, dbgrid1.columns[datacol].field, State);

end;

---------------------------------------------------------------------------------------------------

Function FormataFone(Fone: String; Area: String): string;

// Formata uma cadeia de strings numericos em formato de numero de telefone

var

DDD : String;

Prefixo : String;

Numero : String;

Telefone : String;

Caracter : String;

Ind : Integer;

Estado : Integer; // 0-DDD, 1-Prefixo, 2-Numero

begin

Ind := 1;

DDD := '';

Prefixo := '';

Numero := '';

Estado := -1;

Telefone := '';

while ind <= length(Fone) do

begin

caracter := Copy(Fone,ind,1);

if caracter = '(' then

begin

Estado := 0;

end

else

begin

if caracter = ')' then

begin

if Estado = 0 then

begin

Estado := 1;

end;

end

else

begin

if caracter = '-' then

begin

if Estado = 1 then

begin

Estado := 2;

end;

end;

end;

end;

case Estado of

0 : DDD := DDD + Caracter;

1 : Prefixo := Prefixo + Caracter;

2 : Numero := Numero + Caracter;

end;

Ind := Ind + 1;

end;

if Estado = -1 then

begin

Telefone := Fone;

if Length(Telefone) = 10 then

begin

Result := '('+Copy(Telefone,1,3)+') '+Copy(Telefone,4,3)+'-'+Copy(Telefone,7,4);

end

else

begin

if Length(Telefone) = 7 then

begin

Result := '('+Area+') '+Copy(Telefone,1,3)+'-'+Copy(Telefone,4,4)

end

else

begin

Result := Fone;

end;

end;

end

else

begin

if Length(DDD) = 0 then

begin

DDD := Area;

end;

if Length(Numero) = 0 then

begin

Result := '('+DDD+') '+Prefixo

end

else

begin

Result := '('+DDD+') '+Prefixo+'-'+Numero;

end;

end;

end;

A exemplo de utilização, a function pode ser usada no evento OnExit de uma Edit, como segue:

EdFone.Text := FormataFone(EdFone.Text,EdFone.Text);

Valor de entrada: 0692594687.

Valor de retorno: (069) 259-4687

------------------------------------------------------------------------------------------------

{ Voce pode colocar isto dentro de um if apos validar uma senha ou simplesmente para simular que o progrma esta carregando(todo este codigo pode ir dentro do click de um botão )}

if(Vericação de uma senha)then

begin

Progressbar1.Min := 0;

Progressbar1.Max := 12;

Progressbar1.Step := 1;

for i:=0 to 11 do

begin

Progressbar1.StepIt;

sleep(200);

end

else

showmessage('Senha incorreta ,programa não carregou')

end. 

------------------------------------------------------------------------------------------------

Como clonar um form  

//1: Adicione alguns componentes no form;

//2: Adicione um botão no form e no evento onClick do mesmo digite o código abaixo;

//3:

var

Ms : TMemoryStream;

NewForm : TForm1;

begin

Ms := TMemoryStream.Create;

Try

Ms.WriteComponent(Form1);

NewForm := TForm1.CreateNew(Application);

Ms.Position := 0;

Ms.ReadComponent(NewForm);

NewForm.Show;

ShowMessage('Mova o Form de lugar')

Finally

Ms.Free;

end;

{Execute o programa e clique no botão, com este exemplo o clone do form é 

criado em cima do form orginal, para perceber a mudança arraste o form criado.

---------------------------------------------------------------------------------------------------------

Criar codigo de barras  

Procedure CriaCodigo(Cod : String; Imagem : TCanvas);

Const

digitos : array['0'..'9'] of string[5]= ('00110',

'10001',

'01001',

'11000',

'00101',

'10100',

'01100',

'00011',

'10010',

'01010');

Var

Numero : String;

Cod1 : Array[1..1000] Of Char;

Cod2 : Array[1..1000] Of Char;

Codigo : Array[1..1000] Of Char;

Digito : String;

c1,c2 : Integer;

x,y,z,h : LongInt;

a,b,c,d : TPoint;

I : Boolean;

Begin

Numero := Cod;

For x := 1 to 1000 Do

Begin

Cod1 [x] := #0;

Cod2 [x] := #0;

Codigo[x] := #0;

End;

c1 := 1;

c2 := 1;

x := 1;

For y := 1 to Length(Numero) div 2 do

Begin

Digito := Digitos[Numero[x ]];

For z := 1 to 5 do

Begin

Cod1[c1] := Digito[z];

Inc(c1);

End;

Digito := Digitos[Numero[x+1]];

For z := 1 to 5 do

Begin

Cod2[c2] := Digito[z];

Inc(c2);

End;

Inc(x,2);

End;

y := 5;

Codigo[1] := '0';

Codigo[2] := '0';

Codigo[3] := '0';

Codigo[4] := '0'; { Inicio do Codigo }

For x := 1 to c1-1 do

begin

Codigo[y] := Cod1[x]; Inc(y);

Codigo[y] := Cod2[x]; Inc(y);

end;

Codigo[y] := '1'; Inc(y); { Final do Codigo }

Codigo[y] := '0'; Inc(y);

Codigo[y] := '0';

Imagem.Pen .Width := 1;

Imagem.Brush.Color := ClWhite;

Imagem.Pen .Color := ClWhite;

a.x := 1; a.y := 0;

b.x := 1; b.y := 79;

c.x := 2000; c.y := 79;

d.x := 2000; d.y := 0;

Imagem.Polygon([a,b,c,d]);

Imagem.Brush.Color := ClBlack;

Imagem.Pen .Color := ClBlack;

x := 0;

i := True;

for y:=1 to 1000 do

begin

If Codigo[y] <> #0 Then

Begin

If Codigo[y] = '0' then

h := 1

Else

h := 3;

a.x := x; a.y := 0;

b.x := x; b.y := 79;

c.x := x+h-1; c.y := 79;

d.x := x+h-1; d.y := 0;

If i Then

Imagem.Polygon([a,b,c,d]);

i := Not(i);

x := x + h;

End;

end;

end;

Como Usar:

procedure TForm1.Button1Click(Sender: TObject);

begin

CriaCodigo('03213213241',Image1.Canvas);

end;

---------------------------------------------------------------------------------------------------------

C++ em delphi  

Voce pode abrir projetos do Delphi no builder que ele converte, mas vice versa não.

Para usar codigo escrito em C++ no delphi voce precisará gerar o .OBJ no

 Builder ou no Visual C++ e em seguida incluir este .OBJ no seu projeto via diretiva de compilaçao:

{$I filec.obj}  

--------------------------------------------------------------------------------------------------------

Chamando o help  

Application.HelpFile:='SeuHelp.hlp';

Application.HelpCommand(parametros, 0);

//Parâmetros:

HELP_CONTENTS// - Chama o arquivo de Help como se tivesse dado um duplo-clique no arquivo .hlp

HELP_FINDER // - Chama o help a partir do menu Conteúdo.

HELP_QUIT // - Desativa o Help.  

---------------------------------------------------------------------------------------------------------

Dbgrid zebrado  

{O exemplo abaixo mostra como deixar cada linha do componente DBGrid de uma cor diferente, 

dando assim um efeito zebrado. O controle é feito no evento OnDrawColumnCell. }

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Db, DBTables, Grids, DBGrids, StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

DBGrid1: TDBGrid;

Table1: TTable;

DataSource1: TDataSource;

procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);

begin

If odd(Table1.RecNo) then

begin

DBGrid1.Canvas.Font.Color:= clWhite;

DBGrid1.Canvas.Brush.Color:= clGreen;

end

else

begin

DBGrid1.Canvas.Font.Color:= clBlack;

DBGrid1.Canvas.Brush.Color:= clWhite;

end;

DBGrid1.Canvas.FillRect(Rect);

DBGrid1.Canvas.TextOut(Rect.Left+2,Rect.Top,Column.Field.AsString);

end;  

-------------------------------------------------------------------------------------------------------------------------

Formatando cep  

{ Esta função forma CEP como: 99.999-999 }

function tbFormataCEP(const CEP: string): string;

var

  I: integer;

begin

  Result := '';

  for I := 1 to Length(CEP) do

  if CEP[I] in ['0'..'9'] then

  Result := Result + CEP[I];

  if Length(Result) <> 8 then

  raise Exception.Create('CEP inválido.')

  else

  Result :=

  Copy(Result, 1, 2) + '.' +

  Copy(Result, 3, 3) + '-' +

  Copy(Result, 6, 3);

end; {Use assim:

- Coloque um Edit e um Button no form;

- No evento OnClick do Button coloque a instrução abaixo:}

Edit1.Text := tbFormataCEP(Edit1.Text);  

---------------------------------------------------------------------------------------

Senhas aleatórias  

Procedure TForm1.Button1Click(Sender: TObject);

var

i:integer;

const

str='1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ';

max=6;

begin

Edit1.Text:='';

for i:=1 to max do

Edit1.Text:=Edit1.Text+str[random(length(str))+1];

end;

end.  

------------------------------------------------------------------------------------------

Senha em tabelas  

{Colocar componete session (Guia dataset) } sessio1.addpassword('senha')

table1.active:= true

{OBS: no databasedekstop programar a opção password security }  

-------------------------------------------------------------------------------------------

Como incrementar a barra de status  

{No formulário principal coloque uma statusbar com 3 panels,1 time e aplicationeventos e digite as funções abaixo }

function mostrahora:string;

begin

mostrahora:=timetostr(time);

end;

function mostradata:string;

var

dthoje:tdatetime;

diasemana:integer;

strdiasemana:string;

begin

dthoje:=date;

diasemana:=dayofweek(dthoje);

case diasemana 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;

// Selecione o aplicationeventos e na guia eventos do objeto inspector depois clique no evento OnHint e digite o código ->

procedure TFnomedoform.ApplicationEvents1Hint(Sender: TObject);

Begin

StatusBar1.Panels[2].Text:=Application.Hint;

// todos os hints do seu projeto apareceram no statusbar

end;

// agora faça com que suas funções apareçam o resultado

procedure TFnomedoform.Timer1Timer(Sender: TObject);

var

presente:tdatetime;

ano,mes,dia:word;

begin

presente:=now;

decodedate(presente,ano,mes,dia);

case mes of

1:STATUSBAR1.PANELS[1].TEXT:=' JANEIRO '+inttostr(ano);

2:STATUSBAR1.PANELS[1].TEXT:='FEVEREIRO'+inttostr(ano);

3:STATUSBAR1.PANELS[1].TEXT:='MARÇO '+inttostr(ano);

4:STATUSBAR1.PANELS[1].TEXT:='ABRIL '+inttostr(ano);

5:STATUSBAR1.PANELS[1].TEXT:='MAIO '+inttostr(ano);

6:STATUSBAR1.PANELS[1].TEXT:='JUNHO '+inttostr(ano);

7:STATUSBAR1.PANELS[1].TEXT:='JULHO '+inttostr(ano);

8:STATUSBAR1.PANELS[1].TEXT:='AGOSTO '+inttostr(ano);

9:STATUSBAR1.PANELS[1].TEXT:='SETEMBRO '+inttostr(ano);

10:STATUSBAR1.PANELS[1].TEXT:='OUTUBRO '+inttostr(ano);

11:STATUSBAR1.PANELS[1].TEXT:='NOVEMBRO '+inttostr(ano);

12:STATUSBAR1.PANELS[1].TEXT:='DEZEMBRO '+inttostr(ano);

end;

STATUSBAR1.PANELS[0].TEXT:=mostrahora();

STATUSBAR1.PANELS[1].TEXT:=mostradata();

end;

-------------------------------------------------------------------------------------------

Formatando cpf  

//Passe a string a ser formatada para a função.

Function FormataCPF(CPF : string): string;

begin

Result := Copy(CPF,1,3)+'.'+Copy(CPF,4,3)+'.'+Copy(CPF,7,3)+'-'+Copy(CPF,10,2);

end;

-------------------------------------------------------------------------------------------

 Função para validar data  

{Passar a data como string, neste caso, e depois convertê-lá em date é onde se verificará se a data é válida. O função MSGAviso é uma função minha que já incluí neste site.}

Function ValidaData(sData : String): Boolean;

Begin

Try

sData := DateToStr(StrToDate(sData));

Result := True;

Except

Result := False;

MSGAviso('Data inválida!', 'Erro!');

End;

End;  

-------------------------------------------------------------------------------------------

Descobrir senhas ****** pelo delphi  

{De repente acontece e você está lá: de frente para o computador. E na tela do computador apenas a misteriosa

"*****". Então você se pergunta: que senha será esta que está digitada? Bom, antes de você optar pelo método

de tentativa e erro, crie uma aplicação nova no Delphi e coloque no formulário um componente TTimer. No

evento OnTimer deste componente coloque o seguinte código:}

var

WndHint: THintWindow = nil; // declare a variável fora da procedure

procedure TForm1.Timer1Timer(Sender: TObject);

var

Pos: TPoint;

HWin: THandle;

Paswd: array[0..63] of Char;

R: TRect;

begin

GetCursorPos(Pos);

HWin := WindowFromPoint(Pos);

if SendMessage(HWin, EM_GETPASSWORDCHAR, 0, 0) <> 0 then

begin

if WndHint = nil then

begin

WndHint := THintWindow.Create(Self);

WndHint.Color := clInfoBk;

SendMessage(HWin, WM_GETTEXT, 64, Longint(@Paswd));

R := Rect(Pos.X, Pos.Y + 18, Pos.X +

WndHint.Canvas.TextWidth(Paswd) + 8,

Pos.Y + 18 + WndHint.Canvas.TextHeight(Paswd));

WndHint.ActivateHint(R, Paswd);

end;

end

else if WndHint <> nil then

begin

WndHint.ReleaseHandle;

WndHint := nil;

end;

end;

//By Instance  

------------------------------------------------------------------------------------------- 

Formatar cpf em bd  

{Dica para formatação de CPF em DbEdit:

1º. Dê um duplo click na tabela desejada;

2º. Quando aparecer a janela "Form1.Table1", dê um click com o botão esquerdo do mouse, ao aparecer o menu suspenso click em: "ADD FIELDS" e depois em OK;

3º. Selecione o campo CPF, ou como vc estiver denominado o campo que receberá o CPF;

4º. No Object Inspector, click na propriedade "EDitMask", nos três pontinhos à direita;

5º. Na Janela Input Mask Editor, digite a maneira a qual o CPF se comporta: 999.999.999-99;

6º. Desmarque o checkbox "Save Literal Characters", e clique em OK;

7º. Pronto! CPF formatado;

}  

-------------------------------------------------------------------------------------------

Impedir alt f4  

{Coloque o seguinte código no evento onKeyDown, mas não esqueça de setar o propriedade KeyPreview para True.}

if ((ssAlt in Shift) and (Key = VK_F4)) then

Key := 0;

-------------------------------------------------------------------------------------------

pegando o nome do usuário e a empresa do windows  

Uses Registry;

Procedure GetUserCompany;

var

reg: TRegIniFile;

begin

reg := TRegIniFile.create('SOFTWAREMICROSOFTMS SETUP (ACME)');

Edit1.Text := reg.ReadString('USER INFO','DefName','');

Edit2.Text := reg.ReadString('USER INFO','DefCompany','');

reg.free;

end;

--------------------------------------------------------------------------------------------------------------------