domingo, 31 de maio de 2009

Como saber se o ano é bissexto?

Function TForm1.AnoBiSsexto(Ayear: Integer): Boolean;
begin
Result := (AYear mod 4 = 0) and ((AYear mod 100 <> 0) or
(AYear mod 400 = 0));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if AnoBiSexto(1999) Then
ShowMessage('Ano de 1999 é Bissexto')
Else ShowMessage('Ano de 1999 não é Bissexto');
end;

Como saber se estou conectado à internet?

Interface
uses
Windows, SysUtils, Registry, WinSock, WinInet;

type
TConnectionType = (ctNone, ctProxy, ctDialup);

function ConnectedToInternet : TConnectionType;
function RasConnectionCount : Integer;


implementation

const
cERROR_BUFFER_TOO_SMALL = 603;
cRAS_MaxEntryName = 256;
cRAS_MaxDeviceName = 128;
cRAS_MaxDeviceType = 16;
type
ERasError = class(Exception);

HRASConn = DWord;
PRASConn = ^TRASConn;
TRASConn = record
dwSize: DWORD;
rasConn: HRASConn;
szEntryName: Array[0..cRAS_MaxEntryName] Of Char;
szDeviceType : Array[0..cRAS_MaxDeviceType] Of Char;
szDeviceName : Array [0..cRAS_MaxDeviceName] of char;
end;

TRasEnumConnections =
function (RASConn: PrasConn; { buffer para receber dados da conexao}
var BufSize: DWord; { tamanho em bytes do buffer }
var Connections: DWord { numero de conexoes escritas no buffer }
): LongInt; stdcall;


function ConnectedToInternet: TConnectionType;
var
Reg : TRegistry;
bUseProxy : Boolean;
UseProxy : LongWord;
begin
Result := ctNone;
Reg := TRegistry.Create;
with REG do
try
try
RootKey := HKEY_CURRENT_USER;
if OpenKey('SoftwareMicrosoftWindowsCurrentVersionInternet settings',False) then begin
//I just try to read it, and trap an exception
if GetDataType('ProxyEnable') = rdBinary then
ReadBinaryData('ProxyEnable', UseProxy, SizeOf(LongWord) )
else begin
bUseProxy := ReadBool('ProxyEnable');
if bUseProxy then
UseProxy := 1
else
UseProxy := 0;
end;
if (UseProxy <> 0) and ( ReadString('ProxyServer') <> '' ) then Result := ctProxy;
end;
except
//Nao conectado com proxy
end;
finally
Free;
end;

if Result = ctNone then begin
if RasConnectionCount > 0 then Result := ctDialup;
end;
end;

function RasConnectionCount : Integer;
var
RasDLL : HInst;
Conns : Array[1..4] of TRasConn;
RasEnums : TRasEnumConnections;
BufSize : DWord;
NumConns : DWord;
RasResult : Longint;
begin
Result := 0;

//Load the RAS DLL
RasDLL := LoadLibrary('rasapi32.dll');
if RasDLL = 0 then exit;

try
RasEnums := GetProcAddress(RasDLL,'RasEnumConnectionsA');
if @RasEnums = nil then
raise ERasError.Create('RasEnumConnectionsA not found in rasapi32.dll');

Conns[1].dwSize := Sizeof (Conns[1]);
BufSize := SizeOf(Conns);

RasResult := RasEnums(@Conns, BufSize, NumConns);

If (RasResult = 0) or (Result = cERROR_BUFFER_TOO_SMALL) then Result := NumConns;
finally
FreeLibrary(RasDLL);
end;
end;

Como saber quantos dias tem no mês?

Function TForm1.AnoBiSexto(Ayear: Integer): Boolean;
begin
// Verifica se o ano é Bi-Sexto
Result := (AYear mod 4 = 0) and ((AYear mod 100 <> 0) or
(AYear mod 400 = 0));
end;

function TForm1.DiasPorMes(Ayear, AMonth: Integer): Integer;
const DaysInMonth: array[1..12] of Integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
begin
Result := DaysInMonth[AMonth];
if (AMonth = 2) and AnoBiSexto(AYear) then
Inc(Result);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Caption := IntToStr(DiasPorMes(1999, 10));
end;

Como saber qual o objeto que esta com o foco no form?

//Através do evento onKeyPress do form, pode-se testar:


if (ActiveControl is TCustomEdit) and (Key = #1) then
blablabla;
ou Como no exemplo abaixo:

procedure TForm1.mnuPasteClick(Sender: TObject);
var
CanPaste: Boolean;
Ctrl: TWinControl;
begin
Ctrl := ActiveControl;
if (Assigned(Ctrl) and
Clipboard.HasFormat(CF_TEXT)) then
begin
if (Ctrl is TEdit) then
CanPaste := (not TEdit(Ctrl).ReadOnly)
else if (Ctrl is TMaskEdit) then
CanPaste := (not TMaskEdit(Ctrl).ReadOnly)
else if (Ctrl is TMemo) then
CanPaste := (not TMemo(Ctrl).ReadOnly)
else if (Ctrl is TRichEdit) then
CanPaste := (not TRichEdit(Ctrl).ReadOnly)
else
CanPaste := False;
if (CanPaste) then
TCustomEdit(Ctrl).PasteFromClipboard;
end;
end;

Num lock, caps lock e scroll lock?

{Utilize a função getkeystate em conjunto com o código das teclas, ela retorna 0 se a tecla estiver OFF e 1 se a tecla estiver ON: } If getkeystate(vk_numlock) = 0 then // Num lock está OFF
If getkeystate(vk_numlock) = 1 then // Num lock está ON
If getkeystate(vk_scroll) = 0 then // Scroll lock está OFF
If getkeystate(vk_scroll) = 1 then // Scroll lock está ON
If getkeystate(vk_CAPITAL) = 0 then // Caps lock está OFF
If getkeystate(vk_CAPITAL) = 1 then // Caps lock está ON

Como saber há quanto tempo o windows foi inicializado?

{Use a função GetTickCount da API do Windows. Ela retorna o intervalo em milisegundos. Obs.: Esta função é útil quando se quer determinar o intervalo de tempo decorrido durante uma ação de um aplicativo.}

var
TempoInicial, TempoFinal, Intervalo: Integer
begin
TempoInicial := GetTickCount;
...
// código a ser executado
...
TempoFinal := GetTickCount;
Intervalo := TempoFinal - TempoInicial;
end.

Como retornar várias informações sobre a bios?

{Esta função retorna várias informações sobre a BIOS, no formato String que você poderá facilmente jogar para um memo usando o seguinte:}


Memo1.Lines.Text := GetBiosInfoAsText; {O Memo apresentará todas as informações que a

função retirou sobre a BIOS.}

function GetBiosInfoAsText: string;
var
p, q: pchar;
begin
q := nil;
p := PChar(Ptr($FE000));
repeat
if q <> nil then begin
if not (p^ in [#10, #13, ' '..'~' , '©' , '¸' ]) then begin
if (p^ = #0) and (p - q >= 8) then begin
Result := Result + TrimRight(String(q)) + #13#10;
end;
q := nil;
end;
end else
if p^ in ['!'..'~' , '©' , '¸' ] then
q := p;
inc(p);
until p > PChar(Ptr($FFFFF));
Result := TrimRight(Result);
end;

terça-feira, 26 de maio de 2009

Como retornar a uma lista os campos indexados de um tabela?

Procedure TForm1.Button1Click(Sender: TObject);
var
i : integer;
begin
Table1.IndexDefs.Update;
ListBox1.Items.add
('******** Índice Primário ********');
for i:=0 to Table1.IndexDefs.Count-1 do
begin
if Table1.IndexDefs.Items[i].Options = [ixPrimary..ixUnique] then
ListBox1.Items.add(Table1.IndexDefs.Items[I].Fields)
else
begin
ListBox1.Items.add('');
ListBox1.Items.add
('**** Índice Secundário ****');
Listbox1.Items.Add(Table1.IndexDefs.Items[I].Name);
end;
end;
end;

Como retornar a cor de um pixel de uma imagem?

{Para testar o exemplo inclua em um form um componente Image e inclua neste componente Image uma imagem qualquer. Inclua o código abaixo no evento OnMouseMove.}
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
begin
// Retornar a cor
Caption := ColorToString(Image1.Canvas.Pixels[X,Y]);
{ Retornar o número da cor }
Caption := Caption + ' - '+IntToStr(ColorToRGB(Image1.Canvas.Pixels[X,Y]));
end; //Esta dica foi testada com uma imagem de formato BMP

Como reduzir o tempo e carga de um programa?

{É comum acontecer um sensível aumento do tempo de carga de um aplicativo desenvolvido em Delphi à medida que este aplicativo cresce e adquire mais e mais formulários. Às vezes o tempo de carga se torna totalmente insuportável.

Os programas se tornam lentos principalmente devido à grande quantidade de formulários que são criados e inicializados logo no início da execução do programa. Antes de ser efetivamente utilizado, todo formulário precisa ser criado. A criação do formulário

Sempre que você adiciona um novo formulário ao sistema, o IDE do Delphi providencia código para que ele seja criado automaticamente. Isto simplifica a vida do programador que não precisará se preocupar com este detalhe.

O aumento do tempo de carga do aplicativo pode ser resolvido pela simples remoção do código que o Delphi gerou para a criação do formulário. Entretanto isto cria um problema. Antes de efetivamente mostrar o formulário na tela (ou antes de usar e/ou alterar)

Para remover o código que o Delphi criou automaticamente, selecione Project/Options no menu. Selecione a aba 'Forms'. Aponte para um dos formulários e clique no botão '>'. Isto faz com que o formulário passe do painel 'Auto-create forms' para o painel 'Available forms'

Se você quer saber onde está este código, clique em View/Units (ou use Ctrl-F12) e selecione o seu projeto na lista de units que aparecerá. O código que cria formulários é algo mais ou menos como se segue:}


Application.CreateForm(TForm1, Form1); {Cada formulário auto-criado terá uma linha como esta. Quando o formulário passa para o painel de 'Available forms', a linha correspondente é removida. Você também pode simplesmente remover a linha manualmente, usando o editor de textos.

Tipicamente usar um formulário significa mostrá-lo na tela. Isto é feito invocando-se os métodos Show ou ShowModal do formulário conforme o estilo do aplicativo. Agora que o formulário não é mais criado automaticamente, isto se torna um pouco mais complicado.}


if Form1 = nil then
Form1 := TForm1.Create ( Application );
Form1.Show; { ou Form1.ShowModal; } //Alternativamente você poderia escrever assim:


if Form1 = nil then
Application.CreateForm ( TForm1, Form1 );
Form1.Show; { ou Form1.ShowModal; } {O efeito é o mesmo.

Você deve ter extremo cuidado ao usar esta técnica. Se você tirar o código de criação automática do formulário e tentar executar o Show ou ShowModal você vai receber um erro do tipo 'Access violation'. Tome cuidado e faça isto um formulário por vez.

Atenção! Não faça isto para o seu formulário principal. O formulário principal precisa ser o primeiro formulário a ser criado. Assim é melhor mantê-lo como auto-criado.

Esta técnica efetivamente 'distribui' o tempo de carga e inicialização do aplicativo pela execução do programa. Os formulários agora são carregados 'sob-demanda'. Formulários nunca utilizados nunca serão criados. Isto também melhora o uso de memória.

E, no evento onClose de cada form, pode-se colocar:}

Action := caFree;

//Isso liberará o form da memória, ocupando assim menos espaço.

Como posso saber a coluna que estou posicionado no dbgrid?

{É fácil saber a coluna que você está no DBGrid. Para isso vamos usar a propriedade SelectedIndex que retorna o número da coluna. Veja um exemplo: }
procedure Tform1.DBGrid1ColEnter(Sender:TObject);
begin
Edit1.Text := IntToStr(DBGrid1.SelectedIndex);
end;

Como posso rolar um form com pgup e pgdn?

{O rolamento do form é completo fazendo-se uma modificação na posição das propriedades VertScrollbar ou HorzScrollbar do form. Como mostrado no código a seguir:}


procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
const
PageDelta = 10;
begin
With VertScrollbar do
if Key = VK_NEXT then
Position := Position + PageDelta
else if Key = VK_PRIOR then
Position := Position - PageDelta;
end;

Como pegar o diretório de uma alias?

Unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, Db, DBTables ;

type
TForm1 = class(TForm)
Label1: TLabel;
BitBtn1: TBitBtn;
Edit1: TEdit;
Table1: TTable;
Label2: TLabel;
procedure BitBtn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
WAlias : TStringList; //Capitura o Alias do Bde
WServidor : String; //Retorna o Caminho
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
{Para validar a Session e necessario ter um compomente table anexado ao projeto}
WAlias := TStringList.Create;
// Session.GetAliasParams('CrAdm',WAlias); //Coloque o Alias diretamente ou Troque pelo Edit
Session.GetAliasParams(Edit1.Text,WAlias);
WServidor := WAlias[0];
WServidor := Copy(WServidor,6,255);
WServidor := Copy(WServidor,1,(Length(WServidor)));
Label1.Caption := WServidor;
end;

end.

Como pegar a url ativa no browser?

Uses ddeman;

function GetURL(Service: string): String;
var
ClDDE: TDDEClientConv;
temp:PChar;
begin
Result := '';
//create a new DDE Client object
ClDDE:= TDDEClientConv.Create( nil );
with ClDDE do
begin
SetLink(Service,'WWW_GetWindowInfo');
temp := RequestData('0xFFFFFFFF');
Result := StrPas(temp);
StrDispose(temp);
CloseLink;
end;
ClDDE.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(GetURL('IExplore'));
end;

Como pegar a lista de favoritos do internet explorer?

Function GetIEFavoritos(const favpath: string):TStrings;
var
searchrec:TSearchrec;
str:TStrings;
path,dir,filename:String;
Buffer: array[0..2047] of Char;
found:Integer;
begin
str:=TStringList.Create;
//Pega todos os nomes de arquivo no path dos favoritos
path:=FavPath+'*.url';
dir:=ExtractFilepath(path);
found:=FindFirst(path,faAnyFile,searchrec);
while found=0 do begin
SetString(filename, Buffer, GetPrivateProfileString('InternetShortcut',
PChar('URL'), NIL, Buffer, SizeOf(Buffer), PChar(dir+searchrec.Name)));
str.Add(filename);
found:=FindNext(searchrec);
end;
found:=FindFirst(dir+'*.*',faAnyFile,searchrec);
while found=0 do begin
if ((searchrec.Attr and faDirectory) > 0) and (searchrec.Name[1]<>'.') then
str.AddStrings(GetIEFavourites(dir+''+searchrec.name));
found:=FindNext(searchrec);
end;
FindClose(searchrec);
Result:=str;
end;

procedure TForm1.Button1Click(Sender: TObject);
var pidl: PItemIDList;
FavPath: array[0..MAX_PATH] of char;
begin
SHGetSpecialFolderLocation(Handle, CSIDL_FAVORITES, pidl);
SHGetPathFromIDList(pidl, favpath);
ListBox1.Items:= GetIEFavoritos (StrPas(FavPath));
end;

Como obter informações do s.o. (nome, versão, compilação)?

Unit sobreManager;
interface
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls, Buttons, ExtCtrls;
type
TfrmSobreManager = class(TForm)
btnOK: TButton;
ProductName: TLabel;
Version: TLabel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Copyright: TLabel;
Panel1: TPanel;
Image2: TImage;
GroupBox1: TGroupBox;
Bevel1: TBevel;
stOSVersao: TStaticText;
stOSBuilder: TStaticText;
stOS: TStaticText;
stOSService: TStaticText;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmSobreManager: TfrmSobreManager;
implementation

{$R *.DFM}
// VERIFICA E APRESENTA AS INFORMAÇÕES do SISTEMA OPERACIONAL
procedure TfrmSobreManager.FormCreate(Sender: TObject);
var
verInfo : TOsVersionInfo;
str : String;
I : Word;
begin
verInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
if GetVersionEx(verInfo) then begin
stOSVersao.Caption := 'Versão : '+ IntToStr(verInfo.dwMajorVersion) +
IntToStr(verInfo.dwMinorVersion);
OSBuilder.Caption := 'Compilação : '+IntToStr(verInfo.dwBuildNumber);
str := 'Sistema Operacional : ';
case verInfo.dwPlatformId of
VER_PLATFORM_WIN32s : stOS.Caption := str +'Windows 95';
VER_PLATFORM_WIN32_WINDOWS : stOS.Caption := str +'Windows 95 Osr2 / 98';
VER_PLATFORM_WIN32_NT : stOS.Caption := str +'Windows NT';
end;
str := '';
for I := 0 to 127 do
str := str + verInfo.szCSDVersion[I];
stOSService.Caption := 'Informações Adicionais : '+ str;
end
end;
end.

Obrigando a digitação de maiúsculos em um memo?

Procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);
begin
Key:= Upcase(Key);
end;

Como mudar a cor de uma regiao de texto richedit?

Var
sStart: word;
begin
sStart := REdit.SelStart;
REdit.SelStart := 6;
REdit.SelLength := 10;
REdit.SelAttributes.color := clBlue; // set color
REdit.SelAttributes.style := [fsUnderline]; // set attributes
Application.Processmessages;
REdit.SelStart := sStart;
REdit.SelLength := 0;
end;

Como mostrar o mouse como uma ampulheta?

try
Screen.Cursor := crHourGlass;
{ Escreva o ação a executar aqui }
finally
Screen.Cursor := crDefault;
end;
Application.ProcessMessages;

Manipulando arquivos .ini 2

{Os arquivos .INI são arquivos de texto que servem para guardar informações úteis de configuração, como a passagem de uma data de um programa para outro, o arquivo .INI tem o formato: } [SEÇÃO]

variável=valor

{Para usar um arquivo .INI seguem os passos abaixo:

* acrescentar na Uses do projeto a bibliteca IniFiles

uses IniFiles;

* criar uma variável do tipo TIniFile}


var
data:TIniFile; //* Criar o arquivo .INI


Data := TIniFile.Create('Data.ini'); {Onde Data.ini é o nome do arquivo (você pode colocar inclusive o caminho do arquivo, o padrão é o diretório do Windows).

* Gravar a informação}


Data.WriteString('Mes/Ano','Data',Edit1.Text);
Data.Free; //esta linha libera a variável da memória {Onde Mes/Ano é o nome da seção, Data é o nome da variável e Edit1.Text é a data digitada pelo usuário

* Ler a informação

Crie outra variável no outro programa apenas para ler a string}


Data.TiniFile.Create('Data.ini');
Data.ReadString('Mes/Ano','Data','');
Data.Free;

Manipulando arquivos .ini

//Inclua a unit IniFiles na clausula uses do seu form.
Procedure TForm1.GravaIni( Numero : Longint ; Texto : String ; Condicao : Boolean);
var
ArqIni : TIniFile;
begin
ArqIni := TIniFile.Create('c:windowstempTeste.Ini');
Try
ArqIni.WriteInteger('Dados', 'Numero', Numero);
ArqIni.WriteString('Dados', 'Texto', Texto);
ArqIni.WriteBool('Dados', 'Condição', Condicao);
Finally
ArqIni.Free;
end;
end;

Procedure TForm1.LeIni( Var Numero : Longint ; Var Texto : String ; Var Condicao : Boolean);
var
ArqIni : tIniFile;
begin
ArqIni := tIniFile.Create('c:windowstempTeste.Ini');
Try
Numero := ArqIni.ReadInteger('Dados', 'Numero', Numero );
Texto := ArqIni.ReadString('Dados', 'Texto', Texto );
Condicao := ArqIni.ReadBool('Dados', 'Condição', Condicao );
Finally
ArqIni.Free;
end;
end;
// Utilize as procedures assim:

procedure TForm1.Button1Click(Sender: TObject);
begin
GravaIni(1234,'TESTE',True);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
N: Integer;
T: String;
C: Boolean;
begin
LeIni(N,T,C);
Showmessage(IntToStr(N)+' '+T);
end;

Como 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; ou

procedure LimpaEdit (Form: TForm);
var
i : Integer;
begin
for i := 0 to Form.ComponentCount - 1 do
if Form.Components[i] is TCustomEdit then
(Form.Components[i] as TCustomEdit).Clear;
end;

segunda-feira, 25 de maio de 2009

Como mover um componente em run-time?

{No exemplo abaixo deve ser incluído um componente Button. Para testar este exemplo mantenha a tecla CTRL pressionada clique com o mouse no componente Button. Feito isto, basta arrastar o componente Button para qualquer lado.}

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Button1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Button1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
MouseDownSpot : TPoint;
Capturing : bool;
end;
var
Form1: TForm1;

implementation
{$R *.DFM}

// Evento OnMouseDown do Form
procedure TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if ssCtrl in Shift then begin
SetCapture(Button1.Handle);
Capturing := true;
MouseDownSpot.X := x;
MouseDownSpot.Y := Y;
end;
end;

// Evento OnMouseMove do Form
procedure TForm1.Button1MouseMove(Sender:
TObject; Shift: TShiftState; X, Y: Integer);
begin
if Capturing then begin
Button1.Left:= Button1.Left-(MouseDownSpot.x-x);
Button1.Top:= Button1.Top - (MouseDownSpot.-y);
end;
end;

// Evento OnMouseUp do Form
procedure TForm1.Button1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Capturing then begin
ReleaseCapture;
Capturing := false;
Button1.Left := Button1.Left - (MouseDownSpot.x -x);
Button1.Top := Button1.Top - (MouseDownSpot.y - y);
end;
end;

Como limpar o conteúdo de um lookupcombobox?

DBLookupComboBox1.KeyValue:=' ';

Como ler código de barras?

//Crie um Edit e no evento OnChange coloque a seginte rotina:

procedure TForm1.Edit1Change(Sender: TObject);
begin
try
// Crie um indice secundário para o campo de código de Barras
Tabela.IndexFieldNames := 'nome do campo de Código de Barra ';
Tabela.Editkey;
Tabela.FindNearest([Edit1.Text]);
Tabela.Refresh;
except on
EDBEngineError do MessageDlg('Erro na busca! Tente novamente.', mtError,
[mbOK], 0);
end
end;

Como instalar rxlib para delphi 5.x?

{
1) Rode o RXINST.EXE para instalar os arquivos necessários (acho que issovocê já fez)

Obs : Veja a observação abaixo :

If you have Delphi 5 Professional or Standard Edition, desactivate the

conditional define {$DEFINE DCS} in the RX.INC file before compiling the

library.

2) Depois disso vá em File/Open e abra o arquivo RXCTL5.DPK e compile ele.

Repita a operação para os arquivos RXDB5.DPK e RXBDE5.DPK (tem que ser nessa

ordem).

3) Feche os 3 arquivos sem salvar.

4) Verifique também se os arquivos rxbde5.bpl, rxctl5.bpl e rxdb5.bpl estão

no seu Windows/System.

5) Vá novamente em File/Open e abra o arquivo DCLRX5.DPK. Compile e instale

esse arquivo. Isso já vai criar uma nova guia no Delphi. Repita a operação

para os arquivos DCLRXDB5.DPK e DCLRXBD5.DPK (mais uma vez a ordem é

importante).

Feito isso as 3 guias foram criadas. Feche os arquivos sem salvar.

6) Vá em Tools/Environment Option/Library. Na opção Library path inclua o

diretório aonde estão os .pas e .dcu da RxLib (é o diretório Units dentro da

arvore da Rx).
}

Como instalar o activex do flash?

{Primeiro você deve instalar o Flash (as vezes não se faz necessário) ai você irá em COMPONENT ---> IMPORT ACTIVEX CONTROL

ai você irá instalar o ShockWave Flash (version 1.0) e pronto. Vá na Aba ActiveX e você encontrará o componente ShockWaveFlash

é só especificar os parâmetros e usá-los. }

Como instalar um componente ?

{No delphi a três maneiras de instalar componentes. Existe a possibilidade de instalar componentes através de três tipos de extensões de arquivos: *.pas, *.dcu, *.dpk. Explicando um por um:

1 - Para arquivos que necessitam de um Package (normalmente componentes que possuem somente o *.PAS), execute o Delphi e feche o projeto, acesse o menu 'Component' e clique na opção 'install component'. Na janela que se apresenta, acesse a aba ' Into New Packages', clique no botão 'Browse' ao lado da caixa de texto 'Unit File Name' abra o arquivo com extensão *.pas, dê ok e logo após 'Compile' e 'Install' e o arquivo criará uma aba na barra de componentes com um nome para a sua localização.

2 - Para instalar pacotes de componentes (Packages, arquivos com a extensão *.DPK), execute o Delphi e feche o projeto, acesse o menu 'File' e clique na opção 'Open', abra o arquivo que contém os componentes. Dê Ok e depois é só clicar en 'install'. Pronto seu pacote de componentes será instalado.

3 - Para arquivos com a extensão *.dcu, é um pouco mais complicado. Acesse o menu 'Component' e clique na opção 'install package'. Verifique se na lista 'Design packages' existe a opção 'Borland user component', se sim, clique no botão 'edit', abrirá uma caixa de mensagens, clique no botão 'yes'. Na janela que aparece clique no botão 'add', na janela que se abrirá clique no botão 'browse' da caixa de texto 'unit file name'. Na caixa de combinação 'files of type' escolha 'Delphi compiled unit(*.dcu)', depois na caixa de texto 'File name' direcione o arquivo a ser instalado, clique no botão 'open'. Clique no botão 'ok' na janela que aparece e clique no botão install. Pronto o seu componente será instalado.

Observação:

Se na lista 'Design packages' não tiver a opção 'Borland user component' você deverá primeiro instalar componentes que estão em arquivos com extensão *.pas. }

