Limpar Todos os
Edit's de um Form de uma só vez?
Procedure LimpaEdit;
var i : Integer;
begin
for i := 0 to ComponentCount -1 do
if Components[i] is TEdit then
begin
TEdit(Components[i]).Text := '';
end;
end;
Alterar o papel de parede do Windows
program wallpapr;
uses Registry, WinProcs;
procedure SetWallpaper(sWallpaperBMPPath : String; bTile : boolean );
var
reg : TRegIniFile;
begin
// Mudando o Registro HKEY_CURRENT_USER
// Control Panel\Desktop
// TileWallpaper (REG_SZ)
// Wallpaper (REG_SZ)
reg := TRegIniFile.Create('Control Panel\Desktop' );
with reg do begin
WriteString( '', 'Wallpaper',sWallpaperBMPPath );
if( bTile )then begin
WriteString( '', 'TileWallpaper', '1' );
end else begin
WriteString( '', 'TileWallpaper', '0' );
end;
end;
reg.Free;
// Mostrar que o parametro do sistema foi alterado
SystemParametersInfo( SPI_SETDESKWALLPAPER,0, Nil, SPIF_SENDWININICHANGE );
end;
begin
SetWallpaper( 'c:\winnt\winnt.bmp', False );
end.
Alterando cor de linha de um DBGrid
Coloque a propriedade defaultdrawdata do dbgrid em FALSE
No evento onDrawColumnCell do seu grid coloque o seguinte:
procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject;
const Rect: TRect; DataCol: Integer; Column: TColumn;
State: TGridDrawState);
begin
If table1PRAZO.Value > DATE then // condição
Dbgrid1.Canvas.Font.Color:= clFuchsia; // coloque aqui a cor desejada
Dbgrid1.DefaultDrawDataCell(Rect, dbgrid1.columns[datacol].field, State);
end;
Diretório de instalação do windows
function PegaSysDir: string;
var
MeuBuffer: Array [1..128] of Char;
retorno: Integer;
Begin
retorno:=GetSystemDirectory(@MeuBuffer,128);
if (retorno>128) OR (retorno=0) then
PegaSysDir:=''
else
PegaSysDir:=StrPas(@MeuBuffer);
End; {prc}
Exclusividade para o programa
Gostaria de saber como fazer para que, ao iniciar minha aplicacao
Delphi, eu " desabilite " o shell do Windows (Explorer). Ou seja, o que
eu preciso e' de uma forma de fazer com que apos a minha aplicacao seja
iniciada, o usuario nao tenha como alternar entre programas, acessar
outros icones, etc
No System.ini você tem uma configuração como esta :
Shell=Explorer.exe
Basta trocar por
Shell=Myprog.exe
Ou usando delphi
procedure Tform1.ChangeShell(String programa);
var ArquivoIni : Tinifile;
begin
try
ArquivoIni := Tinifile.Create('System.ini');
ArquivIni.WriteSection('Config','Shell','Myprog.exe');
fynally
ArquivoIni.Destroy;
end;
end;
Substituindo TAB pelo ENTER
procedure TF_Padrao.FormKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
if not (ActiveControl is TDBGrid) then
begin
Key := #0;
Perform(WM_NEXTDLGCTL, 0, 0);
end
else if (ActiveControl is TDBGrid) then
with TDBGrid(ActiveControl) do
if selectedindex < (fieldcount -1) then
selectedindex := selectedindex +1
else
selectedindex := 0;
end;
Ou então, pode-se tentar o seguinte método:
Utilize o evento onkeydown do componente e insira o seguinte comando:
if Key = VK_RETURN then Perform(Wm_NextDlgCtl,0,0);
este comando testa a tecla pressionada, se ela for um enter, manda o foco
para o componente posterior.
Copiando arquivos
CopyFile(Pchar(Origem),Pchar(Destino),false);
Onde Origem e' a variavel de que contem o nome do arquivo de origem
Destiono e' a variavel que contem o nome do arquivo destino
False : Instrui para sobrescrever o arquivo destino (caso encontre)
Criando tabela em tempo de execução
Use os metodos FieldDefs e CreateTable para isso. Veja como criar uma
estrutura temporaria:
with TTable.Create(Application) do begin
Active := False;
DatabaseName := 'C:\TEMP';
TableName := 'TESTE.TMP';
TableType := ttDefault;
FieldDefs.Add('CODCLI', ftString, 5, False);
FieldDefs.Add('NOMCLI', ftString, 40, False);
FieldDefs.Add('DATCAD', ftDate, 0, False);
CreateTable;
Free;
end;
Executar comandos do Dos
WinExec(PChar('command.com /c format a: /v ' +Edit1.Text),SW_SHOWNORMAL);
Armazendo
BMP's em arquivos RES
1. Criem um arquivo texto, por exemplo: RECURSOS.RC com um conteudo igual a este:
BITMAP_1 BITMAP "C:\Imagens\Grafico.bmp"
para todos os bitmap's que vc deseja;
2. Compilem este arquivo usando o BRCC32.EXE que esta no diretorio BIN do Delphi sera
gerado o arquivo RECURSOS.RES; e
3. Coloquem dentro do fonte do projeto:
{$R RECURSOS.RES}
Para usar o bitmap faca o seguinte:
VarTipoTBitmap:= LoadBitmap(HInstance,'BITMAP_1');
QR armazenado num Blop
Os campos do Tipo TBlobField, tem metodos que permitem que
sejam armazenados dados contidos em arquivos, ou em um Stream...
No primeiro caso (dos arquivos), o codigo seria algo como:
TBlobField(SuaTabela.FieldByName('SeuCampo')).LoadFromFile('NomedoArquivo');
No segundo caso, poderia ser feito um exemplo com o TRichEdit:
var
Stream : TMemoryStream;
begin
Stream := TMemoryStream.Create;
try
RichEdit1.Lines.SaveToStream(Stream);
Stream.Seek(0,soFromBeginning);
TBlobField(SuaTabela.FieldByName('SeuCampo')).LoadFromStream(Stream);
finally
Stream.Free;
end;
end;
Ambos os exemplos, assumem que a tabela ja' estaria em modo
de Edicao ou de Insercao.
Deletando um arquivo
if FileExists('C:\MEUDIR\MEUARQ.DAT') then DeleteFile('C:\MEUDIR\MEUARQ.DAT');
Diretório Windows e System
Function ExtractWindowsDir : String;
Var Buffer : Array[0..144] of Char;
Begin
GetWindowsDirectory(Buffer,144);
Result := FormatPath(StrPas(Buffer));
End;
Function ExtractSystemDir : String;
Var Buffer : Array[0..144] of Char;
Begin
GetSystemDirectory(Buffer,144);
Result := FormatPath(StrPas(Buffer));
End;
Function ExtractTempDir : String;
Var Buffer : Array[0..144] of Char;
Begin
GetTempPath(144,Buffer);
Result := FormatPath(StrPas(Buffer));
End;
Como fazer um "Hot Link"
Adicione um componente com o URL. Digite o seguinte código no seu evento OnClick:
procedure Tform1.URLLabelClick(Sender: TObject);
var TempString : array[0..79] of char;
begin
StrPCopy(TempString,URLLabel.Caption);
OpenObject(TempString);
end;
Insira a seguinte procedure logo após implementation:
procedure TTOKAboutBox.OpenObject(sObjectPath : PChar);
begin
ShellExecute(0, Nil, sObjectPath, Nil, Nil, SW_NORMAL);
end;
Adicione "ShellAPI" no uses.
Como saber se o disquete está no
drive.
function DiskInDrive(const Drive: char): Boolean;
var DrvNum: byte;
EMode: Word;
begin
result := false;
DrvNum := ord(Drive);
if DrvNum >= ord('a') then dec(DrvNum,$20);
EMode := SetErrorMode(SEM_FAILCRITICALERRORS);
try
if DiskSize(DrvNum-$40) <> -1 then result := true else messagebeep(0);
finally SetErrorMode(EMode);
end;
end;