[Delphi] Biblioteca De Tutorias

[Surfistinha£ 20]

Indice

Mac Address do adaptador de rede

 

Escrever no Bloco de Notas

 

Captions no DBNavigator

 

Arredondamento financeiro

 

Calcular idade (em anos completos)

 

DBGrid zebrado

 

Consultar por mês de um campo data

 

Mudar a cor do Edit ao receber o foco

 

Selecionar um item no ListView

 

Alinhar ao centro e à direita em StringGrid

 

Copiar o texto do Edit para o Clipboard

 

Mostrar bitmap progressivamente

 

Converter JPeg para Bitmap

 

Converter Bitmap para JPeg

 

Colocar arquivo como recurso dentro do EXE

 

Pintar bitmap no DBGrid

 

Pintar um Bitmap diretamente no Canvas do Form

 

Mostrar o nome do EXE no caption do form

 

Obter tipo de uma propriedade

 

Pintar uma imagem JPG no form

 

Executar comando do MS-DOS

 

Formatar CEP

 

Permitir cancelar processo demorado

 

Descobrir se uma data é fim do mês

 

Obter o tipo de dado de um valor no Registro do Windows

 

Limpar todas as células de um StringGrid

 

Programar meu aplicativo para abrir arquivos a partir do Windows Explorer

 

Ocultar aplicação da lista de tarefas - CTRL+ALT+DEL

 

Desligar/Ligar monitor

 

Mostrar mensagem mesmo que esteja no Prompt do DOS

 

Implementar procedure Delay do Pascal no Delphi

 

Criar uma DLL de Bitmaps e usá-la

 

Obter status da memória do sistema

 

Mostrar o diálogo About (Sobre) do Windows

 

Converter de Hexadecimal para Inteiro

 

Colocar uma ProgressBar na StatusBar

 

Configurar linhas de diferentes alturas em StringGrid

 

Adicionar o evento OnClick do DBGrid

 

Converter a primeira letra de um Edit para maiúsculo

 

Verificar se uma string contém uma hora válida

 

Verificar se uma string contém um valor numérico válido

 

Mostrar uma mensagem durante um processamento

 

Mostrar um cursor de ampulheta durante um processamento

 

Ler e escrever dados binários no Registro do Windows

 

Mudar a resolução do vídeo via programação

 

Adicionar barra de rolagem horizontal no ListBox

 

Adicionar zeros à esquerda de um número

 

Obter a versão da biblioteca ComCtl32.DLL (usada na unit ComCtrls do Delphi)

 

Implementar rotinas assembly em Pascal

 

Exibir o diálogo About do Windows

 

Obter a linha e coluna atual em um TMemo

 

Exibir um arquivo de ajuda do Windows

 

Obter o valor de uma variável de ambiente

 

Fechar um aplicativo com uma mensagem de erro fatal

 

Criar um EXE que seja executado apenas através de outro EXE criado por mim

 

Truncar valores reais para n casas decimais

 

Saber se o sistema está usando 4 dígitos para o ano

 

Obter o nome do usuário e da empresa informado durante a instalação do Windows

 

Evitar que seu programa apareça na barra de tarefas

 

Carregar um cursor animado (.ani)

 

Executar um programa DOS e fechá-lo em seguida

 

Fechar um programa a partir de um programa Delphi

 

Colocar Hint's de várias linhas

 

Separar (filtrar) caracteres de uma string

 

Colocar zeros à esquerda de números

 

Trabalhar com cores no formato string

 

Verificar se determinado programa está em execução (Word, Delphi, etc)

 

Gerar uma tabela no Word através do Delphi

 

Evitar que um programa seja executado mais de uma vez

 

Saber a resolução de tela atual

 

Saber a resolução de tela atual

 

O objeto Screen contém várias informações importantes: largura e altura da tela, fontes instaladas no Windows, etc.

 

Onde encontrar tutoriais sobre construção de componentes em Delphi

 

Para que servem OnGetEditMask, OnGetEditText e OnSetEditText do TStringGrid

 

Descobrir o nome de classe de uma janela do Windows

 

Ocultar/exibir a barra de tarefas do Windows

 

Evitar a proteção de tela durante seu programa

 

Criar cores personalizadas (sistema RGB)

 

Adicionar uma nova fonte no Windows

 

Saber se determinada Font está instalada no Windows

 

Acertar a data e hora do sistema através do programa

 

Paralizar um programa durante n segundos

 

Criar um Alias através do seu programa

 

Incio

Mac Address do adaptador de rede

 

 

A função abaixo retorna o Mac Address do adaptador de rede:

function MacAddress: string;

var

Lib: Cardinal;

Func: function(GUID: PGUID): Longint; stdcall;

GUID1, GUID2: TGUID;

begin

Result := '';

Lib := LoadLibrary('rpcrt4.dll');

if Lib <> 0 then

begin

@Func := GetProcAddress(Lib, 'UuidCreateSequential');

if Assigned(Func) then

begin

if (Func(@GUID1) = 0) and

(Func(@GUID2) = 0) and

(GUID1.D4[2] = GUID2.D4[2]) and

(GUID1.D4[3] = GUID2.D4[3]) and

(GUID1.D4[4] = GUID2.D4[4]) and

(GUID1.D4[5] = GUID2.D4[5]) and

(GUID1.D4[6] = GUID2.D4[6]) and

(GUID1.D4[7] = GUID2.D4[7]) then

begin

Result :=

IntToHex(GUID1.D4[2], 2) + '-' +

IntToHex(GUID1.D4[3], 2) + '-' +

IntToHex(GUID1.D4[4], 2) + '-' +

IntToHex(GUID1.D4[5], 2) + '-' +

IntToHex(GUID1.D4[6], 2) + '-' +

IntToHex(GUID1.D4[7], 2);

end;

end;

end;

end;

Início

Escrever no Bloco de Notas

 

Problema:

 

Gostaria verificar se o bloco de notas está aberto e, caso esteja, escrever um texto a partir de um programa feito em Delphi. Isto é possível?

 

Solução:

 

Sim, isto é possível. O código abaixo escreve o conteúdo de uma variável no Bloco de Notas caso ele esteja aberto no momento do Click em Button1:

procedure TForm1.Button1Click(Sender: TObject);

var

JanelaPrincipal, JanelaFilha: THandle;

I: integer;

Texto: string;

begin

Texto := 'Daniel';

JanelaPrincipal := FindWindow('Notepad', nil);

if JanelaPrincipal > 0 then

begin

JanelaFilha := FindWindowEx(JanelaPrincipal, 0, 'Edit', nil);

if JanelaFilha > 0 then

begin

for I := 1 to Length(Texto) do

PostMessage(JanelaFilha, WM_CHAR, Ord(Texto), 0);

end;

end;

end;

Observações:

 

Uma alternativa mais interessante seria abrir o Bloco de Notas caso ele ainda não esteja aberto. Mas vou deixar este problema como exercício de fixação.

 

 

Início

Captions no DBNavigator

Por padrão, o DBNavigator não possui uma propriedade para especificar os captions dos botões, mas isto pode ser resolvido com o código abaixo:

type

TMeuDBNavigator = class(TDBNavigator);

 

procedure TForm1.FormCreate(Sender: TObject);

const

Legendas: array[TNavigateBtn] of string = (

'Primeiro', 'Anterior', 'Próximo', 'Último',

'Incluir', 'Excluir', 'Editar', 'Salvar',

'Cancelar', 'Atualizar');

var

Botao: TNavigateBtn;

begin

for Botao := nbFirst to nbRefresh do

begin

with TMeuDBNavigator(DBNavigator1).Buttons[botao] do

begin

Caption := Legendas[botao];

Layout := blGlyphTop;

end;

end;

end;

Início

Arredondamento financeiro

É muito comum encontrar programadores Delphi que têm dúvidas sobre como arredondar um valor real para "n" casas após o separador decimal. A princípio parece um problema simples, pois o próprio Delphi já possui uma função que arredonda para o inteiro mais próximo, a qual poderia facilmente ser utilizada para arredondar para qualquer quantidade de casas decimais. Exemplo:

{ x receberá o valor de y arredondado para 2 casas após o separador. }

x := Round(y * 100) / 100;

 

{ z receberá o valor de y arredondado para 3 casas após o separador. }

z := Round(y * 1000) / 1000;

No entanto dois problemas poderão aparecer com os exemplos acima:

 

* O arredondamento feito pelo Delphi difere daquele feito pelas calculadores financeiras, bem como bancos de dados como InterBase e FireBird.

* poderão ocorrer pequenos arredondamentos devido ao modo como o Delphi trata números reais, tais como aparecer 3.9999999... em vez de 4.

 

A função abaixo resolve estes dois problemas.

{ Esta função faz arredondamento de valores reais para "n" casas

decimais após o separador decimal, seguindo os critérios das

calculadoras financeiras e dos bancos de dados InterBase e FireBird.

}

function TBRound(Value: Extended; Decimals: integer): Extended;

var

Factor, Fraction: Extended;

begin

Factor := IntPower(10, Decimals);

{ A conversão para string e depois para float evita

erros de arredondamentos indesejáveis. }

Value := StrToFloat(FloatToStr(Value * Factor));

Result := Int(Value);

Fraction := Frac(Value);

if Fraction >= 0.5 then

Result := Result + 1

else if Fraction <= -0.5 then

Result := Result - 1;

Result := Result / Factor;

end;

Início

Calcular idade (em anos completos)

A função abaixo calcula o número de anos completos entre duas datas. É ideal para calcular idades de pessoas, por exemplo.

function CalcAnos(const Data1, Data2: TDateTime): integer;

var

D1, M1, A1,

D2, M2, A2: Word;

begin

DecodeDate(Data1, A1, M1, D1);

DecodeDate(Data2, A2, M2, D2);

 

Result := A2 - A1;

 

if (M1 > M2) or ((M1 = M2) and (D1 > D2)) then

Dec(Result);

end;

Exemplo de uso:

 

* Coloque um Edit (TEdit) para digitar a data de nascimento.

* Coloque um botão (TButton).

* Coloque o código a seguir no evento OnClick do botão:

var

DataNasc: TDateTime;

begin

DataNasc := StrToDate(Edit1.Text);

ShowMessage(IntToStr(CalcAnos(DataNasc, Date)) + ' anos');

end;

Início

DBGrid zebrado

 

Programe o evento OnDrawColumnCell do DBGrid como abaixo:

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject;

const Rect: TRect; DataCol: Integer; Column: TColumn;

State: TGridDrawState);

begin

if State = [] then

begin

if Table1.RecNo mod 2 = 1 then

DBGrid1.Canvas.Brush.Color := clAqua

else

DBGrid1.Canvas.Brush.Color := clWhite;

end;

DBGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, State);

end;

Observação:

 

O objeto Table1 é da classe TTable (relativa ao BDE), mas esta dica poderá ser usada com outros DataSet's, tais como IBDataSet, ClientDataSet, etc.

Início

Consultar por mês de um campo data

Problema:

 

Tenho um cadastro de clientes com Codigo, Nome, DataNasc, etc.

Preciso fazer uma consulta onde apareceão apenas os clientes

que fazem aniversário em determinado mês. Como fazer?

 

Solução:

 

Use uma Query como abaixo:

- Coloque no form os seguintes componentes:

* TQuery

* TDataSource

* TDBGrid

* TEdit

* TButton

 

- Altere as propriedades dos componentes como abaixo:

* Query1.DatabaseName = (alias do BDE)

* DataSource1.DataSet = Query1

* DBGrid1.DataSource = DataSource1

 

- Coloque o código abaixo no evento OnClick de Button1:

Query1.Close;

Query1.SQL.Clear;

Query1.SQL.Add('select * from dCli');

