Delphi

Como executar programas externos

Winexec('Command.com /C Teste.exe',Tipo_de_Janela);

Tipo_de_Janela :

SW_SHOWNORMAL - Visualização normal da janela
SW_MAXIMIZE - Janela maximizada
SW_MINIMIZE - Janela minimizada
SW_HIDE - Escondido

Tecla ENTER funcionar como TAB

Setar a propriedade KeyPreview do Form para True.
Setar a propriedade Default de todos os botões do Form para False.
Criar um evento OnKeyPress para o Form como este:

Procedure Tform1.FormKeyPress(Sender: Tobject; var Key: Char);
begin
If key = #13 then
Begin
Key:= #0;
Perform(Wm_NextDlgCtl,0,0);
end;
end;

Alterando Idapi32.Cfg Via Programa

Check(DbiAddAlias(Nil, PChar(' AliasName '), Nil, PChar(' AliasPath'), True));

Substitua AliasName pelo nome do alias que você quer criar e em AliasPath pelo path dos arquivos de dados que você quer no seu alias.

Inclua na cláusula "USES" as units BD e BDE.

Trocando a cor da fonte num DBGrid

Coloque a propriedade defaultdrawdata do dbgrid em FALSE;
No evento onDrawColumnCell do dbgrid coloque o código para mudar a cor do font do dbgrid e a chave do método para "desenhar" os dados.

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject;
const Rect: TRect; DataCol: Integer; Column: TColumn;
State: TGridDrawState);
begin
If Condição then Dbgrid1.Canvas.Font.Color:= clFuchsia; // coloque aqui a cor desejada
Dbgrid1.DefaultDrawDataCell(Rect, dbgrid1.columns[datacol].field, State);
end;

Pegando a linha e coluna atuais de um memo

With Memo1 do
begin
Line:= Perform(EM_LINEFROMCHAR,SelStart, 0);
Column:= SelStart - Perform(EM_LINEINDEX, Line, 0);
end;

Habilitar e desabilitar ctrl+alt+del

// desabilita
procedure TForm1.Button1Click(Sender: TObject);
var
numero: integer;
begin
SystemParametersInfo(97,Word(true),@numero,0);
end;

// habilita
procedure TForm1.Button2Click(Sender: TObject);
var
numero: integer;
begin
SystemParametersInfo(97,Word(false),@numero,0);
end;

Criando uma Splash Screen (abertura)

Você pode criar uma tela de abertura no seu programa em Delphi. Após ter criado um formulário principal, crie um formulário para a tela de abertura. Aqui iremos chamá-lo de ABERTURAFORM.

