|
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 - 9
- 10
fontesbrasil.com® Todos os direitos reservados.
Redirecinar: http://www.fontesbrasil.com Melhor visualização 800 x 600