Executar programa do DOS e fechá-lo em seguida 



{ Coloque isto no evento OnClick de um botão: }

WinExec('command.com /c programa.exe',sw_ShowNormal);

{ Se quizer passar parâmetros pasta adicioná-los após o
nome do programa. Exemplo: }

WinExec('command.com /c programa.exe param1 param2',sw_ShowNormal); 





 

 

Reproduzir arquivos de som WAV 





{ Inclua na seção uses: MMSystem }

PlaySound('C:\NomedoArquivodeSom.wav', 1, SND_ASYNC); 




 


Enviar Arquivo para lixeira 





Inclua na seção uses: ShellApi

{ Coloque a procedure abaixo na seção implementation }

procedure ArqParaLixeira(const NomeArq: string; var MsgErro: string);
var
Op: TSHFileOpStruct;
begin
MsgErro := '';
if not FileExists(NomeArq) then begin
MsgErro := 'Arquivo não encontrado.';
Exit;
end;
FillChar(Op, SizeOf(Op), 0);
with Op do begin
wFunc := FO_DELETE;
pFrom := PChar(NomeArq);
fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_SILENT;
end;
if ShFileOperation(Op) <> 0 then
MsgErro := 'Não foi possível enviar o arquivo para a lixeira.';
end;

{ - Coloque um botão no Form;
- Altere o evento OnClick do botão conforme abaixo: }

procedure TForm1.Button1Click(Sender: TObject);
var
S: string;
begin
ArqParaLixeira('c:\Diretorio\Teste.doc', S);
if S = '' then
ShowMessage('O arquivo foi enviado para a lixeira.')
else
ShowMessage(S);
end; 




 

 


Fechar o Windows





{ Reinicia o Windows }
ExitWindowsEx(EWX_REBOOT, 0);

{ Desliga o Windows }
ExitWindowsEx(EWX_SHUTDOWN, 0); 

{ Força todos os programa a desligarem-se }
ExitWindowsEx(EWX_FORCE, 0); 





 

 

Não deixar que seu Programa apareça na Barra de tarefas 



{ Você já observou a caixa "Propriedades", aquela que mostra
as propriedades de um arquivo no Windows Explorer, não
aparece na lista do Alt+Tab e tampouco na barra de tarefas?

Isto ocorre porque ela funciona como uma ToolWindow, enquanto
os demais aplicativos funcionam como AppWindow. Porém podemos
mudar o comportamento de nossos programas feito em Delphi
para que se comportem como uma ToolWindow também.

Para experimentar, crie um novo projeto e altere o
Project1.dpr como abaixo (não esqueça do uses): 
}

program Project1;

uses
Forms, Windows,
Unit1 in 'Unit1.pas' {Form1};

{$R *.RES}

var
ExtendedStyle : Integer;
begin
Application.Initialize;

ExtendedStyle := GetWindowLong(Application.Handle, gwl_ExStyle);
SetWindowLong(Application.Handle, gwl_ExStyle, ExtendedStyle or
ws_Ex_ToolWindow and not ws_Ex_AppWindow);

Application.CreateForm(TForm1, Form1);
Application.Run;
end; 




 


Obter nome do usuário e a empresa registrada no Windows

 



Inclua na seção uses: Registry

{ Coloque um botão no form e altere seu evento OnCkick
como abaixo: }

