Trocando o Papel de Parede do Windows com delphi

Trocando o Papel de Parede do Windows

Para trocar o papel de parede (wallpaper) do Windows via código, use a seguinte procedure:

type
WallPaperFormat = (wpLadoALado, wpCentralizado);

procedure SetWallPaper (Arquivo : String; Formato : WallPaperFormat);
var
Reg : TRegIniFile;
begin
Reg := TRegIniFile.Create ('Control Panel\Desktop');
Reg.WriteString ('', 'Wallpaper', Arquivo);
if Formato = wpLadoALado then
Reg.WriteString ('', 'TileWallpaper', '1');
else
Reg.WriteString ('', 'TileWallpaper', '0');
Reg.Free;
SystemParametersInfo (SPI_SETDESKWALLPAPER, 0, nil,
SPIF_SENDWININICHANGE);
end;

O parâmetro Formato deverá ser wpLadoALado para o papel de parede ficar lado a lado, ou
wpCentralizado para ficar centralizado.

Testando drive de disquete com delphi

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;

Utilize a função assim:

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;

Habilitando e Desabilitando o Ctrl+Alt+Del e o Alt+Tab com delphi

Habilitando / Desabilitando o Ctrl+Alt+Del e o Alt+Tab

Para desabilitar o Ctrl+Alt+Del, o Alt+Tab e o Ctrl+Esc, utilize a seguinte rotina:

procedure TNomeDoForm.ButtonNameClick(Sender: TObject);
var
Numero : Integer;
begin
SystemParametersInfo (97, Word (True), @Numero, 0);
end;

E para reabilitar, utilize a rotina abaixo:

procedure TNomeDoForm.ButtonName2Click(Sender: TObject);
var
Numero : Integer;
begin
SystemParametersInfo(97, Word (False), @Numero, 0);
end;

Formatar um disquete através de um programa Delphi

Formatar um disquete através de um programa Delphi
{ 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;
Observações
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.

Fechar outro programa usando o delphi

Fechar outro programa procedure TForm1.Button1Click(Sender: TObject);
begin
PostMessage(FindWindow(nil, 'Calculadora.exe'), WM_CLOSE,0,0);
end;

Para desligar, reiniciar, resetar ou dar logout no windows com delphi

Fechando o Windows

Para desligar, reiniciar, resetar ou dar logout no sistema, use a função ExitWindowsEx, como
abaixo:

ExitWindowsEx (uFlags, 0);

onde uFlags é o tipo de reinicialização que vai ocorrer.

Valores de uFlags:

Valor
Significado
EWX_FORCE
Força todos os processos a terminar. Ao invés de aparecer a
mensagem "A aplicação não está respondendo", ele força o
programa que não responde a finalizar.
EWX_LOGOFF
Faz "logout" do sistema, ou seja, volta à tela de login (a que
pede nome e senha)
EWX_POWEROFF
Desliga o computador (caso o computador não tenha o recurso
de auto-desligamento, ele fecha todos os programas e informa
que o sistema pode ser desligado).
EWX_REBOOT
Reinicializa o computador (o equivalente a pressionar
Ctrl+Alt+Del)
EWX_SHUTDOWN
Fecha todos os programas e informa ao usuário que é seguro
desligar o computador.


A função retorna True se funcionar, ou False em outro caso (bem, se funcionar você vai ver o
computador sendo desligado, não?).

Usuários NT: verifique se o usuário tem o direito a desligar o computador em sua lista de
privilégios.

Fazer a barra de título ficar piscar com delphi

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: }

procedure TForm1.Timer1Timer(Sender: TObject);
begin
FlashWindow(Handle, true);
FlashWindow(Application.Handle, true);
end;

Evitar que um programa seja executado mais de uma vez em delphi

Evitar que um programa seja executado mais de uma vez
{ Muitos programas Windows permitem apenas uma cópia em
execução de cada vez. Isto é interessante principalmente
quando é um grande aplicativo, pois duas cópias ao mesmo
tempo usuaria muito mais memória. Em aplicativos
desenvolvidos em Delphi podemos ter esta característica.
Vejamos:

- Crie um novo projeto;
- Mude o "Name" do Form1 para DPGFormPrinc;
- Altere o código-fonte do arquivo Project1.dpr
conforme abaixo: }