Query1.SQL.Add('where extract(month from DataNasc) = :Mes');

Query1.ParamByName('Mes').AsInteger := StrToInt(Edit1.Text);

Query1.Open;

- Execute. Digite um número de 1 a 12 no Edit e clique no

botão.

 

 

Observações

 

Os números de 1 a 12 representam, respectivamente, os meses de Janeiro a Dezembro. Este exemplo foi testado com Delphi4, BDE5 e tabela Paradox7.

[/b]

Início

Mudar a cor do Edit ao receber o foco

Alguns programas mostram o Edit que está com o foco em uma

cor diferente dos demais. Como fazer isto em Delphi?

 

Na seção private do form declare o procedimento abaixo:

private

procedure MudancaDeFoco(Sender: TObject);

public

end;

Na seção implementation, escreva o código do procedimento:

{ Esta rotina será chamada através do evento OnExit (perda do foco)

de todos os componentes do tipo TEdit que existirem no form. }

procedure TForm1.MudancaDeFoco(Sender: TObject);

var

I: integer;

Ed: TEdit;

begin

{ Percorre a matriz de componentes do form }

for I := 0 to ComponentCount - 1 do

{ Se o componente é do tipo TEdit... }

if Components is TEdit then

begin

{ Faz um type-casting pata o tipo TEdit }

Ed := Components as TEdit;

 

{ Se o Edit está com o foco... }

if Ed.Focused then

Ed.Color := clYellow { Amarelo }

else

Ed.Color := clWhite; { Branco }

end;

end;

No evento OnCreate do Form, coloque o código abaixo:

procedure TForm1.FormCreate(Sender: TObject);

var

I: integer;

begin

{ Percorre a lista de componentes do form (matriz de componentes)

e verifica cada componente para saber se é um TEdit. Se for,

associa o evento OnExit do componente com a procedure

"MudancaDeFoco". }

for I := 0 to ComponentCount - 1 do

if Components is TEdit then

(Components as TEdit).OnExit := MudancaDeFoco;

end;

No evento OnActivate coloque:

procedure TForm1.FormActivate(Sender: TObject);

begin

{ Esta chamada é necessária para que o estado inicial seja

controlado. }

MudancaDeFoco(nil);

end;

Observações

 

Existem outras técnicas mais profissionais para resolver o problema proposto. Uma alternativa excelente é a criação de um novo componente herdado da classe TEdit (ou TCustomEdit) que implemente a mudança de cor no método DoEnter e DoExit.

 

 

Início

Selecionar um item no ListView

 

 

Para selecionar um item no ListView via programação use

o código abaixo.

{ Manda o foco para o ListView }

ListView1.SetFocus;

{ Seleciona o quarto item }

ListView1.Items.Item[3].Selected := true;

{ Manda o foco para o quarto item }

ListView1.Items.Item[3].Focused := true;

Observações

 

Um procedimento semelhante pode ser usado com o TreeView.

 

Início

Alinhar ao centro e à direita em StringGrid

 

1. Coloque no formulário um componente TStringGrid.

2. No evento OnCreate do formulário escreva:

 

procedure TForm1.FormCreate(Sender: TObject);

begin

{ Número de linhas }

StringGrid1.RowCount := 5;

{ Número de colunas }

StringGrid1.ColCount := 3;

{ Linhas fixas }

StringGrid1.FixedRows := 1;

{ Colunas fixas }

StringGrid1.FixedCols := 0;

{ Largura padrao das colunas (em pontos) }

StringGrid1.DefaultColWidth := 80;

{ Permite editar }

StringGrid1.Options :=

StringGrid1.Options + [goEditing];

{ Cabeçalho }

StringGrid1.Cells[0,0] := 'Esquerda';

StringGrid1.Cells[1,0] := 'Centro';

StringGrid1.Cells[2,0] := 'Direita';

end;

3. No evento OnDrawCell do StringGrid escreva:

var

LarguraTexto, AlturaTexto, X, Y: integer;

Texto: string;

begin

{ Pega o texto da célula }

Texto := StringGrid1.Cells[ACol, ARow];

 

{ Calcura largura e altura (em pontos) do texto }

LarguraTexto := StringGrid1.Canvas.TextWidth(Texto);

AlturaTexto := StringGrid1.Canvas.TextHeight(Texto);

 

{ Calcula a posição horizontal do início do texto }

if ACol = 0 then { Esquerda }

X := Rect.Left + 2

else if ACol = 1 then { Centro }

X := Rect.Left + (Rect.Right - Rect.Left) div 2 -

LarguraTexto div 2

else { Direita }

X := Rect.Right - LarguraTexto - 2;

 

{ Calcula a posição vertical do início do texto para

que seja impresso no centro (verticalmente) da célula }

Y := Rect.Top + (Rect.Bottom - Rect.Top) div 2 -

AlturaTexto div 2;

 

{ Pinta o texto }

StringGrid1.Canvas.TextRect(Rect, X, Y, Texto);

end;

Observações

 

Uma técnica semelhante a esta pode ser usada para pintar figuras nas células do StringGrid.

Início

Copiar o texto do Edit para o Clipboard

 

O próprio componente TEdit possui um método para copiar o texto

para a área de transferência (clipboard). No entanto este

método copia apenas o texto selecionado, de forma que temos

que chamar o método SelectAll() antes de chamar

CopyToClipboard().

 

Veja o exemplo:

procedure TForm1.Button1Click(Sender: TObject);

begin

Edit1.SelectAll;

Edit1.CopyToClipboard;

end;

Observações

 

Outros componentes, tais como TMemo, possuem também este método.

 

Início

Mostrar bitmap progressivamente

 

Inclua na seção uses: Graphics

Esta é uma boa dica para quem eseja fazer aplicativos para exibir fotografias.

 

1. Coloque no form um TButton e um PaintBox.

2. No evento OnClick do Button escreva:

procedure TForm1.Button1Click(Sender: TObject);

var

I, J: integer;

R: TRect;

Bmp: TBitmap;

begin

Bmp := TBitmap.Create;

try

Bmp.LoadFromFile('c:\teste\imagem.bmp');

 

PaintBox1.ClientWidth := Bmp.Width;

PaintBox1.ClientHeight := Bmp.Height;

PaintBox1.Canvas.FillRect(PaintBox1.ClientRect);

 

R.Left := 0;

R.Right := Bmp.Width -1;

 

for I := 1 to 10 do begin

J := I - 1;

while J < (Bmp.Height -1) do begin

R.Top := J;

R.Bottom := J+1;

PaintBox1.Canvas.CopyRect(R, Bmp.Canvas, R);

J := J + 10;

end;

Sleep(50);

end;

finally

Bmp.Free;

end;

end;

Observações

 

Esta dica é só uma idéia inicial, mas com um pouco de criatividade o programador poderá criar outros efeitos mais interessantes.

Início

Converter JPeg para Bitmap

Inclua na seção uses: Graphics, JPeg

 

O procedimento abaixo converte um arquivo de imagem JPeg

para Bitmap. O arquivo Bitmap terá o mesmo nome do arquivo JPeg, mas com a extensão bmp.

procedure ConverterJPegParaBmp(Arquivo: string);

var

JPeg: TJPegImage;

Bmp: TBitmap;

begin

JPeg := TJPegImage.Create;

try

JPeg.LoadFromFile(Arquivo);

Bmp := TBitmap.Create;

try

Bmp.Assign(JPeg);

Bmp.SaveToFile(ChangeFileExt(Arquivo, '.bmp'));

finally

Bmp.Free;

end;

finally

JPeg.Free;

end;

end;

Exemplo de uso:

ConverterJPegParaBmp('c:\diretorio\arquivo.jpg');

Início

Converter Bitmap para JPeg

Inclua na seção uses: Graphics, JPeg

 

O procedimento abaixo converte um arquivo de imagem Bitmap

para JPeg. O arquivo JPeg terá o mesmo nome do arquivo Bitmap,

mas com a extensão jpg.

procedure ConverterBmpParaJPeg(Arquivo: string);

var

Bmp: TBitmap;

JPeg: TJPegImage;

begin

Bmp := TBitmap.Create;

try

Bmp.LoadFromFile(Arquivo);

JPeg := TJPegImage.Create;

try

JPeg.CompressionQuality := 100; { Qualidade: 100% }

JPeg.Assign(Bmp);

JPeg.SaveToFile(ChangeFileExt(Arquivo, '.jpg'));

finally

JPeg.Free;

end;

finally

Bmp.Free;

end;

end;

Exemplo de uso:

 

ConverterBmpParaJPeg('c:\diretorio\arquivo.bmp');

Observações

 

Veja que usei neste exemplo 100% de qualidade para a imagem JPeg. Isto faz com que o arquivo fique grande. Se preferir pode usar uma qualidade inferior, mas lembre-se que a aparência da imagem será prejudicada.

Início

Colocar arquivo como recurso dentro do EXE

Inclua na seção uses: Classes

 

Existem alguns casos em que precisamos levar para a máquina

do usuário, além do EXE, alguns arquivos sem os quais nossa

aplicação teria problema. Normalmente estes casos incluem:

 

- arquivos com imagem (bmp, jpeg, gif, etc);

- arquivos de fontes (TTF);

- bibliotecas (dll);

- e outros.

 

A partir desta dica você saberá como incluir tais arquivos

dentro do próprio EXE. Dentro do EXE podemos colocar qualquer

tipo de arquivo que se comportará como um recurso. Vamos aos

passos.

 

1. Crie um arquivo texto com o nome ARQ_RECURSO.** e escreva

neste arquivo a linha abaixo:

 

NOME_DO_RECURSO RCDATA "c:\diretorio\arquivo.ext"

 

2. Compile este arquivo de recurso com o programa BRCC32.EXE:

 

BRCC32 ARQ_RECURSO.**

 

3. Confira se foi criado um arquivo chamado ARQ_RECURSO.RES.

4. Abra um novo projeto no Delphi.

5. Salve o projeto no mesmo diretório de ARQ_RECURSO.RES.

5. Escreve a linha abaixo após a palavra implementation

 

{$R ARQ_RECURSO.RES}

 

6. Escreva o evento OnCreate do form como abaixo:

procedure TForm1.FormCreate(Sender: TObject);

var

Stream: TResourceStream;

begin

Stream := TResourceStream.Create(hInstance,

'NOME_DO_RECURSO', RT_RCDATA);

try

Stream.SaveToFile('c:\diretorio\arquivo_extraido.ext');

finally

Stream.Free;

end;

end;

Pronto! Muito fácil! Vamos agora entender os passos citados.

 

Primeiro criamos um script (arquivo .**) para gerar o arquivo

de recurso (.res). No script informamos o nome do recurso,

o tipo e o conteúdo. O conteúdo, neste caso, foi o arquivo

"c:\diretorio\arquivo.ext".

 

Depois compilamos o script com o compilador de recursos da

Borland (BRCC32.EXE). Este processo gerou o arquivo

ARQ_RECURSO.RES.

 

A seguir colocamos no código-fonte uma instrução para que

o compilador do Delphi incluísse o arquivo de recurso (.res) no

executável - {$R ARQ_RECURSO.RES}.

 

No evento OnCreate do form acessamos o recurso como um Stream

e o salvamos em arquivo no disco.

 

 

Observações

 

Para incluir um arquivo de fonte no EXE e instalar a fonte na máquina do usuário na primeira vez que o programa for executado, combine este dica com a dica número 12.

Início

Pintar bitmap no DBGrid

Embora pareça complicada, esta tarefa é muito simples.

O Delphi nos permite controlar totalmente o desenho de cada

célula do DBGrid através do evento OnDrawColumnCell. O que

precisamos fazer neste evento é:

 