Como inserir um registro com o componente updatesql?

//Na propriedade InsertSQL informe com a seguinte sintaxe:

INSERT INTO ":Senior:E085CLI" (CodCli, NomCli)
VALUES ( 1, 'Jerônimo' )

Como inserir um item em uma treeview (run time)?

Procedure TForm1.Button1Click(Sender: TObject);
var
MyTreeNode1, MyTreeNode2: TTreeNode;
begin
with TreeView1.Items do
begin
Clear; { Remove qualquer node existente }
MyTreeNode1 := Add(nil, 'RootTreeNode1'); { Adiciona o node raiz }
{ Adiciona um sub item no node adiciona anteriormente }
AddChild(MyTreeNode1,'ChildNode1');
{Adiciona outro node raiz}
MyTreeNode2 := Add(MyTreeNode1, 'RootTreeNode2');
AddChild(MyTreeNode2,'ChildNode2');
MyTreeNode2 := TreeView1.Items[3];
AddChild(MyTreeNode2,'ChildNode2a');
Add(MyTreeNode2,'ChildNode2b');
Add(MyTreeNode1, 'RootTreeNode3');
end;
end;

Como indexar um vetor?

//Veja o exemplo:
for x := 1 to 10 do
for y := 1 to 10 do
if array[x] < array[y] then begin
varaux := array[y];
array[y] := array[x];
array[x] := varaux;
end; {Consiste no seguinte para cada item do vetor você verifica todos os outros, se for menor faz a troca. }

Como incrementar um mês numa data?

IncMonth(Data, 1);

//No exemplo, a variável Data é do tipo TDateTime.

Função transformar minutos p/ horas

//Função para transformar minutos em horas
//Ex: 90 min = 1:30

Function MinparaHora(Minuto: integer): string;
var
hr, min : Integer;
begin
hr := 0;
while minuto >= 60 do begin
minuto := minuto - 60;
hr := hr + 1;
end;
min := minuto;
Result := FormatFloat('00:', hr) + FormatFloat('00', min);
end;

Como imprimir?(codigo fonte)

Unit animais; {exemplo de impressao com codigo fonte do arquivo exemplo de delphi chamado animais. mostra como aumentar a fonte, mudar a fonte, mudar a grossura da linha, imprimir uma reta, imprimir caracteres e dados}

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, DBCtrls, ExtCtrls, Grids, DBGrids, Db, DBTables, ExtDlgs, StdCtrls,printers, ComCtrls, Buttons, Outline, DirOutln;

type
TForm1 = class(TForm)
dtanimais: TTable;
dsanimais: TDataSource;
DBGrid1: TDBGrid;
DBNavigator1: TDBNavigator;
DBImage1: TDBImage;
Imprime: TBitBtn;
dtanimaisNAME: TStringField;
dtanimaisSIZE: TSmallintField;
dtanimaisWEIGHT: TSmallintField;
dtanimaisAREA: TStringField;
dtanimaisBMP: TBlobField;
procedure ImprimeClick(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);

private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
pag:integer;
linha:integer;

implementation

{$R *.DFM}

//ESTA PROCEDURE AVALIA A TECLA PRESSIONADA, SE FOR ESC O EVENTO DO FORM FORMKEYPRESS SERÁ ACIONADO E ENTÃO ABORTARÁ A IMPRESSÃO. PARA ISTO VOCÊ PRECISA IR NO EVENTO FORMKEYPRESS DO FORM E CLICAR SOBRE ELE.

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
if (Key=VK_ESCAPE) and (Printer.Printing) then
begin
Printer.Abort;
MessageDlg('Impressão abortada', mtInformation, [mbOK],0);
end;
end;

// ESTA PROCEDURE É O CABEÇALHO DO RELATÓRIO E É CHAMADO NO INICIO DA IMPRESSÃO LOGO APÓS O BEGINDOC.

procedure cabrelat;
begin
inc(pag,1); // INCREMENTA NA VARIAVEL PAG +1
printer.canvas.pen.width:=9; {expessura do traco}
INC(LINHA,80); // INCREMENTA NA VARIAVEL LINHA +80 printer.canvas.textout(3700,LINHA,'PAG: '+INTTOSTR(PAG));
INC(LINHA,80);
printer.canvas.moveto(4000,LINHA); {moveto e lineto funcionam como coluna inicial e final}
printer.canvas.lineto(5,LINHA); {traco da coluna 5 ate a 4000 em pixels, varia de impressora p/impressora}
INC(LINHA,5);
printer.canvas.font.size:=14; {tamanho da fonte}
printer.canvas.textout(3,LINHA,’NOME’); {O PRINTER.CANVAS.TEXTOUT, imprime dados ou caracteres}
printer.canvas.textout(1400, linha,’TAMANHO’);
printer.canvas.textout(2300, linha,’PESO’);
printer.canvas.textout(3100, linha,’AREA’);
INC(LINHA,120);
printer.canvas.moveto(4000,LINHA);
printer.canvas.lineto(5,LINHA);
INC(LINHA,10);
printer.canvas.font.size:=12;
end;

// ESTA PROCEDURE É O RODAPÉ DO RELATÓRIO E É CHAMADO NO FINAL DA IMPRESSÃO.

procedure rodape;
begin
INC(LINHA,80);
printer.canvas.font.style:=[fsitalic]; {tipos de fonte: fsBold, fsItalic, fsUnderline, fsStrikeOut);}
printer.canvas.textout(4000,LINHA,'CONTINUA');
INC(LINHA,80); {font.color := clred;}
printer.canvas.pen.width:=9; {espessura da linha}
printer.canvas.moveto(4000,linha);
printer.canvas.lineto(5,linha);
printer.canvas.font.style:=[]; {estilo da linha}
printer.newpage;
linha:=30;
end;

procedure TForm1.ImprimeClick(Sender: TObject);

VAR
nnumero: integer;
begin
{dtanimais.setkey;}
cancela.visible:=true;
{torna visivel o botao de cancelar no form}
form1.refresh;
{faz o form mostrar o botao cancela, sem o refresh nao adianta colocar o botao de cancela visivel}
nnumero:=0;
pag:=0;
linha:=30;
printer.begindoc; {inicializa a impressora}
CABRELAT;
dtanimais.first;
while not (dtanimais.eof) do
begin
printer.canvas.textout(3, linha,dtanimaisname.text);// IMPRIME OS CAMPOS DO ARQUIVO
printer.canvas.textout(1800, linha,dtanimaissize.text); {campo size}
printer.canvas.textout(2500, linha,dtanimaisweight.text);{campo weight}
printer.canvas.textout(3100, linha,dtanimaisarea.text); {campo area}
inc(linha,120); { o inc() incrementa pixels e aqui esta incrementando 120}{ entre um registro e outro}
dtanimais.next; {pula registro}
application.processmessages; {Sem isso nao adianta clicar no botao cancela}
if not printer.printing then {caso tenha abortado a impressao num click}
{o printer ja nao estara imprimindo, entao entrara aqui}
exit;
inc(nnumero,1);
if linha>=3400 then
BEGIN
RODAPE;
CABRELAT;
END;
if dtanimais.eof then
begin
printer.canvas.pen.width:=9;
INC(LINHA,80);
printer.canvas.moveto(4000,LINHA);
printer.canvas.lineto(5,LINHA);
INC(LINHA,60);
printer.canvas.font.name:='arial';
printer.canvas.font.size:=10;
printer.canvas.textout(5,linha,'TOTAL DE ANIMAIS:');
printer.canvas.textout(1000,linha,INTTOSTR(NNUMERO));
INC(LINHA,100);
printer.canvas.moveto(4000,LINHA);
printer.canvas.lineto(5,LINHA);
printer.canvas.font.size:=14;
printer.enddoc;
end;
end;
if printer.printing then
printer.enddoc;
dtanimais.first; {retorno ao inicio da tabela}
end;
end.

Como importar dados de um arquivo texto para uma tabela?

Var
sArquivo: TextFile;
Entrada, sArq2: string;
iLinha: integer;
begin
tblCep.Open;
tblCepLoc.Open;
bCancelaImport := False;
AssignFile(sArquivo, FileNameEdit1.FileName);
sArq2 := After('Cep_Loc.txt',FileNameEdit1.FileName);

iLinha := 0;
if FileNameEdit1.FileName = 'C:DownloadCepsCep_loc.txt' then begin
// Arquivo de Localidades
RzProgressBar1.TotalParts := 0;
RzProgressBar1.TotalParts := NumLinhasArq(FileNameEdit1.FileName);

Reset(sArquivo);
Readln(sArquivo,Entrada);
while not Eoln(sArquivo) do begin
Inc(iLinha);
Readln(sArquivo,Entrada);

// 0 = Base Total e 2 = Inclusao
if (copy(Entrada,90,1) = '0') or (copy(Entrada,90,1) = '2') then
begin
tblCepLoc.Append;
tblCepLoc.FieldByName('cep_ChvLocal').AsString :=
copy(Entrada,1,6);
tblCepLoc.FieldByName('cep_Cidade').AsString :=
copy(Entrada,7,60);
tblCepLoc.FieldByName('cep_UF').AsString := copy(Entrada,75,2);
try
tblCepLoc.Post;
except
tblCepLoc.Cancel;
end;
end
else if (copy(Entrada,90,1) = '1') then begin // Exclusao
if tblCepLoc.Locate('cep_ChvLocal', copy(Entrada,1,6),
[loPartialKey]) then
tblCepLoc.Delete;
end
else if (copy(Entrada,90,1) = '3') then begin // Alteracao
if tblCepLoc.Locate('cep_ChvLocal', copy(Entrada,1,6),
[loPartialKey])
then begin
tblCepLoc.Edit;
tblCepLoc.FieldByName('cep_Cidade').AsString :=
copy(Entrada,7,60);
tblCepLoc.FieldByName('cep_UF').AsString :=
copy(Entrada,75,2);
end;
try
tblCepLoc.Post;
except
tblCepLoc.Cancel;
end;
end;
RzProgressBar1.PartsComplete := iLinha;
Application.ProcessMessages;
if bCancelaImport then
Break;
end;
CloseFile(sArquivo);
end;

Impedindo ctrl+del num dbgrid

{Como impedir de apagar um registro em um DBGRID através das teclas CTRL+DEL?

Colocar no evento OnKeyDown do DBGRID:}


if (Shift = [ssCtrl]) and (Key = 46) Then
KEY := 0;

Como gravar as alterações feitas no dbgrid em tempo de execução?

//Se você quer salvar apenas as configurações de um DBGrid, faça assim:

DBGrid1.Columns.SaveToFile('c:nome_arquivo');

// para abrir:


DBGrid1.Columns.LoadFromFile('c:nome_arquivo');

Como gerar um clone de um programa?

Function CloneProgram(sExecutableFilePath : string ): string;
var
pi: TProcessInformation;
si: TStartupInfo;
begin
FillMemory( @si, sizeof( si ), 0 );
si.cb := sizeof( si );
CreateProcess(Nil, PChar( sExecutableFilePath ), Nil, Nil, False, NORMAL_PRIORITY_CLASS,Nil, Nil, si, pi );
CloseHandle( pi.hProcess );
CloseHandle( pi.hThread );
end;

Como formatar data para exibição por extenso?

{O Delphi permite formatar datas para apresentação por extenso de forma bastante simples. Vejamos os seguintes exemplos: Para formatar a data 18/03/1999, podemos utilizar:

No create do form colocar

Shortdateformat:=

dddd, dd/mm/yyyy = Quinta, 18/03/1999
dd/mmm/yyyy = 18/Mar/1999
dddd, dd" de "mmmm" de "yyyy = Quinta, 18 de Março de 1999
dd" de "mmmm" de "yyyy, dddd = 18 de Março de 1999, Quinta }

Como finalizar o windows sem avisar?

ExitWindowsEx(EWX_FORCE+EWX_SHUTDOWN,0)

Como filtrar registros de uma tabela pelo mês de um campo data?

//Você pode usar a função DecodeDate( ) no evento onFilterRecord de um componente TTable. //Ex.:

// não se esqueça de mudar a propriedade Filtered para True;
// isto fará com que o evento onFilterRecord seja disparado.
procedure TForm1.Table1FilterRecord(DataSet: TDataSet; var Accept: Boolean);
var
Dia, Mes, Ano: word;
begin
Accept := false;
DecodeDate(Table1['Competencia'],Ano,Mes,Dia);
if Mes=MesFiltrado then
Accept := True;
end;

{Obs.: Você pode usar este mesmo código para filtrar por Ano ou por Dia, basta utilizar a comparação adequada no bloco if ... then }