procedure TForm1.Button1Click(Sender: TObject);
var
Reg: TRegIniFile;
S: string;
begin
Reg := TRegIniFile.Create('SOFTWARE\MICROSOFT\MS SETUP (ACME)\');
try
S := Reg.ReadString('USER INFO','DefName','');
S := S + #13;
S := S + Reg.ReadString('USER INFO','DefCompany','');
ShowMessage(S);
finally
Reg.free;
end; 
end; 





 

 

Realizar Formatação 





{ Coloque o código abaixo imediatamente abaixo da palavra
implementation: }

const
SHFMT_ID_DEFAULT = $FFFF;

{ Opções de formatação }
SHFMT_OPT_QUICKFORMAT = $0000; { Formatação rápida }
SHFMT_OPT_FULL = $0001; { Formatação completa }
SHFMT_OPT_SYSONLY = $0002; { Copia sistema }

{ Códigos de errros }
SHFMT_ERROR = $FFFFFFFF; { Ocorreu erro }
SHFMT_CANCEL = $FFFFFFFE; { Foi cancelado }
SHFMT_NOFORMAT = $FFFFFFFD; { Não formatou }

function SHFormatDrive(Handle: HWND; Drive, ID, Options: Word):
LongInt; stdcall; external 'shell32.dll' name 'SHFormatDrive'

{ Coloque um botão no form e altere o evento OnClick dele
conforme abaixo: }

procedure TForm1.Button3Click(Sender: TObject);
var
Erro: DWord;
Msg: string;
begin
Erro := SHFormatDrive(Handle, 0, SHFMT_ID_DEFAULT, SHFMT_OPT_QUICKFORMAT);
case Erro of
SHFMT_ERROR: Msg := 'Ocorreu um erro.';
SHFMT_CANCEL: Msg := 'A formatação foi cancelada.';
SHFMT_NOFORMAT: Msg := 'Não foi possível formatar.';
else
Msg := 'Disco formatado com sucesso.';
end;
ShowMessage(Msg);
end;

{Para formatação completa troque SHFMT_OPT_QUICKFORMAT por SHFMT_OPT_FULL. O segundo
parâmetro (zero no exemplo) indica a unidade, sendo que A é 0 (zero), B é 1, etc. }





 

 

 

Imprimir texto justificado na lx-300 





{ A impressora Epson LX-300 dispõe de um comando que justifica
o texto. Este recurso é interessante, pois com ele podemos
continuar a enviar os comandos de formatação de caracteres
como condensado, negrito, italico, expandido, etc.

Para o exemplo abaixo:
- Coloque um botão no form;
- Altere o evento OnClick deste botão como abaixo: }

procedure TForm1.Button1Click(Sender: TObject);
const
cJustif = #27#97#51;
cEject = #12;

{ Tamanho da fonte }
c10cpi = #18;
c12cpi = #27#77;
c17cpi = #15;
cIExpandido = #14;
cFExpandido = #20;
{ Formatação da fonte }
cINegrito = #27#71;
cFNegrito = #27#72;
cIItalico = #27#52;
cFItalico = #27#53;
var
Texto: string;
F: TextFile;
begin
Texto := c10cpi +
'Este e um teste para impressora Epson LX 300. ' +
'O objetivo e imprimir texto justificado sem deixar ' +
'de usar formatacao, tais como: ' +
cINegrito + 'Negrito, ' + cFNegrito +
cIItalico + 'Italico, ' + cFItalico +
c17cpi + 'Condensado (17cpi), ' + c10cpi +
c12cpi + '12 cpi, ' + c10cpi +
cIExpandido + 'Expandido.' + cFExpandido +
' Este e apenas um exemplo, mas voce podera adapta-lo ' +
'a sua realidade conforme a necessidade.';

AssignFile(F, 'LPT1');
Rewrite(F);
try
WriteLn(F, cJustif, Texto);
WriteLn(F, cEject);
finally
CloseFile(F);
end;
end; 



 



 

Técnica de Impressão de caracteres acentuados 





{ Usando comandos da impressora podemos fazer isto de uma
forma bastante simples. Quando enviamos o caractere ASCII
número 8 (oito) para a impressora, a cabeça de impressão 
retrocede uma posição, pois este caractere é o BackSpace.
Então podemos imprimir a letra sem acento e, sem seguida,
voltar e imprimir o acento desejado. Vejamos um exemplo:

- Coloque um botão no form;
- Altere o evento OnClick deste botão conforme abaixo:
}

procedure TForm1.Button2Click(Sender: TObject);
var
F: TextFile;
begin
AssignFile(F, 'LPT1');
Rewrite(F);
try
{ Regra: caractere sem acento + chr(8) + acento }
WriteLn(F, 'Este e' + #8 + '''' + ' um teste.');
WriteLn(F, 'Acentuac' + #8 + ',a' + #8 + '~o.');
WriteLn(F, 'Vovo' + #8 + '^');
WriteLn(F, 'U' + #8 + '''' + 'ltimo.');
WriteLn(F, #12); // Eject
finally
CloseFile(F);
end;
end; 





 

 

Saber quais são os Drives existentes na Máquina 





{ A função abaixo retorna uma string contendo
as letras de unidades de discos presentes. }

function tbGetDrives: string;
var
Drives: DWord;
I: byte;
begin
Result := '';
Drives := GetLogicalDrives;
if Drives <> 0 then
for I := 65 to 90 do
if ((Drives shl (31 - (I - 65))) shr 31) = 1 then
Result := Result + Char(I);
end;

{ Para saber se uma determinada unidade está presente,
basta fazer algo como: }
if Pos('A', tbGetDrives) > 0 then
ShowMessage('Unidade A: presente.')
else
ShowMessage('Unidade A: ausente.'); 




 


Alterar nome de volume do Disco 





{ Da unidade C: }
SetVolumeLabel('c:\', 'NovoLabel');

{ Da unidade atual: }
SetVolumeLabel(nil, 'NovoLabel'); 





 

 

Obter informações de um volume do Disco 





{ - Coloque um memo (TMemo) no form;
- Coloque um botão e escreve seu evento
OnClick como abaixo: }

procedure TForm1.Button1Click(Sender: TObject);
var
SLabel, SSysName: PChar;
Serial, FileNameLen, X: DWord;
begin
Memo1.Clear;
GetMem(SLabel, 255);
GetMem(SSysName, 255);
try
GetVolumeInformation('C:\', SLabel, 255,
@Serial, FileNameLen, X, SSysName, 255);
with Memo1.Lines do begin
Add('Nome do volume (Label): ' + string(SLabel));
Add('Número Serial: ' + IntToHex(Serial, 8));
Add('Tamanho máximo p/ nome arquivo: ' +
IntToStr(FileNameLen));
Add('Sistema de Arquivos: ' + string(SSysName));
end;
finally
FreeMem(SLAbel, 255);
FreeMem(SSysName, 255);
end;
end; 





 

 

 

Obter espaço total e disponível de um Disco 





{ - Coloque um memo (TMemo) no form;
- Coloque um botão e altere seu OnClick como abaixo: }

procedure TForm1.Button1Click(Sender: TObject);
var
SetoresPorAgrup, BytesPorSetor, AgrupLivres,
TotalAgrup: DWord;
begin
Memo1.Clear;
if GetDiskFreeSpace('C:\', SetoresPorAgrup,
BytesPorSetor, AgrupLivres, TotalAgrup) then
with Memo1.Lines do begin
Add('Setores por agrupamento: ' + IntToStr(SetoresPorAgrup));
Add('Bytes por setor: ' + IntToStr(BytesPorSetor));
Add('Agrupamentos livres: ' + IntToStr(AgrupLivres));
Add('Total de agrupamentos: ' + IntToStr(TotalAgrup));
Add('----- Resumo -----');
Add('Total de bytes: ' +
IntToStr(TotalAgrup * SetoresPorAgrup * BytesPorSetor));
Add('Bytes livres: ' +
IntToStr(AgrupLivres * SetoresPorAgrup * BytesPorSetor));
end;
end;

{ O exemplo acima retorna as medidas em Bytes, Setores e
Agrupamentos. Se preferir algo mais simples,
use funções do Delphi. Veja: }

Memo1.Lines.Add('Total de bytes: ' + IntToStr(DiskSize(3)));
Memo1.Lines.Add('Bytes livres: ' + IntToStr(DiskFree(3)));

{ Onde o parâmetro (3) é o número da unidade, sendo
1=A, 2=B, 3=C, ... } 





 

 

Obter/Definir tempo máximo de Double-Click do mouse 





{ - Coloque um botão no form e escreva seu OnClick como
abaixo: }

procedure TForm1.Button6Click(Sender: TObject);
var
Tempo: Cardinal;
begin
{ Obtém }
Tempo := GetDoubleClickTime;
ShowMessage(IntToStr(Tempo) + ' milisegundos');

{ Define }
SetDoubleClickTime(300);
end; 




 


Inverter Botões do mouse 





{ Para inverter: }
SwapMouseButton(true);

{ Para voltar ao normal: }
SwapMouseButton(false); 





 

 

Fazer que seu Programa só abra através de outro seu 





{ Antes da linha "Application.Initialize;" de Prog1.dpr (programa
a ser chamado), coloque o código abaixo:
}

if ParamStr(1) <> 'MinhaSenha' then begin
{ Para usar ShowMessage, coloque Dialogs no uses }
ShowMessage('Execute este programa através de Prog2.EXE');
Halt; { Finaliza }
end;

{ No Form1 de Prog2 (programa chamador) coloque um botão e
escreva o OnClick deste botão como abaixo:
}

procedure TForm1.Button1Click(Sender: TObject);
var
Erro: Word;
begin
Erro := WinExec('Pro2.exe MinhaSenha', SW_SHOW);
if Erro <= 31 then { Se ocorreu erro... }
ShowMessage('Erro ao executar o programa.');
end;

{ Aqui o parâmetro passado foi 'MinhaSenha'. Você deverá trocar 'MinhaSenha' por algo que apenas você saiba
(uma senha). Caso uma pessoa conheça esta senha, será possível chamar este programa passando-a como
parâmetro. Neste caso sua "trava" estará violada. }






 

 

Usar Assembly com Delphi 





{ O Delphi permite a implementação de rotinas assembly
mescladas ao código Pascal. Não entrarei em detalhes
minuciosos, mas darei alguns exemplos básicos de como
implementar rotinas simples que retornam números inteiros.
}

{ Soma dois inteiros de 8 bits }
function Soma8(X, Y: byte): byte;
asm
mov al, &X
add al, &Y
end;

{ Soma dois inteiros de 16 bits }
function Soma16(X, Y: Word): Word;
asm
mov ax, &X
add ax, &Y
end;

{ Soma dois inteiros de 32 bits }
function Soma32(X, Y: DWord): DWord;
asm
mov eax, &X
add eax, &Y
end;

{ A chamada a estas funções são feitas da mesma forma 
que chamamos uma função Pascal. Exemplo: }
var
A: byte;
begin
A := Soma8(30, 25); { A = 55 }
end; 





 

 

 

Verificar se a String é uma Data válida 






function tbStrIsDate(const S: string): boolean;
begin
try
StrToDate(S);
Result := true;
except
Result := false;
end;
end;

Para testar:
- Coloque um Edit no form;
- Coloque um Button;
- No evento OnClick do botão coloque o código abaixo:

if tbStrIsDate(Edit1.Text) then
ShowMessage(Edit1.Text + ' é data válida.')
else
ShowMessage(Edit1.Text + ' NÃO é data válida.'); 





 

 

Veja com usar o Registro do Windows 





Inclua na seção uses: Registry e Windows

- Coloque no form dois edits e dois botões.
- No evento OnClick do Button1 escreva o código abaixo:

procedure TForm1.Button1Click(Sender: TObject);
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
try
{ Define a chave-raiz do registro }
Reg.RootKey := HKEY_CURRENT_USER;
{ Abre a chave (path). Se não existir, cria e abre. }
Reg.OpenKey('MeuPrograma\Configuração', true);
{ Escreve um inteiro }
Reg.WriteInteger('Numero', StrToInt(Edit1.Text));
{ Escreve uma string }
Reg.WriteString('Nome', Edit2.Text);
finally
Reg.Free;
end;
end;

- No evento OnClick do Button2, escreva:

procedure TForm1.Button2Click(Sender: TObject);
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.KeyExists('MeuPrograma\Configuração') then
begin
Reg.OpenKey('MeuPrograma\Configuração', false);

if Reg.ValueExists('Numero') then
Edit1.Text := IntToStr(Reg.ReadInteger('Numero'))
else
ShowMessage('Não existe valor com o nome "Numero"');

if Reg.ValueExists('Nome') then
Edit2.Text := Reg.ReadString('Nome')
else
ShowMessage('Não existe valor com o nome "Nome"');

end else
ShowMessage('Não existe a chave no registro');
finally
Reg.Free;
end;
end; 




 


Converter primeira letra de um Edit para maiúscula 





with Edit2 do
if Text <> '' then
Text := AnsiUpperCase(Text[1]) + Copy(Text, 2, Length(Text));

Isto pode ser colocado, por exemplo, no OnExit do Edit.

Você pode também converter durante a digitação. Para isto 
coloque o código abaixo no evento OnKeyPress do Edit:

if Edit1.SelStart = 0 then
Key := AnsiUpperCase(Key)[1]
else
Key := AnsiLowerCase(Key)[1]; 





 

 

Colocar linhas de diferentes alturas em um DBGrid 





- Coloque o StringGrid no form.
- No evento OnCreate do form coloque o código abaixo:

procedure TForm1.FormCreate(Sender: TObject);
begin
StringGrid1.RowHeights[0] := 15;
StringGrid1.RowHeights[1] := 20;
StringGrid1.RowHeights[2] := 50;
StringGrid1.RowHeights[3] := 35;
end; 





 

 

Ligar/Desligar Caps-Lock 





{ Esta função liga/desliga Caps Lock, conforme o parãmetro
State }

procedure tbSetCapsLock(State: boolean);
begin
if (State and ((GetKeyState(VK_CAPITAL) and 1) = 0)) or
((not State) and ((GetKeyState(VK_CAPITAL) and 1) = 1)) then
begin
keybd_event(VK_CAPITAL, $45, KEYEVENTF_EXTENDEDKEY or 0, 0);
keybd_event(VK_CAPITAL, $45, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0);
end;
end;

{ Exemplos de uso: }

tbSetCapsLock(true); { Liga Caps Lock }

tbSetCapsLock(false); { Desliga Caps Lock } 





 

 

 

Verificar se o Delphi está aberto 





If FindWindows('TAppBuilder',Nil ) <> 0 then
Showmessage('O Delphi está rodando');





 

 

Configurar Século 





TWODIGITYEARCENTURYWINDOW indica quantos anos a partir do ano corrente ainda vai ser contado como
o do mesmo século, isto é , 1900 .

Por exemplo, o nº 2 indica que a partir do ano corrente toda data com 2 anos de diferença será contada como ano
2000.
Ano Corrente = 98
TWODIGITYEARCENTURYWINDOW : = 2 ;
95 será 2095




 


Preview do Quick Report  personalizado 





No relatório, criar a procedure SHOWPREVIEW contendo:

PROCEDURE Showpreview;
begin
preview.showmodal;
end;

aonde preview é o nome do form criado para preview. Não esquecer de incluir o nome da procedure na cláusula
uses.

Após isso, deve-se incluir no evento CREATE do formulário principal ou o do relatório o direcionamento do
objeto Qprinter, com a seguir:

qprinter.onpreview:=showpreview;

Isto faz com que toda vez que se desejar exibir um preview, o programa abra a rotina 'showpreview', que abre o
formulário criado, chamado "preview".





 


Desabilitar Botão fechar do Form 





O exemplo abaixo irá desabilitar o botão fechar do Bloco de Notas do Windows. Antes de testar este exemplo
chame o Bloco de Notas do Windows. Abra um projeto em Delphi e inclua um componente Button. Inclua o
código abaixo no evento OnClick do componente Button.
// Evento OnClick do componente Table
procedure TForm1.Button1Click(Sender: TObject);
var
hwndHandle : THANDLE;
hMenuHandle : HMENU;
begin
hwndHandle := FindWindow(nil, 'Sem título - Bloco de Notas');
if (hwndHandle <> 0) then
begin
hMenuHandle := GetSystemMenu(hwndHandle, FALSE);
if (hMenuHandle <> 0) then
DeleteMenu(hMenuHandle, SC_CLOSE, MF_BYCOMMAND);
end;
end;




 


Desabilitar um item do TradioGroup 





Este exemplo demonstra como você pode acessar um radio button indivitual do componente TRadioGroup. Note
que o RadioGroup.Controls inicia a partir do 0.
procedure TForm1.Button1Click(Sender: TObject);
begin
TRadioButton(RadioGroup1.Controls[1]). Enabled := False;
end;




 


Envia direto para Impressora em Rede 





Var
Texto : string;
F : TextFile;
Imp, A : String; // Variáveis que retornam a impressora da rede
numcopias: byte;
linhas : byte;
begin
// retornar o caminho da impressora na rede
if PrintDialog1.Execute then
begin
A := Printer.Printers[Printer.PrinterIndex];
If Pos('\\',A) > 0 then
Imp := Copy(A, Pos('\\', A), Length(A))
else
Imp := 'LPT1';
Screen.Cursor := crHourGlass;
AssignFile(F,Imp); // Indicar a sair, por ex. 'LPT1' ou '\\Servidor\LX-300'
Rewrite(F);
Writeln(F,'Frase ');
Closefile(F);
end; 





 

 

Extrair palavra que está sob a posição corrente do cursor 





function RECharIndexByPos(RichEdit: TRichEdit; X, Y: Integer): Integer;
{ retorna a posição absoluta do caracter para um conjunto de coordenadas do cursor}
var
P: TPoint;
begin
P := Point(X, Y);
Result := SendMessage(RichEdit.Handle, EM_CHARFROMPOS, 0, longint(@P));
end;

function REExtractWordFromPos(RichEdit: TRichEdit; X, Y: Integer): string;
{ X, Y – coordenadas num controle rich edit }
{retorna a palavra sob a posição corrente do cursor}
var
BegPos, EndPos: Integer;
begin
BegPos := RECharIndexByPos(RichEdit, X, Y);
if (BegPos < 0) or
(SendMessage(RichEdit.Handle,EM_FINDWORDBREAK,WB_CLASSIFY,BegPos) and
(WBF_BREAKLINE or WBF_ISWHITE) <> 0 ) then
begin
result:='';
exit;
end;
if SendMessage(RichEdit.Handle, EM_FINDWORDBREAK, WB_CLASSIFY, BegPos- 1) and
(WBF_BREAKLINE or WBF_ISWHITE) = 0 then
BegPos := SendMessage(RichEdit.Handle, EM_FINDWORDBREAK,
WB_MOVEWORDLEFT, BegPos);
EndPos := SendMessage(RichEdit.Handle, EM_FINDWORDBREAK,
WB_MOVEWORDRIGHT, BegPos);
Result := TrimRight(REGetTextRange(RichEdit, BegPos, EndPos - BegPos));
end;





 

 

Executar Bat 





Na Unit FMXUtils existe uma função chamada Executefile. 





 

 

Criar documento no Word 





procedure TForm1.Button1Click(Sender: TObject); 
var 
MSWord: Variant; 
begin 
MSWord:= CreateOleObject ('Word.Basic'); 
MSWord.AppShow;//mostra o word 
MSWord.FileNew;//inicia um novo documento 
MSWord.insert('Contrato de Locação'); //Escreve algo 
MSWord.insert(#13+'Contrato de Locação');//Pula uma 
linha e escreve 
MSWord.FontSize(24);//muda o tamanho da fonte 
MSWord.italic;//coloca italico 
MSWord.bold;//coloca negrito 
MSWord.underline;//sublina 
MSWord.insert(#13+'Contrato de Locação');//pula a linha 
e escreve novamente 
MSWord.FontSize(12);//muda o tamanho da fonte 
MSWord.Font('Arial');//muda a fonte usada 
MSWord.underline(false);//retira o sublinhado 
MSWord.italic(false);//retira o italico 
MSWord.bold(false);//retira o bold 
MSWord.insert(#13 +'teste'); 
MSWord.insert(#13+#9 +'teste');//nova linha e um TAB 
MSWord.insert(#13+Table1Razao_Social.Value);//insere 
algo de uma tabela 
MSWord.LineUp(2, 1); //seleciona uma parte do texto 
MSWord.TextToTable(ConvertFrom := 2, NumColumns := 1);// 
monta uma tabela com o texto selecionado 
MSWord.Filesaveass;// salva o arquivo 
end; 





 

 

Descobrir diretório do Windows 





function WindowsDir : string;
var
WinDir : array [0..144] of char;
begin
GetWindowsDirectory (WinDir, 144);
Result := StrPas (WinDir);
end;




 


Executar um Programa e esperar sua Finalização

 



function Executa (Arquivo : String; Estado : Integer): Integer;
var
Programa : array [0..512] of char;
CurDir : array [0..255] of char;
WorkDir : String;
StartupInfo : TStartupInfo;
ProcessInfo : TProcessInformation;
begin
StrPCopy (Programa, Arquivo);
GetDir (0, WorkDir);
StrPCopy (CurDir, WorkDir);
FillChar (StartupInfo, Sizeof (StartupInfo), #0);
StartupInfo.cb := sizeof (StartupInfo);
StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
StartupInfo.wShowWindow := Estado;
if not CreateProcess (nil, Programa, nil,nil, false, CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS,nil,
nil, StartupInfo, ProcessInfo) then
Result := -1
else
begin
WaitForSingleObject (ProcessInfo.hProcess,Infinite);
GetExitCodeProcess (ProcessInfo.hProcess,Result);
end;
end;

Estado é o tipo de janela que aparecerá, que pode ser:

SW_SHOWNORMAL - Janela em modo normal 
SW_MAXIMIZE - Janela maximizada 
SW_MINIMIZE - Janela minimizada 
SW_HIDE - Janela Escondida 




 


Verificar quantidade de cores do Windows 





Para descobrir a quantidade atual de cores no Windows (16, 256, 65536 -16 bit Color - ou 24 bit Color), use a
seguinte função:

function NumeroDeCores : Integer;
var
DC : HDC
BitsPorPixel : Integer;
begin
Dc := GetDc (0) ; // 0 = vídeo
BitPerPixel := GetDeviceCaps (DC, BitsPorPixel);
Result:= 2 shl (BitsPorPixel - 1);
end;

Nota: caso o Windows esteja em16 cores, a função retornará 2 (ao invés de 16). 





 

 

Verificar se há Placa de Som 





Para testar se há uma placa de som instalada no sistema, use a função abaixo (retorna True se há uma placa de
som; False em outro caso):

function TestaSom : Boolean;
begin
Result := (WaveOutGetNumDevs > 0);
end; 





 

 

 

Executar programa do DOS e fechar a janela em seguida 





Quando você executa um programa DOS no Windows95, sua janela permanece aberta até ser fechada pelo
usuário.
Para executar um programa DOS que fecha sua janela após a execução, deve ser especificado "command.com /c
programa" na linha de comando. Usando a função da API WinExec para executar um programa chamado
progdos.exe, a chamada deve ser:

WinExec('command.com /c progdos.exe',sw_ShowNormal);

Obs. Se o programa deve ser executado sem que seja visualizado pelo usuário, o segundo parâmetro deve ser
sw_Hide. Deve ser especificada a extensão .com senão o programa não será executado.



Home   1 - 2 - 3 - 4 - 5 Proxima     7 - 8 - - 10

                      fontesbrasil.com® Todos os direitos reservados.


Redirecinar: http://www.fontesbrasil.com      Melhor visualização 800 x 600