1. Verificar o estado da célula (fixa, selecionada, etc).

2. Verificar se é a coluna do campo da imagem.

3. Criar um objeto bitmap.

4. Copiar o conteúdo do campo da imagem para o bitmap.

5. Desenhar o bitmap na célula do DBGrid.

6. Destruir o bitmap.

 

Agora que já conhecemos os passos, vamos ao exemplo:

 

1. Coloque um TTable e ligue ao Alias DBDEMOS e à tabela

animals.dbf.

2. Coloque um TDataSource e ligue-o ao Table1.

3. Coloque um DBGrid e ligue-o ao DataSource1.

3. Mude Table1.Active para true.

4. No evento OnDrawColumnCell escreva o código abaixo:

procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject;

const Rect: TRect; DataCol: Integer; Column: TColumn;

State: TGridDrawState);

var

Bmp: TBitmap;

begin

if (not (gdFixed in State)) and

(UpperCase(Column.FieldName) = 'BMP') then

begin

Bmp := TBitmap.Create;

try

Bmp.Assign(Table1.FieldByName('Bmp'));

DBGrid1.Canvas.StretchDraw(Rect, Bmp);

finally

Bmp.Free;

end;

end;

end;

Conforme eu disse no início, é muito simples!

 

 

Observações

 

Neste exemplo usei o mínimo possível de código. Para obtermos um visual melhor poderíamos, por exemplo, deixar uma margem em torno da imagem. Não é difícil, mas vou deixar como desafio aos interessados.

Início

Pintar um Bitmap diretamente no Canvas do Form

- Declare a variavel Bmp na seção private:

private

Bmp: TBitmap;

- Coloque um botão no Form e no evento OnClick digite:

Bmp:= TBitMap.Create;

try

Bmp.LoadFromFile('c:\teste\arquivo.bmp');

Canvas.Draw(0,0, Bmp);

finally

Bmp.Free;

end;

Pronto! Irá aparecer a imagem no Canvas. É útil para fazer

animações.

 

Dica enviada por: Alisson Viana Jardim

Revisada por: Daniel Pereira Guimarães

 

Início

Mostrar o nome do EXE no caption do form

 

{ Esta função extrai apenas o nome do arquivo passado,

sem path e extensão }

function Titulo(Nome: String): String;

var

N, D: String;

begin

N := ExtractFileName(Nome); { Retira o path }

D := ChangeFileExt(N,''); { Retira a extensão }

 

{ Coloca a primeira letra em maiúscula e o resto

em minúscula }

Titulo := UpperCase(Copy(D,1,1)) +

LowerCase(Copy(D,2,Length(D)-1));

end;

 

{ No OnCreate do form, coloque: }

 

procedure TForm1.FormCreate(Sender: TObject);

begin

Caption := Titulo(ParamStr(0));

end;

- Dica enviada por: Luiz Eduardo.

Início

Obter tipo de uma propriedade

Inclua na seção uses: TypInfo

{ Esta função retorna uma string com o nome do tipo de dado

de uma propriedade. Exemplos de retornos:

 

PropType(Button1, 'Caption'); // Retorna 'TCaption'

PropType(Edit1, 'Width'); // Retorna 'Integer';

PropType(Edit1, 'Color'); // Retorna 'TColor';

}

 

function PropType(const Obj: TObject; const PropName: string): string;

var

Info: PPropInfo;

begin

Info := GetPropInfo(Obj.ClassInfo, PropName);

if Assigned(Info) then

Result := Info^.PropType^.Name

else

Result := '';

end;

 

{ Exemplo de uso:

- Coloque um TButton e um TEdit;

- No OnClick do Button1 coloque o código abaixo;

- Execute, digite 'Caption' no Edit1 e clique em Button1.

}

 

procedure TForm1.Button2Click(Sender: TObject);

begin

ShowMessage(PropType(Button1, Edit1.Text));

end;

Observações

 

Verdadeiramente não sei exatamente onde poderíamos aplicar esta dica, mas divulguei-a porque achei interessante. Acredito que o Object Inspector use algo parecido.

 

Início

Pintar uma imagem JPG no form

Inclua na seção uses: Graphics, JPeg

 

Problema:

 

Gostaria de pintar imagens de arquivos JPG (JPeg) nos forms

de minha aplicação. Isto é possível? Como?

 

Solução:

 

Para trabalhar com arquivos JPG você precisa usar um objeto

TPicture, assim como colocar no uses a unit JPeg. Siga os

passos abaixo para pintar uma imagem JPG no form:

 

- No evento OnPaint do form coloque o código abaixo:

procedure TForm1.FormPaint(Sender: TObject);

var

Imagem: TPicture;

begin

Imagem := TPicture.Create;

try

Imagem.LoadFromFile('c:\teste\foto.jpg');

Canvas.StretchDraw(ClientRect, Imagem.Graphic);

finally

Imagem.Free;

end;

end;

- E no evento OnResize do form, coloque:

procedure TForm1.FormResize(Sender: TObject);

begin

Repaint;

end;

Observações

 

Não se esqueça de trocar o nome do arquivo JPG conforme sua necessidade. Este exemplo foi elaborado usando Delphi4.

Início

Executar comando do MS-DOS

 

Usando WinExec você pode executar qualquer comando do DOS.

Para isto chame o COMMAND.COM passando como parâmetro a linha

de comando a ser executada. O parâmetro /C é opcional e faz

com que a janela do DOS seja fechada assim que o comando

terminar. No exemplo abaixo estou executando a seguinte

linha de comando: DIR C:\*.*

WinExec('COMMAND.COM /C DIR C:\*.*', SW_SHOW);

Observações

 

Para que a janela do DOS não seja exibida, use SW_HIDE no lugar de SW_SHOW.

 

Início

Formatar CEP

{ Esta função forma CEP como: 99.999-999 }

function tbFormataCEP(const CEP: string): string;

var

I: integer;

begin

Result := '';

for I := 1 to Length(CEP) do

if CEP in ['0'..'9'] then

Result := Result + CEP;

if Length(Result) <> 8 then

raise Exception.Create('CEP inválido.')

else

Result :=

Copy(Result, 1, 2) + '.' +

Copy(Result, 3, 3) + '-' +

Copy(Result, 6, 3);

end;

=== Para testar ===

 

- Coloque um Edit e um Button no form;

- No evento OnClick do Button coloque a instrução abaixo:

Edit1.Text := tbFormataCEP(Edit1.Text);

Observações

 

Para formatar outros códigos como CPF, CGC, etc., pode-se usar a mesma idéia.

 

Início

Permitir cancelar processo demorado

 

Problema:

 

Em determinadas partes no programa existem processos que podem

demorar vários minutos para serem concluídos. Muitas vezes o

usuário desiste e deseja cancelar o processamento. Como

permitir este cancelamento?

 

Solução:

 

Em aplicativos para Windows é comum, em processamentos

demorados, o programa mostrar uma janela de diálogo avisando

que o processo pode levar um tempo extra. Nesta mesma janela

normalmente coloca-se também um botão "Cancelar" que dá ao

usuário a opção aguardar ou desistir do processo. Para fazer

isto em um aplicativo Delphi, siga os passos abaixo:

 

- Vamos considerar em nosso exemplo que o processamento ocorre

na unit do Form1.

 

- Declare, na seção public do Form1, uma variável boolean.

 

public;

Cancelar: boolean;

 

- Crie um novo form (vou chamá-lo de Form2);

- Coloque um botão neste novo form. Programe o OnClick deste

botão conforme abaixo:

Form1.Cancelar := true;

- Na parte onde ocorre o loop do processamento demorado

coloque algo como:

try

{ Antes de começar o processamento }

Form2.Caption := 'Processamento demorado...';

Form2.Show;

 

{ No início do loop "Cancelar" precisa ser false }

Cancelar := false;

 

{ Aqui inicia o loop do processamento demorado }

while {...} do begin

 

{ ... Processa algo aqui... }

 

{ Permite que o programa processe mensagens do Windows }

Application.ProcessMessages;

 

{ Se a variável "Cancelar" foi alterada para true... }

if Cancelar then begin

ShowMessage('Operação cancelada pelo usuário.');

Break; { Sai do loop }

end;

 

end;

 

finally

Form2.Close;

end;

Observações

 

Não se esqueça de que o Form1 precisa usar Form2 e vice-versa.

 

Início

Descobrir se uma data é fim do mês

Inclua na seção uses: SysUtils

{ Esta função retorna true se a data passada como parâmetro

é fim de mês. Retorna false caso contrário. }

 

function tbFimDoMes(const Data: TDateTime): boolean;

var

Ano, Mes, Dia: Word;

begin

DecodeDate(Data +1, Ano, Mes, Dia);

Result := Dia = 1;

end;

 

Autor: Daniel P. Guimarães

Home-page:

É necessário se cadastrar para acessar o conteúdo.

• Entre
• ou
• Cadastre-se

 

Início

Obter o tipo de dado de um valor no Registro do Windows

Inclua na seção uses: Registry, Dialogs

 

{

- Coloque um botão no form;

- Altere o evento OnClick do botão conforme abaixo:

}

 

procedure TForm1.Button1Click(Sender: TObject);

const

cRegPath = 'System\CurrentControlSet\control\FileSystem';

cRegValue = 'ACDriveSpinDown';

var

Reg: TRegistry;

S: string;

begin

Reg := TRegistry.Create;

try

Reg.RootKey := HKEY_LOCAL_MACHINE;

if Reg.OpenKey(cRegPath, false) then begin

case Reg.GetDataType(cRegValue) of

rdUnknown: S := 'Tipo Desconhecido';

rdString: S := 'String';

rdExpandString: S := 'ExpandString';

rdInteger: S := 'Inteiro';

rdBinary: S := 'Binário';

end;

 

ShowMessage(S);

 

end else

ShowMessage('Erro ao abrir chave do Registro');

finally

Reg.Free;

end;

end;

Observações

 

A unit Dialogs foi acrescentada no uses somente para podermos usar a procedure ShowMessage.

Início

Obter a célula de um StringGrid que está sob o cursor do mouse

Inclua na seção uses: Windows

{ Esta procedure pega a linha e coluna da célula onde estiver

o mouse. Valores negativos para Linha ou Coluna indicam que

o mouse está fora da área cliente do StringGrid }

 

procedure MouseCell(Grid: TStringGrid;

var Coluna, Linha: integer);

var

Pt: TPoint;

begin

GetCursorPos(Pt);

Pt := Grid.ScreenToClient(Pt);

if PtInRect(Grid.ClientRect, Pt) then

Grid.MouseToCell(Pt.X, Pt.Y, Coluna, Linha)

else begin

Coluna := -1;

Linha := -1;

end;

end;

 

{ Exemplo de uso:

- Coloque um botão no form;

- Altere o evento OnClick deste botão como abaixo:

}

 

procedure TForm1.Button1Click(Sender: TObject);

var

Coluna, Linha: integer;

begin

MouseCell(StringGrid1, Coluna, Linha);

if (Coluna >= 0) and (Linha >= 0) then

Caption := 'Coluna: ' + IntToStr(Coluna) + ' - ' +

'Linha: ' + IntToStr(Linha);

else

Caption := 'O mouse não está no StringGrid';

end;

 

{ Para testar:

- Execute o programa;

- Posicione o cursor do mouse sobre alguma célula do

StringGrid;

- Pressione TAB até chegar ao botão e pressione ENTER;

- O resultado será mostrado no Caption do form;

}

Observações

 

Note que a procedure MouseCell usa um valor negativo (-1) para coluna e linha se o mouse não estiver sobre o StringGrid.

Início

Limpar todas as células de um StringGrid

 

Existem três métodos que podemos aplicar para limpar

