Dicas 2:

Preenche com quantidade determinada de zeros o lado esquerdo de uma string

unit Zero;

interface

function RetZero(ZEROS:string;QUANT:integer):String;

implementation

function RetZero(ZEROS:string;QUANT:integer):String;

var

   I,Tamanho:integer;

   aux: string;

begin

  aux:=zeros;

  Tamanho:=length(ZEROS);

  ZEROS:='';

    for I:=1 to quant-tamanho do

        ZEROS:=ZEROS+'0';

  aux:=zeros+aux;

  RetZero:=aux;

end;

end.

Ponto Decimal

if Key in [',','.'] then Key := DecimalSeparator;

Coloque no evento OnKeyPress dos seus TEdits numéricos

FindNearest numa Query

Query.Locate('campo onde ira porcurar',Texto a buscar,[loPartialKey])

Relatórios em HTML

Em vez de Quickreport1.Print faca :

QuickRep1.ExportToFilter(TQRHtmlExportFilter.Create('teste.html'));

Desligando Windows via programação

function ExitWindowsEx(uFlags : integer;                      // shutdown operation

                   dwReserved : word) : boolean; // reserved

  external 'user32.dll' name 'ExitWindowsEx';

procedure Tchau;

const

  EWX_LOGOFF   = 0; // Dá "logoff" no usuário atual

  EWX_SHUTDOWN = 1; // "Shutdown" padrão do sistema

  EWX_REBOOT   = 2; // Dá "reboot" no equipamento

  EWX_FORCE    = 4; // Força o término dos processos

  EWX_POWEROFF = 8; // Desliga o equipamento

begin

  ExitWindowsEx(EWX_FORCE, 0);

end;

Como saber se o CD está no drive

Function MidiaPresente(MediaPlayer: TMediaPlayer): Boolean;
var
Params: MCI_STATUS_PARMS;
S: array [0.255] of char;
r: Integer;
begin
//verifica se existe um cd inserido
Params.dwItem:= MCI_STATUS_MEDIA_PRESENT;
r:= MCISendCommand(MediaPlayer.DeviceID, MCI_STATUS,


MCI_STATUS_ITEM, Integer(Addr(Params)));
if r <> 0 then
begin
MCIGetErrorString(r, S, SizeOf(S));
ShowMessage('Erro: ' + StrPas(S));
end
else
Result:= Params.dwReturn = 1;
end;

Tradução de Mensagens

Depois de algum tempo pesquisando uma forma de fazer aparecer as mensagens
em português, consegui uma solução muito fácil de implementar no ambiente
de programação do Delphi 3.

CHEGA DE YES/NO !!!