Depois de criar os dois formulários, clique no menu VIEW, na opção PROJECT SOURCE, que permite que seja exibido o código do arquivo principal do projeto. Localize no código a linha em que o formulário de abertura é criado e apague-a (ou coloque em modo de observação, inserindo // no início da linha).

Linha que deve ser apagada:

begin
...
Application.CreateForm(TAberturaForm, AberturaForm); {Esta linha deve ser apagada}
...
end;

Após remover a linha acima, insira as linhas abaixo antes da criação dos demais formulários do seu aplicativo:

Linhas que devem ser inseridas:

begin
AberturaForm:= TAberturaForm.Create(Application);
AberturaForm.show
{Os demais formulários devem ser criados aqui}
...
AberturaForm.Hide;
AberturaForm.Free;
Application.Run;
End;

Os comandos...

AberturaForm:= TAberturaForm.Create(Application); - cria o formulário
AberturaForm.Show - exibe o formulário de abertura na tela
AberturaForm.Hide; - esconde o formulário de abertura
AberturaForm.Free; - tira o formulário da memória

Pegar nome do usuário na rede

function TForm1.usuario : string;
var
szNetName: Array[0..48] of Char;
iResult: DBIResult;
begin
iResult:= DBIGetNetUserName(szNetName);
if iResult <> DBIErr_None then
DBIError( iResult )
else
Result:= StrPas(szNetName);
end;

Colocar na chamada de Uses de sua Unit as seguintes DCUs : DBITYPES, DBIPROCS, DBIERRS e DB.

Criando tabelas

var
Tabela: TTable;
Indices: TIndexOptions;
begin
Tabela:= TTable.Create;
Indices:= [ixPrimary, IxUnique];
with Tabela do
begin
active:= false;
databasename:= 'c:\teste';
tablename:= 'Tabela';
tabletype:= ttDefault;
fielddefs.clear;
fielddefs.add('Codigo', ftInteger, 0, false);
...
indexdefs.clear;
indexdefs.add('Codigo_Chave', 'codigo', Indices);
CreateTable;
end;

Gerenciando mais de uma linha selecionada num DBGrid (Multiselect)

O DBGrid tem uma propriedade não documentada chamada SelectedRows
(Tbookmark). Com ela você pode gerenciar Multiselect da seguinte forma:

var
contador: Integer;
begin
With Dbgrid1 do
Begin
for contador:= 0 to Pred(SelectedRows.Count) do
Begin
Datasource.Dataset.Bookmark:= SelectedRows[contador]; // posiciona nos registros selecionados do DBGrid
end;
end;

Reproduzindo sons wav, sem o componente mediaplayer

Coloque na clásula Uses a unit MMSystem

SndPlaySound('C:\Windows\Media\Som.wav',SND_ASYNC);

Número de série do hd

Function TForm1.SerialNum(FDrive:String) :String;
var
Serial: DWord;
DirLen, Flags: DWord;
DLabel : Array[0..11] of Char;
begin
Try
GetVolumeInformation(PChar(FDrive+':\'),dLabel,12,@Serial,DirLen,Flags,nil,0);
Result := IntToHex(Serial,8);
Except
Result := '';
end;
end;

Extraindo o ano, mês ou dia de uma data via SQL

Select * from nome_tabela where extract(year from campo_data) = 1997

Você pode extrair o mês (MONTH) ou o dia (DAY).

Como formatar números com zeros à esquerda

var
Numero: Integer;
begin
Numero:= 123;
Edit1.text:= Format('%5.5d',[Numero]); // resulta '00123';
end;

Data por extenso no Quickreport

var
nrdia: Integer;
diasemana: array[1..7] of String;
meses: array[1..12] of String;
dia, mes, ano: Word;
begin
diasemana[1]:= 'Domingo';
diasemana[2]:= 'Segunda-feira';
diasemana[3]:= 'Terça-feira';
diasemana[4]:= 'Quarta-feira';
diasemana[5]:= 'Quinta-feira';
diasemana[6]:= 'Sexta-feira';
diasemana[7]:= 'Sábado';
meses[1]:= 'Janeiro';
meses[2]:= 'Fevereiro';
meses[3]:= 'Março';
meses[4]:= 'Abril';
meses[5]:= 'Maio';
meses[6]:= 'Junho';
meses[7]:= 'Julho';
meses[8]:= 'Agosto';
meses[9]:= 'Setembro';
meses[10]:= 'Outubro';
meses[11]:= 'Novembro';
meses[12]:= 'Dezembro';
DecodeDate(DATE,ano,mes,dia);
nrdia:= DayOfWeek(DATE);
QRLabel1.Caption:= diasemana[nrdia]+', '+INTTOSTR(dia)+' de '+meses[mes]+' de '+INTTOSTR(ano);

Imprimindo um campo memo via Canvas

Coloque na clásula Uses a unit printers

procedure TForm1.Button1Click(Sender: TObject);
var
i, altura : Integer;
sMemo : String;
begin
With Printer do
begin
Title:= 'Imprimindo memo';
BeginDoc;
With Canvas do
begin
altura := TextHeight('A');
for i := 1 to Memo1.Lines.Count do
begin
sMemo := Memo1.Lines[I];
TextOut(1, (i - 1) * Altura, sMemo);
end;
end;
EndDoc;
end;
end;

Procura e substituição de string num campo memo

Procedure TForm1.Button1Click (Sender: TObject);
Begin
FindReplace(Edit1.Text,Edit2.Text, Memo1);
end;

Procedure FindReplace (const Enc, subs: String; Var Texto: TMemo);
Var
i, Posicao: Integer;
Linha: string;
Begin
For i:= 0 to Texto.Lines.count - 1 do
begin
Linha := Texto. Lines[i];
Repeat
Posicao:=Pos(Enc,Linha);
If Posicao > 0 then
Begin
Delete(Linha,Posicao,Length(Enc));
Insert(Subs,Linha,Posicao);
Texto.Lines[i]:=Linha;
end;
until Posicao = 0;
end;
end;

Como limpar todos os edits de um form

procedure TForm1.Button1Click(Sender: TObject);
var i : integer;
begin
for i := 0 to ComponentCount-1 do
begin
If Components[i].ClassName = 'TEdit' then
Tedit(Components[i]).clear; // ou TEdit(components[i]).text:= ''
end;
end;

Testando drives

function TForm1.TemDiscoNoDrive(const drive : char): boolean;
var
DriveNumero : byte;
EMode : word;
begin
result := false;
DriveNumero := ord(Drive);
if DriveNumero >= ord('a') then
dec(DriveNumero,$20);
EMode := SetErrorMode(SEM_FAILCRITICALERRORS);
try
if DiskSize(DriveNumero-$40) <> -1 then
Result := true
else
messagebeep(0);
finally
SetErrorMode(EMode);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if TemDiscoNoDrive('a') then
ShowMessage('Tem disco no drive A:')
else
ShowMessage('Não tem disco no drive A:');
end;

Como saber o estado das teclas Num lock, Caps lock e Scroll lock

Para saber o estado das teclas acima citadas, utilize a função getkeystate em conjunto com o código das teclas, ela retorna 0 se a tecla estiver OFF e 1 se a tecla estiver ON, assim:

If getkeystate(vk_numlock) = 0 then // Num lock está OFF
If getkeystate(vk_numlock) = 1 then // Num lock está ON
If getkeystate(vk_scroll) = 0 then // Scroll lock está OFF
If getkeystate(vk_scroll) = 1 then // Scroll lock está ON
If getkeystate(vk_CAPITAL) = 0 then // Caps lock está OFF
If getkeystate(vk_CAPITAL) = 1 then // Caps lock está ON

Como compartilhar uma pasta de um outro micro e mapear com uma letra

var
err : DWord;
PServer, PSenha, PLetra : PChar;
Begin
PServer := '\\Caminho\Caminho' + #0;
PLetra := 'L:';
PSenha := '';

ERR := WNetAddConnection ( PServer , PSenha , PLetra );

CASE ERR of
ERROR_ACCESS_DENIED : ShowMessage ( 'Acesso negado.' );
ERROR_ALREADY_ASSIGNED : ShowMessage ( 'A letra do drive especificada já está conectada.' );
ERROR_BAD_DEV_TYPE : ShowMessage ( 'O tipo de dispositivo e o tipo de recurso não são compatíveis.' );
ERROR_BAD_DEVICE : ShowMessage ( 'Letra inválida.' );
ERROR_BAD_NET_NAME : ShowMessage ( 'Nome do servidor não é válido ou não pode ser localizado.' );
ERROR_BAD_PROFILE : ShowMessage ( 'Formato incorreto de parâmetros.' );
ERROR_CANNOT_OPEN_PROFILE : ShowMessage ( 'Conexão permanente não disponível.' );
ERROR_DEVICE_ALREADY_REMEMBERED : ShowMessage ( 'Uma entrada para o dispositivo especificado já está no perfil do usuário.' );
ERROR_EXTENDED_ERROR : ShowMessage ( 'Erro de rede.' );
ERROR_INVALID_PASSWORD : ShowMessage ( 'Senha especificada inválida.' );
ERROR_NO_NET_OR_BAD_PATH : ShowMessage ( 'A operação não foi concluída porque a rede não foi inicializada ou caminho é inválido.' );
ERROR_NO_NETWORK : ShowMessage ( 'A rede não está presente.' );
else if Err > 0 then
ShowMessage (IntToStr(Err));
end;
end;

Commit (Delphi 3)

Inclua DBISaveChanges(Nome da Tabela.handle) no evento After Post. Inclua em uses a biblioteca DBIProcs.

procedure TForm1.Table1AfterPost(DataSet: TDataSet);
begin
DBISaveChanges(TTable(Dataset).handle);
end;

Como extrair o ícone de um executável

Inclua a unit Shellapi na cláusula uses do seu form.

Image1.Picture.Icon.Handle:= ExtractIcon(Handle,PChar('c:\windows\calc.exe'),0);

Aguardar um determinado número de segundos

procedure TForm1.Delay(Tempo: Word);
var x1: Double;
begin
x1:= now;
repeat until ((now-x1)*86400) > Tempo;
end;

Como extrair o número de cores do modo de vídeo corrente do Windows95

var
hnd: THandle;
bitsPorPixel: integer;
begin
hnd:= GetDC( Handle );
bitsPorPixel:= GetDeviceCaps( hnd, BITSPIXEL );
// 8 = 256 cores; 16 = high color; 24 = true color
end;

Verificando a memória

var
MemoryStatus: TMemoryStatus;
begin
MemoryStatus.dwLength:= sizeof(MemoryStatus);
GlobalMemoryStatus(MemoryStatus);
Label1.Caption := 'Total de memória física : ' + IntToStr(MemoryStatus.dwTotalPhys);
end;

{typedef struct _MEMORYSTATUS
DWORD dwLength; // sizeof(MEMORYSTATUS)
DWORD dwMemoryLoad; // percentual de memória em uso
DWORD dwTotalPhys; // bytes de memória física
DWORD dwAvailPhys; // bytes livres de memória física
DWORD dwTotalPageFile; // bytes de paginação de arquivo
DWORD dwAvailPageFile; // bytes livres de paginação de arquivo
DWORD dwTotalVirtual; // bytes em uso de espaço de endereço
DWORD dwAvailVirtual; // bytes livres}

Trocando a cor de uma célula num DBGrid

No evento onDrawColumnCell do dbgrid coloque o código para mudar a cor da fonte do dbgrid e a chave do método para "desenhar" os dados.

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
if (Column.Field.FieldName = 'NOMEDOCAMPO') then
begin
if condição then // coloque aqui sua condição
begin
DBGrid1.Canvas.Brush.Color:= clAqua;
DBGrid1.Canvas.Font.Color:= clWindowText;
DBGrid1.Canvas.FillRect(Rect);
DBGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, State);
end;
end;
end;

Exponenciação

Inclua a unit Math na clausula uses do seu form. Depois disso utilize a função Power.

Edit1.text:= FloatToStr(Power(2,4));

Como manipular arquivos INI

Inclua a unit IniFiles na clausula uses do seu form.

Procedure TForm1.GravaIni( Numero : Longint ; Texto : String ; Condicao : Boolean);
var
ArqIni : TIniFile;
begin
ArqIni := TIniFile.Create('c:\windows\temp\Teste.Ini');
Try
ArqIni.WriteInteger('Dados', 'Numero', Numero);
ArqIni.WriteString('Dados', 'Texto', Texto);
ArqIni.WriteBool('Dados', 'Condição', Condicao);
Finally
ArqIni.Free;
end;
end;

Procedure TForm1.LeIni( Var Numero : Longint ; Var Texto : String ; Var Condicao : Boolean);
var
ArqIni : tIniFile;
begin
ArqIni := tIniFile.Create('c:\windows\temp\Teste.Ini');
Try
Numero := ArqIni.ReadInteger('Dados', 'Numero', Numero );
Texto := ArqIni.ReadString('Dados', 'Texto', Texto );
Condicao := ArqIni.ReadBool('Dados', 'Condição', Condicao );
Finally
ArqIni.Free;
end;
end;

Utilize as procedures assim:

procedure TForm1.Button1Click(Sender: TObject);
begin
GravaIni(1234,'TESTE',True);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
N: Integer;
T: String;
C: Boolean;
begin
LeIni(N,T,C);
Showmessage(IntToStr(N)+' '+T);
end;

Como extrair o número do registro atual em tabelas Paradox ou Dbase

Inclua a unit BDE na clausula uses do seu form.

procedure TForm1.DataSource1DataChange(Sender: TObject; Field: TField);
var
CP: CurProps;
RP: RecProps;
RecID: Longint;
begin
with Table1 do
begin
UpdateCursorPos;
Check(DbiGetCursorProps(Handle, CP));
Check(DbiGetRecord(Handle, dbiNOLOCK, nil, @RP));
if StrComp(CP.szTableType, szDBASE) = 0 then
RecID := RP.iPhyRecNum
else if StrComp(CP.szTableType, szPARADOX) = 0 then
RecID := RP.iSeqNum
else raise EDatabaseError.Create('ERRO! Não é uma tabela Paradox ou dBASE.');
end;
Label1.Caption:= IntToStr(RecID) +' de '+ IntToStr(Table1.recordcount);
end;

Como extrair o tamanho de um arquivo

function TForm1.TamArquivo(Arquivo: string): Integer;
begin
with TFileStream.Create(Arquivo, fmOpenRead or fmShareExclusive) do
try
Result := Size;
finally
Free;
end;
end;

Utilize a função assim:

procedure TForm1.Button1Click(Sender: TObject);
begin
edit1.text:= inttostr(TamArquivo('CAMINHO\NOMEDOARQUIVO'));
end;

Como alterar a data e a hora do sistema

procedure TForm1.Button1Click(Sender: TObject);
var
SystemTime : TSystemTime;
begin
With SystemTime do
begin
//Definindo o dia do sistema
wYear:= 1996;
wMonth:= 5;
wDay:= 10;
//Definindo a hora do sistema
wHour:= 20; //hora
wMinute:= 50; //minutos
wSecond:= 59; //segundos
end;
//Colocar a hora e data do sistema
SetLocalTime(SystemTime);
end;

Voltar