um StringGrid.

{ Limpando uma célula de cada vez: }

 

procedure TForm1.Button1Click(Sender: TObject);

var

I, J: integer;

begin

with StringGrid1 do

for I := 0 to ColCount -1 do

for J := 0 to RowCount -1 do

Cells[i,J] := '';

end;

 

{ Limpando uma linha de cada vez: }

 

procedure TForm1.Button2Click(Sender: TObject);

var

I: integer;

begin

with StringGrid1 do

for I := 0 to RowCount -1 do

Rows.Clear;

end;

 

{ Limpando uma coluna de cada vez: }

 

procedure TForm1.Button3Click(Sender: TObject);

var

I: integer;

begin

with StringGrid1 do

for I := 0 to ColCount -1 do

Cols.Clear;

end;

Observações

 

Em todos os exemplos estamos limpando o StringGrid completamente, inclusive linhas e colunas fixas. Para preservar linhas ou colunas fixas troque os valores iniciais de I ou J conforme a necessidade.

Início

Programar meu aplicativo para abrir arquivos a partir do Windows Explorer

 

Inclua na seção uses: Registry

 

Problema:

 

Criei um editor de textos no Delphi. Agora gostaria que o

Windows Explorer usasse este editor para abrir arquivos com

a extensão .dpg e .dan. Como fazer?

 

Solução:

 

Para fazer isto será necessária a criação de algumas chaves no

Registro do Windows. O exemplo abaixo cria todas as chaves

necessárias.

 

- Coloque um TButton e no evento OnClick dele coloque o

código abaixo:

procedure TForm1.Button1Click(Sender: TObject);

var

Reg: TRegistry;

begin

Reg := TRegistry.Create;

try

Reg.RootKey := HKEY_CLASSES_ROOT;

Reg.LazyWrite := false;

 

{ Define o nome interno (ArquivoDaniel) e uma legenda

que aparecerá no Windows Explorer (Arquivo do Daniel) }

Reg.OpenKey('ArquivoDaniel', true);

Reg.WriteString('', 'Arquivo do Daniel');

Reg.CloseKey;

 

{ Define o comando a ser executado quando abrir um

arquivo pelo Windows Explorer (NomeDoExe %1). O símbolo

%1 indica que o arquivo a ser aberto será passado como

primeiro parâmetro para o aplicativo - ParamStr(1). }

Reg.OpenKey('ArquivoDaniel\shell\open\command', true);

Reg.WriteString('', ParamStr(0) + ' %1'); { NomeDoExe %1 }

Reg.CloseKey;

 

{ Define o ícone a ser usado no Windows Explorer:

0 - primeiro ícone do EXE

1 - segundo ícone do EXE, etc }

Reg.OpenKey('ArquivoDaniel\DefaultIcon', true);

Reg.WriteString('', ParamStr(0) + ',0'); { 0 = primeiro ícone }

Reg.CloseKey;

 

{ Define as extensões de arquivos que serão abertos pelo

meu aplicativo }

 

{ *.dpg }

Reg.OpenKey('.dpg', true);

Reg.WriteString('', 'ArquivoDaniel');

Reg.CloseKey;

 

{ *.dan }

Reg.OpenKey('.dan', true);

Reg.WriteString('', 'ArquivoDaniel');

Reg.CloseKey;

finally

Reg.Free;

end;

end;

- Coloque um TMemo;

- No evento OnShow do Form coloque o código abaixo:

procedure TForm1.FormShow(Sender: TObject);

begin

{ Se o primeiro parâmetro for um nome de arquivo existente... }

if FileExists(ParamStr(1)) then

{ Carrega o conteúdo do arquivo no memo }

Memo1.Lines.LoadFromFile(ParamStr(1));

end;

*** Para testar ***

- Execute este programa;

- Clique no botão para criar as chaves no Registro do Windows;

- Feche o programa;

- Crie alguns arquivos com as extensões .dpg e .dan;

- Vá ao Windows Explorer e procure pelos arquivos criados;

- Experimente dar um duplo-clique sobre qualquer dos arquivos

com uma das extensões acima.

 

 

Observações

 

Existem outros recursos que poderão ser configurados. Porém, para começar, este já é um bom exemplo.

 

Início

Ocultar aplicação da lista de tarefas - CTRL+ALT+DEL

 

- Declare a função abaixo antes da palavra implementation:

function RegisterServiceProcess(dwProcessID, dwType: Integer):

Integer; stdcall; external 'KERNEL32.DLL';

- Coloque dois botões no Form;

- No evento OnClick do Button1 coloque:

 

RegisterServiceProcess(GetCurrentProcessID, 1);

 

- No evento OnClick do Button2 coloque:

 

RegisterServiceProcess(GetCurrentProcessID, 0);

 

=== Para testar ===

 

Clique no Button1 e pressione CTRL+ALT+DEL. O seu programa

não aparecerá na lista.

 

Clique no Button2 e pressione CTRL+ALT+DEL. Agora seu programa

aparecerá na lista.

 

Início

Ativar a proteção de tela do Windows

Inclua na seção uses: Windows

{ Ativa a proteção de tela do Windows,

se estiver configurada. }

 

SendMessage(Application.Handle, WM_SYSCOMMAND, SC_SCREENSAVE, 0);

Início

Desligar/Ligar monitor

Inclua na seção uses: Windows

 

No Win95 podemos desligar o monitor afim de economizar

energia elétrica. Normalmente este recurso é controlado pelo

próprio Windows. Porém sua aplicação Delphi também pode fazer

isto. O exemplo abaixo desliga o monitor, aguarde 5 segundos

e re-liga monitor.

SendMessage(Application.Handle, WM_SYSCOMMAND,

SC_MONITORPOWER, 0);

Sleep(5000); { Aguarde 5 segundos }

SendMessage(Application.Handle, WM_SYSCOMMAND,

SC_MONITORPOWER, -1);

Observações

 

Este recurso pode não funcionar dependendo da configuração do sistema.

 

Início

Mostrar mensagem mesmo que esteja no Prompt do DOS

 

Inclua na seção uses: Windows

 

Problema:

 

Fiz um programa que mostra mensagens de lembrete quando é

chegada determinada data/hora. Porém quando o usuário vai

para o Prompt do MS-DOS em modo tela cheia, a mensagem

não aparece. O que devo fazer?

 

Solução:

 

Antes de mostrar a mensagem, coloque sua aplicação na frente

das demais.

SetForegroundWindow(Application.Handle);

ShowMessage('Teste');

Início

Ocultar o aplicativo do CTRL+ALT+DEL

 

Inclua no implementation de seu programa a seguinte linha:

function RegisterServiceProcess(dwProcessID, dwType: Integer):

Integer; stdcall; external 'KERNEL32.DLL';

e depois no OnCreate ponha a seguinte linha:

 

RegisterServiceProcess(GetCurrentProcessID, 1);

 

Isso vai fazer o programa nao aparecer no CTRL+ALT+DEL,

mas seu form principal vai continuar aparecendo. Para ocultar

também o form, basta por no OnCreate antes da linha acima

a seguinte linha:

Application.ShowMainForm:=False;

Resposta enviada por: dexter07

 

 

Observações

 

Segundo o autor desta resposta, esta solução foi testada em Win95, mas também deve funcionar em Win98. Não sabe se funciona em NT.

Início

Personalizar a caixa de mensagem de exceções (erro) do Delphi

Problema:

 

Quando ocorre uma exceção no Delphi, ele automaticamente

exibe uma mensagem de erro. Gostaria de poder personalizar

estas mensagens, acrescentando, por exemplo, o e-mail do

suporte técnico. Isto é possível?

 

Solução:

 

Sim. Siga os passos abaixo:

 

- Declare um método (procedure) na seção private do

form principal conforme abaixo:

private

procedure ManipulaExcecoes(Sender: TObject; E: Exception);

- Vá até a seção implementation e implemente este método,

conforme o exemplo:

 

procedure TForm1.ManipulaExcecoes(Sender: TObject; E: Exception);

begin

MessageDlg(E.Message + #13#13 +

'Suporte técnico:'#13 +

'[email protected]',

mtError, [mbOK], 0);

end;

- No evento OnCreate do Form principal escreva o código

abaixo:

 

procedure TForm1.FormCreate(Sender: TObject);

begin

Application.OnException := ManipulaExcecoes;

end;

=== Para testar ===

 

- Coloque um Button no form;

- No evento OnClick deste botão coloque o código abaixo:

 

procedure TForm1.Button1Click(Sender: TObject);

begin

StrToInt('ABCD'); { Isto provoca uma exception }

end;

Observações

 

Cuidado! Não coloque código que possa gerar exceção na rotina que manipula as exceções, pois se ocorrer uma exceção neste rotina, esta será chamada recursivamente até estourar a pilha.

Início

Implementar procedure Delay do Pascal no Delphi

Inclua na seção uses: Windows, Forms

 

Problema:

 

O Pascal para DOS possui uma procedure chamada Delay que

serve para pausar o processamento atual em "n" milésimos

de segundo. Como implemento isto no Delphi?

 

Solução:

 

Simles. Veja:

 

procedure Delay(MSec: Cardinal);

var

Start: Cardinal;

begin

Start := GetTickCount;

repeat

Application.ProcessMessages;

until (GetTickCount - Start) >= MSec;

end;

=== Exemplos de uso: ===

 

Delay(1000); { Aguarda 1 segundo }

Delay(5000); { Aguarda 5 segundos }

Delay(60000); { Aguarda 60 segundos - 1 minuto }

Observações

 

Além da procedure Delay criada acima, o programador Delphi pode usar também a API do Windows Sleep. Há porém uma diferença: Delay permite que que o programa continue a processar as mensagens do Windows (mouse, teclado, etc).

 

Início

Criar uma DLL de Bitmaps e usá-la

 

Problema:

 

Gostaria de colocar algums bitmaps em uma DLL e usá-los em

tempo de execução. É possível fazer isto em Delphi?

 

Solução:

 

Sim. Siga os passos abaixo para criar a DLL de bitmaps:

 

- Crie um arquivo de recursos (.RES) contendo os Bitmaps.

Use o Image Editor do Delphi para criar este arquivo.

Salve-o com o nome BMPS.RES na pasta onde será salvo

o projeto do Delphi;

- Crie um novo projeto no Delphi;

- Remova todos os forms do projeto;

- Salve este projeto com o nome DLLBmp.dpr;

- Abra o arquivo de projeto (DLLBmp.dpr) e altere para

ficar somente com as linhas abaixo:

 

{$R BMPS.RES}

library DLLBmp;

end.

 

- Compile o projeto (Ctrl+F9). Será criado o

arquivo DLLBmp.DLL.

- Feche o projeto atual e crie um novo projeto;

- Salve-o na mesma pasta que salvou o anterior,

mas com outro nome qualquer;

- Coloque no form um Edit e um Button;

- No evento OnClick do Button coloque o código abaixo:

 

procedure TForm1.Button1Click(Sender: TObject);

var

Bmp: TBitmap;

HandleDLL: THandle;

begin

{ Carrega a DLL }

HandleDLL := LoadLibrary('DLLBmp.DLL');

if HandleDLL = 0 then

ShowMessage('Não foi possível carregar DLLBmp.DLL')

else

try

Bmp := TBitmap.Create;

try

Bmp.Handle := LoadBitmap(HandleDLL, PChar(Edit1.Text));

if Bmp.Handle = 0 then

ShowMessage('Não foi possível carregar o Bitmap.')

else

{ Pinta o Bitmap no form }

Canvas.Draw(0, 0, Bmp);

finally

Bmp.Free;

end;

finally

{ Libera a DLL }

FreeLibrary(HandleDLL);

end;

end;