messagedlg('Confirma ? mtConfirmation, [mbYes, mbNo], 0);

Aí vai:

1 - No diretório DELPHI3\LIB, copie o arquivo consts.dcu para consts.old;
2 - Inicie o Delphi e crie um nova Unit;
3 - Insira nesta, o arquivo consts.int do diretório DELPHI3\DOC E faça as
devidas alterações nas mensagens que desejares alterar e nas
partes duplicadas da Unit como "implement" e etc, também deixe o
cabeçalho como Unit Consts.
4 - Salve esta nova Unit no diretório DELPHI\LIB e pronto todas as
mensagens alteradas por você estarão aplicadas nos seus
próximos programas sem uma linha de programa e da
forma que você quiser.

Função que devolve tempo decorrido em uma string

Function NumDiasExtenso(NumDias:integer):string;
var
Anos, Meses, Dias : integer;
sAnos, sMeses, sDias : string;
begin
{ --- Calcula o número de anos --- }
Anos := 0;
while NumDias >= 365 do
begin
Anos := Anos + 1;
NumDias := NumDias - 365;
end;
if Anos > 1 then
sAnos := ' anos,'
else
sAnos := ' ano,';

{ --- Calcula o número de meses --- }
Meses := 0;
while NumDias >= 30 do
begin
Meses := Meses + 1;
NumDias := NumDias - 30;
end;
if Meses > 1 then
sMeses := ' meses e '
else
sAnos := ' mês e ';

{ --- O Número de dias é a sobra --- }
Dias := NumDias;
if sDias > 1 then
sDias := 'dias'
else
sDias := 'dia';

Return := Inttostr(Anos)+sAnos+inttostr(Meses)+sMeses+inttostr(Dias)+sDias;
end;

Criando uma rotina para pegar todos os erros do programa.

Procedure MostraErro;
Begin
ShowMessage('Ocorreu algum erro!');
end;

TForm1.Create;
Begin
Application.OnException:=MostraErro;
end;

Capturando 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;

Obtendo número do registro atual

Function Recno(Dataset: TDataset): Longint;

var
CursorProps: CurProps;
RecordProps: RECProps;

begin
{ Return 0 if dataset is not Paradox or dBASE }
Result := 0;
with Dataset do
begin
if State = dsInactive then DBError(SDataSetClosed);
Check(DbiGetCursorProps(Handle, CursorProps));
UpdateCursorPos;
try
Check(DbiGetRecord(Handle, dbiNOLOCK, nil, @RecordProps));
case CursorProps.iSeqNums of
0: Result := RecordProps.iPhyRecNum; { dBASE }
1: Result := RecordProps.iSeqNum; { Paradox }
end;
except
on EDBEngineError do
Result := 0;
end;
end;
end;

Enviando um arquivo para a lixeira

uses ShellAPI;

Function DeleteFileWithUndo(sFileName : string ) : boolean;

var
fos : TSHFileOpStruct;

Begin
FillChar( fos, SizeOf( fos ), 0 );
With fos do
begin
wFunc := FO_DELETE;
pFrom := PChar( sFileName );
fFlags := FOF_ALLOWUNDO
or FOF_NOCONFIRMATION
or FOF_SILENT;
end;
Result := ( 0 = ShFileOperation( fos ) );
end;

Desabilitar o CTRL+ALT+DEL e ALT+TAB

Var
numero: integer;
begin
SystemParametersInfo(97,Word(true),@numero,0);
end;

{ Para habilitar é só chamar a mesma função com Word(false) }

Carregar um cursor animado (*.ani)

const
cnCursorID1 = 1;
begin
Screen.Cursors[ cnCursorID1 ] :=
LoadCursorFromFile('c:\win95\cursors\cavalo.ani' );
Cursor := cnCursorID1;
end;

Saindo do Windows

{ Reinicia o Windows }
ExitWindowsEx(EWX_REBOOT, 0);

{ Desliga o Windows }
ExitWindowsEx(EWX_SHUTDOWN, 0);

{ Força todos os programa a desligarem-se }
ExitWindowsEx(EWX_FORCE, 0);

Modificando a posição do cursor em um Memo

Modificando a posição:

ActiveControl:=Memo1;
MemoCursorTo(Memo1,2,3);

Obtendo a Posição:

GetMemoLineCol(Memo1,Linha,Coluna);

Traduzindo a mensagem “Delete Record ?”

Quando clicamos sobre o botão de deleção no DBNavigator (o do sinal de menos) surge uma box com a mensagem "Delete Record?" com botões Ok e Cancel.
Para fazer aparecer a mensagem em português deverá selecionar o componente Table e mudar a propriedade ConfirmDelete para False e no evento da tabela BeforeDelete colocar o seguinte:

procedure TForm1.Table1BeforeDelete(DataSet:TDataSet);
begin
if MessageDlg('Eliminar o Registro?',mtConfirmation,[mbYes,mbNo],0)<>mrYes then Abort;
end;

Pegando o Nome do usuário e a Empresa do Windows

Uses Registry;

Procedure GetUserCompany;
var
reg: TRegIniFile;
begin
reg := TRegIniFile.create('SOFTWARE\MICROSOFT\MS SETUP (ACME)\');
Edit1.Text := reg.ReadString('USER INFO','DefName','');
Edit2.Text := reg.ReadString('USER INFO','DefCompany','');
reg.free;

end;

Escrevendo um Texto na Diagonal usando o Canvas

procedure TForm1.Button1Click(Sender: TObject);
var
lf : TLogFont;
tf : TFont;
begin
with Form1.Canvas do begin
Font.Name := 'Arial';
Font.Size := 24;
tf := TFont.Create;
tf.Assign(Font);
GetObject(tf.Handle, sizeof(lf), @lf);
lf.lfEscapement := 450;
lf.lfOrientation := 450;
tf.Handle := CreateFontIndirect(lf);
Font.Assign(tf);
tf.Free;
TextOut(20, Height div 2, 'Texto Diagonal!');
end;
end;

Fundo do texto transparente

procedure TForm1.Button1Click(Sender: TObject);
var
OldBkMode : integer;
begin
with Form1.Canvas do begin
Brush.Color := clRed;
FillRect(Rect(0, 0, 100, 100));
Brush.Color := clBlue;
TextOut(10, 20, 'Não é Transparente!');
OldBkMode := SetBkMode(Handle, TRANSPARENT);
TextOut(10, 50, 'É Transparente!');
SetBkMode(Handle, OldBkMode);
end;
end;

Formatação de Casas Decimais

procedure TForm1.Button1Click(Sender: TObject);
var num : integer;
begin
num:=12450;
Edit1.text:=formatfloat('###,###,##0.00', num)
end;

Escondendo/Mostrando o botão Iniciar

procedure EscondeIniciar(Visible:Boolean);
Var taskbarhandle,
buttonhandle : HWND;
begin
taskbarhandle := FindWindow('Shell_TrayWnd', nil);
buttonhandle := GetWindow(taskbarhandle, GW_CHILD);
If Visible=True Then Begin
ShowWindow(buttonhandle, SW_RESTORE); {mostra o botão}
End Else Begin
ShowWindow(buttonhandle, SW_HIDE); {esconde o botão}
End;
end;

Esconde/Mostra a Barra de Tarefas

procedure EscondeTaskBar(Visible: Boolean);
var wndHandle : THandle;
wndClass : array[0..50] of Char;
begin
StrPCopy(@wndClass[0],'Shell_TrayWnd');
wndHandle := FindWindow(@wndClass[0], nil);
If Visible=True Then Begin
ShowWindow(wndHandle, SW_RESTORE); {Mostra a barra de tarefas}
End Else Begin
ShowWindow(wndHandle, SW_HIDE); {Esconde a barra de tarefas}
End;
end;

Desabilitando o Alt+Tab

procedure TurnSysKeysOff;
var OldVal : LongInt;
begin
SystemParametersInfo (97, Word (True), @OldVal, 0)
end;

procedure TurnSysKeysOn;
var OldVal : LongInt;
begin
SystemParametersInfo (97, Word (False), @OldVal, 0)
end;

Por: Adenilton Rodrigues - arinfo@estaminas.com.br

Detectando o Numero Serial do HD

Function SerialNum(FDrive:String) :String;

Var Serial:DWord;

    DirLen,Flags: DWord;

    DLabel : Array[0..11] of Char;

begin

 Try

  GetVolumeInformation(PChar(FDrive+':\'),dLabel,12,@Serial,DirLen,Flags,nil,0);

  Result := IntToHex(Serial,8); 

 Except Result :='';

 end;

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;

Marcando um pedaço do código

As Vezes quando vc tem uma unidade com muitas linhas de código (umas 1000 por exemplo), fica difícil achar o bloco de código que você quer; e para facilitar isso o Delphi tem um tipo de "bookmark" de código.

Para colocar o bookmark, posicione no lugar onde você quer marcar e pressione CTRL+SHIFT+ o número do bookmark que você vai criar de (0..9), por exemplo CTRL+SHIFT+0.

Para retornar ao bloco marcado você deve pressionar CTRL+ o número do bookmark. Por exemplo CTRL+1.

Ps: A opção Editor FindTextAtCursor deve estar marcada, ou estas teclas não irão funcionar.

Um programinha para alterar o papel de parede do Windows

program wallpapr;
uses Registry, WinProcs;
procedure SetWallpaper(sWallpaperBMPPath : String; bTile : boolean );
var
reg : TRegIniFile;
begin
// Mudando o Registro HKEY_CURRENT_USER
// Control Panel\Desktop
// TileWallpaper (REG_SZ)
// Wallpaper (REG_SZ)
reg := TRegIniFile.Create('Control Panel\Desktop' );
with reg do begin
WriteString( '', 'Wallpaper',sWallpaperBMPPath );
if( bTile )then begin
WriteString( '', 'TileWallpaper', '1' );
end else begin
WriteString( '', 'TileWallpaper', '0' );
end;
end;
reg.Free;

// Mostrar que o parametro do sistema foi alterado

SystemParametersInfo( SPI_SETDESKWALLPAPER,0, Nil, SPIF_SENDWININICHANGE );
end;
begin
SetWallpaper( 'c:\winnt\winnt.bmp', False );
end.

Alterando cor de linha de um DBGrid

Coloque a propriedade defaultdrawdata do dbgrid em FALSE

No evento onDrawColumnCell do seu grid coloque o seguinte:

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject;
const Rect: TRect; DataCol: Integer; Column: TColumn;
State: TGridDrawState);
begin
If table1PRAZO.Value > DATE then // condição
Dbgrid1.Canvas.Font.Color:= clFuchsia; // coloque aqui a cor desejada
Dbgrid1.DefaultDrawDataCell(Rect, dbgrid1.columns[datacol].field, State);
end;

Diretório de instalação do windows

function PegaSysDir: string;
var
MeuBuffer: Array [1..128] of Char;
retorno: Integer;
Begin
retorno:=GetSystemDirectory(@MeuBuffer,128);
if (retorno>128) OR (retorno=0) then
PegaSysDir:=''
else
PegaSysDir:=StrPas(@MeuBuffer);
End; {prc}

Exclusividade para o programa

Gostaria de saber como fazer para que, ao iniciar minha aplicacao
Delphi, eu " desabilite " o shell do Windows (Explorer). Ou seja, o que
eu preciso e' de uma forma de fazer com que apos a minha aplicacao seja
iniciada, o usuario nao tenha como alternar entre programas, acessar
outros icones, etc

No System.ini você tem uma configuração como esta :

Shell=Explorer.exe

Basta trocar por

Shell=Myprog.exe

Ou usando delphi

procedure Tform1.ChangeShell(String programa);
var ArquivoIni : Tinifile;
begin
try
ArquivoIni := Tinifile.Create('System.ini');
ArquivIni.WriteSection('Config','Shell','Myprog.exe');
fynally
ArquivoIni.Destroy;
end;

end;

Substituindo TAB pelo ENTER

procedure TF_Padrao.FormKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
if not (ActiveControl is TDBGrid) then
begin
Key := #0;
Perform(WM_NEXTDLGCTL, 0, 0);
end
else if (ActiveControl is TDBGrid) then
with TDBGrid(ActiveControl) do
if selectedindex < (fieldcount -1) then
selectedindex := selectedindex +1
else
selectedindex := 0;
end;

Ou então, pode-se tentar o seguinte método:

Utilize o evento onkeydown do componente e insira o seguinte comando:

if Key = VK_RETURN then Perform(Wm_NextDlgCtl,0,0);

este comando testa a tecla pressionada, se ela for um enter, manda o foco
para o componente posterior.

Copiando arquivos

CopyFile(Pchar(Origem),Pchar(Destino),false);

Onde Origem e' a variavel de que contem o nome do arquivo de origem
Destiono e' a variavel que contem o nome do arquivo destino
False : Instrui para sobrescrever o arquivo destino (caso encontre)

Criando tabela em tempo de execução

Use os metodos FieldDefs e CreateTable para isso. Veja como criar uma
estrutura temporaria:

with TTable.Create(Application) do begin
Active := False;
DatabaseName := 'C:\TEMP';
TableName := 'TESTE.TMP';
TableType := ttDefault;

FieldDefs.Add('CODCLI', ftString, 5, False);
FieldDefs.Add('NOMCLI', ftString, 40, False);
FieldDefs.Add('DATCAD', ftDate, 0, False);
CreateTable;
Free;
end;

Executar comandos do Dos

WinExec(PChar('command.com /c format a: /v ' +Edit1.Text),SW_SHOWNORMAL);

Armazendo BMP’s em arquivos RES

1. Criem um arquivo texto, por exemplo: RECURSOS.RC com um conteudo igual a este:

BITMAP_1 BITMAP "C:\Imagens\Grafico.bmp"

para todos os bitmap's que vc deseja;
2. Compilem este arquivo usando o BRCC32.EXE que esta no diretorio BIN do Delphi sera
gerado o arquivo RECURSOS.RES; e
3. Coloquem dentro do fonte do projeto:
{$R RECURSOS.RES}

Para usar o bitmap faca o seguinte:
VarTipoTBitmap:= LoadBitmap(HInstance,'BITMAP_1');

QR armazenado num Blop

Os campos do Tipo TBlobField, tem metodos que permitem que
sejam armazenados dados contidos em arquivos, ou em um Stream...
No primeiro caso (dos arquivos), o codigo seria algo como:

TBlobField(SuaTabela.FieldByName('SeuCampo')).LoadFromFile('NomedoArquivo');

No segundo caso, poderia ser feito um exemplo com o TRichEdit:

var
Stream : TMemoryStream;
begin
Stream := TMemoryStream.Create;
try
RichEdit1.Lines.SaveToStream(Stream);
Stream.Seek(0,soFromBeginning);
TBlobField(SuaTabela.FieldByName('SeuCampo')).LoadFromStream(Stream);
finally
Stream.Free;
end;
end;

Ambos os exemplos, assumem que a tabela ja' estaria em modo
de Edicao ou de Insercao.

Deletando um arquivo

if FileExists('C:\MEUDIR\MEUARQ.DAT') then DeleteFile('C:\MEUDIR\MEUARQ.DAT');

Diretório Windows e System

Function ExtractWindowsDir : String;
Var Buffer : Array[0..144] of Char;
Begin
GetWindowsDirectory(Buffer,144);
Result := FormatPath(StrPas(Buffer));
End;

Function ExtractSystemDir : String;
Var Buffer : Array[0..144] of Char;
Begin
GetSystemDirectory(Buffer,144);
Result := FormatPath(StrPas(Buffer));
End;

Function ExtractTempDir : String;
Var Buffer : Array[0..144] of Char;
Begin
GetTempPath(144,Buffer);
Result := FormatPath(StrPas(Buffer));
End;

Alterar papel de parede

procedure ChangeWallpaper(bitmap: string);

var pBitmap : pchar;

begin

bitmap:=bitmap+#0; {bitmap contém um arquivo *.bmp}

pBitmap:=@bitmap[1];

SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, pBitmap, SPIF_UPDATEINIFILE);

end;

Como fazer um “Hot Link”

Adicione um componente com o URL. Digite o seguinte código no seu evento OnClick:

procedure Tform1.URLLabelClick(Sender: TObject);

var TempString : array[0..79] of char;

begin

   StrPCopy(TempString,URLLabel.Caption);

   OpenObject(TempString);

end;

Insira a seguinte procedure logo após implementation:

procedure TTOKAboutBox.OpenObject(sObjectPath : PChar);

begin

 ShellExecute(0, Nil, sObjectPath, Nil, Nil, SW_NORMAL);

end;

Adicione “ShellAPI” no uses.

Como saber se o disquete está no drive.

function DiskInDrive(const Drive: char): Boolean;

var DrvNum: byte;

EMode: Word;

begin

 result := false;

 DrvNum := ord(Drive);

 if DrvNum >= ord('a') then dec(DrvNum,$20);

 EMode := SetErrorMode(SEM_FAILCRITICALERRORS);

 try

  if DiskSize(DrvNum-$40) <> -1 then result := true else messagebeep(0);

  finally SetErrorMode(EMode);

 end;

end;

Formatar disquete.

{implementation section}

....

const SHFMT_ID_DEFAULT = $FFFF;

// Formating options

SHFMT_OPT_QUICKFORMAT = $0000;

SHFMT_OPT_FULL = $0001;

SHFMT_OPT_SYSONLY = $0002;

// Error codes

SHFMT_ERROR = $FFFFFFFF;

SHFMT_CANCEL = $FFFFFFFE;

SHFMT_NOFORMAT = $FFFFFFFD;

function SHFormatDrive(Handle: HWND; Drive, ID, Options: Word): LongInt; stdcall; external 'shell32.dll' name 'SHFormatDrive'

procedure TForm1.btnFormatDiskClick(Sender: TObject);

var

 retCode: LongInt;

begin

 retCode:= SHFormatDrive(Handle, 0, SHFMT_ID_DEFAULT, SHFMT_OPT_QUICKFORMAT);

 if retCode < 0 then ShowMessage('Could not format drive');

end;

Como detectar as teclas de “seta”.

Use os eventos KeyDown ou KeyUp e teste se Key = VK_LEFT ou VK_RIGHT, etc.

Caps Lock 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.

BDE em 1 disqiete

Depois que apanhei bastente do BDE, recorri a lista e ninguem consegui
me ajudar ... consegui resolver o problema. E como acredito que outras
pessoas tenham o mesmo problema, resolvi colocar essa dica na lista.
Por favor, se alguem tiver algo a acresentar ou mesmo corrigir,
sinta-se a vontade para compartilhar conosco.


Arquivos Exenciais para o BDE:
EUROPE.BLL
USA.BLL
IDR20009.DLL
IDAPI32.DLL
BLW32.DLL
IDAPI32.CFG <--- esse arquivo pode ter qualquer outro nome, desde que
seja configurado no registro.

Drivers de Banco de Dados:
IDPDX32.DLL <--- Driver Paradox
IDASCI32.DLL <--- Driver ASCII
IDDBAS32.DLL <--- Driver DBase
IDODBC32.DLL <--- Driver ODBC

O BDE precisa de pelo menos um Driver de Banco de Dados para funcionar.
Esses acima sao apenas alguns, existem varios outros.

O BDE 4.51 + Driver Paradox compactados com o Algoritimo ZIP, ocuparam
aproximadamente 650 Kb.

Entradas no Registro do Win95:
HKEY_LOCAL_MACHINE
SOFTWARE\Borland\Database Engine
DLLPATH -> localizacao do BDE (Unidade+Caminho Completo)
CONFIGFILE01 -> localizacao do arquivo de configuracao (Unidade+Caminho
Completo+Nome do Arquivo)
SOFTWARE\Borland\BLW32
BLAPIPATH -> localizacao do BDE (Unidade+Caminho Completo)
LOCALE_LIB1 -> localizacao do arquivo USA.BLL (Unidade+Caminho
Completo+USA.BLL)
LOCALE_LIB2 -> localizacao do arquivo EUROPE.BLL (Unidade+Caminho
Completo+EUROPE.BLL)


Segue um pequeno exemplo de como registrar o BDE no Registro do Win95:

begin
Registry.RootKey := HKEY_LOCAL_MACHINE;
Registry.CreateKey('SOFTWARE\Borland\Database Engine');
Registry.OpenKey('SOFTWARE\Borland\Database Engine', False);
Registry.WriteString('DLLPATH', 'C:\ARQUIVOS DE PROGRAMAS\BDE\');
Registry.WriteString('CONFIGFILE1', 'C:\ARQUIVOS DE
PROGRAMAS\BDE\IDAPI32.CFG');
Registry.OpenKey('\', False);
Registry.CreateKey('SOFTWARE\Borland\BLW32');
Registry.OpenKey('SOFTWARE\Borland\BLW32', False);
Registry.WriteString('BLAPIPATH', 'C:\ARQUIVOS DE PROGRAMAS\BDE\');
Registry.WriteString('LOCALE_LIB1', 'C:\ARQUIVOS DE
PROGRAMAS\BDE\USA.BLL');
Registry.WriteString('LOCALE_LIB2', 'C:\ARQUIVOS DE
PROGRAMAS\BDE\EUROPE.BLL');
end;

Para compilar esse codigo, sera necessario declarar a Unit Registry.
Como eu disse, esse e um exemplo bem simples. Ele nem mesmo verifica se
o BDE ja esta registrado ou não.
Para criar o Alias atravez do seu instalador, voce pode usar a funcao
da api do BDE chamada DbiAddAlias.

Cor de fundo do hint

Veja as propriedades dp TApplication...

Application.HintColor := clAqua;
Application.HintPause := ...
Application.HintShortPause := ...

Margem para RichText

Se for um richedit e margens laterais(direita e esquerda) tenta

RichEdit1.Paragraph.FirstIndent -> Paragrafo
RichEdit1.Paragraph.LeftIndent -> margem esquerda
RichEdit1.Paragraph.RightIndent -> margem direita

Mostrando progresso de uma SQL

Algumas pessoas estavam interessadas em saber como apresentar o progresso
de um TQuery enquanta ele esta sendo aberto (ou executada, no caso de um
INSERT / UPDATE / DELETE).

A tecnica que vou demostrar nao apenas serve para o proposito procurado,
mas tambem serve para mostrar o progresso de diversas outras atividades que
o BDE executa, como:

* Criacao de tabelas
* Criacao de indices para tabelas
* Reestruturacao de tabelas
* Execucao de queries (ja comentado)
* alguma outra coisa que no momento nao me ocorre... :))


Importante:

1) No meu exemplo, estou usando o Delphi 3.02. Caso seu Delphi seja de
uma versao menor, vc devera ter um trabalho extra para repor a classe
TBDECallback. Acredito que seja possivel fazer uma rotina que funcione em
Delphi 1, mas que com certeza dara um certo trabalhinho, ah, isso dara...
:-/

2) Ate agora so usei esse codigo com tabelas Paradox, mas realmente
acredito que ele venha a funcionar com base de dados Interbase, Oracle,
etc...

3) Nao sei se com o uso do Opus, Apollo ou qualquer outro substituto do
BDE a tecnica ira funcionar, uma vez que nao se estaria trabalhando com o
BDE original. Talvez alguem da lista possa dar essa informacao.


Teoria
=====

Segundo o help do Delphi, "o TBDECallback eh um wrapper para uma funcao
de callback do BDE. Com ele eh possivel instruir o BDE para que o mesmo
execute algumas tarefas em resposta a eventos que ocorram durante uma
chamada de uma funcao do BDE. " - Fim do plagio do arquivo de help.


O tipo de callback depende de um parametro CBType que eh fornecido no
momento da criacao do TBDECallback. E, entre os diversos valores que o
CBType pode apresentar, existe um que muito nos interessa; o cbGENPROGRESS.
:))

Assim, vc deveria criar uma funcao de callback do tipo cbGENPROGRESS
chamada AtualizaGauge e indicar que a mesma eh que devera ser executada
"entre cada respiracao" do BDE. Na rotina AtualizaGauge, o BDE iria te
informar o percentual de progresso da tarefa .
O que voce faria nessa rotina ? Simples... atualizar o Gauge / ProgressBar.


Tudo muito bonito, tudo muito comovente, mas agora vamos para o lado
pratico...


Pratica
======

Para que o BDE possa informar o progresso da tarefa, ele precisa obter
essa informacao da base de dados que esta sendo utilizada. Acontece que,
por razoes diferentes, nem sempre ele eh capaz de saber o PERCENTUAL da
tarefa. Numa copia de registros de uma tabela para outra, ele pode saber
que ja foram copiados 270 registros, mas nao saber que esse esforco
representa 36 % de todos os registros que serao copiados.

Assim sendo, na funcao de callback que sera criada, receberemos um
parametro do tipo pCBPROGRESSDesc, que por sua vez eh um ponteiro para uma
estrutura que contem duas informacoes:

iPercentDone => percentual do servico realizado
szMsg => texto descrevendo o progresso do servico.

Como usar esses parametros ? Simples: sempre que o iPercentDone for
negativo, voce devera considerar o texto descrito no campo szMsg. Se for
igual ou maior que zero, entao vc devera considerar o valor do proprio
iPercentDone.

Uma boa noticia para quem se preocupa com as mensagens que aparecem em
ingles, quando se quer na verdade mostra-las em portugues: a mensagem
fornecida por szMsg devera sempre aparecer no formato <mensagem><:><valor>
.....
Exemplo:

Records copied: 170

Assim, voce pode procurar pelos dois pontos ":" e pegar o valor que vem a
seguir para montar sua propria informacao em portugues.


Pessoalmente, ate agora nunca obtive um iPercentDone positivo. Li no
newsgroup da Borland que poucas bases de dados eram capazes de informar o
real percentual para o BDE. Se nao me engano, o Sybase era um deles... NAO
ESTOU CERTO DISSO.




Vamos para um exemplo pratico ? Crie um projeto novo, e coloque um:
TQuery, TButton, TProgressBar e TLabel.
Sua query deve ser montada para abrir uma tabela razoavelmente grande, de
modo que a operacao de abertura demore um pouco.

Agora vamos aos codigos:


1) Acrescente a unit BDE no seu USES da unit.