Fechando o arquivo de help ao encerrar a aplicação

//Coloque no evento onDestroy

application.HelpCommand(help_quit, 0);

Como fazer uma unit biblioteca?

{PRIMEIRO:

PARA FAZER UMA UNIT DE FUNÇÕES, VOCÊ TEM QUE COMPILA-LA PARA GERAR A EXTENSÃO DCU. PARA FAZER COM QUE ELA VIRE UMA BIBLIOTECA DE FUNÇÕES ELA TEM QUE TER A EXTENSÃO DCU.

SEGUNDO:

VOCÊ NÃO VAI CONSEGUIR COMPILAR UMA UNIT SE ELA ESTIVER SOZINHA, ISTO PORQUE O DELPHI SÓ COMPILA PROJETOS E COMO UNIT NÃO É PROJETO A OPÇÃO DE COMPILAÇÃO NÃO ESTARÁ DISPONÍVEL. PORTANTO, ABRA UM PROJETO QUALQUER, OU MESMO CRIE UM ALEATÓRIO E ABRA UMA NOVA UNIT, É NESTA UNIT E NÃO A DO PROJETO QUE VOCÊ CRIARÁ TODAS AS SUAS FUNÇÕES. DEPOIS DISTO ENTÃO VOCÊ ABANDONA O FORM E SÓ VAI USAR A UNIT.

TERCEIRO:

QUANDO VOCÊ ABRIR A UNIT, ESTA VIRÁ SOMENTE COM O NOME, INTERFACE, IMPLEMENTATION E END..

EXEMPLO:}


Unit unit1;
Interface
Implementation
End. {QUARTO:

PARA VOCÊ CRIAR UMA FUNÇÃO O PROCEDIMENTO É IGUAL Á UNIT COMUM, MAS PARA QUE ELA SEJA ENXERGADA POR OUTROS PROGRAMAS PRECISA SER DECLARADA ABAIXO DA INTERFACE E ABAIXO DE POSSÍVEIS USES NECESSÁRIOS AS SUAS FUNÇÕES.

EXEMPLO DE UMA UNIT DE FUNÇÕES:}


unit ufuncoes; //NOME DA UNIT

interface

uses // CLASSES NECESSÁRIAS ÁS FUNÇÕES ABAIXO, NAS SUAS TALVEZ PRECISE DE OUTRAS
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,Dialogs, StdCtrls, Grids, DBGrids;

function data(vdata:string):boolean; // DECLARAÇÃO DAS FUNÇÕES OU PROCEDURES

procedure cor(grade:tdbgrid;color:tcolor); // PARA PODEREM SER ENXERGADAS POR OUTRAS UNITS.
// COLOQUE OS MESMOS CABEÇALHOS DA SUA FUNÇÃO

implementation // AQUI QUE VOCÊ VAI CRIAR AS SUAS FUNÇÕES, NÃO SE ESQUEÇA O QUE CRIAR AQUI, TERÁ QUE DECLARAR EM CIMA SENÃO NENHUMA OUTRA UNIT AS ENXERGARÁ.

function data(vdata:string):boolean;
begin
try
StrToDate(vdata);
data:=true;
except
MessageDlg('Data Inválida !!' , mtInformation, [mbOk], 0);
data:=false;
end;
end;

procedure cor(grade:tdbgrid;color:tcolor);
// muda a cor para preto para todas as colunas de qualquer dbgrid
var
i:integer;
numcampos:integer;
begin
numcampos:=grade.FieldCount;
{subtraio -1 aqui embaixo porque as colunas começam de zero}
for I := 0 to numcampos-1 do // COLOCA AS 23 COLUNAS COM COR PRETA
grade.columns[i].font.color:=color;
end;
end. {QUINTO:

PARA QUALQUER UNIT ENXERGAR ESTAS DUAS FUNÇÕES ACIMA, É NECESSÁRIO QUE VOCÊ COLOQUE ESTA UNIT NO DIRETÓRIO DO SEU PROGRAMA QUE VAI UTILIZÁ-LA E DEPOIS É SÓ COLOCÁ-LA NA USES DA UNIT QUE FARÁ O USO DAS MESMAS. APÓS ISTO É SÓ CHAMAR AS FUNÇÕES QUE NELA CONSTEM QUE FUNCIONARÃO PERFEITAMENTE, INCLUSIVE PODEM SER DEBUGADAS, O DEBUG ENTRARÁ NA UNIT DAS FUNÇÕES SE VOCÊ FOR TECLANDO F7}

Como fazer um protetor de tela no delphi?

Para o pessoal que queria saber, esta ai. Lembrando também que você poderá encontra um exemplo com fontes na parte de exemplo. A) No .Dpr ponha {$D SCRNSAVE } depois do uses

B) No Form principal nao ponha borda ou icone. No metodo Activate ponha left e top como 0 e o Windowstate como wsMaximize.

C) no form.Create ponha application.OnMessage para um metodo que controle a desativacao do screen saver. Ponha tb o application.OnIdle para "rodar" o dito cujo...

D) Tb no Form.Create teste a linha de comando para /c ou /s. Estes Parametros dizem o que e' para fazer (/c configura)

E) Compile e renomeie o .exe p/ .scr, move para o diretorio do windows e teste.

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 fazer para que o combobox abra na direção desejada?

SendMessage(ComboBox1.Handle,CB_SHOWDROPDOWN,1,0);

Como fazer para o sistema não pedir o login banco de dados?

{Coloque um componente TDatabase, mude a propriedade LoginPrompt para false e os parâmetros de nome e senha de usuário na propriedades dos parâmetros, sem esquecer-se de colocar o nome do alias e definir um nome padrão para o banco. }

Como fazer para o computador soar o beep?

messageBeep(0);

Largura do display (dbgrid) igual ao tamanho na tabela

Procedure TForm1.btnTestClick(Sender: TObject);
var i: integer;
begin
for i:= 0 to Table1.FieldCount-1 do
Table1.Fields[i].DisplayWidth:= Length(Table1.Fields[i].DisplayLabel);
end;

Como extrair o ícone de um executável?

//Inclua a unit Shellapi na cláusula uses do seu form.

Image1.Picture.Icon.Handle:= ExtractIcon(Handle,PChar('c:windowscalc.exe'),0);

Como extrair o tamanho de um arquivo?

Function TForm1.TamArquivo(Arquivo: string): Integer;
begin
with TFileStream.Create(Arquivo, fmOpenRead or fmShareExclusive) do
try
Result := Size;
finally
Free;
end;
end;

Utilize a função assim:

procedure TForm1.Button1Click(Sender: TObject);
begin
edit1.text:= inttostr(TamArquivo('CAMINHONOMEDOARQUIVO'));
end;

Como extrair o primeiro nome de uma pessoa?

{Para pegar o primeiro nome de uma pessoa, crie a seguinte função: }

function PrimeiroNome (Nome : String) : String;
var
PNome : String;
begin
PNome := '';
if pos (' ', Nome) <> 0 then
PNome := copy (Nome, 1, pos (' ', Nome) - 1);
Result := PNome;
end;

Como extrair o número de cores do modo de vídeo corrente

Var
hnd: THandle;
bitsPorPixel: integer;
begin
hnd:= GetDC( Handle );
bitsPorPixel:= GetDeviceCaps( hnd, BITSPIXEL );
// 8 = 256 cores; 16 = high color; 24 = true color
end;

Como executar programas externos?

Winexec('Command.com /C Teste.exe',Tipo_de_Janela);

//Tipos de Janela :

SW_SHOWNORMAL //- Visualização normal da janela

SW_MAXIMIZE //- Janela maximizada

SW_MINIMIZE //- Janela minimizada

SW_HIDE //- Escondido.

Como evitar repetição em uma lista de combobox?

Procedure TProcRep.ComboBox1Click(Sender: TObject);
begin
WITH COMBOBOX1 DO
IF (TEXT <> '') AND (ITEMS.INDEXOF (TEXT) < 0) THEN
ITEMS.ADD (TEXT);
end;

Como evitar que apareçam números negativos na consulta?

SELECT DECODE(SIGN(valor),-1,'aqui',valor) FROM arquivo

//Onde aqui é o que deve aparecer quando 'valor' for menor que 0.

Como evitar efeito de maximização?

{Se você já desenvolveu uma aplicação MDI com um formulário MDIChild que tem que ser exibido em estado Maximizado (WindowState=wsMaximized), provavelmente você já se deparou com aquele deselegante problema em que o usuário acompanha a maximização do seu formulário. Para evitar isto, faça o seguinte: Antes de criar o seu formulário para a exibição, utilize LockWindowUpdate(Handle);

Após a criação do formulário, utilize LockWindowUpdate(0);

Com isto, você dará um efeito mais profissional às suas aplicações.

Exemplo:}

procedure MainForm.ItemArqCadFor(Sender: TObject);
begin
LockWindowUpdate(Handle);
with TFrmCadFor.Create(self) do Show;
LockWindowUpdate(0);
end;

Como evitar as mensagens de warning do compilador ?

{$WARNINGS OFF}
function TfrmEdit.ProjectTypeToUse(const cPath: string): Integer; var
SR: TSearchRec;
begin
if not DirectoryExists(cPath) then begin
ErrMsg('Path não localizado!');
Exit;
end;
try
if FindFirst(cPath + '*.VBP',faDirectory,SR) = 0 then
Result := VBP_FILTER
else
Result := DPR_FILTER;
except
ErrMsg('Falha de sistema -' + cPath);
Result := 1
end;
end;
{$WARNINGS ON}

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 esvaziar uma tabela?

Function EsvaziaTabela(Tabela : TTable): Boolean;
// Esvazia a tabela passada como parametro
var
lExclusivo : boolean;
begin
Tabela.Active := False;
repeat
try
Tabela.Exclusive := True;
Tabela.Active := True;
Tabela.EmptyTable;
lExclusivo := True;
Break;
except
on EDatabaseError do
if MessageDlg('A tabela está sendo usada por outro usuário. Tenta novamente ?', mtError,[mbOK, mbCancel], 0) <> mrOK then
begin
lExclusivo := False;
raise;
end;
end;
until False;
Result := lExclusivo;
end;

Mensagem para todos que estão na redewinnt?

Function NetSend(dest, source, msg: string): longint;
type
TNetMessageBufferSendFunction = function(servername, msgname, fromname:
PWideChar; buf: PWideChar; buflen: Cardinal): longint; stdcall;
var
NetMessageBufferSend: TNetMessageBufferSendFunction;
SourceWideChar: PWideChar;
DestWideChar: PWideChar;
MessagetextWideChar: PWideChar;
Handle: THandle;
begin

Handle := LoadLibrary('NETAPI32.DLL');
if Handle = 0 then
begin
Result := GetLastError;
exit;
end;

@NetMessageBufferSend := GetProcAddress(Handle, 'NetMessageBufferSend');
if @NetMessageBufferSend = nil then
begin
Result := GetLastError;
exit;
end;

MessagetextWideChar := nil;
SourceWideChar := nil;
DestWideChar := nil;

try
GetMem(MessagetextWideChar, Length(msg) * SizeOf(WideChar) + 1);
GetMem(DestWideChar, 20 * SizeOf(WideChar) + 1);
StringToWideChar(msg, MessagetextWideChar, Length(msg) *
SizeOf(WideChar) + 1);
StringToWideChar(Dest, DestWideChar, 20 * SizeOf(WideChar) + 1);
if source = '' then
result := NetMessageBufferSend(nil, DestWideChar, nil,
MessagetextWideChar, Length(msg) * SizeOf(WideChar) + 1)
else
begin
GetMem(SourceWideChar, 20 * SizeOf(WideChar) + 1);
StringToWideChar(source, SourceWideChar, 20 * SizeOf(WideChar) + 1);
result := NetMessageBufferSend(nil, DestWideChar, SourceWideChar,
MessagetextWideChar, Length(msg) * SizeOf(WideChar) + 1);
freemem(SourceWideChar);
end;
finally
FreeMem(MessagetextWideChar);
FreeLibrary(Handle);
end;
end;

Como enviar dados do delphi para o excel?