program Project1;

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

{$R *.RES}

var
Handle: THandle;
begin
Handle := FindWindow('TDPGFormPrinc', nil);
if Handle <> 0 then begin { Já está aberto }
Application.MessageBox('Este programa já está aberto. A cópia ' +
'anterior será ativada.', 'Programa já aberto', MB_OK);
if not IsWindowVisible(Handle) then
ShowWindow(Handle, SW_RESTORE);
SetForegroundWindow(Handle);
Exit;
end;
Application.Initialize;
Application.CreateForm(TDPGFormPrinc, DPGFormPrinc);
Application.Run;
end.
Observações
Para testar este programa você deverá compilar o projeto e fechar o Delphi. Depois, procure o Project1.exe (projeto compilado) usando o Windows Explorer e tente executá-lo mais de uma vez e veja o que acontece. Mas porque alterar o name do form principal para "DPGFormPrinc"? Este poderia ser qualquer outro nome, mas preferi usar as iniciais do meu nome (DPG). Procurei deixar um nome bem pessoal para não correr o risco de colocar um nome que possa ser encontrado em outro aplicativo do Windows. Por exemplo: se deixar Form1, será bem fácil encontrar outro aplicativo feito em Delphi que possua uma janela com este nome, o que causaria problema.

Tocar wave em delphi

Acrescente a Unit MMSystem ao seu projeto e escreva o codigo abaixo:

sndPlaysound('c:\windows\ding.wav',snd_async);

3) Acrescente a ShellApi a clausula uses de sua Unit e escreva:

ShellExecute(0,nil,'ARJ.EXE','A BACKUP C:\DADOS\*.DB' ,nil,sw_hide);

Testa se uma data é valida em delphi

//-------------------------------------------------- Testa se uma data é valida
function DataValida(StrD: string): Boolean;
begin
Result := true;
try
StrToDate(StrD);
except
on EConvertError do Result:=False;
end;
end;

Retorna uma data por extenso em delphi

//------------------------------------------------ Retorna uma data por extenso
function DataExtenso(Data:TDateTime): String;
var
NoDia : Integer;
DiaDaSemana : array [1..7] of String;
Meses : array [1..12] of String;
Dia, Mes, Ano : Word;
begin
{ Dias da Semana }
DiaDasemana [1]:= 'Domingo';
DiaDasemana [2]:= 'Segunda-feira';
DiaDasemana [3]:= 'Terçafeira';
DiaDasemana [4]:= 'Quarta-feira';
DiaDasemana [5]:= 'Quinta-feira';
DiaDasemana [6]:= 'Sexta-feira';
DiaDasemana [7]:= 'Sábado';
{ Meses do ano }
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 (Data, Ano, Mes, Dia);
NoDia := DayOfWeek (Data);
Result := DiaDaSemana[NoDia] + ', ' +
IntToStr(Dia) + ' de ' + Meses[Mes]+ ' de ' + IntToStr(Ano);
end;

Rotina para substituir caracteres acentuados por não acentuados em delphi

Rotina para substituir caracteres acentuados por não acentuados
Use a seguinte função :

function RetiraAcentos(txt: String): String;
var
i: Integer;
begin
Result := txt;
for i := 0 to Length(Result) do
case Result[i] of
'á', 'à', 'â', 'ä', 'ã': Result[i] := 'a';
'Á', 'À', 'Â', 'Ä', 'Ã': Result[i] := 'A';
'é', 'è', 'ê', 'ë': Result[i] := 'e';
'É', 'È', 'Ê', 'Ë': Result[i] := 'E';
'í', 'ì', 'î', 'ï': Result[i] := 'i';
'Í', 'Ì', 'Î', 'Ï': Result[i] := 'I';
'ó', 'ò', 'ô', 'ö', 'õ': Result[i] := 'o';
'Ó', 'Ò', 'Ô', 'Ö', 'Õ': Result[i] := 'O';
'ú', 'ù', 'û', 'ü': Result[i] := 'u';
'Ú', 'Ù', 'Û', 'Ü': Result[i] := 'U';
'ç': Result[i] := 'c';
'Ç': Result[i] := 'C';
end;
end;

Converter Hora para Minuto em delphi