=== Para testar ===

 

- Execute este projeto;

- Digite no Edit1 o nome que foi dado ao Bitmap no arquivo

de recursos (.RES);

- Clique no botão. O bitmap deverá ser pintado no form.

 

 

Observações

 

O arquivo DLL poderá ser colocado na pasta onde estiver o EXE, no diretório do Windows ou ainda no sub-diretório System do Windows. Além de bitmaps podemos colocar qualquer outro tipo de recurso em DLL's.

 

Início

Obter status da memória do sistema

Inclua na seção uses: Windows, SysUtils

 

- Coloque um TMemo no form

- Coloque um TButton no form e altere seu OnClick

conforme abaixo:

 

procedure TForm1.Button1Click(Sender: TObject);

const

cBytesPorMb = 1024 * 1024;

var

M: TMemoryStatus;

begin

M.dwLength := SizeOf(M);

GlobalMemoryStatus(M);

Memo1.Clear;

with Memo1.Lines do begin

Add(Format('Memória em uso: %d%%',

[M.dwMemoryLoad]));

Add(Format('Total de memória física: %f MB',

[M.dwTotalPhys / cBytesPorMb]));

Add(Format('Memória física disponível: %f MB',

[M.dwAvailPhys / cBytesPorMb]));

Add(Format('Tamanho máximo do arquivo de paginação: %f MB',

[M.dwTotalPageFile / cBytesPorMb]));

Add(Format('Disponível no arquivo de paginação: %f MB',

[M.dwAvailPageFile / cBytesPorMb]));

Add(Format('Total de memória virtual: %f MB',

[M.dwTotalVirtual / cBytesPorMb]));

Add(Format('Memória virtual disponível: %f MB',

[M.dwAvailVirtual / cBytesPorMb]));

end;

end;

Início

Mostrar o diálogo About (Sobre) do Windows

Inclua na seção uses: ShellApi

procedure TForm1.Button1Click(Sender: TObject);

begin

ShellAbout(Handle, 'Sistema Financeiro', 'Marcelo Senger',

Application.Icon.Handle);

end;

Início

Converter de Hexadecimal para Inteiro

Inclua na seção uses: SysUtils

 

Problema:

 

A função IntToHex do Delphi converte inteiro para

hexadecimal. O que preciso, no entanto, é fazer o contrário,

ou seja, converter de hexadecimal para inteiro. Existe

isto pronto no Delphi ou terei que escrever uma função

para isto?

 

Solução:

 

A função StrToInt pode receber uma string no formato de um

número decimal ou hexadecimal. Então podemos usá-la assim:

 

var

I: integer;

begin

I := StrToInt('$' + Edit1.Text);

{...}

end;

Observações

 

No Delphi, um número na notação decimal deve iniciar com o símbolo $.

 

Início

Colocar uma ProgressBar na 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.

 

 

Observações

 

Com um pouco de criatividade podemos fazer outras coisas interessantes usando o evento OnDrawPanel da StatusBar.

 

Início

Configurar linhas de diferentes alturas em StringGrid

 

- Coloque o StringGrid no form.

- No evento OnCreate do form coloque o código abaixo:

 

procedure TForm1.FormCreate(Sender: TObject);

begin

StringGrid1.RowHeights[0] := 15;

StringGrid1.RowHeights[1] := 20;

StringGrid1.RowHeights[2] := 50;

StringGrid1.RowHeights[3] := 35;

end;

Observações

 

Cuidado para não especificar uma linha inexistente.

 

 

Início

Adicionar o evento OnClick do DBGrid

 

Problema:

 

Meu programa precisa processar algo quando o usuário clicar

no DBGrid em um determinado form. O problema é que o DBGrid não

possui o evento OnClick. É possível adicionar este evento no

DBGrid?

 

Solução:

 

É possível sim. Afinal é muito simples. Siga os passos abaixo

para resolver seu problema:

 

- Monte seu form normalmente, colocando o DBGrid e demais

componentes;

- Vá na seção "private" da unit e declare a procedure abaixo:

 

private

procedure DBGridClick(Sender: TObject);

 

- Logo após a palavra "implementation", escreva a procedure:

 

implementation

 

{$R *.DFM}

 

procedure TForm1.DBGridClick(Sender: TObject);

begin

ShowMessage('Clicou no DBGrid.');

end;

 

- Coloque as instruções abaixo no evento OnCreate do Form:

 

procedure TForm1.FormCreate(Sender: TObject);

begin

DBGrid1.ControlStyle :=

DBGrid1.ControlStyle + [csClickEvents];

TForm(DBGrid1).OnClick := DBGridClick;

end;

- E pronto. Execute e teste.

 

 

Observações

 

O segredo principal desta dica está OnCreate do Form. A primeira instrução ativa o evento OnClick. A segunda instrução acessa o manipulador do evento OnClick. Para isto precisamos tratar o DBGrid como se fosse Form, pois o evento OnClick está declarado como protegido (protected) na classe TDBGrid.

 

Início

Converter a primeira letra de um Edit para maiúsculo

 

with Edit2 do

if Text <> '' then

Text := AnsiUpperCase(Text[1]) + Copy(Text, 2, Length(Text));

Isto pode ser colocado, por exemplo, no OnExit do Edit.

 

Você pode também converter durante a digitação. Para isto

coloque o código abaixo no evento OnKeyPress do Edit:

 

if Edit1.SelStart = 0 then

Key := AnsiUpperCase(Key)[1]

else

Key := AnsiLowerCase(Key)[1];

Início

Verificar se uma string contém uma hora válida

 

- Use a função abaixo:

 

function StrIsTime(const S: string): boolean;

begin

try

StrToTime(S);

Result := true;

except

Result := false;

end;

end;

Início

Verificar se uma string contém um valor numérico válido

 

- Use uma das funções abaixo, conforme o tipo de dado que se

quer testar:

 

function StrIsInteger(const S: string): boolean;

begin

try

StrToInt(S);

Result := true;

except

Result := false;

end;

end;

 

function StrIsFloat(const S: string): boolean;

begin

try

StrToFloat(S);

Result := true;

except

Result := false;

end;

end;

Início

Mostrar uma mensagem durante um processamento

 

Problema:

 

Um processamento em meu sistema é bastante demorado e por isto

colocar apenas o cursor de ampulheta continua deixando o

usuário confuso, pensando que o sistema travou. É possível

exibir uma mensagem enquanto um processamento demorado ocorre?

 

Sim. E é fácil. Vejamos:

 

- Crie um form com a mensagem. Um pequeno form com um

Label já é suficiente. Aqui vou chamá-lo de FormMsg.

- Vá em Project|Options e passe o FormMsg de

"Auto-create forms" para "Available forms".

- Abaixo vou simular um processamento demorado, usando a

API Sleep:

 

procedure TForm1.Button1Click(Sender: TObject);

var

Form: TFormMsg;

I: integer;

begin

Form := TFormMsg.Create(Self);

try

Form.Label1.Caption := 'Processamento demorado...';

Form.Show;

for I := 1 to 5 do begin

Form.UpDate;

Sleep(1000); { Aguarda um segundo }

end;

finally

Form.Free;

end;

end;

Observações

 

A função Sleep é uma API do Windows e serve para paralisar a aplicação por um determinado dempo. Este tempo é em milisegundos.

 

Início

Mostrar um cursor de ampulheta durante um processamento

 

- Salve o cursor atual

- Defina o novo cursor (crHourGlass é ampulheta)

- Faça o processamento

- Restaure o cursor.

 

Vejamos:

 

var

PrevCur: TCursor;

begin

PrevCur := Screen.Cursor;

try

Screen.Cursor := crHourGlass;

{ Coloque aqui as instruções do processamento }

finally

Screen.Cursor := PrevCur;

end;

end;

Observações

 

Existem diversos outros cursores pré-definidos no Delphi. Dê uma olhada na propriedade Cursor de um componente visual para ver uma lista de todos eles. Você poderá também criar o seu próprio cursor.

 

Início

Ler e escrever dados binários no Registro do Windows

Inclua na seção uses: Registry

 

Coloque no Form:

- três edits;

- dois botões.

 

Logo abaixo da palavra implementation declare:

 

type

 

{ Declara um tipo registro }

TFicha = record

Codigo: integer;

Nome: string[40];

DataCadastro: TDateTime;

end;

- Escreva o evento OnClick do Button1 conforme abaixo:

 

procedure TForm1.Button1Click(Sender: TObject);

var

Reg: TRegistry;

Ficha: TFicha;

begin

{ Coloca alguns dados na variável Ficha }

Ficha.Codigo := StrToInt(Edit1.Text);

Ficha.Nome := Edit2.Text;

Ficha.DataCadastro := StrToDate(Edit3.Text);

 

Reg := TRegistry.Create;

try

{ Define a chave-raiz do registro }

Reg.RootKey := HKEY_CURRENT_USER;

 

{ Abre uma chave (path). Se não existir cria e abre. }