Procedure TFormCTEmbarque.SpeedButton1Click(Sender: TObject);
var
Excel : Variant;
Linha:Integer;
begin
Excel := CreateOleObject('Excel.Application');
Excel.Visible :=True;
{Excel.Workbooks.Add;}
Excel.WorkBooks.Open('\SERVIDORCotacaoGerar.xls');
Excel.WorkBooks[1].Sheets[1].Cells[2,7]:=Now;
Excel.WorkBooks[1].Sheets[1].Cells[3,2]:=DMCotacao.TBLiberaRemetente.Value;
Excel.WorkBooks[1].Sheets[1].Cells[3,5]:=DMCotacao.TBLiberaColeta.Value +
'-' +DMCotacao.TBLiberaUF_Coleta.Value;
Excel.WorkBooks[1].Sheets[1].Cells[4,2]:=DMCotacao.TBLiberaDestinatario.Value;
Excel.WorkBooks[1].Sheets[1].Cells[4,5]:=DMCotacao.TBLiberaDestino.Value +
'-' +DMCotacao.TBLiberaUF_Destino.Value;
Excel.WorkBooks[1].Sheets[1].Cells[5,2]:=DMCotacao.TBLiberaQuantidade.AsString;
Excel.WorkBooks[1].Sheets[1].Cells[5,5]:=DMCotacao.TBLiberaFreteEmpresa.AsString;
Excel.WorkBooks[1].Sheets[1].Cells[5,7]:=DMCotacao.TBLiberaContrato.AsString;
Excel.WorkBooks[1].Sheets[1].Cells[6,2]:=FormCTEmbarque.Edit2.Text;
Excel.WorkBooks[1].Sheets[1].Cells[6,5]:=FormCTEmbarque.Edit3.Text;
Excel.WorkBooks[1].Sheets[1].Cells[6,7]:=FormCTEmbarque.Edit4.Text;
Excel.WorkBooks[1].Sheets[1].Cells[7,2]:=DMCotacao.TBLiberaObservacao.Value;
DmCotacao.QCTEmbarque.Open;
Linha:=10;
While not DMCotacao.QCTEmbarque.Eof do
Begin
Excel.WorkBooks[1].Sheets[1].Cells[Linha,2]:=DMCotacao.QCTEmbarqueCTRC.Value;
Excel.WorkBooks[1].Sheets[1].Cells[Linha,3]:=DMCotacao.QCTEmbarqueNotaFiscal.Value;
Excel.WorkBooks[1].Sheets[1].Cells[Linha,4]:=DMCotacao.QCTEmbarquePeso.Value;
Excel.WorkBooks[1].Sheets[1].Cells[Linha,5]:=DMCotacao.QCTEmbarquePlaca.Value;
Excel.WorkBooks[1].Sheets[1].Cells[Linha,6]:=DMCotacao.QCTEmbarqueData.Value;
DmCotacao.QCTEmbarque.Next;
Linha:=Linha+1;
end;
Excel.WorkBooks[1].SaveAs('\SERVIDORCotacaoControle.xls');
DMCotacao.TBCotacao.Refresh;
end;

domingo, 24 de maio de 2009

Como diminuir o tempo de abertura do table e query?

{Operação feita quando é executado o método Open do componente TTable ou TQuery, que produz a compilação e execução do comando select. Quando esse método é executado através do componente TTable, o Delphi realiza uma série de outros comandos SQLs para buscar informações do catálogo da tabela necessárias para as operações de seleção e atualização. Essa busca pode ser otimizada através da opção ENABLE SCHEMA CACHE do BDE, fazendo com que essas informações sejam lidas apenas uma vez durante a execução da aplicação. Quando o primeiro acesso é feito, o BDE armazena as informações em um arquivo e qualquer nova necessidade de abertura da mesma tabela não necessita buscar novamente os elementos do catálogo. Por outro lado, utilizando-se o componente TQuery, pode-se desviar dessa busca desde que não se utilize a propriedade Request Live que torna o "result set" da "query" atualizável automaticamente pelo Delphi. Se o valor da propriedade Request Live for TRUE e o SELECT utilizado obedecer as restrições para que o Delphi consiga atualizar o "result set", as mesmas buscas utilizadas para o componente TTable terão que ser feitas.

Concluindo, para que a busca de elementos do catálogo não seja feita é necessário utilizar o componente TQuery e controlar as atualizações manualmente ou através de componentes do tipo TUpdateSQL. }

Como detectar as teclas de seta?

{Use os eventos KeyDown ou KeyUp e teste se Key = VK_LEFT , VK_RIGHT, VK_UP mou VK_DOWN. }

Como desenhar um bitmap num form?

Var
Form1: TForm1;
Bmp: TBitmap;
implementation
{$R *.DFM}


procedure TForm1.FormCreate(Sender: TObject);
begin
Bmp:=TBitmap.Create;
Bmp.Loadfromfile('c:windowsnuvens.bmp');
end;

procedure TForm1.TForm1.FormPaint(Sender: TObject);
begin
Canvas.Draw(50,50,Bmp);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Bmp.Free;
end;

Como desenhar figuras no desktop?

//Você pode também, usar textos ou outros por exemplo.
var
sc: Tcanvas;
begin
sc := TCanvas.Create;
try
sc.Handle:=GetDC(0);
sc.Brush.Style := bsClear;
sc.Draw(6,6,Tela.Picture.Graphic);
ReleaseDC(0, sc.handle);
finally
sc.free;
end;

Como desconectar unidade de rede?

Function DesconectaRede(Letra:Pchar;Forcada:boolean):String;
//
// Disconecta uma unidade mapeada via programação
//
// Letra = Letra atribuida a unidade
// Forcada = Força o cancelamento do mapeamento
//
begin
WNetCancelConnection2(Letra,0,Forcada);
Case GetLastError() of
1205: Result := 'Não foi possível abrir o perfil';
1206: Result := 'Perfil do usuário não encontrado ou inválido';
1208: Result := 'Ocorreu um Erro específico na rede';
2138: Result := 'Rede não encontrada ou fora do ar';
2250: Result := 'Mapeamento inválido ou não encontrado';
2401: Result := 'Existem muitos arquivos abertos';
else
Result := 'Unidade disconectada com sucesso';
end;
end;

Como descobrir se você esta conectado com a internet?

//1º) Você deve acrescentar um componente NMFTP (da paleta FastNet).
//2º) Insira o seguinte código no evento OnShow do formulário.

If (NMFtp1.GetLocalAddress <> '0,0,0,0') Then ShowMessage('Você não está conectado!') Else ShowMessage('Você está conectado!');

//3º) Execute o programa e veja o resultado.

Como desabilitar o fechamento do form?

public
{ Public declarations }
fecha: Boolean;
end;

implementation

{$R *.DFM}

Function GetStateK (Key: integer): boolean;
begin
Result := Odd (GetKeyState (Key));
end;

procedure Tfrm_HIP.FormClose(Sender: TObject; var Action: TCloseAction);
begin
If Not fecha Then
Action := caNone Else
Action := caFree;
end;

procedure Tfrm_HIP.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
If GetStateK (VK_LMENU) And (Key = VK_F4) Then
fecha := False;
end;

Como definir seu próprio hotkey?

//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 criar um form completo com botões dinamicamente?

{Você pode criar qualquer componente do delphi de forma dinâmica, incluindo todos os componentes visuais(buttons, textedits, maskedits, labels). Para que serviria isso? Para muitas coisas, uma delas é que você pode criar qualquer controle em tempo de execução e depois de utiliza-lo descarrega-lo da memória... Exemplo:Como Criar um botão quando o mouse for pressionado e associar eventos nele....

É só colar dentro da unit da form.}


unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
TForm1 = class(TForm)
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
contador:integer;
implementation

{$R *.DFM}
uses stdctrls;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var b:tbutton;
begin
b:=Tbutton.create(self);
b.visible:=false;
b.parent:=self;
b.left:=x;
b.top:=y;
b.name:='Btn'+inttostr(contador);
b.Caption:='Clique-me';
inc(contador);
b.visible:=true;


end;

procedure TForm1.FormCreate(Sender: TObject);
begin
contador:=1;
end;

end. //Se quiser associar um evento ao botão é só copiar os procedimento clicou e alterar

//o procedimento mouse down para o que segue.

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var b:tbutton;
begin
b:=Tbutton.create(self);
b.visible:=false;
b.parent:=self;
b.left:=x;
b.top:=y;
b.name:='Btn'+inttostr(contador);
b.Caption:='Clique-me';
inc(contador);
b.visible:=true;
b.onclick:=clicou;
end;

procedure TForm1.clicou(sender: TObject);
begin
ShowMessage('Clicou!!!');
end;

Como criar uma figura do tipo marca d' água?

Procedure TForm1.Button1Click(Sender: TObject);
var
X, Y : Integer;
begin
brush.style := bsClear;
for y:=0 to image1.height-1 do
for x:=0 to image1.width-1 do
begin
if (x mod 2)=(y mod 2) then
image1.canvas.pixels[x,y]:=clWhite;
end;
end;

Contador de página para quickreport

