[DELPHI 7] Vários Códigos e Dicas

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'