2) Acrescente algumas declaracoes na declaracao do seu Form:
==============================
type
TForm1 = class(TForm)
... (bla bla bla)
private
{ Private declarations }
FCBPROGRESSDesc: pCBPROGRESSDesc;
FProgressCallback: TBDECallback;
function GetDataCallback(CBInfo: Pointer): CBRType;
public
{ Public declarations }
end;
==============================


No evento OnCreate do seu Form:
==============================
procedure TForm1.FormCreate(Sender: TObject);
begin
FCBPROGRESSDesc := AllocMem(SizeOf(CBPROGRESSDesc));
FProgressCallback := TBDECallback.Create(Self, Query1.Handle,
cbGENPROGRESS, FCBPROGRESSDesc, SizeOf(CBPROGRESSDesc),
GetDataCallback, True);
end;
==============================

Percebam que no segundo parametro do Create do callback, eu coloquei
Query1.Handle.
Caso voce queira usar isso numa TTable, coloque Table1.Handle.
E se quiser que essa funcao de callback seja chamada para todos os
"progressos" de qualquer componente DataSet, voce deixa esse parametro como
NIL.



No evento OnDestroy do Form:
==============================
procedure TForm1.FormDestroy(Sender: TObject);
begin
FProgressCallback.Free;
FreeMem(FCBPROGRESSDesc, SizeOf(CBPROGRESSDesc));
end;
==============================