Var
Form1: TForm1;
i : integer;
implementation
{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
i := 0 ;
QuickRep1.Prepare;
QrLabel2.Caption := IntToStr(i);
QuickRep1.Preview;
end;

procedure TForm1.QuickRep1StartPage(Sender: TQuickRep);
begin
i := i + 1;
Form2.Label1.caption := IntToStr(i);
end;

Como criar um arquivo de backup

Procedure TFormCopia.BitBtn1Click(Sender: TObject);
var
I: Integer;
begin
Database1.Connected:=True; // Database para controle
Table2.DatabaseName:=DirectoryListBox1.Directory; // Seleciona local de destino da cópia
with Session1 do
begin
Active:=True;
GetTableNames('AliasName','*.*',True,True,Memo1.Lines); // Retorna o nome das tabelas
end;
for I:= 0 to Memo1.Lines.Count - 1 do
begin
Table1.TableName:=Memo1.Lines[I]; // Tabela origem
Table2.TableName:=Memo1.Lines[I]; // Tabela destino
BatchMove1.Execute;
end;
end; Para efetuar a restauração:


procedure TFormRestaura.BitBtn1Click(Sender: TObject);
var I: Integer;
begin
Database1.Connected:=True;
Table2.DatabaseName:=DirectoryListBox1.Directory; // Origem da restauração
with Session1 do
begin
Active:=True;
GetTableNames(Table2.DatabaseName,'*.*',True,True,Memo1.Lines); // Retorna nomes das tabelas
end;
for I:= 0 to Memo1.Lines.Count - 1 do
begin
Table1.TableName:=Memo1.Lines[I]; // Tabela origem
Table2.TableName:=Memo1.Lines[I]; // Tabela destino
BatchMove1.Execute;
end;
end;
//Após restaurar por este método, você deve recriar os índices.

Como criar novas tabelas a partir de consulta sql?

//Para criar tabelas permanentes do resultado de uma query faça o seguinte:
Query1.Open
DBIMakePermanent(Query1.Handle, 'Nome-Da-Tabela.db', True);
Query1.Close;

//Utilize BDE na Clausula USES para utilizar a função DBIMakePermanent

Como criar forms em tempo de execução?

{Para você economizar memória, pode-se criar os forms de sua aplicação somente no momento da execução. Na criação do Form você define se ele é MODAL ou NÃOMODAL. Para Isso observe os seguintes códigos: }

//MODAL- Mostra form em modo exclusivo


procedure TForm1.Button1Click(Sender: TObject);
begin
Application.CreateForm(TForm2, Form2);{Carrega form na memória}
Form2.ShowModal;{Mostra form em modo exclusivo}
Form2.Free; {Libera Memória}
end; //NÃO MODAL - Mostra form em modo não exclusivo


procedure TForm1.Button1Click(Sender: TObject);
begin
Application.CreateForm(TForm2, Form2);{Carrega form na memória}
Form2.ShowModal;{Mostra form em modo exclusivo}
end; //No evento OnClose do Form2 coloque o seguinte código.


procedure TForm2.FormClose (Sender: Tobject; var Action : TCloseAction);
begin
Action:= caFree;
end; {Aliado a este código, deve deve alterar no delphi, no menu Options, opção Project. Mudando os forms a serem criados dinamicamente da coluna Auto-Create Forms para Avaliable Forms.}

Paradox para texto ou dbase e vice-versa?

//1) Inclua um TDATABASE no seu Form e sete as seguintes propriedades:
DatabaseName = 'Temp'
DriverName = 'STANDARD'
Params.Strings = 'path=c: este'
Connected = True
//2) Inclua outro TTable em seu Form e sete as seguintes propriedades:
DatabaseName = 'Temp'
Name = 'DESTINO'
TableType = ttASCII ou ttDbase ou ttParadox
TableName = o nome da nova tabela, sem extensão. Ex: 'Clientes' IMPORTANTE: Não mexa na propriedade ACTIVE.

//3) Inclua um TTable em seu Form, contendo a tabela que você quer copiar e mude a propriedade Name para ORIGEM.

IMPORTANTE: Não mexa na propriedade ACTIVE.


//4) Inclua um TBATCHMOVE em seu Form e sete as seguintes propriedades:
Destination = 'DESTINO'
Mode = batCopy
Source = 'ORIGEM'
//5) Inclua um TBUTTON em seu form e dê um duplo click no evento OnClick.
//6) Escreva o seguinte código na procedure OnClick:
var
fn: FMTNumber;
begin
// O código a seguir verifica se o separador de
// decimais é virgula e muda-o, para evitar
// problemas de compatibilidade
Check(DbiGetNumberFormat(fn));
if fn.cDecimalSeparator = ',' then
begin
fn.cDecimalSeparator := '.';
fn.cThousandSeparator := ',';
DbiSetNumberFormat(fn);
end;
// Aqui executamos a CÓPIA
BatchMove1.Execute;
end;

Como copiar os valores de campos de uma tabela para outra?

{ Este exemplo copia apenas tabelas de mesma estrutura }
var
Num: SmallInt;
begin
for Num := 0 to TabelaOrigem.FieldCount - 1 do
begin
TabelaDestino.Insert;
TabelaDestino.Fields[Num].Assign(TabelaOrigem.Fields[Num]);
TabelaDestino.Post;
end;
end;

Como converter decimal para romanos?

Function DecToRoman( Decimal: LongInt ): String;
{Converte um numero decimal em algarismos romanos}
const
Romans: Array[1..13] of String = ( 'I', 'IV', 'V', 'IX', 'X', 'XL', 'L', 'XC', 'C', 'CD', 'D', 'CM', 'M' );
Arabics: Array[1..13] of Integer =( 1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000);
var
i: Integer;
scratch: String;
begin
scratch := '';
for i := 13 downto 1 do
while ( Decimal >= Arabics[i] ) do
begin
Decimal := Decimal - Arabics[i];
scratch := scratch + Romans[i];
end;
Result := scratch;
end;

Como converter decimal para base especificada?

Function DecToBase( Decimal: LongInt; const Base: Byte): String;
{converte um número decimal na base especificada}
const
Symbols: String[16] = '0123456789ABCDEF';
var
scratch: String;
remainder: Byte;
begin
scratch := '';
repeat
remainder := Decimal mod Base;
scratch := Symbols[remainder + 1] + scratch;
Decimal := Decimal div Base;
until ( Decimal = 0 );
Result := scratch;
end;

Como converter de decimal para binário?

Function DecToBinStr(n: integer): string;
{Converte um numero decimal em binário}
var
S: string;
i: integer;
Negative: boolean;
begin
if n < 0 then
begin
Negative := true;
end;
n := Abs(n);
for i := 1 to SizeOf(n) * 8 do
begin
if n < 0 then
begin
S := S + '1';
end
else
begin
S := S + '0';
end;
n := n shl 1;
end;
Delete(S,1,Pos('1',S) - 1);//remove leading zeros
if Negative then
begin
S := '-' + S;
end;
Result := S;
end;

Como converter dbf para paradox e acess para paradox?

{ACCESS PARA PARADOX

DIGAMOS QUE VOCÊ TENHA UM BANCO DE DADOS EM ACCESS CHAMADO DISCOTECA.MDB E QUE NELE TENHA VÁRIAS TABELAS, VAMOS CONVERTER APENAS UMA, QUE NO NOSSO EXEMPLO SE CHAMA: AUTORES, E QUE SE QUISESSEMOS CONVERTER OUTRAS O PROCEDIMENTO SERIA EXATAMENTE O MESMO.

Abra o database desktop e crie um alias chamado DISCO, informe o drive desejado como ACCESS, veja bem é ACCESS e não microsoft access drive, tá legal ???, depois no campo database que se abriu bem abaixo, indique o diretorio onde se encontra o banco do access exemplo: c:discotecadadosdiscoteca.mdb, para testar e ver se está correto clique no botão conectt, se der algum erro é porque não existe o caminho ou o arquivo mdb informado no campo database.

Uma vez que conectou, feche o alias e vá em file no menu da database desktop, clique em new e depois em sql file, na janela que se abre digite select * from autores, uma vez que digitou a instrução, clique no botão Query que está em cima há direita, ele tem um ponto de interrogação preto, bom depois de clicar se abrirá uma tela, bem no meio tem table type com duas opções: PARADOX E DBASE, ESCOLHA PARADOX, depois vá onde está table name bem no meio da tela, digite o diretório e o nome do arquivo que quer que receba a tabela do access convertida, pronto, quando fizer isso ela já estará convertida, com o nome que você deu com extensão db. Ou seja você tem uma tabela paradox com os dados que estavam em autores dentro do banco do access.

DBF PARA PARADOX

Abrir o database desktop, abra uma nova qbe e procure o diretorio onde está o dbf.

Uma vez escolhido, clique nele, aparecerá um retangulo como quadrinhos ao lado de cada campo, clique no primeiro quadrado que marcará todos automaticamente. Feito isso clique na paleta onde está escrito Query e vá em propriedades, aparecerá um form onde você pode escolher entre paradox ou dbase, escolha paradox e logo embaixo digite o diretorio e o nome da tabela que voce quer criar, tecle o raizinho para rodar a query que então ele converterá para paradox. }

Como controlar o pressionamento da tecla enter?

Procedure TForm1.EditKeyPress(Sender: TObject; var Key: Char);
{ através do evento onKeyPress do formulário de controle... }
begin
{ se a "var Key" retornar o código #13 corresponde a , #9 corresponde a tecla TAB }
if Key = #13 then
begin
Key := #0 { Suprime o som }
{ escreva aqui os seus comandos }
end;
end;

Como controlar o fechamento de um formulário?

Procedure TForm1.FormCloseQuery(Sender: Tobject;
var CanClose: Bolean);
begin
if MessageDlg ( 'Você tem certeza de que quer sair?',
mtConfirmation, [mbYes, mbNo], 0) = idNo then
Canclose:=False;
end;

Como conectar uma unidade de rede?

Procedure TForm1.Button1Click(Sender: TObject);
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;

Compartilhando e mapeando uma pasta

Var
err : DWord;
PServer, PSenha, PLetra : PChar;
Begin
PServer := '\CaminhoCaminho' + #0;
PLetra := 'L:';
PSenha := '';

ERR := WNetAddConnection ( PServer , PSenha , PLetra );

CASE ERR of
ERROR_ACCESS_DENIED : ShowMessage ( 'Acesso negado.' );
ERROR_ALREADY_ASSIGNED : ShowMessage ( 'A letra do drive especificada já está conectada.' );
ERROR_BAD_DEV_TYPE : ShowMessage ( 'O tipo de dispositivo e o tipo de recurso não são compatíveis.' );
ERROR_BAD_DEVICE : ShowMessage ( 'Letra inválida.' );
ERROR_BAD_NET_NAME : ShowMessage ( 'Nome do servidor não é válido ou não pode ser localizado.' );
ERROR_BAD_PROFILE : ShowMessage ( 'Formato incorreto de parâmetros.' );
ERROR_CANNOT_OPEN_PROFILE : ShowMessage ( 'Conexão permanente não disponível.' );
ERROR_DEVICE_ALREADY_REMEMBERED : ShowMessage ( 'Uma entrada para o dispositivo especificado já está no perfil do usuário.' );
ERROR_EXTENDED_ERROR : ShowMessage ( 'Erro de rede.' );
ERROR_INVALID_PASSWORD : ShowMessage ( 'Senha especificada inválida.' );
ERROR_NO_NET_OR_BAD_PATH : ShowMessage ( 'A operação não foi concluída porque a rede não foi inicializada ou caminho é inválido.' );
ERROR_NO_NETWORK : ShowMessage ( 'A rede não está presente.' );
else if Err > 0 then
ShowMessage (IntToStr(Err));
end;
end;
{Obs.:Se "PLetra" for deixada em branco, o acesso será liberado sem ser criada uma unidade lógica.}

Como colocar uma única linha de uma stringgrid editável?

//use o evento OnSelectCell e verifique se é a linha que você quer. {Quando encontrar a linha desejada, coloque a propriedade GoEditing := true ou se não for coloque GoEditing := false. }

if ARow=Linha
then Grid.Options := Grid.Options + [goEditing]
else Grid.Options := Grid.Options - [goEditing];

Deixando uma coluna do dbgrid c/ maiúsculas

Procedure TForm1.DBGrid1KeyPress(Sender: TObject; var Key: Char);
begin
if DBGrid1.SelectedField.FieldName='NOME' THEN
Key := AnsiUpperCase(Key)[Length(Key)];
end;

Como colocar imagens em uma statusbar?

Unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ImgList, ComCtrls;

type
TForm1 = class(TForm)
StatusBar1: TStatusBar;
ImageList1: TImageList;
procedure StatusBar1DrawPanel(StatusBar: TStatusBar;
Panel: TStatusPanel; const Rect: TRect);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}
{Adicione um StatusBar e um ImageList, iclua no imagelist as figuras que deseja
mostrar apos mude a propriedade Style dos Panels do StatusBar para psOwnerDraw,
em seguida inclua o codigo abaixo no evento OnDrawPanel do StatusBar}

procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar;
Panel: TStatusPanel; const Rect: TRect);
begin
with StatusBar1.Canvas do
begin
FillRect(Rect);
//Definir Font e Style
Font.Name := 'Arial';
Font.Color := ClNavy;
Font.Style := [FsBold];
//Desenha as imagens de acordo com o indice de cada panel
ImageList1.Draw(StatusBar1.Canvas,Rect.Left+5,Rect.Top+1,Panel.Index);
//Escreve o texto em cada panel
if Panel.Index = 0 then
TextOut(Rect.Left + 25, Rect.Top + 1,'LloydSoft - Panel1');
if Panel.Index = 1 then
TextOut(Rect.Left + 25, Rect.Top + 1,'LloydSoft - Panel 1');
if Panel.Index = 2 then
TextOut(Rect.Left + 25, Rect.Top + 1,'LloydSoft - Panel 2');
end;
end;
end.

Como chamar a pasta impressoras?

//Colocar na uses shellapi;
Arquivo := 'Control';
Parametro := 'Printers';
ShellExecute(0, 'open', PChar(Arquivo), PChar(Parametro), nil, SW_ShowNormal);

Como calcular digito verificador de cnpj e cpf?

Function CalculaCnpjCpf(Numero : String) : String;
var
i,j,k, Soma, Digito : Integer;
CNPJ : Boolean;
begin
Result := Numero;
case Length(Numero) of
9:
CNPJ := False;
12:
CNPJ := True;
else
Exit;
end;
for j := 1 to 2 do
begin
k := 2;
Soma := 0;
for i := Length(Result) downto 1 do
begin
Soma := Soma + (Ord(Result[i])-Ord('0'))*k;
Inc(k);
if (k > 9) and CNPJ then
k := 2;
end;
Digito := 11 - Soma mod 11;
if Digito >= 10 then
Digito := 0;
Result := Result + Chr(Digito + Ord('0'));
end;
end;

Como atribuir um valor inicial para uma variável global?

{No Delphi, pode-se atribuir um valor inicial para uma variável global enquanto a declara. É possível escrever, por exemplo: } var

Value: Integer = 10;

Correct: Boolean = True;

{Esta técnica de inicialização funciona apenas para variáveis globais, não para variáveis declaradas no escopo de um procedimento ou método.}

Alterando driver de acesso do access no bde