// Converter hora (HH:MM) para minutos.Function HoraParaMin(Hora: String): Integer;beginResult := (StrToInt(Copy(Hora,1,2))*60) + StrToInt(Copy(Hora,4,2));end;

Converter a primeira letra de um Edit para maiúsculo em delphi

Converter a primeira letra de um Edit para maiúsculo
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

Coneverter Letras Para Maiuscula e Minuscula em delphi

converte a string para Maiuscula
function ToUpper(Text: String): String;
var
Ind: Integer;

const
LW = 'áâãàéêíóôõúüûçñ';
UP = 'ÁÂÃÀÉÊÍÓÔÕÚÜÛÇÑ';

begin
Result := '';
for Ind := 1 to Length(Text) do
if Pos(Copy(Text, Ind, 1), LW) > 0 then
Result := Result + Copy(UP, Pos(Copy(Text, Ind, 1), LW), 1)
else
Result := Result + UpperCase(Copy(Text, Ind, 1));
end;

E a segunda função converte a string para minúscula:

function ToLower(Text: String): String;
var
Ind: Integer;

const
LW = 'áâãàéêíóôõúüûçñ';
UP = 'ÁÂÃÀÉÊÍÓÔÕÚÜÛÇÑ';

begin
Result := '';
for Ind := 1 to Length(Text) do
if Pos(Copy(Text, Ind, 1), UP) > 0 then
Result := Result + Copy(LW, Pos(Copy(Text, Ind, 1), UP), 1)
else
Result := Result + LowerCase(Copy(Text, Ind, 1));
end;

Como evitar a mensagem de erro Key Violation em delphi

Como evitar a mensagem de erro Key Violation
Inclua a unit DBITYPES na clausula uses do seu form.

procedure TForm1.Table1PostError(DataSet: TDataSet; E: EDatabaseError; var
Action: TDataAction);
begin
if EDBEngineError(E).Errors[0].ErrorCode = 9729 then
ShowMessage('Registro já existe!');
Action:= daAbort;
end;

Como definir seu próprio hotkey (Tecla Quente) em delphi

Como definir seu próprio hotkey (Tecla Quente):
Primeiro fixe a propriedade KeyPreview do Form para TRUE:

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (ssCtrl in Shift) and (chr(Key) in ['A', 'a']) then
ShowMessage('Ctrl-A');
end;

Como copiar a tela do Windows via código em delphi

procedure PrintScreen(Image: TBitmap);
var
DC: HDC;
begin
DC:= GetDC(GetDesktopWindow);
try
Image.Width:= GetDeviceCaps(DC, HorzRes);
Image.Height:= GetDeviceCaps(DC, VertRes);
BitBlt(Image.Canvas.Handle, 0, 0, Image.Width, Image.Height, DC, 0, 0, SRCCOPY);
finally
ReleaseDC(GetDesktopWindow, DC);
end;
end;
Utilize o procedimento assim:
begin
Image1.Picture:= nil;
PrintScreen(Image1.Picture.Bitmap);
end;

Aguardar determindo tempo em delphi

procedure Delay(Segundos: Word);var x1: Double;
begin
x1:= Now;
repeat{Comando vazio}
until ((Now-x1)*86400) > Segundos;
end;

Adicionar zeros à esquerda em delphi

Adicionar zeros à esquerda de um númeroExistem várias formas.

Vejamos uma:
function tbStrZero(const I: integer; const Casas: byte): string;var Ch: Char;begin Result := IntToStr(I); if Length(Result) > Casas then begin Ch := '*'; Result := ''; end else Ch := '0';
while Length(Result) < Casas do Result := Ch + Result;end;

{ Exemplo de como usá-la: }
var S: string; Numero: integer; {...}begin {...} S := tbStrZero(Numero, 6); {...}end; ObservaçõesSe o comprimento desejado (Casas) não for suficiente para conter o número, serão colocados asteriscos.

Abrindo e fechando o drive de CD-ROM

Para abrir a gaveta do drive de CD-ROM,

Coloque a unit MMSystemna cláusula Uses da sua unit

Para Abrir
mciSendString ('Set cdaudio door open wait', nil, 0, handle).

Para fechar
e para fechar: mciSendString ('Set cdaudio door closed wait', nil, 0, handle);