Para converter corretamente caracteres do dos para win

Function JOemToAnsiStr(const OemStr: string): string;
begin
SetLength(Result, Length(OemStr));
if Length(Result) > 0 then
{$IFDEF WIN32}
OemToCharBuff(PChar(OemStr), PChar(Result), Length(Result));
{$ELSE}
OemToAnsiBuff(@OemStr[1], @Result[1], Length(Result));
{$ENDIF}
end;

Exemplo
var
Variavel: String;
begin
//Pode pegar por exemplo de uma variável DOS q venha de um DBF e converter para o padrão Win
Variavel := JOemToAnsiStr('Texto em DOS');
...



P. 1140

Protegendo uma aplicação com uma senha armazenada na própria aplicaçati

// Evento OnCreate do Form
procedure TForm1.FormCreate(Sender: TObject);
var
Senha : String;
OK : Boolean;
Tentativa : integer;
begin
Tentativa := 0;
OK := False;
while (Tentativa < 3) do
begin
InputQuery(‘Digite a sua senha’, ‘Você tem ‘ + IntToStr(3 - Tentativa) + ‘ tentativas’, senha);
if (senha = ‘Senha’) then
begin
OK := True;
Break;
end;
Inc(Tentativa);
end;
if not OK then
begin
ShowMessage(‘Tentativas excedidas. Pressione OK para terminar.’);
Application.Terminate;
end;
end;

Uma boa forma de usar mdichild

{Quando uso este recurso nas minhas aplicações eu consigo reduzir em muito o tempo de carregamento do software, sendo assim, resolvi partilhar com todos.

É simples, baseada em uma função (FormExiste), que verifica se um form (MDIChild) já existe na memória. Se existir ele somente dá o foco ao mesmo, senão ele o cria e o deixa na tela pronto para funcionar...

Deixando de conversa, vamos ao código!}

//Função de reconhecimento de MDIChilds
function FormExiste(NomeJanela : TForm) : Boolean;
//Função declarada

//Implementando a função
function TForm1.FormExiste (NomeJanela : TForm) : Boolean;
var i : integer;
begin
formexiste := false;
for i := 0 to ComponentCount -1 do
if Components[i] is TForm then
if TForm(Components[i]) = NomeJanela then
FormExiste := true;
end;