E agora, a tao falada funcao de callback:
==============================
function TForm1.GetDataCallback(CBInfo: Pointer): CBRType;
begin
Result := cbrCONTINUE;
with pCBPROGRESSDesc(CBInfo)^ do
begin
if iPercentDone < 0 then
begin
Label1.Caption := szMsg;
Label1.Refresh;
ProgressBar1.StepIt; {Apenas para ficar rodando o gauge}
end
else
ProgressBar1.Position := iPercentDone;
end;
end;
==============================


Agora eh so executar a query no clicar do botao e curtir o visual... :))


IMPORTANTE !!!!!!

Caso voce receba uma mensagem de erro informando que nao foi possivel
inicializar o BDE (o que provavelmente acontecera, pois voce esta criando
uma funcao de callback do BDE, quando ate entao nenhuma tabela havia sido
aberta), va no DPR do seu projeto (Menu View -> Project Source) e faca o
seguinte:

1) Acrescente a unit BDE no uses do projeto.
2) Acrescente a instrucao

DbiInit(nil);

apos a instrucao Application.Initialize;

Isso deve resolver o problema.

Bom, nao vou me alongar mais, porque senao essa mensagem vai ficar maior do
que ja esta...
Espero que tenha contribuido para a solucao desse problema de mostar
progresso de uma query. Qualquer duvida mandem mensagem.