Procedure ChangeAccessDLL32(Dll : String); // Altera a Propriedade do BDEDriversNativeMSACCESSDll32
var
Reg : TRegistry;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.OpenKey('SoftwareBorlandDataBase
EngineSettingsDriversMSACCESSINIT', True)
then Reg.WriteString('DLL32',Dll);
finally
Reg.CloseKey;
Reg.Free;
end;
end;

//Use de preferência no OnCreate do Form ou DataModule da seguinte

ChangeACCESSDll32('IDDA3532.DLL'); // Mudando a DLL de acesso ao ACCESS

Como alterar o caption da janela de preview do quickreport?

//Para mudar o título da barra de título da janela de Preview de seus relatórios, use o seguinte comando:

QRPrinter.PreviewCaption := 'Visualização do Relatório';

Como alterar a data e a hora do sistema?

Procedure TForm1.Button1Click(Sender: TObject);
var
SystemTime : TSystemTime;
begin
With SystemTime do
begin
//Definindo o dia do sistema
wYear:= 1996;
wMonth:= 5;
wDay:= 10;
//Definindo a hora do sistema
wHour:= 20; //hora
wMinute:= 50; //minutos
wSecond:= 59; //segundos
end;
//Colocar a hora e data do sistema
SetLocalTime(SystemTime);
end;

Como acrescentar dias úteis a uma data?

Function Datafinal(dataini:tdatetime; dias_uteis:integer):tdatetime;
// Retorna uma data acresçida de mais um certo número de dias
// uteis descontando os fins de semana
var dw:integer;
begin
dw := DayOfWeek(dataini)-1;
result := dataini+dias_uteis+((dias_uteis-1+dw) div 5)*2;
end;

Como acrescentar características em um objeto?

{Para visualizar uma imagem em um DBGrid, você vai ter que criar um descendente dele que aceite essas figuras. O código está abaixo:}


unit DBPicGrd;

interface

uses
DBGrids, DB, DBTables, Grids, WinTypes, Classes, Graphics;

type
TDBPicGrid = class (TDBGrid)
protected
procedure DrawDataCell(const Rect: TRect; Field: TField; State:
TGridDrawState); override;
public
constructor Create (AOwner : TComponent); override;
published
property DefaultDrawing default False;
end;

procedure Register;

implementation

constructor TDBPicGrid.Create (AOwner : TComponent);
begin
inherited Create (AOwner);
DefaultDrawing := False;
end;

procedure TDBPicGrid.DrawDataCell (const Rect: TRect; Field: TField;
State: TGridDrawState);
var
bmp : TBitmap;
begin
with Canvas do
begin
FillRect(Rect);
if Field is TGraphicField then
try
bmp := TBitmap.Create;
bmp.Assign (Field);
Draw (Rect.Left, Rect.Top, bmp);
finally
bmp.Free;
end
else
TextOut (Rect.Left, Rect.Top, Field.Text);
end;
end;

procedure Register;
begin
RegisterComponents ('Custom', [TDBPicGrid]);
end;
end.

Como achar um modem e sua porta?

{Todas as informações sobre o modem instalado estão contidas no registro do Windows. Usando TRegistry podemos, facilmente, ter acesso à essas informações. Porém, dependendo do modem, ele pode não especificar em qual porta está instalado. Então devemos primeiro
descobrir quantas portas serial existem no sistema, criar um Handle para receber a Porta e depois fazer tentativas de abertura em cada uma delas no modo Leitura/Escrita (GENERIC_READ or GENERIC_WRITE). Se tentarmos, por exemplo, abrir a COM1 (que, geralmente, está o mouse), não conseguiremos abrí-la e retornará erro (INVALID_HANDLE_VALUE). Podemos então manipular o retorno. A forma ideal é criar um loop para que todas as portas sejam checadas.

O Procedure abaixo, pega as informações contida nas chaves: HKEY_LOCAL_MACHINE....SerialComm e ....modem000
A chave ...modem000, refere-se ao primeiro modem encontrado, caso existir mais que um, este será ..modem001, 0002... e assim por diante.

Veja bem, poderemos ir diretamente apenas na chave do modem para saber em que porta ele está instalado. Esta informação estará na Subsecção "AttachedTO", porém, nem todos os modems registram esta informação. Portando, o modo mais seguro, e eficaz, é usar tentativas
de abertura como descrito abaixo. }
unit PegaPorta;


interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,StdCtrls, Registry;

type
TForm1 = class(TForm)
ComboBox1: TComboBox;
Label1: TLabel;
Button1: TButton;
Label2: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure PegaModem(porta: string);
procedure ComboBox1Change(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.PegaModem(porta : string);
var
FHandle : THandle;
Reg : TRegistry;
Lista : TStrings;
i : integer;
varPorta, varModelo : string;
begin
Reg :=TRegistry.Create;

//Procurar na secção...
Reg.RootKey :=HKEY_LOCAL_MACHINE;

//SubSecção onde estão as Portas de comunicação disponíveis
if Reg.OpenKey('HardwareDeviceMapSerialComm', false) then begin

//Cria a uma 'lista' das portas encontradas (mouse, modem... etc..)
lista := TStringList.Create;

//Adiciona à 'lista' as portas encontradas
Reg.GetValueNames(lista);
for i := 0 to lista.count -1 do begin
if trim(porta) = '' then
begin
varPorta := Reg.ReadString(lista[i]);// Lê nome da porta
combobox1.Items.Add(varPorta);
end
else
varPorta := porta;

{Cria o Handle para receber a(s) porta(s) e faz tentativa de abertura em todas encontradas, no modo leitura ou escrita (modem) }
FHandle := CreateFile(
PChar('\.' + varPorta),
GENERIC_READ or GENERIC_WRITE,
0,
nil,
OPEN_EXISTING,
FILE_FLAG_OVERLAPPED,
0);

// Se for uma porta válida para modem...
if FHandle <> INVALID_HANDLE_VALUE then begin
CloseHandle(FHandle); // Fecha o Handle e a porta

//Pega o nome/modelo do modem instalado na porta existente
if Reg.OpenKey('SystemCurrentControlSet'+
'ServicesClassModem000', false)then begin
varModelo := Reg.ReadString('Model');
Label2.Caption := varModelo+' - Instalado na porta '+varPorta;
Combobox1.Text := varPorta;
end;
end
else
Label2.Caption := 'Não há modem instalado na porta '+varPorta;
end;
//Fecha e libera variáveis
Reg.CloseKey;
Lista.Free;
Reg.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Close;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
porta : string;
begin
Combobox1.Clear;
PegaModem(porta);
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
var
porta : string;
begin
//Verificar se existe mais de um modem...
porta := combobox1.text;
PegaModem(porta);
end;

end.

Como acessar tabelas access?

{Primeiro crie um alias apontando para o diretorio onde está o arquivo .mdb do access, este apontamento deve ser testado clicando no botão connectt. Se funcionar, pode fechar salvando o novo alias. Caso contrário verifique se o diretório está correto e se o arquivo mdb existe neste diretório. Bem, após isso, vá no delphi, abra um projeto novo, coloque um componente tdatabase, uma query, um datasource e um dbgrid. Após isso clique duas vezes no componente tdatabase, após clicar, aparecerá um formulário, informe o nome que deseja dar ao database em name, em alias name, clique na seta e escolha o alias criado anteriormente, depois clique em defaults, se quiser uma senha para acesso ao banco, procure a palavra PASSWORD dentro da janela que foi preenchida com comandos quando você clicou em defaults, e digite a senha desejada, se não quiser senha deixe em branco. Após fazer isto, clique em OK. Bem, agora vá em propriedades do tdatabase e clique em conectt, ele vai pedir um usuário e uma senha, se não colocou password, basta clicar em ok que ele se conectará e caso tenha uma password digite-a. Uma vez conectado, vá na query, na propriedade strings, coloque a instrução SELECT acessando a tabela que está dentro do arquivo MDB. Veja bem, não é para colocar o arquivo mdb mas sim uma ou mais das tabelas que estão dentro do MDB. Depois disso na propriedade database, escolha o nome que deu ao seu database, se você fez tudo correto, o nome dele tem que estar na lista. Bom, agora active a query. Após isso vá no datasource e conecte-o á query, e depois vá no dbgrid e sete o datasource para o datasource criado. Se fez tudo correto e se a tabela tiver dados, você os verá no dbgrid. }

Como abrir um combobox sem clicá-lo?

ComboBox1.DroppedDown := True;

Comandos para threads

Minhathread.pause; {da pausa na thread }
minhathread.resume; { reinicia a thread }
minhathread.terminate; { termina a thread }
minhatrhread.execute; { executa a thread }

Colocando zeros à esquerda de um valor digitado em um edit

Procedure TForm1.Edit1Exit(Sender: TObject);
begin
Edit1.Text := FormatFloat('000000',StrToFloat(Edit1.Text));
end;

Colocando uma progressbar dentro de uma statusbar

{- Coloque uma StatusBar no form. - Adicione dois paineis na StatusBar (propriedade Panels).

- Ajuste as propriedades do primeiro painel conforme abaixo:

Style = psOwnerDraw

Width = 150

- Coloque uma ProgressBar no form e mude sua propriedade

Visible para false.

- No evento OnDrawPanel da StatusBar digite o código abaixo:}


procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar;
Panel: TStatusPanel; const Rect: TRect);
begin
{ Se for o primeiro painel... }
if Panel.Index = 0 then begin
{ Ajusta a tamanho da ProgressBar de acordo com
o tamanho do painel }
ProgressBar1.Width := Rect.Right - Rect.Left +1;
ProgressBar1.Height := Rect.Bottom - Rect.Top +1;
{ Pinta a ProgressBar no DC (device-context) da StatusBar }
ProgressBar1.PaintTo(StatusBar.Canvas.Handle, Rect.Left, Rect.Top);
end;
end; //- Coloque um Button no form

//- Digite no evento OnClick do Button o código abaixo:


procedure TForm1.Button1Click(Sender: TObject);
var
I: integer;
begin
for I := ProgressBar1.Min to ProgressBar1.Max do begin
{ Atualiza a posição da ProgressBar }
ProgressBar1.Position := I;
{ Repinta a StatusBar para forçar a atualização visual }
StatusBar1.Repaint;
{ Aguarda 50 milisegundos }
Sleep(50);
end;

{ Aguarde 500 milisegundos }
Sleep(500);
{ Reseta (zera) a ProgressBar }
ProgressBar1.Position := ProgressBar1.Min;
{ Repinta a StatusBar para forçar a atualização visual }
StatusBar1.Repaint;
end; //- Execute e clique no botão para ver o resultado.

Colocando senhas em tabelas paradox

//Coloque o seguinte antes de abrir a tabela :
Table1.DBSession.AddPassword('senha_da_tabela'); {Lembrando que tabelas paradox podem ser abertas também com uma senha "master", não importando a senha que você colocou.}

Colocando bmps em uma dll

{Por vezes, quando iniciamos um projeto, temos uma preocupação: fazer uma aplicação pequena. Bem, a solução pode passar por colocar todos os bitmaps que vamos utilizar em uma DLL. Para fazer isso você deve usar o Image Editor, criar uma nova Resource File (.res), neste ficheiro vamos colocar os bitmaps e icons (ambos funcionam da mesma forma) que queremos na nossa aplicação, clique com a tecla direita do rato na nova resource file e crie um novo bitmap, depois desenhe ou cole do clipboard um bitmap, finalmente guarde o ficheiro com o nome images.res. Depois disto estar feito vá ao IDE do Delphi e no File menu clique New... e escolha DLL depois cole o código abaixo, não se esqueça de adicionar uma unit vazia ao projecto. Guarde o projecta da dll no mesmo directório do ficheiro image.res, finalmente faça o build da dll (não se esqueça, que não se pode correr (executar) uma dll)

Código da Dll:}

library ImageRes; {nome da dll}
uses DummyUnit; {DummyUnit é uma unit vazia, que é necessária}
{$R images.res} {nome da resource file, que deve estar no mesmo caminho da dll}
begin
end.

Código da DummyUnit:


unit DummyUnit;
interface
implementation
end. {Usando os bitmaps que estão na dll:

Estão aqui alguns exemplos como extrair os bitmaps da dll:}

procedure TForm1.SpeedButton1Click(Sender:TObject);
var
MyHandle :THandle;
Bmp : TBitmap;
begin
MyHandle := LoadLibrary('ImageRes.DLL'); {nome da dll construida acima}
Bmp := TBitmap.Create;
Bmp.Handle := LoadBitmap(MyHandle, 'BITMAP1'); {Bitmap1 é o nome do bitmap criado no ficheiro image.res}
SpeedButton1.Glyph.Handle := LoadBitmap(MyHandle,'BITMAP1'); {Carrega o Bitmap1 para o glyph do SpeedButton1}
Canvas.Draw(0,0,Bmp); {Desenha o bitmap no canvas da form}
Image1.picture.bitmap:=Bmp; {Carrega o bitmap para o componente Timage}
Bmp.Free;
end;

Colocando o mês por extenso

Unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
function MesExtenso( Mes:Word ) : string;
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

function TForm1.MesExtenso( Mês:Word ) : string; const meses : array[0..11] of PChar = ('Janeiro', 'Fevereiro', 'Março', 'Abril', 'Maio', 'Junho', 'Julho', 'Agosto', 'Setembro','Outubro', 'Novembro', 'Dezembro');
begin
result := meses[mes-1];
End;

procedure TForm1.Button1Click(Sender: TObject);
begin
label1.Caption := MesExtenso(3);
end;

end.

Colocando o cursor no final de um edit

//No evento OnEnter do TEdit coloque:
procedure TForm1.Edit1Enter(Sender: TObject);
begin
Edit1.Selstart:= Length(Edit1.text);
end;

Colocando uma barra de progresso para o batchmove

{1 - No form, coloque um componente TDataSource. 2 - Na propriedade DataSet do TDataSource inserido, coloque a tabela de origem, ou seja, "DataSource1.DataSet:=BatchMove1.Source;"

3 - Utilize o evento OnChangeData do TDataSource p/ acompanhar o processo de cópia.

Lembre-se que antes disso você deverá utilizar a propriedate RecordCount da tabela de origem para saber o total de registros que serão copiados.

Lembre-se também que a cada registro lido, o evento OnChangeData é chamado, portanto, é através desse evento que você poderá acompanhar o

processo de cópia, e por exemplo, atualizar uma barra de porcentagem}

Colocando e usando funções em uma dll

//Edite diretamente no DPR, e depois salve como Funções.dpr: Library Funcoes;

Uses SysUtils,WinTypes,WinProcs; { Uma função que tira os espaços no início e no final de uma string }


Function Trim(J:String):String; Export;
Begin
While J[Length(J)]=#32 do Dec(J[0]);
If Length(J)>1 then
While (J[1]=' ') do
Begin
Delete(J,1,1);
If Length(J)<=1 then J:='';
end;
Result:=J;
end;
Exports { Torna visivel para os programas }
Trim;
Begin
End. //Para usar em um programa:

Unit Unit1;
Interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, Buttons;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
Var
Form1: TForm1;
Implementation
{ Declara a funcao }
Function Trim(J:String):String; External 'funcoes.dll';
{$R *.DFM}
Procedure TForm1.FormClick(Sender: TObject);
begin
Caption:=Trim(' Visite sempre o Delphi Club '); { Note os espacos }
end;

{As vantagens de colocar as funções em DLL são:

1. O programa exigirá menos memória

2. Você poderá reaproveitar as funções

3. Em alguns casos pode-se atualizar apenas as dll para um upgrade}

Colocando bmps em stringgrids

With StringGrid1.Canvas do
begin
{...}
Draw(Rect.Left, Rect.Top, Image1.Picture.Graphic);
{...}
end;

Colocando bitmaps num combobox

//Ajuste a propriedade Style do ComboBox para csOwnerDrawVariable.

var
Form1: TForm1;
Bmp1, Bmp2, Bmp3: TBitmap;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
Bmp1:=TBitmap.Create;
Bmp1.Loadfromfile('c:chip16.bmp');
Bmp2:=TBitmap.Create;
Bmp2Loadfromfile('c:zoom.bmp');
Bmp3:=TBitmap.Create;
Bmp3Loadfromfile('c:disk.bmp');
ComboBox1.Items.AddObject('Chip',Bmp1);
ComboBox1.Items.AddObject('Zoom',Bmp2);
ComboBox1.Items.AddObject('Disk',Bmp3);
end;

procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOWnerDrawState);
var
Bitmap: TBitmap;
Offset: Integer;
begin
with (Control as TComboBox).Canvas do
begin
FillRect(Rect); Bitmap:= TBitmap(ComboBox1.Items.Objects[index]);
BrushCopy(Bounds(Rect.Left + 2, Rect.Top + 2, Bitmap.Width,
Bitmap.Height), Bitmap, Bounds(0, 0, Bitmap.Width, Bitmap.Height), clRed);
Offset: Bitmap.width + 8;
TextOut(Rect.Left + Offset, Rect.Top, ComboBox1.Items[index]);
end;
end;