Reg.OpenKey('Cadastro\Pessoas\', true);

 

{ Grava os dados (o registro) }

Reg.WriteBinaryData('Dados', Ficha, SizeOf(Ficha));

finally

Reg.Free;

end;

end;

 

- Escreva o evento OnClick do Button2 conforme abaixo:

 

procedure TForm1.Button2Click(Sender: TObject);

var

Reg: TRegistry;

Ficha: TFicha;

begin

Reg := TRegistry.Create;

try

{ Define a chave-raiz do registro }

Reg.RootKey := HKEY_CURRENT_USER;

 

{ Se existir a chave (path)... }

if Reg.KeyExists('Cadastro\Pessoas') then

begin

{ Abre a chave (path) }

Reg.OpenKey('Cadastro\Pessoas', false);

 

{ Se existir o valor... }

if Reg.ValueExists('Dados') then

begin

{ Lê os dados }

Reg.ReadBinaryData('Dados', Ficha, SizeOf(Ficha));

Edit1.Text := IntToStr(Ficha.Codigo);

Edit2.Text := Ficha.Nome;

Edit3.Text := DateToStr(Ficha.DataCadastro);

end else

ShowMessage('Valor não existe no registro.')

end else

ShowMessage('Chave (path) não existe no registro.');

finally

Reg.Free;

end;

end;

Observações

 

Qualquer tipo de dado pode ser gravado e lido de forma binária no registro do Windows. Para isto você precisa saber o tamanho do dado. Para dados de tamanho fixo, use SizeOf(). Lembrete: não grave dados muito extensos no Registro do Windows (ex: imagens), pois isto prejudicará o desempenho do sistema.

Início

Mudar a resolução do vídeo via programação

 

- Coloque um ListBox no form

- Modifique o OnCreate do form assim:

procedure TForm1.FormCreate(Sender: TObject);

var

i : Integer;

DevMode : TDevMode;

begin

i := 0;

while EnumDisplaySettings(nil,i,Devmode) do begin

with Devmode do

ListBox1.Items.Add(Format('%dx%d %d Colors',

[dmPelsWidth,dmPelsHeight, 1 shl dmBitsperPel]));

Inc(i);

end;

end;

- Coloque um botão no form

- Altere o evento OnClick do botão conforme abaixo:

procedure TForm1.Button1Click(Sender: TObject);

var

DevMode : TDevMode;

begin

EnumDisplaySettings(nil,Listbox1.ItemIndex,Devmode);

ChangeDisplaySettings(DevMode,0);

end;

Observações

 

Nos testes que fiz, nem tudo funcionou adequadamente. Mas vale a pena experimentar.

 

Início

Ler e escrever dados no Registro do Windows

Inclua na seção uses: Registry

 

- Coloque no form dois edits e dois botões.

- No evento OnClick do Button1 escreva o código abaixo:

 

procedure TForm1.Button1Click(Sender: TObject);

var

Reg: TRegistry;

begin

Reg := TRegistry.Create;

try

{ Define a chave-raiz do registro }

Reg.RootKey := HKEY_CURRENT_USER;

{ Abre a chave (path). Se não existir, cria e abre. }

Reg.OpenKey('MeuPrograma\Configuração', true);

{ Escreve um inteiro }

Reg.WriteInteger('Numero', StrToInt(Edit1.Text));

{ Escreve uma string }

Reg.WriteString('Nome', Edit2.Text);

finally

Reg.Free;

end;

end;

- No evento OnClick do Button2, escreva:

 

procedure TForm1.Button2Click(Sender: TObject);

var

Reg: TRegistry;

begin

Reg := TRegistry.Create;

try

Reg.RootKey := HKEY_CURRENT_USER;

if Reg.KeyExists('MeuPrograma\Configuração') then

begin

Reg.OpenKey('MeuPrograma\Configuração', false);

 

if Reg.ValueExists('Numero') then

Edit1.Text := IntToStr(Reg.ReadInteger('Numero'))

else

ShowMessage('Não existe valor com o nome "Numero"');

 

if Reg.ValueExists('Nome') then

Edit2.Text := Reg.ReadString('Nome')

else

ShowMessage('Não existe valor com o nome "Nome"');

 

end else

ShowMessage('Não existe a chave no registro');

finally

Reg.Free;

end;

end;

 

 

Observações

 

User o aplicativo RegEdit.exe do windows para ver o registro. Cuidado para não alterar as configurações do Windows!

 

Início

Adicionar barra de rolagem horizontal no ListBox

 

{ - Coloque um ListBox no form;

- Altere o OnCreate do Form conforme abaixo:

}

 

procedure TForm1.FormCreate(Sender: TObject);

var

I, Temp, MaxTextWidth: integer;

begin

{ Adiciona algumas linhas no ListBox }

Listbox1.Items.Add('Linha 1');

Listbox1.Items.Add('Linha 2, longa para que seja necessária a barra de rolagem horizontal');

Listbox1.Items.Add('Linha 3');

 

if Listbox1.Items.Count > 1 then begin

 

{ Obtém o comprimento, em pixels, da linha mais longa }

MaxTextWidth := 0;

for I := 0 to Listbox1.Items.Count - 1 do begin

Temp := ListBox1.Canvas.TextWidth(ListBox1.Items);

if Temp > MaxTextWidth then

MaxTextWidth := Temp;

end;

 

{ Acrescenta a largura de um "W" }

MaxTextWidth := MaxTextWidth + Listbox1.Canvas.TextWidth('W');

 

{ Envia uma mensagem ao ListBox }

SendMessage(ListBox1.Handle, LB_SETHORIZONTALEXTENT, MaxTextWidth, 0);

end;

end;

 

{ Para ocultar use a instrução abaixo: }

 

SendMessage(ListBox1.Handle, LB_SETHORIZONTALEXTENT, 0, 0);

Início

Verificar se uma string é uma data válida

Escreva a função abaixo:

 

function tbStrIsDate(const S: string): boolean;

begin

try

StrToDate(S);

Result := true;

except

Result := false;

end;

end;

Para testar:

- Coloque um Edit no form;

- Coloque um Button;

- No evento OnClick do botão coloque o código abaixo:

 

if tbStrIsDate(Edit1.Text) then

ShowMessage(Edit1.Text + ' é data válida.')

else

ShowMessage(Edit1.Text + ' NÃO é data válida.');

Início

Adicionar zeros à esquerda de um número

 

Existem várias formas. Vejamos uma:

 

function tbStrZero(const I: integer; const Casas: byte): string;

var

Ch: Char;

begin

Result := IntToStr(I);

if Length(Result) > Casas then begin

Ch := '*';

Result := '';

end else

Ch := '0';

 

while Length(Result) < Casas do

Result := Ch + Result;

end;

 

{ Exemplo de como usá-la: }

 

var

S: string;

Numero: integer;

{...}

begin

{...}

S := tbStrZero(Numero, 6);

{...}

end;

Observações

 

Se o comprimento desejado (Casas) não for suficiente para conter o número, serão colocados asteriscos.

 

Início

Obter a versão da biblioteca ComCtl32.DLL (usada na unit ComCtrls do Delphi)

Inclua na seção uses: ComCtrls

 

{ A versão desta biblioteca determina a aparência de alguns

controles do Delphi, tais como ToolBar e CoolBar. O exemplo

abaixo obtém a versão desta biblioteca.

 

Para este exemplo, coloque um TEdit e um TButton no Form.

O evento OnClick do botão escreva o código abaixo: }

 

procedure TForm1.Button1Click(Sender: TObject);

var

Ver: Cardinal;

MaiorVer, MenorVer: Word;

begin

Ver := GetComCtlVersion;

MaiorVer := HiWord(Ver);

MenorVer := LoWord(Ver);

Edit1.Text := IntToStr(MaiorVer) + '.' + IntToStr(MenorVer);

end;

 

Observações

 

Normalmente, a versão 4.72 está presente quando o Internet Explorer 4 está instalado.

Início

Implementar rotinas assembly em Pascal

 

{ O Delphi permite a implementação de rotinas assembly

mescladas ao código Pascal. Não entrarei em detalhes

minuciosos, mas darei alguns exemplos básicos de como

implementar rotinas simples que retornam números inteiros.

}

 

{ Soma dois inteiros de 8 bits }

function Soma8(X, Y: byte): byte;

asm

mov al, &X

add al, &Y

end;

 

{ Soma dois inteiros de 16 bits }

function Soma16(X, Y: Word): Word;

asm

mov ax, &X

add ax, &Y

end;

 

{ Soma dois inteiros de 32 bits }

function Soma32(X, Y: DWord): DWord;

asm

mov eax, &X

add eax, &Y

end;

 

{ A chamada a estas funções são feitas da mesma forma

que chamamos uma função Pascal. Exemplo: }

var

A: byte;

begin

A := Soma8(30, 25); { A = 55 }

end;

Início

Exibir o diálogo About do Windows

Inclua na seção uses: Windows

 

{ About padrão do Windows }

ShellAbout(Handle, 'Windows', '', 0);

 

{ Personalizada }

ShellAbout(Handle, 'NomePrograma',

'Direitos autorais reservados a'#13'Fulano de Tal',

Application.Icon.Handle);

Início

Obter a linha e coluna atual em um TMemo

 

{ === SOLUÇÃO 1 === }

 

{ Esta procedure obtém a linha e coluna atual de um TMemo }

procedure tbGetMemoLinCol(Memo: TMemo; var Lin, Col: Cardinal);

begin

with Memo do begin

Lin := Perform(EM_LINEFROMCHAR, SelStart, 0);

Col := SelStart - Perform(EM_LINEINDEX, Lin, 0);

end;

end;

 

{ Use-a como abaixo: }

 

var

Lin, Col: Cardinal;

begin

tbGetMemoLinCol(Memo1, Lin, Col);

{ ... }

end;

 

{ === SOLUÇÃO 2 === }

 

var

Lin, Col: integer;

begin

Lin := Memo1.CaretPos.y;

Col := Memo1.CaretPos.x;

{...}

end;

- A segunda solução foi apresentada por:

Vanderley Pereira Rocha

 

Início

Exibir um arquivo de ajuda do Windows

Inclua na seção uses: Windows

 

{ Você precisa saber:

- Caminho e nome do arquivo;

- A estrutura do arquivo de Help.

 

No exemplo abaixo abre o arquivo de ajuda da Calculadora

do Windows e vai para o tópico n. 100

}

 

procedure TForm1.Button1Click(Sender: TObject);

begin

WinHelp(0, 'c:\Win95\Help\Calc.hlp', HELP_CONTEXT, 100);

end;

Observações

 

Para utilizar um arquivo de ajuda em seu programa desenvolvido em Delphi, basta usar os recursos do próprio Delphi. O exemplo acima é somente para mostrar o uso de uma API para este fim.

 

Início

Obter o valor de uma variável de ambiente

Inclua na seção uses: Windows

 

{ Esta função recebe o nome da variável de ambiente

que queremos acessar e retorna uma string com seu

valor, ou uma string vazia se a variável não existir. }

 

function tbGetEnvVar(const VarName: string): string;

var

I: integer;

begin

Result := '';

 

{ Obtém o comprimento da variável }

I := GetEnvironmentVariable('PATH', nil, 0);

 

if I > 0 then begin

SetLength(Result, I);

GetEnvironmentVariable('PATH', PChar(Result), I);

end;

end;

 

{ Para usá-la, faça como neste exemplo: }

Edit1.Text := tbGetEnvVar('PATH');

Início

Fechar um aplicativo com uma mensagem de erro fatal

Inclua na seção uses: Windows

 

procedure TForm1.Button1Click(Sender: TObject);

begin

FatalAppExit(0, 'Erro fatal na aplicação.');

end;

Observações

 

A função FatalAppExit é uma API do Windows. Esta mostra uma caixa de diálogo (normalmente branca) com a mensagem passada no segundo parâmetro. Quando a caixa de diálogo é fechada a aplicação é finalizada. O evento OnCloseQuery dos forms não são chamados quando usamos esta função.

 

Início

Criar um EXE que seja executado apenas através de outro EXE criado por mim

Inclua na seção uses: Windows

 

{ Problema:

 

Gostaria que um determinado programa (Prog1.EXE) fosse

executado apenas através de outro programa (Prog2.EXE).

 

Solução:

 

Antes da linha "Application.Initialize;" de Prog1.dpr (programa

a ser chamado), coloque o código abaixo:

}

 

if ParamStr(1) <> 'MinhaSenha' then begin

{ Para usar ShowMessage, coloque Dialogs no uses }

ShowMessage('Execute este programa através de Prog2.EXE');

Halt; { Finaliza }

end;

 

{ No Form1 de Prog2 (programa chamador) coloque um botão e

escreva o OnClick deste botão como abaixo:

}

 

procedure TForm1.Button1Click(Sender: TObject);

var

Erro: Word;

begin

Erro := WinExec('Pro2.exe MinhaSenha', SW_SHOW);

if Erro <= 31 then { Se ocorreu erro... }

ShowMessage('Erro ao executar o programa.');

end;

Observações

 

Aqui o parâmetro passado foi 'MinhaSenha'. Você deverá trocar 'MinhaSenha' por algo que apenas você saiba (uma senha). Caso uma pessoa conheça esta senha, será possível chamar este programa passando-a como parâmetro. Neste caso sua "trava" estará violada.

Início

Truncar valores reais para n casas decimais

 

{ Às vezes você precisa considerar apenas duas casas de valores

reais, mas o Delphi não oferece algo pronto para isto. Se

usarmos funções como Round que vem com o Delphi, o valor será

arredondado (e não truncado). Com Round() o valor abaixo será

135.55 (e não 135.54) com duas casas decimais.

}

 

ValorReal := 135.54658;

 

{ Somente a parte inteira - nenhuma casa decimal }

X := Trunc(ValorReal); // X será 135

 

{ Duas casas }

X := Trunc(ValorReal * 100) / 100; // X será 135.54

 

{ Três casas }

X := Trunc(ValorReal * 1000) / 1000; // X será 135.5465

Observações

 

Isto pode não funcionar se ValorReal for muito alto. Isto por causa da multiplicação que poderá estourar a capacidade do tipo em uso. Lembre-se: os tipos reais aceitam valores muuuiiiito altos.

Início

Saber se o sistema está usando 4 dígitos para o ano

 

{ Para não correr o risco de surpresas desagradáveis,

é melhor que seu programa em Delphi verifique se

o Windows está ajustado para trabalhar com 4 dígitos

para o ano. Assim seu programa pode alertar o usuário

quando o ano estiver sendo representado com apenas 2 dígitos.

A função abaixo retorna true se estiver ajustado para

4 dígitos.

}

 

function Is4DigitYear: Boolean;

begin

result:=(Pos('yyyy',ShortDateFormat)>0);

end;

Início

Obter o nome do usuário e da empresa informado durante a instalação do Windows

Inclua na seção uses: Registry

 

{ Coloque um botão no form e altere seu evento OnCkick

como abaixo: }

 

procedure TForm1.Button1Click(Sender: TObject);

var

Reg: TRegIniFile;

S: string;

begin

Reg := TRegIniFile.Create('SOFTWARE\MICROSOFT\MS SETUP (ACME)\');

try

S := Reg.ReadString('USER INFO','DefName','');

S := S + #13;

S := S + Reg.ReadString('USER INFO','DefCompany','');

ShowMessage(S);

finally

Reg.free;

end;

end;

Início

Evitar que seu programa apareça na barra de tarefas

Inclua na seção uses: Windows

 

{ Você já observou a caixa "Propriedades", aquela que mostra

as propriedades de um arquivo no Windows Explorer, não

aparece na lista do Alt+Tab e tampouco na barra de tarefas?

 

Isto ocorre porque ela funciona como uma ToolWindow, enquanto

os demais aplicativos funcionam como AppWindow. Porém podemos

mudar o comportamento de nossos programas feito em Delphi

para que se comportem como uma ToolWindow também.

 

Para experimentar, crie um novo projeto e altere o

Project1.dpr como abaixo (não esqueça do uses):

}

 

program Project1;

 

uses

Forms, Windows,

Unit1 in 'Unit1.pas' {Form1};

 

{$R *.RES}

 

var

ExtendedStyle : Integer;

begin

Application.Initialize;

 

ExtendedStyle := GetWindowLong(Application.Handle, gwl_ExStyle);

SetWindowLong(Application.Handle, gwl_ExStyle, ExtendedStyle or

ws_Ex_ToolWindow and not ws_Ex_AppWindow);

 

Application.CreateForm(TForm1, Form1);

Application.Run;

end.

Observações

 

Ao executar observe a barra de tarefas e teste o Alt+Tab (seu programa não estará lá!).

 

Início

Fechar o Windows a partir do seu programa

 

{ 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);

Início

Carregar um cursor animado (.ani)

 

{ Altere o evento OnCreate do Form conforme abaixo: }

 

procedure TForm1.FormCreate(Sender: TObject);

begin

Screen.Cursors[1] :=

LoadCursorFromFile('c:\win95\cursors\globe.ani');

Button1.Cursor := 1;

end;

Observações

 

Para este exemplo é necessário ter o arquivo de cursor conforme apontado e também ter, no form, um Button1. Para usar este cursor em outros componentes basta atribuir à propriedade Cursor do componente em questão o valor 1 (um). Exemplo: Edit1.Cursor := 1; Form1.Cursor := 1;, etc.

 

Início

Executar um programa DOS e fechá-lo em seguida

 

{ Coloque isto no evento OnClick de um botão: }

 

WinExec('command.com /c programa.exe',sw_ShowNormal);

 

{ Se quizer passar parâmetros pasta adicioná-los após o

nome do programa. Exemplo: }

 

WinExec('command.com /c programa.exe param1 param2',sw_ShowNormal);

Observações

 

Se quizer que a janela do programa não apareça, troque sw_ShowNormal por sw_Hide.

 

Início

Fechar um programa a partir de um programa Delphi

 

{ - Coloque um botão no form e altere seu evento OnClick

conforme abaixo: }

 

procedure TForm1.Button1Click(Sender: TObject);

var

Janela: HWND;

begin

Janela := FindWindow('OpusApp'), nil);

if Janela = 0 then

ShowMessage('Programa não encontrado')

else

PostMessage(Janela, WM_QUIT, 0, 0);

end;

Observações

 

Este exemplo fecha o MS Word 97 se estiver aberto. A mensagem WM_QUIT fecha o programa da forma "ignorante". Isto significa que se houver dados não salvos, o programa a ser fechado não oportunidade para salvá-los. Uma alternativa mais suave é trocar a mensagem WM_QUIT por WM_CLOSE.

 

Início

Colocar Hint's de várias linhas

 

{ - Coloque um TButton no Form;

- Altere o evento OnCreate do Form como abaixo: }

 

procedure TForm1.FormCreate(Sender: TObject);

begin

Button1.Hint := 'Linha 1 da dica' + #13 +

'Linha 2 da dica' + #13 +

'Linha 3 da dica';

Button1.ShowHint := true;

end;

Início

Separar (filtrar) caracteres de uma string

 

{ Abaixo da palavra implementation digite: }

 

type

TChars = set of Char;

 

function FilterChars(const S: string; const ValidChars: TChars): string;

var

I: integer;

begin

Result := '';

for I := 1 to Length(S) do

if S in ValidChars then

Result := Result + S;

end;

 

{ Para usar a função:

- Coloque um botão no Form;

- Altere o evento OnClick deste botão conforme abaixo: }

 

procedure TForm1.Button4Click(Sender: TObject);

begin

{ Pega só letras }

ShowMessage(FilterChars('D63an*%i+/e68l13',

['A'..'Z', 'a'..'z']));

{ Pega só números }

ShowMessage(FilterChars('D63an*%i+/e68l13', ['0'..'9']));

end;

 

Observações

 

Se quizer usar este função em outras unit's, coloque a declaração do tipo TChars na seção interface. Coloque aí também uma declaração da função FilterChars. E não se esqueça da cláusula uses.

 

Início

Colocar zeros à esquerda de números

{ Isto coloca zeros à esquerda do número até completar 6 casas }

S := FormatFloat('000000', 5);

 

Observações

 

"S" precisa ser uma variável string.

 

Início

Trabalhar com cores no formato string

 

procedure TForm1.Button3Click(Sender: TObject);

begin

 

{ Exibe as cores atuais dos Edit's }

ShowMessage(ColorToString(Edit1.Color));

ShowMessage(ColorToString(Edit2.Color));

 

{ Altera as cores dos Edit's }

Edit1.Color := StringToColor('clBlue');

Edit2.Color := StringToColor('$0080FF80');

 

end;

Início

Verificar se determinado programa está em execução (Word, Delphi, etc)

 

{ Coloque um Button no Form e altere o evento OnClick deste

como abaixo: }

 

procedure TForm1.Button1Click(Sender: TObject);

begin

{ Verifica o Delphi }

if FindWindow('TAppBuilder', nil) > 0 then

ShowMessage('O Delphi está aberto')

else

ShowMessage('O Delphi NÃO está aberto');

 

{ Verifica o Word }

if FindWindow('OpusApp', nil) > 0 then

ShowMessage('O Word está aberto')

else

ShowMessage('O Word NÃO está aberto');

 

{ Verifica o Excell }

if FindWindow('XLMAIN', nil) > 0 then

ShowMessage('O Excell está aberto')

else

ShowMessage('O Excell NÃO está aberto');

end;

Observações

 

Há uma margem de erro nesta verificação: pode haver outros programas que possuam uma janela com os mesmos nomes. Você mesmo pode criar aplicativos em Delphi e, propositadamente, criar uma janela com um destes nomes.

 

Início

Gerar uma tabela no Word através do Delphi

Inclua na seção uses: ComObj

 

{ - Coloque um botão no Form;

- Altere o evento OnClick do botão conforme abaixo: }

 

procedure TForm1.Button1Click(Sender: TObject);

var

Word: Variant;

begin

{ Abre o Word }

Word := CreateOleObject('Word.Application');

try

{ Novo documento }

Word.Documents.Add;

try

{ Adiciona tabela de 2 linhas e 3 colunas }

Word.ActiveDocument.Tables.Add(

Range := Word.Selection.Range,

NumRows := 2,

NumColumns := 3);

{ Escreve na primeira célula }

Word.Selection.TypeText(Text := 'Linha 1, Coluna 1');

{ Próxima célula }

Word.Selection.MoveRight(12);

{ Escreve }

Word.Selection.TypeText(Text := 'Linha 1, Coluna 2');

Word.Selection.MoveRight(12);

Word.Selection.TypeText(Text := 'Linha 1, Coluna 3');

Word.Selection.MoveRight(12);

Word.Selection.TypeText(Text := 'Linha 2, Coluna 1');

Word.Selection.MoveRight(12);

Word.Selection.TypeText(Text := 'Linha 2, Coluna 2');

Word.Selection.MoveRight(12);

Word.Selection.TypeText(Text := 'Linha 2, Coluna 3');

{ Auto-Formata }

Word.Selection.Tables.Item(1).Select; { Seleciona a 1º tabela }

Word.Selection.Cells.AutoFit; { auto-formata }

{ Imprime 1 cópia }

Word.ActiveDocument.PrintOut(Copies := 1);

ShowMessage('Aguarde o término da impressão...');

{ Para salvar... }

Word.ActiveDocument.SaveAs(FileName := 'c:\Tabela.doc');

finally

{ Fecha documento }

Word.ActiveDocument.Close(SaveChanges := 0);

end;

finally

{ Fecha o Word }

Word.Quit;

end;

end;

 

Observações

 

Foram usados neste exemplo o Delphi4 e MS-Word97.

 

Início

Evitar que um programa seja executado mais de uma vez

 

{ Muitos programas Windows permitem apenas uma cópia em

execução de cada vez. Isto é interessante principalmente

quando é um grande aplicativo, pois duas cópias ao mesmo

tempo usuaria muito mais memória. Em aplicativos

desenvolvidos em Delphi podemos ter esta característica.

Vejamos:

 

- Crie um novo projeto;

- Mude o "Name" do Form1 para DPGFormPrinc;

- Altere o código-fonte do arquivo Project1.dpr

conforme abaixo: }

 

program Project1;

 

uses

Forms, Windows,

Unit1 in 'Unit1.pas' {DPGFormPrinc};

 

{$R *.RES}

 

var

Handle: THandle;

begin

Handle := FindWindow('TDPGFormPrinc', nil);

if Handle <> 0 then begin { Já está aberto }

Application.MessageBox('Este programa já está aberto. A cópia ' +

'anterior será ativada.', 'Programa já aberto', MB_OK);

if not IsWindowVisible(Handle) then

ShowWindow(Handle, SW_RESTORE);

SetForegroundWindow(Handle);

Exit;

end;

Application.Initialize;

Application.CreateForm(TDPGFormPrinc, DPGFormPrinc);

Application.Run;

end.

Observações

 

Para testar este programa você deverá compilar o projeto e fechar o Delphi. Depois, procure o Project1.exe (projeto compilado) usando o Windows Explorer e tente executá-lo mais de uma vez e veja o que acontece. Mas porque alterar o name do form principal para "DPGFormPrinc"? Este poderia ser qualquer outro nome, mas preferi usar as iniciais do meu nome (DPG). Procurei deixar um nome bem pessoal para não correr o risco de colocar um nome que possa ser encontrado em outro aplicativo do Windows. Por exemplo: se deixar Form1, será bem fácil encontrar outro aplicativo feito em Delphi que possua uma janela com este nome, o que causaria problema.

 

Início

Saber a resolução de tela atual

 

{ Coloque um TButton no Form e altere o evento

OnClick deste botão como abaixo: }

 

procedure TForm1.Button1Click(Sender: TObject);

begin

ShowMessage('Largura: ' + IntToStr(Screen.Width) + #13 +

'Altura: ' + IntToStr(Screen.Height));

end;

Observações

 

O objeto Screen contém várias informações importantes: largura e altura da tela, fontes instaladas no Windows, etc.

 

Início

Para que servem OnGetEditMask, OnGetEditText e OnSetEditText do TStringGrid

 

O evento OnGetEditMask ocorre quando entramos no modo de edição.

Neste momento podemos verificar em qual linha/coluna se

encontra o cursor e então, se quiser, poderá especificar uma

máscara de edição. Exemplo:

 

procedure TForm1.StringGrid1GetEditMask(Sender: TObject; ACol,

ARow: Integer; var Value: String);

begin

if (ARow = 1) and (ACol = 1) then

Value := '(999) 999-9999;1;_'; // Telefone

end;

O evento OnGetEditText ocorre também quando entramos no modo

de edição. Neste momento podemos manipularmos o texto da

célula atual (linha/coluna) e então podemos simular algo tal

como uma tabela onde opções podem ser digitadas através

de números. Exemplo:

 

procedure TForm1.StringGrid1GetEditText(Sender: TObject; ACol,

ARow: Integer; var Value: String);

begin

if (ARow = 1) and (ACol = 2) then begin

if StringGrid1.Cells[ACol, ARow] = 'Ótimo' then

Value := '1'

else if StringGrid1.Cells[ACol, ARow] = 'Regular' then

Value := '2'

else if StringGrid1.Cells[ACol, ARow] = 'Ruim' then

Value := '3';

end;

end;

O evento evento OnSetEditText ocorre quando saímos do modo de

edição. Neste momento podemos manipular a entrada e trocar

por um texto equivalente. Normalmente usamos este evento em

conjunto com o evento OnGetEditText. Exemplo:

 

procedure TForm1.StringGrid1SetEditText(Sender: TObject; ACol,

ARow: Integer; const Value: String);

begin

if (ARow = 1) and (ACol = 2) then begin

if Value = '1' then

StringGrid1.Cells[ACol, ARow] := 'Ótimo'

else if Value = '2' then

StringGrid1.Cells[ACol, ARow] := 'Regular'

else if Value = '3' then

StringGrid1.Cells[ACol, ARow] := 'Ruim'

end;

end;

Observações

 

Para testar o exemplo anterior crie um novo projeto e coloque no Form1 um TStringGrid. Mude os três eventos mencionados conforme os exemplos. Execute e experimente digitar nas céluas 1 e 2 da primeira linha (na parte não fixada, é claro!).

 

Início

Ocultar/exibir a barra de tarefas do Windows

Inclua na seção uses: Windows

 

{ Coloque no Form dois Botões: BotaoOcultar e BotaoExibir.

No evento OnClick do BotaoOcultar escreva: }

 

procedure TForm1.BotaoOcultarClick(Sender: TObject);

var

Janela: HWND;

begin

Janela := FindWindow('Shell_TrayWnd', nil);

if Janela > 0 then

ShowWindow(Janela, SW_HIDE);

end;

 

{ No evento OnClick do BotaoExibir escreva: }

 

procedure TForm1.BotaoExibirClick(Sender: TObject);

var

Janela: HWND;

begin

Janela := FindWindow('Shell_TrayWnd', nil);

if Janela > 0 then

ShowWindow(Janela, SW_SHOW);

end;

 

{ Execute e teste, clicando em ambos os botões }

Observações

 

A tarefa mais difícil é descobrir o nome de classe da janela da barra de tarefa do Windows, mas isto é fácil se você usar o TBWinName. Pegue-o no link download de

É necessário se cadastrar para acessar o conteúdo.

• Entre
• ou
• Cadastre-se

. O resto é usar as APIs do Windows para manipulação de Janelas.

 

Início

Evitar a proteção de tela durante seu programa

Inclua na seção uses: Windows

 

{ Na seção "private" do Form principal acrescente: }

procedure AppMsg(var Msg: TMsg; var Handled: Boolean);

 

{ Na seção "implementation" acrescente (troque TForm1 para

o nome do seu form principal): }

procedure TForm1.AppMsg(var Msg: TMsg; var Handled: Boolean);

begin

if (Msg.Message = wm_SysCommand) and

(Msg.wParam = sc_ScreenSave) then

Handled := true;

end;

 

{ No evento "OnCreate" do form principal, coloque: }

Application.OnMessage := AppMsg;

Início

Criar cores personalizadas (sistema RGB)

 

{ Coloque um TButton no form e escreva o evento OnClick

deste como abaixo: }

procedure TForm1.Button1Click(Sender: TObject);

var

Vermelho, Verde, Azul: byte;

MinhaCor: TColor;

begin

Vermelho := 0;

Verde := 200;

Azul := 150;

MinhaCor := TColor(RGB(Vermelho, Verde, Azul));

Form1.Color := MinhaCor;

end;

Observações

 

A quantidade de cada cor primária é um número de 0 a 255. Observe que a cor retornada pela função RGB() está no formato do Windows (ColorRef); é por isto que fiz a conversão TColor(RGB(...)).

 

Início

Adicionar uma nova fonte no Windows

 

{ Coloque o código abaixo no OnClick de um botão }

AddFontResource(PChar('c:\MyFonts\Monospac.ttf'));

Observações

 

Troque o nome do arquivo do exemplo anterior pelo nome desejado. Arquivos de fonte possuem uma das seguintes extensões: FON, FNT, TTF, FOT.

 

Início

Saber se determinada Font está instalada no Windows

 

{ Coloque este código no OnClick de um botão }

with Screen.Fonts do

if IndexOf('Courier New') >= 0 then

ShowMessage('A fonte está instalada.')

else

ShowMessage('A fonte não está instalada.');

Início

Acertar a data e hora do sistema através do programa

 

{ Coloque dois TEdit no form.

Coloque um TButton no form e altere o evento OnClick

deste botão como abaixo:

}

procedure TForm1.Button1Click(Sender: TObject);

var

DataHora: TSystemTime;

Data, Hora: TDateTime;

Ano, Mes, Dia,

H, M, S, Mil: word;

begin

Data := StrToDate(Edit1.Text);

Hora := StrToTime(Edit2.Text);

DecodeDate(Data, Ano, Mes, Dia);

DecodeTime(Hora, H, M, S, Mil);

with DataHora do begin

wYear := Ano;

wMonth := Mes;

wDay := Dia;

wHour := H;

wMinute := M;

wSecond := S;

wMilliseconds := Mil;

end;

SetLocalTime(DataHora);

end;

Observações

 

No Edit1 digite a nova data e no Edit2 digite a nova hora.

 

Início

Paralizar um programa durante n segundos

Inclua na seção uses: Windows

 

{ Pausa por 1 segundo }

Sleep(1000);

 

{ Pausa por 10 segundos }

Sleep(10000);

Observações

 

Esta pausa não é interrompida pelo pressionamento de alguma tecla, como acontecia com InKey() do Clipper.

 

Início

Criar um Alias através do seu programa

Inclua na seção uses: DB

 

{ se o alias não existir... }

if not Session.IsAlias('MeuAlias') then

begin

{ Adiciona o alias }

Session.AddStandardAlias('MeuAlias', 'C:\DirProg', 'PARADOX');

{ Salva o arquivo de configuração do BDE }

Session.SaveConfigFile;

end;

Observações

 

Para criar um alias do dBase troque a string 'PARADOX' por 'DBASE'. No caso acima usei como path o caminho "C:\DirProg", mas se você quiser poderá trocar este caminho por ExtractFilePath(ParamStr(0)) para que o alias seja direcionado para o local onde está seu .EXE. Neste último caso será necessário incluir na seção uses: SysUtils, System.

Créditos

Surfistinha

Daniel

Miguel

[DragonBoss 8]

bom topico, otimos tutoriais... alguns sao simples, mas uteis, e outros mais avançados.... bem legal

 

abraços.

[Ex7reMe 2]

Surf Programer Fã

J Salvei Sua Sig

Meu Fã

Dps passa um tutorial

ensinando a fazer um Ativador de scripts

[Surfistinha£ 20]

@Ex7reMe vlw por ser + um dois meus fãns

Passo sim

 

@DragonBoss vl¥w mano mas nen dar pra colocar + nada no topico eu ia ate colocar

[Niik 3]

Man...

Tá Maneiro...

MAs Podia Colocar Cor ai Pra Diferenciar!

Thx!

[Surfistinha£ 20]

Pronto adicionei o indice como pedido e coloquei cor

Espero que gostem

Muito obrigado

[bidoow 0]

oo cara tá muito massa, vai ajuda muita gente! vlw ai !

 

só arruma o titulo né , Varios tuRtoriais delpJhi.

 

asuashasuhasuasuhasu vlw nego

[Surfistinha£ 20]

Ja arrumei mas nao vai

So ali em baixo

Varios turtorias delphi

em cima nao e nen sei pq

vlw

['[S]trom. 0]

Isto não é uma Tutorial de Delphi ... é uma Biblia de Delphi !. Parabens Surf, muito bom topico, cinceramente mereçe fixo, além de ter dado um trabalhão. vc vai levar meu Thks ^^. Man, está perfeito, espero que deem fixo para esse tuto Perfeito ~ *

[viniciusavs 0]

Esse topico mereçe fixo .. ( FATOO )

Mt bom como o 'trom. disse nao é um tutorial de Delphi é uma biblia (:

Levo meu tanks !

[Surfistinha£ 20]

Muito dificil alguem vim fixar um topico aqui mas deixa se eu ajudei alguem tudo bem nen quero fixo mas se fixar ta tranks continuarei criando conteudos desses tipos com indice e tudo vlw

['Cz 13]

Sem palavras, fixo.

[Surfistinha£ 20]

LOL flw man por fixar

Tranks quando os turturial passar da validade XD eu atualizo para novos turtorias

Muito Obrigado

[Niik 3]

LOL

 

Muito Boom surf *-*

 

(Com cor fiko ótimo man!)

 

Até Fixado ;D

[Surfistinha£ 20]

Para nao dar leg desabilitem as assinaturas

 

vlw

[-allucard!. 0]

Muito bom surf e parabens pelo fixo = )

[dejaime 5]

Muito bom manin!

Continue assim!

Vou fixar!

 

--edit--

Já tava fixo [:

[Surfistinha£ 20]

Flw ai irei continuar postando turtorial desses tipos com indicie e tudo bom continuarei assim Obrigado a todos pelo fixo e tudo mas vlw ai pelo apoio quem tiver travando retire a assinatura logo abaixo aonde vc posta muito obrigado

Vlw por editar

[valterfsj 0]

Muito bom mesmo!!!

Porém, peço para arrumar o nome do topico pois "Varios tutorias delphi"

fica feio né...

[mateusv8 0]

Muito bom surfistinha :)

 

 

vc é Show ti admiro, belo topico...

muito obrigadão e continua sempre assim, ajudando os outros :)

[fr0g 0]

cara, que foda *o*

eu queria saber metade de tudo UDHAUDHUDHUDHAUHDAUDHAUD

um dia chego la ;)

[SylvioTavares 0]

Convertir para PDF vou da uma olhada quando eu chega em casa :D

 

Muito legal a iniciativa ai Surfistinha£ Continue assim :D

 

Abraços.

[l2lipe 0]

muito bom surf se lembra de mim o q n conseguia criar o tal modificador de scripts ? pois hj ja sei muita mais coisa em delphi e ja criei varios programas para a wc a tbm o tal modificador, eu consegui criar ohhhh !!!!!!!!!!

vlw pela ajuda por eu n ter desistido acabei conseguindo !!

[Airy 1]

Nuss, mto bom.

T´pico organizadênho.

vlw's suRF

 

aBraÇS

[l2lipe 0]

surf preciso de uma ajuda sua mais vc bloqueio as mp poow desbloqueia issso !!!!

fora isso o topico ta otimo !