Mudar de cor a linha do dbGrid

procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect;
Field: TField; State: TGridDrawState);
begin
if Table1.FieldByName('Pagou').Value = True then
DBGrid1.Canvas.Brush.Color := clGreen
else
DBGrid1.Canvas.Brush.Color := clRed;
DBGrid1.Canvas.FillRect(Rect);
DBGrid1.DefaultDrawDataCell(Rect,Field,State);
end;

Código usados pelas impressoaras HP

Veja abaixo alguns códigos usados pelas impressoras HP:

RESET = 027/069
BOLD1 = 027/040/115/051/066
BOLD0 = 027/040/115/048/066
ITALIC1 = 027/040/115/049/083
ITALIC0 = 027/040/115/048/083
UNDERLINE1 = 027/038/100/049/068
UNDERLINE0 = 027/038/100/064
LPI6 = 027/038/108/054/068
LPI8 = 027/038/108/056/068
CPI5 = 027/040/115/053/072
CPI6 = 027/040/115/054/072
CPI8 = 027/040/115/056/072
CPI10 = 027/040/115/049/048/072
CPI12 = 027/040/115/049/050/072
CPI17 = 027/040/115/049/054/046/054/055/072
CPI20 = 027/040/115/050/048/072

Verificando atributo do arquivo