[DELPHI 7] Vários Códigos e Dicas 07.09.11 22:04
Convertendo Imagem JPEG para BMP.
// Requer a Jpeg declarada na clausua uses da unit
Código:
function JpgToBmp(cImage: String): Boolean;
var
MyJPEG : TJPEGImage;
MyBMP : TBitmap;
begin
Result := False;
if fileExists(cImage+'.Jpeg') then
begin
MyJPEG := TJPEGImage.Create;
with MyJPEG do
begin
try
LoadFromFile(cImage+'.Jpeg');
MyBMP := TBitmap.Create;
with MyBMP do
begin
Width := MyJPEG.Width;
Height := MyJPEG.Height;
Canvas.Draw(0,0,MyJPEG);
SaveToFile(cImage+'.Bmp');
Free;
Result := True;
end;
finally
Free;
end;
end;
end;
end;
________________________________________________________________________
Pegando o registro do windows
Unit Registry
Código:
procedure TSplash_Form.FormActivate(Sender: TObject);
var
reg: TRegIniFile;
begin
reg := TReginiFile.Create('SOFTWARE\MICROSOFT\MS SETUP (ACME)');
Label1.Caption := reg.ReadString('USER INFO','DefName','');
reg.Free;
end;
________________________________________________________________________
Executar um AVI no Form
Código:
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
with MediaPlayer1 do
begin
FileName := 'c:\windows\help\scroll.avi';
Open;
Display := Form2;
Form2.Show;
Play;
end;
end;
________________________________________________________________________
Criando um arquivo de texto
Código:
procedure AddLog;
var
log: textfile;
begin
try
AssignFile(log, 'c:\log.log');
if not FileExists('c:\log.log') then Rewrite(log,'c:\log.log');
Append(log);
WriteLn(log, 'informações a serem inclusas');
finally
CloseFile(log);
end;
end;
________________________________________________________________________
A melhor maneira de liberar um form da memoria
Código:
FormXX := TFormXX.create ( application );
try
FormXX.ShowModal
finally
FormXX.Release;
FormXX := nil;
end;
__________________________________________________ ______________________
Função que arredonda valores
Código:
function Arredondar(Valor: Double; Dec: Integer): Double;
var
Valor1,
Numero1,
Numero2,
Numero3: Double;
begin
Valor1:=Exp(Ln(10) * (Dec + 1));
Numero1:=Int(Valor * Valor1);
Numero2:=(Numero1 / 10);
Numero3:=Round(Numero2);
Result:=(Numero3 / (Exp(Ln(10) * Dec)));
end;
________________________________________________________________________
13 Pequenas modificações no Delphi
As alterações abaixo devem ser feitas no registro com muito cuidado! Faça um backup do seu registro antes de iniciar a alteração!
1) Fazer com que a orelha da paleta de componentes seja automaticamente selecionada quando o mouse estiver sob ela:
[HKEY_CURRENT_USER\Software\Borland\Delphi\5.0\Extr as]
"AutoPaletteSelect"="1"
2) Fazer o Scroll para a direita e para a esquerda quando o mouse estiver sobe as setas da paleta de componentes:
[HKEY_CURRENT_USER\Software\Borland\Delphi\5.0\Extr as]
"AutoPaletteScroll"="1"
3) Desabilitar a seleção de menus com seqüências de Ctrl+Alt em teclados internacionais
[HKEY_CURRENT_USER\Software\Borland\Delphi\5.0\Edit or\Options]
"NoCtrlAltKeys"="0"
4) Forçar o texto da direita para a esquerda no form designer (? ainda nãovi funcionando)
[HKEY_CURRENT_USER\Software\Borland\Delphi\5.0\Form Design]
"AlwaysEnableMiddleEast"="0"
5) Mostrar as fontes no object inspector. Fica lento se houver muitas fontes instaladas
[HKEY_CURRENT_USER\Software\Borland\Delphi\5.0\Extr as]"FontNamePropertyDisplayFontNames"="1"
6) Mostra erros de compilação no message view window
[HKEY_CURRENT_USER\Software\Borland\Delphi\5.0\Comp iling]
"ShowCodeInsiteError"="1"
7) Mudar a cor da metade da direita ad paleta de propriedades do object inspector
[HKEY_CURRENT_USER\Software\Borland\Delphi\5.0\Glob als]
"PropValueColor"="clNavy"
Cool Desabilitar pacotes
[HKEY_CURRENT_USER\Software\Borland\Delphi\5.0\Disa bled Packages]
"$(DELPHI)\Bin\dcldss50.bpl"="
9) Valor default de TwoDigitYearCenturyWindow (see the help file)
[HKEY_CURRENT_USER\Software\Borland\Delphi\5.0\Glob als]
"TwoDigitYearCenturyWindow"="50"
10) Diretório alternativo de componentes templates(shared/network)
[HKEY_CURRENT_USER\Software\Borland\Delphi\5.0\Comp onent Templates]
"CCLibDir"="C:\\D5\\Lib\\Comps"
11) Fonte Default para novos formulários
[HKEY_CURRENT_USER\Software\Borland\Delphi\5.0\Form Design]
"DefaultFont"="MSSansSerif,10,Normal"
12) Não perguntar ao mudar o atual JIT debugger (? ainda não vi funcionando)
[HKEY_CURRENT_USER\Software\Borland\Delphi\5.0\Debu gging]
"DontPromptForJITDebugger"="0"
13) Dll usada para a versão de controle de interface na IDE
[HKEY_CURRENT_USER\Software\Borland\Delphi\5.0\Vers ion Control]
"VCSManager"="C:\\D5\\VersCtrl\\VersCtrl.dll"
________________________________________________________________________
Caracteres Especiais que compõem uma MaskEdit
Caracter Descrição
! Espaços em branco não aparecerão
> Todos os caracteres seguintes serão maiúsculos até que apareça o caracter
< Todos os caracteres seguintes serão minúsculos até que apareça o caracter
\ Indica um caracter literal
l (L minusculo) Somente caracter alfabético
L Obrigatoriamente um caracter alfabético (A-Z, a-z)
a Somente caracter alfanumérico
A Obrigatoriamente caractere alfanumérico ( A-Z, a-z, 0-9)
9 Somente caracter numérico
0 Obrigatoriamente caracter numérico
c permite um caracter
C Obrigatoriamente um caracter
# Permite um caracter numérico ou sinal de mais ou de menos, mas não os requer.
: Separador de horas, minutos e segundos
/ Separador de dias, meses e anos
________________________________________________________________________
Validando CEP
Código:
Function ValidarCEP(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;
________________________________________________________________________
DEFINIDO O TAMANHO MÍNIMO E MÁXIMO DE UM FORM
Código:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TForm1 = class(TForm)
private
{ Private declarations }
procedure WMGetMinMaxInfo(var MSG: TMessage); message WM_GetMinMaxInfo;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.WMGetMinMaxInfo(var MSG: TMessage);
begin
inherited;
with PMinMaxInfo(MSG.lparam)^ do begin
ptMinTRackSize.X := 300;
ptMinTRackSize.Y := 150;
ptMaxTRackSize.X := 350;
ptMaxTRackSize.Y := 250;
end;
end;
end.
________________________________________________________________________
Evento Som Padrão
MessageBeep(0); { no Delphi 2.0 é só usar BEEP; }
Evento Parada Crítica
MessageBeep(16);
Evento Pergunta
MessageBeep(32);
Evento Exclamação
MessageBeep(4Cool;
Evento Asterisco
MessageBeep(64);
________________________________________________________________________
GERANDO SENHAS ALEATORIAS
Código:
procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
const
str='1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ';
max=6;
begin
Edit1.Text:='';
for i:=1 to max do
begin
Edit1.Text:=Edit1.Text+str[random(length(str))+1];
end;
end.
________________________________________________________________________
Tocando Sons WAV
Para reproduzir sons no formato WAV em um programa em Delphi é simples, o usuário deverá colocar na clásula Uses o MMSystem. E no corpo do programa o comando:
Código:
SndPlaySound('C:\Windows\Media\Som.wav',SND_ASYNC);
________________________________________________________________________
Deletando um arquivo
if FileExists('C:\MEUDIR\MEUARQ.DAT') then
DeleteFile('C:\MEUDIR\MEUARQ.DAT');
__________________________________________________ ______________________
Como validar a entrada em um TEdit
Código:
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
begin
If not( key in['0'..'9',#8] ) then
begin
beep;{somente delphi 2.0 ou >}
key:=#0;
end;
end;
________________________________________________________________________
Função que retorna o nome do Computador
Uses Registry;
Código:
function TForm1.Getcomputer : string;
var
registro : tregistry;
begin
registro:=tregistry.create;
registro.RootKey:=HKEY_LOCAL_MACHINE;
registro.openkey('System\CurrentControlSet\Services\VXD\VNETSUP',false);
result:=registro.readstring('ComputerName');
end;
________________________________________________________________________
Fazer a barra de título ficar intermitente (piscante)
Inclua na seção uses: Windows
{ Coloque um TTimer no Form desejado. Define a propriedade Interval do Timer para 1000 (1 segundo). Modifique o evento OnTimer do Timer conforme abaixo: }
Código:
procedure TForm1.Timer1Timer(Sender: TObject);
begin
FlashWindow(Handle, true);
FlashWindow(Application.Handle, true);
end;
__________________________________________________ ______________________
Jogar uma imagem direto para um campo da tabela
Código:
procedure TForm1.Button1Click(Sender: TObject);
var BMP: TBitMap;
begin
BMP := TBitMap.Create;
if OpenPictureDialog1.Execute then
begin
if Table1.State in [dsInsert, dsEdit] then
begin
BMP.LoadFromFile(OpenPictureDialog1.FileName);
Table1Graphic.Assign( BMP );
end;
end;
end;
________________________________________________________________________
Colocar Zeros a Direita de um Inteiro
Código:
function StrZero(Num, Size: Integer): String;
var
Text: String;
i, Tam: integer;
begin
Text := IntToStr(Num);
Tam := Length(Text);
for i := 1 to (Size-Tam) do
Text := '0' + Text;
Result := Text;
end;
________________________________________________________________________
Calcular Idade
Código:
function CalcIdade( DtNasc: String): Integer;
var
AnoNasc, MesNasc, DiaNasc: Integer;
AnoAtu, MesAtu, DiaAtu, Idade: Integer;
begin
AnoNasc := StrToInt(Copy(DtNasc,7,4));
MesNasc := StrToInt(Copy(DtNasc,4,2));
DiaNasc := StrToInt(Copy(DtNasc,1,2));
AnoAtu := StrToInt(Copy(DateToStr(Date()),7,4));
MesAtu := StrToInt(Copy(DateToStr(Date()),4,2));
DiaAtu := StrToInt(Copy(DateToStr(Date()),1,2));
Idade := 0;
if AnoAtu > AnoNasc then
begin
Idade := AnoAtu - AnoNasc;
if (MesAtu < MesNasc) or
((MesAtu = MesNasc) and (DiaAtu < DiaNasc)) then
Idade := Idade - 1;
end;
Result := Idade;
end;
________________________________________________________________________
Creditos: JM'
Obrigado.
// Requer a Jpeg declarada na clausua uses da unit
Código:
function JpgToBmp(cImage: String): Boolean;
var
MyJPEG : TJPEGImage;
MyBMP : TBitmap;
begin
Result := False;
if fileExists(cImage+'.Jpeg') then
begin
MyJPEG := TJPEGImage.Create;
with MyJPEG do
begin
try
LoadFromFile(cImage+'.Jpeg');
MyBMP := TBitmap.Create;
with MyBMP do
begin
Width := MyJPEG.Width;
Height := MyJPEG.Height;
Canvas.Draw(0,0,MyJPEG);
SaveToFile(cImage+'.Bmp');
Free;
Result := True;
end;
finally
Free;
end;
end;
end;
end;
________________________________________________________________________
Pegando o registro do windows
Unit Registry
Código:
procedure TSplash_Form.FormActivate(Sender: TObject);
var
reg: TRegIniFile;
begin
reg := TReginiFile.Create('SOFTWARE\MICROSOFT\MS SETUP (ACME)');
Label1.Caption := reg.ReadString('USER INFO','DefName','');
reg.Free;
end;
________________________________________________________________________
Executar um AVI no Form
Código:
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
with MediaPlayer1 do
begin
FileName := 'c:\windows\help\scroll.avi';
Open;
Display := Form2;
Form2.Show;
Play;
end;
end;
________________________________________________________________________
Criando um arquivo de texto
Código:
procedure AddLog;
var
log: textfile;
begin
try
AssignFile(log, 'c:\log.log');
if not FileExists('c:\log.log') then Rewrite(log,'c:\log.log');
Append(log);
WriteLn(log, 'informações a serem inclusas');
finally
CloseFile(log);
end;
end;
________________________________________________________________________
A melhor maneira de liberar um form da memoria
Código:
FormXX := TFormXX.create ( application );
try
FormXX.ShowModal
finally
FormXX.Release;
FormXX := nil;
end;
__________________________________________________ ______________________
Função que arredonda valores
Código:
function Arredondar(Valor: Double; Dec: Integer): Double;
var
Valor1,
Numero1,
Numero2,
Numero3: Double;
begin
Valor1:=Exp(Ln(10) * (Dec + 1));
Numero1:=Int(Valor * Valor1);
Numero2:=(Numero1 / 10);
Numero3:=Round(Numero2);
Result:=(Numero3 / (Exp(Ln(10) * Dec)));
end;
________________________________________________________________________
13 Pequenas modificações no Delphi
As alterações abaixo devem ser feitas no registro com muito cuidado! Faça um backup do seu registro antes de iniciar a alteração!
1) Fazer com que a orelha da paleta de componentes seja automaticamente selecionada quando o mouse estiver sob ela:
[HKEY_CURRENT_USER\Software\Borland\Delphi\5.0\Extr as]
"AutoPaletteSelect"="1"
2) Fazer o Scroll para a direita e para a esquerda quando o mouse estiver sobe as setas da paleta de componentes:
[HKEY_CURRENT_USER\Software\Borland\Delphi\5.0\Extr as]
"AutoPaletteScroll"="1"
3) Desabilitar a seleção de menus com seqüências de Ctrl+Alt em teclados internacionais
[HKEY_CURRENT_USER\Software\Borland\Delphi\5.0\Edit or\Options]
"NoCtrlAltKeys"="0"
4) Forçar o texto da direita para a esquerda no form designer (? ainda nãovi funcionando)
[HKEY_CURRENT_USER\Software\Borland\Delphi\5.0\Form Design]
"AlwaysEnableMiddleEast"="0"
5) Mostrar as fontes no object inspector. Fica lento se houver muitas fontes instaladas
[HKEY_CURRENT_USER\Software\Borland\Delphi\5.0\Extr as]"FontNamePropertyDisplayFontNames"="1"
6) Mostra erros de compilação no message view window
[HKEY_CURRENT_USER\Software\Borland\Delphi\5.0\Comp iling]
"ShowCodeInsiteError"="1"
7) Mudar a cor da metade da direita ad paleta de propriedades do object inspector
[HKEY_CURRENT_USER\Software\Borland\Delphi\5.0\Glob als]
"PropValueColor"="clNavy"
Cool Desabilitar pacotes
[HKEY_CURRENT_USER\Software\Borland\Delphi\5.0\Disa bled Packages]
"$(DELPHI)\Bin\dcldss50.bpl"="
9) Valor default de TwoDigitYearCenturyWindow (see the help file)
[HKEY_CURRENT_USER\Software\Borland\Delphi\5.0\Glob als]
"TwoDigitYearCenturyWindow"="50"
10) Diretório alternativo de componentes templates(shared/network)
[HKEY_CURRENT_USER\Software\Borland\Delphi\5.0\Comp onent Templates]
"CCLibDir"="C:\\D5\\Lib\\Comps"
11) Fonte Default para novos formulários
[HKEY_CURRENT_USER\Software\Borland\Delphi\5.0\Form Design]
"DefaultFont"="MSSansSerif,10,Normal"
12) Não perguntar ao mudar o atual JIT debugger (? ainda não vi funcionando)
[HKEY_CURRENT_USER\Software\Borland\Delphi\5.0\Debu gging]
"DontPromptForJITDebugger"="0"
13) Dll usada para a versão de controle de interface na IDE
[HKEY_CURRENT_USER\Software\Borland\Delphi\5.0\Vers ion Control]
"VCSManager"="C:\\D5\\VersCtrl\\VersCtrl.dll"
________________________________________________________________________
Caracteres Especiais que compõem uma MaskEdit
Caracter Descrição
! Espaços em branco não aparecerão
> Todos os caracteres seguintes serão maiúsculos até que apareça o caracter
< Todos os caracteres seguintes serão minúsculos até que apareça o caracter
\ Indica um caracter literal
l (L minusculo) Somente caracter alfabético
L Obrigatoriamente um caracter alfabético (A-Z, a-z)
a Somente caracter alfanumérico
A Obrigatoriamente caractere alfanumérico ( A-Z, a-z, 0-9)
9 Somente caracter numérico
0 Obrigatoriamente caracter numérico
c permite um caracter
C Obrigatoriamente um caracter
# Permite um caracter numérico ou sinal de mais ou de menos, mas não os requer.
: Separador de horas, minutos e segundos
/ Separador de dias, meses e anos
________________________________________________________________________
Validando CEP
Código:
Function ValidarCEP(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;
________________________________________________________________________
DEFINIDO O TAMANHO MÍNIMO E MÁXIMO DE UM FORM
Código:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TForm1 = class(TForm)
private
{ Private declarations }
procedure WMGetMinMaxInfo(var MSG: TMessage); message WM_GetMinMaxInfo;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.WMGetMinMaxInfo(var MSG: TMessage);
begin
inherited;
with PMinMaxInfo(MSG.lparam)^ do begin
ptMinTRackSize.X := 300;
ptMinTRackSize.Y := 150;
ptMaxTRackSize.X := 350;
ptMaxTRackSize.Y := 250;
end;
end;
end.
________________________________________________________________________
Evento Som Padrão
MessageBeep(0); { no Delphi 2.0 é só usar BEEP; }
Evento Parada Crítica
MessageBeep(16);
Evento Pergunta
MessageBeep(32);
Evento Exclamação
MessageBeep(4Cool;
Evento Asterisco
MessageBeep(64);
________________________________________________________________________
GERANDO SENHAS ALEATORIAS
Código:
procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
const
str='1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ';
max=6;
begin
Edit1.Text:='';
for i:=1 to max do
begin
Edit1.Text:=Edit1.Text+str[random(length(str))+1];
end;
end.
________________________________________________________________________
Tocando Sons WAV
Para reproduzir sons no formato WAV em um programa em Delphi é simples, o usuário deverá colocar na clásula Uses o MMSystem. E no corpo do programa o comando:
Código:
SndPlaySound('C:\Windows\Media\Som.wav',SND_ASYNC);
________________________________________________________________________
Deletando um arquivo
if FileExists('C:\MEUDIR\MEUARQ.DAT') then
DeleteFile('C:\MEUDIR\MEUARQ.DAT');
__________________________________________________ ______________________
Como validar a entrada em um TEdit
Código:
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
begin
If not( key in['0'..'9',#8] ) then
begin
beep;{somente delphi 2.0 ou >}
key:=#0;
end;
end;
________________________________________________________________________
Função que retorna o nome do Computador
Uses Registry;
Código:
function TForm1.Getcomputer : string;
var
registro : tregistry;
begin
registro:=tregistry.create;
registro.RootKey:=HKEY_LOCAL_MACHINE;
registro.openkey('System\CurrentControlSet\Services\VXD\VNETSUP',false);
result:=registro.readstring('ComputerName');
end;
________________________________________________________________________
Fazer a barra de título ficar intermitente (piscante)
Inclua na seção uses: Windows
{ Coloque um TTimer no Form desejado. Define a propriedade Interval do Timer para 1000 (1 segundo). Modifique o evento OnTimer do Timer conforme abaixo: }
Código:
procedure TForm1.Timer1Timer(Sender: TObject);
begin
FlashWindow(Handle, true);
FlashWindow(Application.Handle, true);
end;
__________________________________________________ ______________________
Jogar uma imagem direto para um campo da tabela
Código:
procedure TForm1.Button1Click(Sender: TObject);
var BMP: TBitMap;
begin
BMP := TBitMap.Create;
if OpenPictureDialog1.Execute then
begin
if Table1.State in [dsInsert, dsEdit] then
begin
BMP.LoadFromFile(OpenPictureDialog1.FileName);
Table1Graphic.Assign( BMP );
end;
end;
end;
________________________________________________________________________
Colocar Zeros a Direita de um Inteiro
Código:
function StrZero(Num, Size: Integer): String;
var
Text: String;
i, Tam: integer;
begin
Text := IntToStr(Num);
Tam := Length(Text);
for i := 1 to (Size-Tam) do
Text := '0' + Text;
Result := Text;
end;
________________________________________________________________________
Calcular Idade
Código:
function CalcIdade( DtNasc: String): Integer;
var
AnoNasc, MesNasc, DiaNasc: Integer;
AnoAtu, MesAtu, DiaAtu, Idade: Integer;
begin
AnoNasc := StrToInt(Copy(DtNasc,7,4));
MesNasc := StrToInt(Copy(DtNasc,4,2));
DiaNasc := StrToInt(Copy(DtNasc,1,2));
AnoAtu := StrToInt(Copy(DateToStr(Date()),7,4));
MesAtu := StrToInt(Copy(DateToStr(Date()),4,2));
DiaAtu := StrToInt(Copy(DateToStr(Date()),1,2));
Idade := 0;
if AnoAtu > AnoNasc then
begin
Idade := AnoAtu - AnoNasc;
if (MesAtu < MesNasc) or
((MesAtu = MesNasc) and (DiaAtu < DiaNasc)) then
Idade := Idade - 1;
end;
Result := Idade;
end;
________________________________________________________________________
Creditos: JM'
Obrigado.