procedure TForm1.ComboBox1MeasureItem(Control: TWinControl; Index: Integer; var Height: Integer);
begin
Height:=20;
end;

Clone monocromático de bitmap

Function CreateDisabledBitmap(FOriginal: TBitmap; OutlineColor: TColor): TBitmap;
// Use-a assim:
// image2.picture.Bitmap := CreateDisabledBitmap(Image1.Picture.Bitmap, clBtnFace);
const
ROP_DSPDxax = $00E20746;
var
MonoBmp: TBitmap;
IRect: TRect;
begin
IRect := Rect(0, 0, FOriginal.Width, FOriginal.Height);
Result := TBitmap.Create;
try
Result.Width := FOriginal.Width;
Result.Height := FOriginal.Height;
MonoBmp := TBitmap.Create;
try
with MonoBmp do
begin
Assign(FOriginal);
{$IFDEF S_D3}
HandleType := bmDDB;
{$ENDIF}
Canvas.Brush.Color := clBlack;
if Monochrome then
begin
Canvas.Font.Color := clWhite;
Monochrome := False;
Canvas.Brush.Color := clWhite;
end;
Monochrome := True;
end;
with Result.Canvas do
begin
Brush.Color := OutlineColor;
FillRect(IRect);
Brush.Color := clBtnHighlight;
SetTextColor(Handle, clBlack);
SetBkColor(Handle, clWhite);
BitBlt(Handle, 1, 1, IRect.Right - IRect.Left, IRect.Bottom - IRect.Top,
MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
Brush.Color := clBtnShadow;
SetTextColor(Handle, clBlack);
SetBkColor(Handle, clWhite);
BitBlt(Handle, 0, 0, IRect.Right - IRect.Left, IRect.Bottom - IRect.Top,
MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
End;
finally
MonoBmp.Free;
end;
except
Result.Free;
raise;
end;
end;

Clicando com o mouse (simulando um clique)

{O exemplo abaixo simula o pressionamento da tecla do botão esquerdo do mouse em uma determinada posição da tela. No exemplo serão utilizados dois botões (Button1 e Button2), ao clicar no Button2 será executado o onClick do Button1 como se o mouse tivesse clicado sobre ele }

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage('Button 1 clicked');
end;

procedure TForm1.Button2Click(Sender: TObject);
var
Pt : TPoint;
begin
Application.ProcessMessages;
{Obtém o point no centro do Button1}
Pt.x := Button1.Left + (Button1.Width div 2);
Pt.y := Button1.Top + (Button1.Height div 2);
{Converte Pt para as coordenadas da tela }
Pt := ClientToScreen(Pt);
Pt.x := Round(Pt.x * (65535 / Screen.Width));
Pt.y := Round(Pt.y * (65535 / Screen.Height));
{Move o mouse}
Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MOVE, Pt.x, Pt.y, 0, 0);
{Simula o pressionamento do botão esquerdo do mouse}
Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTDOWN, Pt.x, Pt.y, 0, 0);
{ Simula soltando o botão esquerdo do mouse }
Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTUP, Pt.x, Pt.y, 0, 0);
end;

Clicando um componente via código (simulando)

//1 - Insira um ListBox e preencha-o com alguns itens;
//2 - Insira um botão qualquer;
//3 - No evento OnDblClick do ListBox, digite:

Button1.Perform(WM_LBUTTONDOWN, 0, 0);

Checando se o símbolo da uf é válido

Function ChecaEstado(Dado : string) : boolean;
const
Estados = 'SPMGRJRSSCPRESDFMTMSGOTOBASEALPBPEMARNCEPIPAAMAPFNACRRRO';
var
Posicao : integer;
begin
Result := true;
if Dado <> '' then
begin
Posicao := Pos(UpperCase(Dado),Estados);
if (Posicao = 0) or ((Posicao mod 2) = 0) then
begin
Result := false;
end;
end;
end;

Chamando um site utilizando o browser padrão

Uses UrlMon;

procedure TForm1.Button1Click(Sender: TObject);
begin
HlinkNavigateString(nil,'http://www.delphi.eti.br');
End;

Chamando um programa e esperando a sua finalização

//Para executar um programa e esperar até esse programa finalizar, use a rotina abaixo:
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_SHOWNORMA//L - Janela em modo normal

SW_MAXIMIZE// - Janela maximizada

SW_MINIMIZE// - Janela minimizada

SW_HIDE //- Janela Escondida

Chamando um e-mail

Procedure TForm1.Button1Click(Sender: TObject);
var Mail : String;
begin
Mail := 'mailto:lloydsoft@ieg.com.br';
ShellExecute(GetDesktopWindow,'open',pchar(Mail),nil,nil,sw_ShowNormal);
end;

Chamando o help

Application.HelpFile:='SeuHelp.hlp';
Application.HelpCommand(parametros, 0);

//Parâmetros:
HELP_CONTENTS// - Chama o arquivo de Help como se tivesse dado um duplo-clique no arquivo .hlp
HELP_FINDER // - Chama o help a partir do menu Conteúdo.
HELP_QUIT // - Desativa o Help.

Centralizando uma string

Function Center(StrX : string; IntX : ShortInt) : string;
begin
Center := Middle (StrX, IntX, EspacoBranco);
end;

Centralizando um form no desktop (via código)

Var
r : TRect;
osv : TOSVersionInfo;
begin
osv.EdwOSVersionInfoSize := sizeof(osv);
GetVersionEx(osv);
if osv.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS then
begin
SystemParametersInfo(SPI_GETWORKAREA, 0, @r, 0);
Left := ((r.right - r.left) - Width) div 2;
Top := ((r.bottom - r.top) - Height) div 2;
end
else
begin
Left := (GetSystemMetrics(SM_CXSCREEN) - Width) div 2;
Top := (GetSystemMetrics(SM_CYSCREEN) - Height) div 2;
end;
end;
{Ou simplesmente vá até a propriedade Position do form e selecione poScreenCenter. }

Carregando um cursor animado (*.ani)

Const
cnCursorID1 = 1;
begin
Screen.Cursors[ cnCursorID1 ] :=
LoadCursorFromFile('c:win95cursorscavalo.ani' );
Cursor := cnCursorID1;
end;

Capturando informações do ambiente dos

{No exemplo abaixo deve ser incluído no objeto TForm um objeto do tipo Button, um objeto do tipo StringGrid e um objeto do tipo ListBox. }

type
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
StringGrid1: TStringGrid;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
implementation
{$R *.DFM}

// Evento OnClick do objeto Button
procedure TForm1.Button1Click(Sender: TObject);
var
Env : PChar;
i : Integer;
S : String;
PosEq : Integer;
begin
Env := GetEnvironmentStrings;
With ListBox1,StringGrid1 do
begin
While Env^ <> #0 do
begin
Items.Add(StrPas(Env));
Inc(Env,StrLen(Env)+1);
end;
RowCount := Items.Count;
for i := 0 to Pred(Items.Count) do
begin
PosEq := Pos(‘=’,Items[i]);
Cells[0,i] := Copy(Items[i],1,PosEq-1);
Cells[1,i] :=
Copy(Items[i],PosEq+1,Length(Items[i]));
end;
end;
end;

Capturando ecrã (tela)

Var bitmap : tbitmap;
jpg : tjpegimage;
dc : hdc;
desktoprect : trect;
desktopcanvas : tcanvas;
x, y : integer;

begin
dc:=getdc(getdesktopwindow);
try
desktopcanvas:=tcanvas.create;
bitmap:=tbitmap.create;
jpg:=tjpegimage.create;
try
bitmap.Width:=320;
bitmap.Height:=240;
desktopcanvas.handle:=dc;
desktoprect:=rect(0,0,319,239);
bitmap.canvas.CopyRect(desktoprect,desktopcanvas,desktoprect);
img.Picture.Bitmap:=bitmap;

for y:=yy to yy+10 do
for x:=xx to xx+10 do
img.canvas.pixels[x,y]:=clwhite;

with jpg do
begin
compressionquality:=25;
assign(bitmap);
compress;
savetofile('data'+filename);
end;
finally
bitmap.free;
desktopcanvas.free;
end;
finally
releasedc(getdesktopwindow,dc);
end;
end;

Capturando a data da bios do sistema

{Insira um objeto do tipo Button com a propriedade name definica como Button1 e um objeto do tipo Label com a propriedade definida como Label1. }

procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Caption := 'Data da Bios: '+String(PChar(Ptr($FFFF5)));
end;

Capturando o conteúdo do desktop

Procedure TForm1.FormResize(Sender: TObject);
var
R : TRect;
DC : HDc;
Canv : TCanvas;
begin
R := Rect( 0, 0, Screen.Width, Screen.Height );
DC := GetWindowDC( GetDeskTopWindow );
Canv := TCanvas.Create;
Canv.Handle := DC;
Canvas.CopyRect( R, Canv, R );
ReleaseDC( GetDeskTopWindow, DC );
end;

Fazendo o caption de um bitbtn ficar com várias linhas

Unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons;

type
TForm1 = class(TForm)
BitBtn1: TBitBtn;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
var
R : TRect;
N : Integer;
Buff : array[0..255] of Char;
begin
with BitBtn1 do
begin
Caption := 'Várias linhas no caption de um botão';
Glyph.Canvas.Font := Self.Font;
Glyph.Width := Width - 6;
Glyph.Height := Height - 6;
R := Bounds(0, 0, Glyph.Width, 0);
StrPCopy(Buff, Caption);
Caption := '';
DrawText(Glyph.Canvas.Handle, Buff,StrLen(Buff),R,
DT_CENTER or DT_WORDBREAK or DT_CALCRECT);
OffsetRect(R,(Glyph.Width - R.Right) div 2,
(Glyph.Height - R.Bottom) div 2);
DrawText(Glyph.Canvas.Handle, Buff, StrLen(Buff), R,
DT_CENTER or DT_WORDBREAK);
end;
end;
end.

Caps e num lock

Procedure TMyForm.Button1Click(Sender: TObject);
Var
KeyState : TKeyboardState;
begin
GetKeyboardState(KeyState);
if (KeyState[VK_NUMLOCK] = 0) then KeyState[VK_NUMLOCK] := 1
else KeyState[VK_NUMLOCK] := 0;
SetKeyboardState(KeyState);
End;

//Para a tecla Caps Lock basta trocar VK_NUMLOCK por VK_CAPITAL.

Calculando o percentual de um valor

Function Gerapercentual(valor:real;Percent:Real):real;
// Retorna a porcentagem de um valor
begin
percent := percent / 100;
try
valor := valor * Percent;
finally
result := valor;
end;
end;