{Para fazer uso correto da função você deve
seguir o exemplo do procedimento abaixo}
procedure TForm1.Button1Click(Sender: TObject);
begin
if FormExiste(frmAlunos) = false then
begin
Screen.Cursor := crhourGlass;
Form2 := TForm2.Create(Self);
Screen.Cursor := crDefault;
end
Else
if FormExiste(Form2 then
begin
Form2.WindowState := wsNormal;
Form2.BringToFront;
Form2.SetFocus;
end;
end;

{Certo?

Espero ter ajudado!

Evaldo Barbosa
evaldobarbosa@hotmail.com}

Criando formulários no formato de bola

{Para criar uma janela não retangular, você deve criar uma Região do Windows e usar a função da API SetWindowRgn, desta maneira (isto funciona apenas em D2/D3):}
var hR : THandle;

begin
// Cria uma Região elíptica
hR := CreateEllipticRgn(0,0,100,200);
SetWindowRgn(Handle,hR,True);
end;

Criando evento em tempo de execução

Memo.onchange := memo1Change;

procedure TForm1.Memo1Change(Sender: TObject);
begin
panel1.caption:='Conteúdo alterado';
end;

Criando e excluindo tfields em tempo de execução

{Objetos TField (e seus descendentes) podem ser criados em tempo de desenvolvimento através do Fields Editor.

O Fileds Editor é acionado quando damos um clique duplo no componente de acesso a dados, ou seja, TTable ou TQuery. Mas nós podemos fazer isto em tempo de execução também.

Descendentes do TField componente (como TStringField, TIntegerField, etc.) são criados para que possamos chamar o métodos Create para o tipo de campo desejado.

Após criar o componente, precisamos especificar algumas propriedades para que a conexão com os dados funcione e assim poderemos alterar dados das tabelas. São
eles:

FieldName: nome do campo na tabela.
Name: nome do componente, usado pelo Delphi.
Index: É um número de identificação para o campo. Este número nunca é repetido,
automaticamente é controlado pelo Delphi.}
DataSet: O componente TTable ou TQuery ao qual queremos associar o campo.

O Código abaixo mostra a criação de um campo String. Usaremos o Objeto Query1
para nos referenciarmos ao DataSet.

procedure TForm1.Button2Click(Sender: TObject);
var T: TStringField;

begin
Query1.Close;

T := TStringField.Create(Self);
T.FieldName := 'CO_NAME';
T.Name := Query1.Name + T.FieldName;
T.Index := Query1.FieldCount;
T.DataSet := Query1;

Query1.FieldDefs.UpDate;
Query1.Open;
end;

Note que é necessário fechar o DataSet(Query1) antes de adicionarmos o novo campo.

Usamos a propriedade "Fieldcount" para definir o número da chave do campo criado, usando esta propriedade obteremos o número de TFileds que o DataSet(Query1) possui no momento, assim sempre estaremos criando um campo novo, pois se o primeiro começa com 0

Excluir um campo é bem mais simples, para isto basta criar um instância do tipo TComponent, e usar a função FindComponent para referenciá-lo ao objeto, para isto basta sabermos o nome do Objeto. A exclusão é feita através do método Free.

procedure TForm1.Button1Click(Sender: TObject);
var TC: TComponent;

begin
TC := FindComponent('Query1CO_NAME');
if not (TC = nil) then
begin
Query1.Close;
TC.Free;
Query1.Open;
end;
end;

Copiando registros de uma tabela para outra incluindo valores

NULL
procedure TtableCopiaRegistro(Origem, Destino: Ttable);
begin
with TabelaOrig do
begin
for i := 0 to FieldCount -1 do
if not Fields[i].IsNull then TabelaDest.Fields[i].Assign(Fields[i]);
end;
end;

Convertendo valores

{No delphi podemos ler um campo armazenado numa tabela, alterando seu tipo, ou seja, podemos ler um campo numérico, por exemplo, como um campo string, e vice-versa. Este recurso é útil e prático, pois permite maior agilidade e menos programação.

Exemplo:

Se quisermos converter um campo numérico armazendo em Tabela1 para string, armazenando-o na variável S, podemos fazer o seguinte:}

S:=tabela1.camponumerico.asstring;

{Pode-se utilizar as seguintes conversões:

Asboolean - Converte para valores booleanos (lógicos)
AsDateTime - Converte para Data/Hora
AsFloat - Converte para valores numéricos de ponto flutuante
AsInteger - Converte para valors numéricos inteiros
AsString - Converte para strings de caracteres}

Convertendo valor hexadecimal para inteiro

Function HexToInt(const HexStr: string): longint;
var iNdx: integer;
cTmp: Char;

begin
Result := 0;
for iNdx := 1 to Length(HexStr) do
begin
cTmp := HexStr[iNdx];
case cTmp of
'0'..'9': Result := 16 * Result + (Ord(cTmp) - $30);
'A'..'F': Result := 16 * Result + (Ord(cTmp) - $37);
'a'..'f': Result := 16 * Result + (Ord(cTmp) - $57);
else
raise EConvertError.Create('Illegal character in hex string');
end;
end;
end;

Convertendo um número real para string com 2 casas

ValorReal : Real;
ValorString : String;
ValorReal := 5;
ValorString := floattostrf(ValorReal,ffFixed,18,2);

Convertendo pchar para string

Var sWinDir: AnsiString;
nTam: Integer;

begin
nTam := MAX_PATH;
SetLength(sWinDir,nTam);
GetWindowsDirectory( PChar( sWinDir ), nTam )
SetLength(sWinDir,nTam);
end;

Conectando uma unidade de rede

Var NRW: TNetResource;

begin
with NRW do
begin
dwType := RESOURCETYPE_ANY;
lpLocalName := 'G:';
lpRemoteName := '\servidorc';
lpProvider := '';
end;

WNetAddConnection2(NRW, 'MyPassword', 'MyUserName', CONNECT_UPDATE_PROFILE);
end;

obtendo o espaço livre em disco.

procedure TForm1.Button1Click(Sender: TObject);
var
FreeAvailable,TotalSpace,TotalFree : Int64;
begin
GetDiskFreeSpaceEx('c:',FreeAvailable,TotalSpace,@TotalFree);
ShowMessage('Espaço livre: '+FormatFloat('#,0',TotalFree)+#13+
'Espaço disponível: '+FormatFloat('#,0',FreeAvailable)+#13+
'Espaço total do disco: '+FormatFloat('#,0',TotalSpace));
end;

Usando mutex pra não deixar seu aplicativo ser executado mais de uma vez.

{1o. Coloque o código abaixo no seu projeto, clicando no menu Project/View Source.

2o. Adicione a Unit Windows no uses de seu projeto.



Esta dica serve para não deixar que seu aplicativo seja executado mais de uma vez, inclusive no Windows XP }


{$R *.res}
Var
MutexHandle: THandle;
hwind:HWND;
begin
MutexHandle := CreateMutex(nil, TRUE, 'MysampleAppMutex');
if MutexHandle <> 0 then
begin
if GetLastError = ERROR_ALREADY_EXISTS then
begin
MessageBox(0, 'Este programa já está em execução!','', mb_IconHand);
CloseHandle(MutexHandle);
hwind:=0;
repeat
hwind:=Windows.FindWindowEx(0,hwind,'TApplication','My sampleapp');
until (hwind<>Application.Handle);
if (hwind<>0) then
begin
Windows.ShowWindow(hwind,SW_SHOWNORMAL);
Windows.SetForegroundWindow(hwind);
end;
Halt;
end
end;
Application.Initialize;
Application.CreateForm(Tf_principal, f_principal);
Application.Run;
end.

Como criar uma variante de carregamento

{1º para que serve uma variante de carregamento?
Uma variante de carregamento serve para você indicar que o programa a ser usado está carregando, como se fosse uma especíe de downloads.
Ai Vai.}

procedure TForm1.Button1Click(Sender: TObject);
var
time1, time2:tdatetime;
n1, n2, total: variant;
begin
time1:= now;
n1:= 0;
n2:= 0;
progressbar1.position:= 0;
while n1 < 5000000 do
begin
n2:=n2 + n1;
inc (n1);
if (n1 mod 50000) = 0 then
begin
progressbar1.position:= n1 div 50000;
application.ProcessMessages;
end;
end;
// devemos usar o resultado
total:=n2;
time2:=now;
label1.caption:= formatdatetime('n:ss', time1-time2) + ' segundos';
end;

//obs: progressbar está em win32.

Como criar uma variante de carregamento

{1º para que serve uma variante de carregamento?
Uma variante de carregamento serve para você indicar que o programa a ser usado está carregando, como se fosse uma especíe de downloads.
Ai Vai.}

procedure TForm1.Button1Click(Sender: TObject);
var
time1, time2:tdatetime;
n1, n2, total: variant;
begin
time1:= now;
n1:= 0;
n2:= 0;
progressbar1.position:= 0;
while n1 < 5000000 do
begin
n2:=n2 + n1;
inc (n1);
if (n1 mod 50000) = 0 then
begin
progressbar1.position:= n1 div 50000;
application.ProcessMessages;
end;
end;
// devemos usar o resultado
total:=n2;
time2:=now;
label1.caption:= formatdatetime('n:ss', time1-time2) + ' segundos';
end;

//obs: progressbar está em win32.

Como obter a data e hora de acesso, criação e alteração de um arquivo

//Usamos o objeto TSearchRec para retornar as datas e horas de um arquivo.

var
SearchFile: TSearchRec;
lpSystemTime: TSystemTime;
begin
{ arquivo }
FindFirst(‘c:ActiveDelphi.exe’,faAnyFile,SearchFile);
try
{ Criação }
FileTimeToSystemTime
(SearchFile.FindData.ftCreationTime,lpSystemTime);
Edit1.text:=DateTimeToStr(SystemTimeToDateTime(lpSystemTime));
{ Modificado }
FileTimeToSystemTime
(SearchFile.FindData.ftLastWriteTime,lpSystemTime);
Edit2.text:=DateTimeToStr
(SystemTimeToDateTime(lpSystemTime));
{ Acessado }
FileTimeToSystemTime
(SearchFile.FindData.ftLastAccessTime,lpSystemTime);
Edit3.text:=DateTimeToStr(SystemTimeToDateTime(lpSystemTime));
finally
FindClose(SearchFile);
end;
end;

Obter status da memória do sistema

//Adicione um TButton e um TMemo, no evento Onclick do TButton insira o código abaixo.



procedure TForm1.Button1Click(Sender: TObject);
const
cBytesPorMb = 1024 * 1024;
var
M: TMemoryStatus;
begin
M.dwLength := SizeOf(M);
GlobalMemoryStatus(M);
Memo1.Clear;
with Memo1.Lines do begin
Add(Format('Memória em uso: %d%%', [M.dwMemoryLoad]));
Add(Format('Total de memória física: %f MB', [M.dwTotalPhys / cBytesPorMb]));
Add(Format('Memória física disponível: %f MB', [M.dwAvailPhys / cBytesPorMb]));
Add(Format('Tamanho máximo do arquivo de paginação: %f MB', [M.dwTotalPageFile / cBytesPorMb]));
Add(Format('Disponível no arquivo de paginação: %f MB', [M.dwAvailPageFile / cBytesPorMb]));
Add(Format('Total de memória virtual: %f MB', [M.dwTotalVirtual / cBytesPorMb]));
Add(Format('Memória virtual disponível: %f MB', [M.dwAvailVirtual / cBytesPorMb]));
end;
end;

como abrir um relatório criado no ms access pelo delphi

procedure TForm1.ImprimeClick(Sender: TObject);
var access : variant;
const
print = $00000000;
viewDesign = $00000001;
preview = $00000002;

begin
// Abre a aplicaçao Access
try
Access := GetActiveOleObject('Access.Application');
except
Access := CreateOleObject('Access.Application');
end;

Access.Visible := true;

// Abre o database
// Informe no primeiro parâmetro o local do arquivo.mdb
// No Segundo parâmetro especificar se o banco de dados do Access abrirá no modo exclusivo, não compartilhado.

Access.OpenCurrentDatabase('C:Mes documentostestearquivo.mdb', True);

{
Abre o relatório criado no Access; informar seu nome no primeiro parâmetro.
O valor do segundo parâmetro deve ser: preview, viewDesign(estrutura) ou print(o qual é default e imprime o relatório imediatamente).
O *terceiro parâmetro, é para uma expressão de sequência que seja o nome válido de uma consulta no banco de dados atual.
O *quarto parâmetro é para cláusula WHERE SQL válida, sem a palavra WHERE.
*não foi usado neste exemplo
}

Access.DoCmd.OpenReport('Relatorio_de_Clientes', preview,
EmptyParam, EmptyParam);

end;

procedure TForm1.FecharAccessClick(Sender: TObject);
var access : variant;
begin
// depois de imprimir, use esse código para fechar:
try
Access := GetActiveOleObject('Access.Application');
except
Access := CreateOleObject('Access.Application');
end;
Access.CloseCurrentDatabase;
Access.Quit;
end;

Exportando timage no formato wmf.

procedure ExportaBMPtoWMF(Imagem:TImage; Dest:Pchar);
var
Metafile : TMetafile;
MetafileCanvas : TMetafileCanvas;
DC : HDC;
ScreenLogPixels : Integer;
begin
Metafile := TMetafile.Create;
try
DC := GetDC(0);
ScreenLogPixels := GetDeviceCaps(DC, LOGPIXELSY);
Metafile.Inch := ScreenLogPixels;
Metafile.Width := Imagem.Picture.Bitmap.Width;
Metafile.Height := Imagem.Picture.Bitmap.Height;
MetafileCanvas := TMetafileCanvas.Create(Metafile, DC);
ReleaseDC(0, DC);
try
MetafileCanvas.Draw(0, 0, Imagem.Picture.Bitmap);
finally
MetafileCanvas.Free; end;
Metafile.Enhanced := FALSE;
Metafile.SaveToFile(Dest);
finally
Metafile.Destroy;
end;

end;