Blog com atividades voltadas ao ambiente de desenvolvimento utilizando a ferramenta de linguagem Delphi. Ao visitar o blog, encontrará dicas úteis para seu dia-a-dia atualizadas diariamente.
segunda-feira, 18 de junho de 2012
Sugestões de Posts
Olá amigos, dispensando comentários sobre o tempo que não realizava mais posts, volto a postar aqui para dessa vez pedir a ajuda de vocês, creio que muitos já se beneficiaram com algum trechinho de código, rotinas completas, ou mesmo aqueles que simplesmente deram só uma breve navegada no blog, que se tiverem alguma sugestão de post que deixem a mesma em forma de comentário neste post aqui, irei analisar a mesma e dentro do possível criar um material e publicar por aqui, onde você e muitos outros delphianos possam ser beneficiados.
Deixem sua identificação nos comentários, pois farei questão de publicar junto no post o autor da dica.
Aguardo as sugestões. Abraço
quinta-feira, 2 de junho de 2011
Criando atalhos rápidos no sistema
Uma dica bem rápida e simples de ser implementada, imaginando sua tela de cadastro de Clientes, onde um dos campos se refere a entrada de CEP e você vai implementar um formulário para pesquisa de Cidades e CEPs, a forma comum é colocar um pequeno botão ao lado do Edit e adicionar o código que chama a janela de consulta, mas e agilizando isso sem usar o mouse, com teclas de atalho, iria ajudar?
Neste mesmo Edit, vamos fazer que quando o mesmo estiver com o foco, ao pressionar a tecla F2 a janela de busca será exibida, basta que adicione ao evento OnKeyDown o seguinte trecho de código:
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = VK_F2 then
begin
frmbusca := Tfrmbusca.Create(Self);
frmbusca.ShowModal;
FreeAndNil(frmbusca);
{Ou substitua as 3 linhas por SeuForm.Show se o mesmo já foi criado}
end;
end;
Pronto, execute a aplicação, posicione o foco dentro com componente Edit1 e pressione a tecla F2, o formulário de consulta será exibido. Abraço e até o próximo post.
Controlar ou limitar caracteres no Edit
O titulo do tópico acaba sendo um pouco limitado, mas o recurso que irei mostrar a seguir é muito simples e pode ser aplicado em qualquer componente utilizado para digitação de caracteres. Partindo do exemplo de um edit, denominado por exemplo para receber o CPF de uma pessoa, obviamente pode aceitar a digitação de números do "0" ao "9" e também o "." (Ponto) e o "-" (hífen), não permitindo mais nenhum outro caractere, ou sim, o "#8", ou seja, o comando de apagar da direita para esquerda (Backspace).
Em qualquer componente que deseja atribuir o controle, basta que adicione ao evento OnKeyPress o seguinte trecho de códigos:
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if not (Key in ['0'..'9','.','-',#8]) then
abort;
end;
Pronto, em qualquer componente que você irá adicionar o código ao evento mencionado, será controlada a digitação destes caracteres. Abraço, até o próximo post.
quinta-feira, 26 de maio de 2011
Capturar Imagem do Form e transformar em JPG
Salve galera, estou estendendo meu dia hoje, ou melhor, minha madrugada para compartilhar uma dica talvez não tão importante, mas que em casos iguais a este que me fez usar o recurso, pode ser interessante. Tenho uma situação de um sistema onde ocorrem casos do cliente dizer "...mas eu tinha colocado o valor certo, foi o sistema que alterou", e já cansado de procurar pelo dito erro no sistema, vou passar a desconfiar do usuário e dar um "Print" no formulário dele a hora que ele salvar e guardar o jpg, ou seja, vou capturar a imagem do form, transformar em jpg e salvar no diretório do sistema. Se ele apagar os arquivos, bom, ai acho que é possível interpretar que ele está assumindo a culpa, caso contrário, vou ter pelo menos uma prova que ele digitou mesmo o valor correto e voltar a bater cabeça procurando o erro no sistema.
A solução é bem simples, declare nas uses a classe "jpeg" e em seguida crie uma função ou adicione o código no próprio botão "Salvar", conforme segue abaixo:
procedure TfrmReservas.BitBtn2Click(Sender: TObject);
var
JpgSave: TJPEGImage;
begin
{aqui minha rotina de salvar o registro, cálculos, atualiza estoque, reserva quantidades, etc...}
//Cria um objeto do tipo Jpeg
JpgSave := TJPEGImage.Create;
try
//Captura a imagem do form
JpgSave.Assign((frmReservas as TForm).GetFormImage);
//Verifica se existe o diretório para salvar a imagem, se não existir, é criado
if not DirectoryExists(ExtractFilePath(Application.ExeName)+'jpg') then
CreateDir(ExtractFilePath(Application.ExeName)+'jpg');
//Salva a imagem no diretório, usando como nome o próprio código do registro salvo no banco
JpgSave.SaveToFile(ExtractFilePath(Application.ExeName)+'jpg\'+LblNumReserva.Caption+'.jpg');
finally
//Limpa objeto da memória
FreeAndNil(JpgSave);
end;
End;
Pronto, após isso, ao executar o sistema e clicar sobre o botão onde o código foi adicionado, observe que uma pasta jpg foi criada no mesmo diretório do executável do sistema e que lá estará o print do formulário. O print a seguir é da tela do sistema onde implementei a função, trata-se da reserva de sementes de grãos para associados de um sindicato, onde o sistema faz uma projeção do estoque disponível e vincula um associado à quantidade solicitada.
Espero que tenha ajudado, abraços.
segunda-feira, 25 de outubro de 2010
Download de arquivos da Internet
Olá pessoal, grande satisfação poder estar de volta ao blog depois de um bom tempo sem postar. Não que eu tenha parado de desenvolver, estou no Delphi quase que direto desenvolvendo sistemas e sites e compartilhando o tempo com manutenção de computadores aqui na loja, orçamentos, vendas de equipamentos de informática, entre outros. Devido a alguns comentários que recebi em outros posts aqui do blog e até e-mails que recebi de delphianos, volto a elaborar e postar este artigo.
Bom, então para começarmos este artigo onde irei mostrar como gerenciar o download de arquivos da internet, saber qual seu tamanho e taxa de transferência, usaremos o Delphi 2007 for Win32, onde inicialmente criaremos um novo projeto e adicionaremos os seguintes componentes:
1 - Label ('lblURL'). Caption: "URL para Download"
2 - Edit ('edtURL')
3 - Button ('btDownload'). Caption: "Download"
4 - Gauge ('Gauge1')
5 - Label ('LblDownload'). Caption: "Aguardando..."
6 - Label ('lblVelocidade'). Caption: "0 kbp/s"
7 - IdHTTP ('IdHTTP1')
8 - SaveDialog ('SaveDialog1')
Adicionados os componentes ao formulário, organize-os conforme imagem abaixo onde daremos continuidade iniciando a codificação das ações do sistema.
Início do Download
Iniciaremos a codificação do aplicativo a partir do evento WorkBegin do componente IdHTTP1, o qual é disparado no momento em que o Download do arquivo é iniciado, onde iremos declarar dentro do bloco Public da unit uma variável para armazenar o horário de início do Download, adicionando a seguinte linha:
FStartDate: TDateTime;
Em seguida, fazendo a codificação do evento adicionando o seguinte código ao mesmo:
procedure TForm1.IdHTTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Integer);
begin
{limpa a barra de progresso}
Gauge1.Progress := 0;
{define o tamanho máximo para o Gauge}
Gauge1.MaxValue := AWorkCountMax;
{Marcando o inicio do Download}
FStartDate:= Now;
end;
Avanço do Download
O controle do avanço do Download faremos a partir do evento OnWork do componente IdHTTP1, o qual será o responsável por incrementar o percentual de conclusão do download a cada pacote de bytes trazidos no objeto de download. Baseados no tamanho total do arquivo, a cada pacote realizamos uma conversão dos valores incrementando o percentual até a conclusão do trabalho. Adicione o código a seguir ao componente:
procedure TForm1.IdHTTP1Work(ASender: TObject; AWorkMode: TWorkMode;AWorkCount: Integer);
begin
{a cada conjunto de bytes trazidos pelo componente, incrementamos o Gauge}
Gauge1.Progress := AWorkCount;
{mostra no label o total de bytes e o progresso do download em bytes}
LblDownload.Caption := 'Baixando '+FormatFloat('#0.00',(AWorkCount/1024)/1024)+'MB de '+FormatFloat('#0.00',(Gauge1.MaxValue/1024)/1024)+'MB';
{reescreve os valores no formulário}
if AWorkMode = wmRead then
begin
//Marca o tempo percorrido
ElapsedTime := SecondsBetween(Now,FStartDate);
if ElapsedTime > 0 then
begin
//Calcula a velocidade com base nos arquivos transferidos e tempo percorrido
lblVelocidade.Caption := Format('%s Kb/s', [FormatFloat('0.00',(AWorkCount/1024)/ElapsedTime)]);
Application.ProcessMessages;
end;
end;
Repaint;
end;
Encerramento do Download
Ao receber todos os bytes do arquivo solicitado através da URL, utilizaremos este evento para informar ao usuário que a tarefa está concluída, exibindo uma simples mensagem no Caption do LblDownload, adicionado o código a seguir:
procedure TForm1.IdHTTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
{conclusão do trabalho, fim do download}
LblDownload.Caption := 'Download concluído!';
end;
Controle do Download
Antes de codificarmos o botão para iniciar o processo de trabalho do componente, iremos adicionar uma nova function que irá manter as atividades e mensagens do formulário atualizadas durante o processo de download que ocorre através de um Stream de arquivos criado, e que irá armazenando o arquivo na medida em que será recebido da web. Há também um controle de exceções caso algum erro ocorra durante o download e ao finalizar, a remoção da variável de stream da memória. Declare dentro do bloco Public da unit a seguinte function:
procedure DownloadFile(SourceFile, FromFile: String);
Utilizando as teclas de atalho Shift+Ctrl+C sobre a função declarada para que o Delphi faça a implementação da mesma, adicione o código abaixo analisando-o de acordo com as ações de cada bloco acompanhados por comentários explicativos.
procedure TForm1.DownloadFile(SourceFile, FromFile: String);
var
fsFromFile: TFileStream;
begin
{atualiza e processa as ações ocorrendo na aplicação}
Application.ProcessMessages;
{cria um stream temporário para o download}
fsFromFile := TFileStream.Create( FromFile, fmCreate );
try
try
{obtem o arquivo solicitado na URL e salva-o em disco}
idHTTP1.Get( SourceFile, fsFromFile );
except
on Error: Exception do
begin
{tratamento dos erros quando houver}
ShowMessage('O seguinte erro ocorreu durante o download:'+#13+Error.Message );
Raise;
end;
end;
finally
{limpa a variável da memória e desconecta o componente}
fsFromFile.Free;
idHTTP1.Disconnect
end;
end;
DICA: caso algum código não seja reconhecido pela não declaração das uses como por exemplo que poderá ocorrer com o Type TFileStream, posicione o cursor sobre o mesmo e usando as teclas Shift+Ctrl+A, selecione aquela que se refere ao tipo declarado e pressione Enter que o mesmo será adicionado automaticamente nas declarações do formulário.
Download
Agora sim, para que o Download de fato aconteça, precisamos codificar o botão responsável pelo Start dos demais eventos e funções que já vimos. Com um duplo clique sobre o botão, adicione o código a seguir, o qual fará uma verificação para saber se realmente há algum valor informado no Edit da URL e em seguida passando para o processo de tratamento do nome a ser atribuído ao arquivo a ser salvo e a escolha de um local no disco para o armazenamento, iniciando dessa forma a transferência do arquivo.
procedure TForm1.btDownloadClick(Sender: TObject);
var
vArquivo: TFileStream;
vFileName : String;
I: Integer;
begin
{somente inicia se houver uma URL no campo}
if Length(edtURL.Text) > 0 then
begin
{Passando a URL para a variável a fim de obter o nome do arquivo}
vFileName := edtURL.Text;
{inicia laço e pesquisa pela última bara para obter filename}
for I := 0 to Length(vFileName) - 1 do
begin
{se encontrar uma barra deleta os caracteres que antecedem a mesma.
Se chegar na última bara permanece apenas o nome do arquivo}
if Pos('/',vFileName) > 0 then
Delete(vFileName,1,Pos('/',vFileName));
end;
{abre o diálogo já preenchido com o nome e solicita local de
armazenamento do download}
SaveDialog1.FileName := vFileName;
if SaveDialog1.Execute then
begin
{inicia o download do arquivo}
DownloadFile(edtURL.Text,SaveDialog1.FileName);
end;
end else
MessageDlg('Informe a URL do Download!',mtWarning,[mbOK],0);
end;
Utilize as teclas Ctrl+F9 para compilar o aplicativo e verificar se não há nenhum problema de codificação e em seguida as teclas Ctrl+Shif+F9 para executar o aplicativo e poder comprovar o seu funcionamento. Adicione uma URL válida ao componente de textos e clique sobre o botão para iniciar o Download, escolha um local para armazenar o arquivo e observe o funcionamento/transferência do arquivo, conforme imagem abaixo:
Para aqueles que quiserem efetuar o download dos fontes, CLIQUE AQUI para ser redirecionado ao site onde estão hospedados os artigos (se preferir, desenvolva o aplicativo antes e faça o download posteriormente usando o aplicativo para poder testá-lo). Abraço pessoal e até o próximo.
sábado, 6 de fevereiro de 2010
Soluções em informática
Bom galera, este post que deixo dessa vez não possui relacionamento direto com dicas Delphi, mas sim com a empresa que montei a pouco tempo oferecendo as mais diversas soluções na área de informática.
A Tchê Soluções oferece à você os melhores produtos pelos menores preços além da prestação de serviços na área de informática com credibilidade e confiança. Acesse o site da empresa (http://www.tchesolucoes.com.br) e confiram os produtos e promoções que temos para lhe oferecer. Entre em contato e solicite um orçamento.
Abraços...
terça-feira, 19 de janeiro de 2010
Manipular componentes TMainMenu no formulário
O componente TMainMenu do Delphi encapsula uma barra de menu e sua queda acompanha down-menus de um formulário.
O componente TMainMenu Delphi não dispõe da propriedade Visible para lhe mostrar ou ocultar o menu para em tempo de execução, logo você poderia dizer que não é possível manipular o menu e seus itens em tempo de execução, não é? Não, mas existe uma maneira de esconder o menu principal para um formulário Delphi em tempo de execução e exibir menus secundários. Veja como ...
Para atribuir um menu de um formulário, de um clique sobre o TMainMenu (digamos que ele tem "MainMenu1" para a sua propriedade Name), adicione itens de menu e atribuá-os para a propriedade Menu de um formulário.
Se pretender ocultar o menu de programação, em tempo de execução, é só usar essa linha de código:
// MainForm é o nome do formulário
MainForm.Menu: = nil;
Para mostrar o menu novamente, basta transferir a propriedade Menu para o formulário:
// MainForm é o nome do formulário
MainForm.Menu: = MainMenu1;
Para mostrar um menu secundário, basta deixar um segundo componente TMainMenu (MainMenu2) pré-configurado e executar a seguinte linha de código:
// MainForm é o nome do formulário
MainForm.Menu: = MainMenu2;
Certo? Até o próximo post!
O componente TMainMenu Delphi não dispõe da propriedade Visible para lhe mostrar ou ocultar o menu para em tempo de execução, logo você poderia dizer que não é possível manipular o menu e seus itens em tempo de execução, não é? Não, mas existe uma maneira de esconder o menu principal para um formulário Delphi em tempo de execução e exibir menus secundários. Veja como ...
Para atribuir um menu de um formulário, de um clique sobre o TMainMenu (digamos que ele tem "MainMenu1" para a sua propriedade Name), adicione itens de menu e atribuá-os para a propriedade Menu de um formulário.
Se pretender ocultar o menu de programação, em tempo de execução, é só usar essa linha de código:
// MainForm é o nome do formulário
MainForm.Menu: = nil;
Para mostrar o menu novamente, basta transferir a propriedade Menu para o formulário:
// MainForm é o nome do formulário
MainForm.Menu: = MainMenu1;
Para mostrar um menu secundário, basta deixar um segundo componente TMainMenu (MainMenu2) pré-configurado e executar a seguinte linha de código:
// MainForm é o nome do formulário
MainForm.Menu: = MainMenu2;
Certo? Até o próximo post!
sexta-feira, 17 de julho de 2009
Imagem de cabeçalho dinâmica no Rave Reports
Você tem o seu sistema, emite relatórios em Rave Reports e precisa customizar o relatório para atualização dos cabeçalhos de relatório a cada novo cliente? E porque não usar cabelhos com imagens e atribui-las dinamicamente ao Rave em tempo de execução? - Neste post veremos como passar para o Rave, através de parâmetros o caminho de um Bitmap que deverá ser carregado em tempo de execução e ser exibido como sendo o cabeçalho do relatório.
Inciando pelo Rave, crie um novo documento de relatórios, crie uma estrutura utilizando os componentes Region e Band e adicione um componente Bitmap Component. Acessando agora o Event Editor do Bitmap, selecione o evento onBeforePrint e insira seguinte linha de código:
function Bitmap1_OnBeforePrint(Self: TRaveBitmap);
begin
Bitmap1.FileLink := Raveproject.getparam('pImagem');
end OnBeforePrint;
Obs.: Clique em compile e certifique-se que o código seja aceito pelo Rave.
O código faz com que o caminho seja atribuido para a imagem em tempo de execução de acordo com o valor recebido no parâmetro "pImagem" que deverá ser criado na propriedade Parameters do relatório.
Agora criando a aplicação Delphi, adicione os componente RvProject e RvSystem, faça a configuração dos mesmos (ver configurações), adicione um componente OpenDialog para localizar o Bitmap e adicione um botão vinculando a ele o seguinte código que irá atribuir o arquivo selecionado ao parâmetro e exibir o relatório:
procedure TForm1.Button1Click(Sender: TObject);
begin
OpenDialog1.Filter := 'Bitmap (*.bmp)|*.bmp';
if OpenDialog1.Execute then
begin
RvProject1.Open;
RvProject1.SelectReport('Report1',False);
RvProject1.SetParam('pImagem',OpenDialog1.FileName);
RvProject1.Execute;
end;
end;
Pronto, execute agora a aplicação e clique sobre o botão, localize a imagem do cabeçalho na extensão .bmp e veja que a mesma é exbida no relatório do Rave Reports. Na sua aplicação, crie uma seção de parâmetros em alguma tabela do banco de dados ou mesmo no arquivo de configurações *.INI (ver configurações) e mantenha o caminho do cabeçalho de relatório sempre salvo. Abraço e até o próximo post.
Inciando pelo Rave, crie um novo documento de relatórios, crie uma estrutura utilizando os componentes Region e Band e adicione um componente Bitmap Component. Acessando agora o Event Editor do Bitmap, selecione o evento onBeforePrint e insira seguinte linha de código:
function Bitmap1_OnBeforePrint(Self: TRaveBitmap);
begin
Bitmap1.FileLink := Raveproject.getparam('pImagem');
end OnBeforePrint;
Obs.: Clique em compile e certifique-se que o código seja aceito pelo Rave.
O código faz com que o caminho seja atribuido para a imagem em tempo de execução de acordo com o valor recebido no parâmetro "pImagem" que deverá ser criado na propriedade Parameters do relatório.
Agora criando a aplicação Delphi, adicione os componente RvProject e RvSystem, faça a configuração dos mesmos (ver configurações), adicione um componente OpenDialog para localizar o Bitmap e adicione um botão vinculando a ele o seguinte código que irá atribuir o arquivo selecionado ao parâmetro e exibir o relatório:
procedure TForm1.Button1Click(Sender: TObject);
begin
OpenDialog1.Filter := 'Bitmap (*.bmp)|*.bmp';
if OpenDialog1.Execute then
begin
RvProject1.Open;
RvProject1.SelectReport('Report1',False);
RvProject1.SetParam('pImagem',OpenDialog1.FileName);
RvProject1.Execute;
end;
end;
Pronto, execute agora a aplicação e clique sobre o botão, localize a imagem do cabeçalho na extensão .bmp e veja que a mesma é exbida no relatório do Rave Reports. Na sua aplicação, crie uma seção de parâmetros em alguma tabela do banco de dados ou mesmo no arquivo de configurações *.INI (ver configurações) e mantenha o caminho do cabeçalho de relatório sempre salvo. Abraço e até o próximo post.
Marcadores:
Delphi,
Parâmetros,
Rave Reports,
SetParam
segunda-feira, 13 de julho de 2009
Listando programas instalados
Já pensou em fazer um aplicativo capaz de listar todos os programas instalados em seu computador? E associar os devidos ícones a cada um dos programas instalados? Neste post irei mostrar a criação de uma rotina bem simples capaz de lhe exibir a lista de todos os programas que você possui instalados ai no seu Windows associando os icones correspondentes a cada um deles.
Para começar, crie uma nova aplicação Delphi for Win32 e adicione ao formulário principal um componente Button alterando a propriedade Align para "alTop", um Label com a propriedade Align para "alBotton", um ListView organizado como "alClient" e também um componente ImageList e adicione neste uma imagem que será utilizada como imagem Default caso não seja possível encontrar o ícone do programa listado.
Acessando a unit de código do aplicativo, declare uma procedure chamada "ListaProgramasInstalados" e a seguir use as teclas Shift+Ctrl+C para fazer a implementação da mesma e adicione o código a seguir que se encontra comentado de acordo com as funcionalidades dos principais blocos que serão executados:
Obs.: declare as uses Registry e Shellapi.
procedure TForm1.ListaProgramasInstalados;
Var
List:TStringList;
Registry : TRegistry;
I:Integer;
Icon : TIcon;
DisplayName, DisplayIcon:String;
Item:TListItem;
begin
{ Cria objeto para pesquisa no registro do Windows }
Registry := TRegistry.Create;
{ Cria uma objeto para listagem dos programas }
List := TStringList.Create;
{ objeto para associar os icones aos programas }
Icon := TIcon.Create;
try
with Registry do
begin
RootKey := HKEY_LOCAL_MACHINE;
if OpenKey('Software\Microsoft\Windows\CurrentVersion\Uninstall',False) Then
Begin
{ obtem a lista de nomes dos programas instalados }
GetKeyNames(List);
CloseKey;
End;
{ percorre a lista de programas e busca o ícone para associá-lo }
for i:=0 to List.Count-1 do
begin
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('Software\Microsoft\Windows\CurrentVersion\Uninstall\'+List[i],False);
DisplayName := ReadString('DisplayName');
DisplayIcon := ReadString('DisplayIcon');
if DisplayName <> '' then
begin
{ faz a associação do ícone ao programa }
Item := ListView1.Items.Add;
Item.Caption := DisplayName;
if DisplayIcon <> '' then
begin
Icon.Handle := ExtractIcon(HInstance,PAnsiChar(DisplayIcon),0);
Item.ImageIndex := ImageList1.AddIcon(Icon);
end else
Item.ImageIndex := 1;
end;
CloseKey;
End;
end;
Finally
{ limpa os objetos da memória }
Registry.Free;
List.Free;
Icon.Free;
end;
end;
Por final, adicione ao evento OnClick do botão o código a seguir fazendo com que o procedimento seja executado e os programas listados, exibindo no Label a quantidade de programas que estão aparecendo na listagem.
procedure TForm1.Button1Click(Sender: TObject);
begin
ListaProgramasInstalados;
Label1.Caption := IntToStr(ListView1.Items.Count)+' programas instalados em seu computador.';
end;
Execute o aplicativo e clique sobre o botão para visualizar seu funcionamento. Abraço q até o próximo post.
Para começar, crie uma nova aplicação Delphi for Win32 e adicione ao formulário principal um componente Button alterando a propriedade Align para "alTop", um Label com a propriedade Align para "alBotton", um ListView organizado como "alClient" e também um componente ImageList e adicione neste uma imagem que será utilizada como imagem Default caso não seja possível encontrar o ícone do programa listado.
Acessando a unit de código do aplicativo, declare uma procedure chamada "ListaProgramasInstalados" e a seguir use as teclas Shift+Ctrl+C para fazer a implementação da mesma e adicione o código a seguir que se encontra comentado de acordo com as funcionalidades dos principais blocos que serão executados:
Obs.: declare as uses Registry e Shellapi.
procedure TForm1.ListaProgramasInstalados;
Var
List:TStringList;
Registry : TRegistry;
I:Integer;
Icon : TIcon;
DisplayName, DisplayIcon:String;
Item:TListItem;
begin
{ Cria objeto para pesquisa no registro do Windows }
Registry := TRegistry.Create;
{ Cria uma objeto para listagem dos programas }
List := TStringList.Create;
{ objeto para associar os icones aos programas }
Icon := TIcon.Create;
try
with Registry do
begin
RootKey := HKEY_LOCAL_MACHINE;
if OpenKey('Software\Microsoft\Windows\CurrentVersion\Uninstall',False) Then
Begin
{ obtem a lista de nomes dos programas instalados }
GetKeyNames(List);
CloseKey;
End;
{ percorre a lista de programas e busca o ícone para associá-lo }
for i:=0 to List.Count-1 do
begin
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('Software\Microsoft\Windows\CurrentVersion\Uninstall\'+List[i],False);
DisplayName := ReadString('DisplayName');
DisplayIcon := ReadString('DisplayIcon');
if DisplayName <> '' then
begin
{ faz a associação do ícone ao programa }
Item := ListView1.Items.Add;
Item.Caption := DisplayName;
if DisplayIcon <> '' then
begin
Icon.Handle := ExtractIcon(HInstance,PAnsiChar(DisplayIcon),0);
Item.ImageIndex := ImageList1.AddIcon(Icon);
end else
Item.ImageIndex := 1;
end;
CloseKey;
End;
end;
Finally
{ limpa os objetos da memória }
Registry.Free;
List.Free;
Icon.Free;
end;
end;
Por final, adicione ao evento OnClick do botão o código a seguir fazendo com que o procedimento seja executado e os programas listados, exibindo no Label a quantidade de programas que estão aparecendo na listagem.
procedure TForm1.Button1Click(Sender: TObject);
begin
ListaProgramasInstalados;
Label1.Caption := IntToStr(ListView1.Items.Count)+' programas instalados em seu computador.';
end;
Execute o aplicativo e clique sobre o botão para visualizar seu funcionamento. Abraço q até o próximo post.
Marcadores:
Delphi,
Programas do Registro,
Registry,
Windows
quarta-feira, 3 de junho de 2009
Executando video no Delphi
Já pensou em fazer seu próprio sistema para reprodução de vídeos? Poder programar o palyer da forma como você quiser? Ao usar o componente MediaPlayer do Delphi, isto pode ser possível, ele além de reproduzir vários formatos de audio é também capaz de reproduzir videos.
Em um novo projeto no Delphi, adicione ao formulário os seguintes componentes:
- Panel: que será utilizado como Display para a reprodução do vídeo.
- MediaPlayer: que fará a execução do vídeo.
- TrackBar: linha do tempo da execução do vídeo.
- Button1: altere o Caption para "abrir".
- Button2: altere para "Pause".
- Button3: altere para "Stop".
- Timer: para atualizar a linha do tempo.
- OpenDialog: para localizar e abrir o arquivo de vídeo.
Adicione o seguinte código ao evento OnClick do botão abrir:
procedure TForm1.Button1Click(Sender: TObject);
var
TheLength: LongInt;
begin
if OpenDialog1.Execute then
begin
with MediaPlayer1 do
begin
DeviceType := dtAVIVideo;
TimeFormat := tfFrames;
FileName := OpenDialog1.FileName;
Open;
TrackBar1.Max := Frames;
TheLength := Length;
Display := Panel1;
DisplayRect := Rect(10,10, Panel1.Width-20,Panel1.Height-20);
Play;
end;
end;
end;
Adicione o seguinte código ao evento OnClick do Button2 (Pause):
procedure TForm1.Button2Click(Sender: TObject);
begin
If Button2.Caption = 'Pause' Then
Button2.Caption := 'Continue'
else
Button2. Caption := 'Pause';
MediaPlayer1.Pause;
end;
Adicione o seguinte código ao evento OnClick do Button3 (Stop):
procedure TForm1.Button3Click(Sender: TObject);
begin
MediaPlayer1.Stop;
MediaPlayer1.Frames := 0;
TrackBar1.Position := 0;
Panel1.Refresh;
end;
Adicione o evento a seguir ao evento OnTimer do componente Timer1 para atualizar a linha do tempo de acordo com o avanço do video:
procedure TForm1.Timer1Timer(Sender: TObject);
begin
if MediaPlayer1.Frames > 0 then
begin
TrackBar1.Position := MediaPlayer1.Position;
end;
end;
Adicione o código a seguir ao evento OnChange do TrackBar1 para atualizar o vídeo no Display caso o usuário avance ou recue a linha do tempo:
procedure TForm1.TrackBar1Change(Sender: TObject);
begin
With MediaPlayer1 do
Begin
StartPos := TrackBar1.Position;
Play;
End;
end;
Salve o projeto em seu computador, compile e execute sua aplicação. Clique no botão "abrir", e localize um arquivo de vídeo no formato "*.avi" para que seja executado. Abraço e até o próximo post.
Em um novo projeto no Delphi, adicione ao formulário os seguintes componentes:
- Panel: que será utilizado como Display para a reprodução do vídeo.
- MediaPlayer: que fará a execução do vídeo.
- TrackBar: linha do tempo da execução do vídeo.
- Button1: altere o Caption para "abrir".
- Button2: altere para "Pause".
- Button3: altere para "Stop".
- Timer: para atualizar a linha do tempo.
- OpenDialog: para localizar e abrir o arquivo de vídeo.
Adicione o seguinte código ao evento OnClick do botão abrir:
procedure TForm1.Button1Click(Sender: TObject);
var
TheLength: LongInt;
begin
if OpenDialog1.Execute then
begin
with MediaPlayer1 do
begin
DeviceType := dtAVIVideo;
TimeFormat := tfFrames;
FileName := OpenDialog1.FileName;
Open;
TrackBar1.Max := Frames;
TheLength := Length;
Display := Panel1;
DisplayRect := Rect(10,10, Panel1.Width-20,Panel1.Height-20);
Play;
end;
end;
end;
Adicione o seguinte código ao evento OnClick do Button2 (Pause):
procedure TForm1.Button2Click(Sender: TObject);
begin
If Button2.Caption = 'Pause' Then
Button2.Caption := 'Continue'
else
Button2. Caption := 'Pause';
MediaPlayer1.Pause;
end;
Adicione o seguinte código ao evento OnClick do Button3 (Stop):
procedure TForm1.Button3Click(Sender: TObject);
begin
MediaPlayer1.Stop;
MediaPlayer1.Frames := 0;
TrackBar1.Position := 0;
Panel1.Refresh;
end;
Adicione o evento a seguir ao evento OnTimer do componente Timer1 para atualizar a linha do tempo de acordo com o avanço do video:
procedure TForm1.Timer1Timer(Sender: TObject);
begin
if MediaPlayer1.Frames > 0 then
begin
TrackBar1.Position := MediaPlayer1.Position;
end;
end;
Adicione o código a seguir ao evento OnChange do TrackBar1 para atualizar o vídeo no Display caso o usuário avance ou recue a linha do tempo:
procedure TForm1.TrackBar1Change(Sender: TObject);
begin
With MediaPlayer1 do
Begin
StartPos := TrackBar1.Position;
Play;
End;
end;
Salve o projeto em seu computador, compile e execute sua aplicação. Clique no botão "abrir", e localize um arquivo de vídeo no formato "*.avi" para que seja executado. Abraço e até o próximo post.
segunda-feira, 1 de junho de 2009
Rodar programa dentro de outro
Por exemplo, você quer mostrar a calculadora do Windows dentro do seu sistema, em um form específico, ou, quer rodar um executável terceirizado só que dentro da interface do seu sistema, é possível?
Sim, ao utilizarmos o Handle de formulários do Delphi conseguimos incorporar outras aplicações dentro da estrutura do nosso sistema, permitindo que as ações sejam executadas no próprio sistema. Veremos como exibir a calculadora do windows ("calc.exe") dentro de um form. Adicione dois botões ao formulário, altere o Caption dos mesmos para "Abrir" e "Incorporar" respectivamente. Ao evento OnClick do botão abrir, adicione o seguinte código que irá executar a calculadora:
WinExec('calc.exe',SW_NORMAL);
Ao botão incorporar adicione a seguinte linha de código que irá localizar o executável da calculadora e em seguida incorporar a sua estrutura dentro da estrutura do formulário que estamos trabalhando (handle):
windows.SetParent( FindWindow( nil, 'Calculadora' ), Form1.handle ) ;
Ao rodar a aplicação, clique primeiramente em "abrir" para que a calculadora seja executada, veja que a mesma está aparecendo na barra de tarefas do windows. Após clique em "incorporar" observando que ela passa a ser exibida como sendo um objeto do formulário que deixa de ser exibida na barra de tarefas do S.O. Faça a utilização desta dica empregada a outros tipos de executáveis. Abraço e até o próximo post.
Sim, ao utilizarmos o Handle de formulários do Delphi conseguimos incorporar outras aplicações dentro da estrutura do nosso sistema, permitindo que as ações sejam executadas no próprio sistema. Veremos como exibir a calculadora do windows ("calc.exe") dentro de um form. Adicione dois botões ao formulário, altere o Caption dos mesmos para "Abrir" e "Incorporar" respectivamente. Ao evento OnClick do botão abrir, adicione o seguinte código que irá executar a calculadora:
WinExec('calc.exe',SW_NORMAL);
Ao botão incorporar adicione a seguinte linha de código que irá localizar o executável da calculadora e em seguida incorporar a sua estrutura dentro da estrutura do formulário que estamos trabalhando (handle):
windows.SetParent( FindWindow( nil, 'Calculadora' ), Form1.handle ) ;
Ao rodar a aplicação, clique primeiramente em "abrir" para que a calculadora seja executada, veja que a mesma está aparecendo na barra de tarefas do windows. Após clique em "incorporar" observando que ela passa a ser exibida como sendo um objeto do formulário que deixa de ser exibida na barra de tarefas do S.O. Faça a utilização desta dica empregada a outros tipos de executáveis. Abraço e até o próximo post.
sexta-feira, 29 de maio de 2009
Acessando componentes dentro do Wizard - Delphi for .NET
Bom galera, o post de hoje vale mais como uma dica. Na verdade parece simples acessar componentes dentro de um Wizard, mas tem um pequeno "esquema" para acessar estes componentes que são adicionados dentro de um componente Wizard no Delphi 2007 for asp.NET onde a estrutura de códigos do Delphi não oferece suporte para acesso direto as propriedades dos componentes, ou seja, no caso de um DropDowList você não conseguira acessar de forma direta a propriedade DataSource, assim:
DropDowList1.DataSource := pDataSet;
Vejamos alguns exemplos para acessar alguns dos mais comuns entre os componentes utilizados no Delphi:
{DropDowList}
(Wizard1.FindControl('DropDownList1') as DropDownList).DataSource := pDataSet;
(Wizard1.FindControl('DropDownList1') as DropDownList).DataBind;
{Button}
(Wizard1.FindControl('Button1') as Button).Text := 'Salvar';
{CheckBox}
(Wizard1.FindControl('CheckBox1') as CheckBox).Checked := True;
{Label}
(Wizard1.FindControl('Label1') as &Label).Text := 'Informe o valor';
{TextBox}
(Wizard1.FindControl('TextBox1') as TextBox).Visible := False;
A partir destes exemplos, adicione outros componentes onde passa a valer a mesma regra para referenciar os componentes utilizados. Abraço e até o próximo post.
DropDowList1.DataSource := pDataSet;
Vejamos alguns exemplos para acessar alguns dos mais comuns entre os componentes utilizados no Delphi:
{DropDowList}
(Wizard1.FindControl('DropDownList1') as DropDownList).DataSource := pDataSet;
(Wizard1.FindControl('DropDownList1') as DropDownList).DataBind;
{Button}
(Wizard1.FindControl('Button1') as Button).Text := 'Salvar';
{CheckBox}
(Wizard1.FindControl('CheckBox1') as CheckBox).Checked := True;
{Label}
(Wizard1.FindControl('Label1') as &Label).Text := 'Informe o valor';
{TextBox}
(Wizard1.FindControl('TextBox1') as TextBox).Visible := False;
A partir destes exemplos, adicione outros componentes onde passa a valer a mesma regra para referenciar os componentes utilizados. Abraço e até o próximo post.
quarta-feira, 6 de maio de 2009
Exibir itens de MainMenu em TreeView (método recursivo)
Surgida a partir da necessidade de leitores do blog, onde possuem estruturas carregadas com submenus em vários níveis em suas aplicações, reformulei a estrutura do post anterior desta vez utilizando um método que será invocado de forma recursiva para cada item de menu que possuir submenus. Nesta nova estrutura, não haverá limitação de níveis para que os itens sejam exibidos no TreeView.
Baseado na estrutura do post anterior, iremos declarar a mesma procedure e realizar a implementação do código conforme segue:
procedure TForm1.PreencherMenus(Menu: TMainMenu);
{função chamada para adicionar itens ou subitens de forma recursiva}
procedure AdicionaSubItens(mS, mI : TMenuItem; n : TTreeNode);
var
j,p: integer;//j= usado no for - p= guarda posiçao
a,b,c2: string;//guarda valores de texto a serem adicionados na Tree
sn, x, y: TTreeNode;//guarda posiçoes de nós da TreeView
begin
for j := 0 to mI.Count - 1 do
begin
{pega os itens do submenu}
mS := mI.Items[j];
{titulos de itens/submenus}
a := mI.Caption;
b := mS.Caption;
p := pos('&',b);
if p > 0 then
Delete(b,p,1);
if b <> '-' then
begin
x := TreeView1.Items.AddChild(n,b);
end;
{verifica se o item tem sub-itens, e então entra em recursividade}
if mI.Items[j].Count > 0 then
begin
c2 := mS.Caption;
AdicionaSubItens(mS,mS,x);//função recursiva
end;
end;
end;
var
i,p: integer;//i= contador - p=posição
a: string;//caption dos menus principais
mI,mS: TMenuItem;//guarda posiçoes e itens do menu
n,sn: TTreeNode;//posições e itens da tree
begin
TreeView1.Items.Clear;
sn := nil;
for i := 0 to Menu.Items.Count - 1 do
begin
mI := Menu.Items[i];
a := mI.Caption; // Titulos do menus
p := pos('&',a);
if p > 0 then
Delete(a,p,1);
n := TreeView1.Items.Add(sn,a); //nó
{Chama a função recursiva para adiçao dos itens de menu}
AdicionaSubItens(mS,Mi,n);
end;
for I := 0 to TreeView1.Items.Count - 1 do
if TreeView1.Items[i].Level <> 0 then
TreeView1.Items[i].StateIndex := 1;
end;
Nesta nova estrutura agora temos uma procedure (AdicionaSubItens) que será chamada para adicionar os itens de menu, e dentro dela mesma, há uma verificação quanto a existência de subitens, e em caso afirmativo, ela fará uma nova chamada a si mesma, tornando-se assim recursiva.
O método de invocação da função principal continua a partir do clique no botão, utilizando os mesmos códigos que no post anterior. Execute a aplicação e veja o resultado.
A partir desta melhoria, faça a implementação em seu código, podendo criar rotinas de segurança a partir dos itens de menu ou simplesmente criando um mapa do sistema para facilitar a localização do usuário. Abraço
Baseado na estrutura do post anterior, iremos declarar a mesma procedure e realizar a implementação do código conforme segue:
procedure TForm1.PreencherMenus(Menu: TMainMenu);
{função chamada para adicionar itens ou subitens de forma recursiva}
procedure AdicionaSubItens(mS, mI : TMenuItem; n : TTreeNode);
var
j,p: integer;//j= usado no for - p= guarda posiçao
a,b,c2: string;//guarda valores de texto a serem adicionados na Tree
sn, x, y: TTreeNode;//guarda posiçoes de nós da TreeView
begin
for j := 0 to mI.Count - 1 do
begin
{pega os itens do submenu}
mS := mI.Items[j];
{titulos de itens/submenus}
a := mI.Caption;
b := mS.Caption;
p := pos('&',b);
if p > 0 then
Delete(b,p,1);
if b <> '-' then
begin
x := TreeView1.Items.AddChild(n,b);
end;
{verifica se o item tem sub-itens, e então entra em recursividade}
if mI.Items[j].Count > 0 then
begin
c2 := mS.Caption;
AdicionaSubItens(mS,mS,x);//função recursiva
end;
end;
end;
var
i,p: integer;//i= contador - p=posição
a: string;//caption dos menus principais
mI,mS: TMenuItem;//guarda posiçoes e itens do menu
n,sn: TTreeNode;//posições e itens da tree
begin
TreeView1.Items.Clear;
sn := nil;
for i := 0 to Menu.Items.Count - 1 do
begin
mI := Menu.Items[i];
a := mI.Caption; // Titulos do menus
p := pos('&',a);
if p > 0 then
Delete(a,p,1);
n := TreeView1.Items.Add(sn,a); //nó
{Chama a função recursiva para adiçao dos itens de menu}
AdicionaSubItens(mS,Mi,n);
end;
for I := 0 to TreeView1.Items.Count - 1 do
if TreeView1.Items[i].Level <> 0 then
TreeView1.Items[i].StateIndex := 1;
end;
Nesta nova estrutura agora temos uma procedure (AdicionaSubItens) que será chamada para adicionar os itens de menu, e dentro dela mesma, há uma verificação quanto a existência de subitens, e em caso afirmativo, ela fará uma nova chamada a si mesma, tornando-se assim recursiva.
O método de invocação da função principal continua a partir do clique no botão, utilizando os mesmos códigos que no post anterior. Execute a aplicação e veja o resultado.
A partir desta melhoria, faça a implementação em seu código, podendo criar rotinas de segurança a partir dos itens de menu ou simplesmente criando um mapa do sistema para facilitar a localização do usuário. AbraçoExibir itens de MainMenu em TreeView
Bom, certamente alguma vez você já pensou em implementar um módulo de segurança em seu sistema, onde você iria listar todos os itens do seu menu em uma árvore (TreeView) e permitir que um administrador faça a manutenção das permissões, mas como listo todos estes itens do menu no TreeView? É o que veremos agora.
Crie uma nova aplicação e adicione ao formulário os seguintes componentes:
- Um componente MainMenu onde deverá criar uma pequena estrutura de itens, por exemplo:
| Arquivo | Cadastros | Ajuda
:Abrir....|:Cidades...|:Sobre o Sistema
:Salvar...|:Clientes
:Sair.....|:Produtos
- Um Button ao topo do formulário que utilizaremos para a listagem dos itens de menu na TreeView;
- Um componente TreeView que será utilizado para exibir os itens do menu.
Acesse o código da aplicação e faça a declaração da seguinte procedure que será a encarregada de ler os itens do menu e adicionar os nodes na TreeView:
procedure PreencherMenus(Menu: TMainMenu);
Em seguida, utilizando as teclas Ctrl+Shift+C faça a implementação do procedimento adicionando a ele o código a seguir:
procedure TForm1.PreencherMenus(Menu: TMainMenu);
var
i,j,p,imgS: integer;
a,b: string;
mI,mS: TMenuItem;
n,sn: TTreeNode;
begin
TreeView1.Items.Clear;
sn := nil;
for i := 0 to Menu.Items.Count - 1 do
begin
mI := Menu.Items[i];
a := mI.Caption; // Titulos do menus
p := pos('&',a);
if p > 0 then
Delete(a,p,1);
n := TreeView1.Items.Add(sn,a); //nó
for j := 0 to mI.Count - 1 do
begin
mS := mI.Items[j];
b := mS.Caption; // Titulos dos sub-menus
p := pos('&',b);
if p > 0 then
Delete(b,p,1);
if b <> '-' then
begin
TreeView1.Items.AddChild(n,b);
end;
end;
end;
for I := 0 to TreeView1.Items.Count - 1 do
if TreeView1.Items[i].Level <> 0 then
TreeView1.Items[i].StateIndex := 1;
end;
Implementado o procedimento que lê os itens de menu um a um e cria nós a serem adicionado no TreeView vamos chamar o procedimento no evento OnClick do botão, adicionando a ele o seguinte código:
procedure TForm1.Button1Click(Sender: TObject);
begin
PreencherMenus(MainMenu1);
TreeView1.FullExpand;//Abre toda a lista de itens
end;
Bom, dessa forma você poderá implementar agora sua próprias funcionalidades à sua aplicação integrando os componentes MainMenu e TreeView. Abraço e até o próximo post.
Crie uma nova aplicação e adicione ao formulário os seguintes componentes:
- Um componente MainMenu onde deverá criar uma pequena estrutura de itens, por exemplo:
| Arquivo | Cadastros | Ajuda
:Abrir....|:Cidades...|:Sobre o Sistema
:Salvar...|:Clientes
:Sair.....|:Produtos
- Um Button ao topo do formulário que utilizaremos para a listagem dos itens de menu na TreeView;
- Um componente TreeView que será utilizado para exibir os itens do menu.
Acesse o código da aplicação e faça a declaração da seguinte procedure que será a encarregada de ler os itens do menu e adicionar os nodes na TreeView:
procedure PreencherMenus(Menu: TMainMenu);
Em seguida, utilizando as teclas Ctrl+Shift+C faça a implementação do procedimento adicionando a ele o código a seguir:
procedure TForm1.PreencherMenus(Menu: TMainMenu);
var
i,j,p,imgS: integer;
a,b: string;
mI,mS: TMenuItem;
n,sn: TTreeNode;
begin
TreeView1.Items.Clear;
sn := nil;
for i := 0 to Menu.Items.Count - 1 do
begin
mI := Menu.Items[i];
a := mI.Caption; // Titulos do menus
p := pos('&',a);
if p > 0 then
Delete(a,p,1);
n := TreeView1.Items.Add(sn,a); //nó
for j := 0 to mI.Count - 1 do
begin
mS := mI.Items[j];
b := mS.Caption; // Titulos dos sub-menus
p := pos('&',b);
if p > 0 then
Delete(b,p,1);
if b <> '-' then
begin
TreeView1.Items.AddChild(n,b);
end;
end;
end;
for I := 0 to TreeView1.Items.Count - 1 do
if TreeView1.Items[i].Level <> 0 then
TreeView1.Items[i].StateIndex := 1;
end;
Implementado o procedimento que lê os itens de menu um a um e cria nós a serem adicionado no TreeView vamos chamar o procedimento no evento OnClick do botão, adicionando a ele o seguinte código:
procedure TForm1.Button1Click(Sender: TObject);
begin
PreencherMenus(MainMenu1);
TreeView1.FullExpand;//Abre toda a lista de itens
end;
Bom, dessa forma você poderá implementar agora sua próprias funcionalidades à sua aplicação integrando os componentes MainMenu e TreeView. Abraço e até o próximo post.
quinta-feira, 30 de abril de 2009
Escrever valores sobrescritos em Label (Simbolizar exponenciação)
Aposto que só de ler o titulo você ficou curioso em saber como fazer pra simbolizar uma exponenciação no Delphi através de um componente Label. Bom, navegando pelos fóruns na web, encontrei um tópico com esse mesmo assunto, e fiquei curioso pra saber a solução. Procurei na web e não consegui encontrar nenhuma rotina pronta que fosse escrever texto e ter um valor sobrescrito, não restou outra alternativa a não ser "criar" a minha própria procedure.
Imagine que você tivesse que simbolizar no seu sistema o número 10 elevado ao expoente 6, como faria (106)? Crie um novo projeto no Delphi, e a ele adicione um componente Button e um Label. Vá agora para o source do projeto onde vamos implementar a procedure "mágica" que irá deixar o texto sobrescrito. Como parâmetros, a procedure irá receber o Label onde o valor será exibido, o valor normal da expressão e o expoente.
procedure TForm1.EscreverSobrescrito(OndeEscrever: TLabel; Valor, Sobrescrito: Integer);
var
upLabel : TLabel;
begin
OndeEscrever.Caption := IntToStr(Valor);
upLabel := TLabel.Create(Self);
upLabel.Font.Size := 6;
upLabel.Parent := Self;
upLabel.Left := OndeEscrever.Left+OndeEscrever.Width+1;
upLabel.Top := OndeEscrever.Top;
upLabel.Caption := IntToStr(Sobrescrito);
end;
Observe que na procedure declaramos uma nova variável do tipo TLabel que será criada em tempo de execução, e esta por sua vez será exibida com posições idênticas ao Label onde será exibido o valor, porém com tamanho de fonte menor, deixando o valor sobrescrito.
Para a chamar a procedure, adicione o seguinte código ao evento OnClick do botão, e veja o resultado:
EscreverSobrescrito(Label1,10,6);

Pronto, agora temos um procedimento capaz de simbolizar valores exponências em componentes do tipo Label no Delphi. Abraços
Imagine que você tivesse que simbolizar no seu sistema o número 10 elevado ao expoente 6, como faria (106)? Crie um novo projeto no Delphi, e a ele adicione um componente Button e um Label. Vá agora para o source do projeto onde vamos implementar a procedure "mágica" que irá deixar o texto sobrescrito. Como parâmetros, a procedure irá receber o Label onde o valor será exibido, o valor normal da expressão e o expoente.
procedure TForm1.EscreverSobrescrito(OndeEscrever: TLabel; Valor, Sobrescrito: Integer);
var
upLabel : TLabel;
begin
OndeEscrever.Caption := IntToStr(Valor);
upLabel := TLabel.Create(Self);
upLabel.Font.Size := 6;
upLabel.Parent := Self;
upLabel.Left := OndeEscrever.Left+OndeEscrever.Width+1;
upLabel.Top := OndeEscrever.Top;
upLabel.Caption := IntToStr(Sobrescrito);
end;
Observe que na procedure declaramos uma nova variável do tipo TLabel que será criada em tempo de execução, e esta por sua vez será exibida com posições idênticas ao Label onde será exibido o valor, porém com tamanho de fonte menor, deixando o valor sobrescrito.
Para a chamar a procedure, adicione o seguinte código ao evento OnClick do botão, e veja o resultado:
EscreverSobrescrito(Label1,10,6);

Pronto, agora temos um procedimento capaz de simbolizar valores exponências em componentes do tipo Label no Delphi. Abraços
Convertendo números decimais para algarismos romanos
Talvez você não vá usar esta rotina em seu sistema, mas quem já não se interessou em criar um sistema capaz de converter números decimais para algarismos romanos? Bom, mais fácil do que decorar a equivalência de cada um dos algarismos é criar uma rotina no Delphi e então vamos lá.
Em um novo projeto, adicione ao formulário um componente Edit, um Button e um Label, um abaixo ao outro nesta ordem. Agora vá no source do projeto e declare a seguinte função que fará a conversão dos valores:
function TForm1.DecimalToRomano(Decimal: Longint): string;
const
Numeros: array[1..13] of Integer =
(1, 4, 5, 9, 10, 40, 50, 90, 100,
400, 500, 900, 1000);
Romanos: array[1..13] of string =
('I', 'IV', 'V', 'IX', 'X', 'XL',
'L', 'XC', 'C', 'CD', 'D', 'CM', 'M');
var
i: Integer;
begin
Result := '';
for i := 13 downto 1 do
while (Decimal >= Numeros[i]) do
begin
Decimal := Decimal - Numeros[i];
Result := Result + Romanos[i];
end;
end;
Nesta função temos duas constantes (listas de Strings) que armazenam os valores do tipo decimal e o valor a ela correspondente. Em seguida, o sistema entra num laço, que de acordo com a quantidade de números vai realizando a substituição do número decimal pelo algarismo romano. Para chamar a rotina, adicione ao evento OnClick do botão o código a seguir, que irá jogar o resultado da função para o componente Label. Como parâmetro passamos à função o número decimal digitado no Edit.
procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Caption := DecimalToRomano(StrToInt(Edit1.Text))
end;
Para garantir que o usuário digite apenas números no Edit e não letras, vamos adicionar uma validação de caracteres ao evento KeyPress do Edit, conforme código que segue:
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if not (key in ['1'..'9',#8]) then
abort;
end;

Codificado todo o sistema, compile e execute o projeto e realize a conversão dos números. Abraço.
Em um novo projeto, adicione ao formulário um componente Edit, um Button e um Label, um abaixo ao outro nesta ordem. Agora vá no source do projeto e declare a seguinte função que fará a conversão dos valores:
function TForm1.DecimalToRomano(Decimal: Longint): string;
const
Numeros: array[1..13] of Integer =
(1, 4, 5, 9, 10, 40, 50, 90, 100,
400, 500, 900, 1000);
Romanos: array[1..13] of string =
('I', 'IV', 'V', 'IX', 'X', 'XL',
'L', 'XC', 'C', 'CD', 'D', 'CM', 'M');
var
i: Integer;
begin
Result := '';
for i := 13 downto 1 do
while (Decimal >= Numeros[i]) do
begin
Decimal := Decimal - Numeros[i];
Result := Result + Romanos[i];
end;
end;
Nesta função temos duas constantes (listas de Strings) que armazenam os valores do tipo decimal e o valor a ela correspondente. Em seguida, o sistema entra num laço, que de acordo com a quantidade de números vai realizando a substituição do número decimal pelo algarismo romano. Para chamar a rotina, adicione ao evento OnClick do botão o código a seguir, que irá jogar o resultado da função para o componente Label. Como parâmetro passamos à função o número decimal digitado no Edit.
procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Caption := DecimalToRomano(StrToInt(Edit1.Text))
end;
Para garantir que o usuário digite apenas números no Edit e não letras, vamos adicionar uma validação de caracteres ao evento KeyPress do Edit, conforme código que segue:
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if not (key in ['1'..'9',#8]) then
abort;
end;

Codificado todo o sistema, compile e execute o projeto e realize a conversão dos números. Abraço.
quarta-feira, 22 de abril de 2009
Passagem de parâmetros para Rave Reports
Bom, após alguns dias com as postagens paradas, estou voltando hoje para iniciar uma série de dicas sobre relatórios com Rave Reports, e para começar, veremos hoje a configuração e passagem de parâmetros do Delphi para um relatório no Rave.
Com o Rave Reports aberto, crie um novo relatório, salve o mesmo em um diretório do seu computador e sem seguida selecione o relatório na Report Library e altere a propriedade Name do mesmo para "rptParam". Observe também que o mesmo possui uma propriedade chamada Parameters, onde você poderá adicionar os parâmetros que deseja passar do Delphi ao Rave. Abra o String Editor de parâmetros e adicione "pNome" (se desejar adicionar mais parâmetros, basta dar um ENTER e digitar o novo parâmetro na próxima linha).
Para que possamos visualizar o valor recebido através do parâmetro na tela, vamos seguir os passos de criação de um relatório profissional adicionando à tela um componente Region da paleta Report. Ajuste as dimensões do componente Region para que utilize todo o espaço da página contida entre o pontilhado vermelho que delimita a área imprimivel do relatório. Arraste agora para o interior do Region um componente Band também da paleta Report, este que por sua vez se alinhará sózinho ao topo. Dentro da Band, adicione um componente Data Text e vá até a propriedade Data Field e clique sobre os 3 pontinhos "..." para abrir o Data Text Editor, no qual vá até o item Project Parameters e selecione o parâmetro "pNome" configurado e adicione-o (Insert Parameter) ao Data Text e confirme a tela.
O próximo passo agora será a codificação do processo para execução do relatório no Delphi, onde após a criação de um novo projeto, arraste da paleta Rave para o formulário os seguintes componentes: - RvSystem - RvProject: defina a propriedade Engine para o RvSystem, onde ficam as configurações do relatório a ser exibido. Em ProjectFile procure o relatório criado no Rave Reports, será o projeto a ser executado. Adicione um Button ("Exibir relatório") ao formulário onde faremos a codificação do processo para passagem de valores ao parâmetro e também exibição do relatório em tela. Adicione o código a seguir ao evento OnClick do botão, onde o mesmo encontra-se comentado de acordo com a função desempenhada por cada bloco:
procedure TForm1.Button1Click(Sender: TObject);
begin
{ fecha o projeto do relatório }
RvProject1.Close;
{ selecione o nome do parâmetro e atribui-lhe um valor }
RvProject1.SetParam('pNome','MAIKEL SCHEID');
{ seleciona o relatório a ser exibido }
RvProject1.Execute;
{ abre o projeto do relatório }
RvProject1.Open; RvProject1.SelectReport('rptParam',True);
{ executa o relatório selecionado }
end;
Finalizado a codificação, execute o projeto e observe que o valor passado ao parâmetro está sendo exibido na tela do relatório (confira resultado na figura abaixo). Desta mesma maneira agora você poderá passar resultados de cálculos realizados no Delphi para ser exibidos no relatório, passar caminhos absolutos de imagens, entre outras funcionalidades que facilitarão seus relatórios.

Bom, por ora seria isto, acompanhe os próximos posts com novas dicas. Abraço
Com o Rave Reports aberto, crie um novo relatório, salve o mesmo em um diretório do seu computador e sem seguida selecione o relatório na Report Library e altere a propriedade Name do mesmo para "rptParam". Observe também que o mesmo possui uma propriedade chamada Parameters, onde você poderá adicionar os parâmetros que deseja passar do Delphi ao Rave. Abra o String Editor de parâmetros e adicione "pNome" (se desejar adicionar mais parâmetros, basta dar um ENTER e digitar o novo parâmetro na próxima linha).
Para que possamos visualizar o valor recebido através do parâmetro na tela, vamos seguir os passos de criação de um relatório profissional adicionando à tela um componente Region da paleta Report. Ajuste as dimensões do componente Region para que utilize todo o espaço da página contida entre o pontilhado vermelho que delimita a área imprimivel do relatório. Arraste agora para o interior do Region um componente Band também da paleta Report, este que por sua vez se alinhará sózinho ao topo. Dentro da Band, adicione um componente Data Text e vá até a propriedade Data Field e clique sobre os 3 pontinhos "..." para abrir o Data Text Editor, no qual vá até o item Project Parameters e selecione o parâmetro "pNome" configurado e adicione-o (Insert Parameter) ao Data Text e confirme a tela.
O próximo passo agora será a codificação do processo para execução do relatório no Delphi, onde após a criação de um novo projeto, arraste da paleta Rave para o formulário os seguintes componentes: - RvSystem - RvProject: defina a propriedade Engine para o RvSystem, onde ficam as configurações do relatório a ser exibido. Em ProjectFile procure o relatório criado no Rave Reports, será o projeto a ser executado. Adicione um Button ("Exibir relatório") ao formulário onde faremos a codificação do processo para passagem de valores ao parâmetro e também exibição do relatório em tela. Adicione o código a seguir ao evento OnClick do botão, onde o mesmo encontra-se comentado de acordo com a função desempenhada por cada bloco: procedure TForm1.Button1Click(Sender: TObject);
begin
{ fecha o projeto do relatório }
RvProject1.Close;
{ selecione o nome do parâmetro e atribui-lhe um valor }
RvProject1.SetParam('pNome','MAIKEL SCHEID');
{ seleciona o relatório a ser exibido }
RvProject1.Execute;
{ abre o projeto do relatório }
RvProject1.Open; RvProject1.SelectReport('rptParam',True);
{ executa o relatório selecionado }
end;
Finalizado a codificação, execute o projeto e observe que o valor passado ao parâmetro está sendo exibido na tela do relatório (confira resultado na figura abaixo). Desta mesma maneira agora você poderá passar resultados de cálculos realizados no Delphi para ser exibidos no relatório, passar caminhos absolutos de imagens, entre outras funcionalidades que facilitarão seus relatórios.

Bom, por ora seria isto, acompanhe os próximos posts com novas dicas. Abraço
segunda-feira, 13 de abril de 2009
Coletar informações da CPU
Já pensou em disponibilizar em seu sistema informações da CPU do computador ou montar um sistema que seja capaz de coletar estas informações e gerar um inventário de hardware do computador? Exatamente assim que eu pensei, quero montar um sistema a fim de documentar os hardwares da minha rede. Abaixo segue estrutura organizada a fim de exibir informações da CPU do computador, informações estas que estão sendo impressas em um componente TImage, que você poderá salvar, enviar por e-mail ou armazenar como documentação.
begin
if s1 <> '' then
begin
img_info.Canvas.Brush.Color := clblue;
img_info.Canvas.Font.Color := clyellow;
img_info.Canvas.TextOut(gn_text_x, gn_text_y, s1);
end;
if s2 <> '' then
begin
img_info.Canvas.Brush.Color := clblue;
img_info.Canvas.Font.Color := clWhite;
img_info.Canvas.TextOut(gn_text_x + img_info.Canvas.TextWidth(s1), gn_text_y, s2);
end;
Inc(gn_text_y, 13);
end;
frmCPU: TfrmCPU;
gn_speed_y: Integer;
gn_text_y: Integer;
const
gn_speed_x: Integer = 8;
gn_text_x: Integer = 15;
gl_start: Boolean = True;
var
_eax, _ebx, _ecx, _edx: Longword;
i: Integer;
b: Byte;
b1: Word;
s, s1, s2, s3, s_all: string;
begin
//Set the startup colour of the image
img_info.Canvas.Brush.Color := clblue;
img_info.Canvas.FillRect(rect(0, 0, img_info.Width, img_info.Height));
gn_text_y := 5; //position of the 1st text
asm //asm call to the CPUID inst.
mov eax,0 //sub. func call
db $0F,$A2 //db $0F,$A2 = CPUID instruction
mov _ebx,ebx
mov _ecx,ecx
mov _edx,edx
end;
for i := 0 to 3 do //extract vendor id
begin
b := lo(_ebx);
s := s + chr(b);
b := lo(_ecx);
s1:= s1 + chr(b);
b := lo(_edx);
s2:= s2 + chr(b);
_ebx := _ebx shr 8;
_ecx := _ecx shr 8;
_edx := _edx shr 8;
end;
info('CPU', '');
info(' - ' + 'Vendor ID: ', s + s2 + s1);
asm
mov eax,1
db $0F,$A2
mov _eax,eax
mov _ebx,ebx
mov _ecx,ecx
mov _edx,edx
end;
//06B1
//|0000| |0000 0000| |0000| |00| |00| |0110| |1011| |0001|
b := lo(_eax) and 15;
info(' - ' + 'Stepping ID: ', IntToStr(b));
b := lo(_eax) shr 4;
info(' - ' + 'Model Number: ', IntToHex(b, 1));
b := hi(_eax) and 15;
info(' - ' + 'Family Code: ', IntToStr(b));
b := hi(_eax) shr 4;
info(' - ' + 'Processor Type: ', IntToStr(b));
//31. 28. 27. 24. 23. 20. 19. 16.
// 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
b := lo((_eax shr 16)) and 15;
info(' - ' + 'Extended Model: ', IntToStr(b));
b := lo((_eax shr 20));
info(' - ' + 'Extended Family: ', IntToStr(b));
b := lo(_ebx);
info(' - ' + 'Brand ID: ', IntToStr(b));
b := hi(_ebx);
info(' - ' + 'Chunks: ', IntToStr(b));
b := lo(_ebx shr 16);
info(' - ' + 'Count: ', IntToStr(b));
b := hi(_ebx shr 16);
info(' - ' + 'APIC ID: ', IntToStr(b));
//Bit 18 =? 1 //is serial number enabled?
if (_edx and $40000) = $40000 then
info(' - ' + 'Serial Number ', 'Enabled')
else
info(' - ' + 'Serial Number ', 'Disabled');
s := IntToHex(_eax, 8);
asm //determine the serial number
mov eax,3
db $0F,$A2
mov _ecx,ecx
mov _edx,edx
end;
s1 := IntToHex(_edx, 8);
s2 := IntToHex(_ecx, 8);
Insert('-', s, 5);
Insert('-', s1, 5);
Insert('-', s2, 5);
info(' - ' + 'Serial Number: ', s + '-' + s1 + '-' + s2);
asm
mov eax,1
db $0F,$A2
mov _edx,edx
end;
info('', '');
//Bit 23 =? 1
if (_edx and $800000) = $800000 then
info('MMX ', 'Supported')
else
info('MMX ', 'Not Supported');
//Bit 24 =? 1
if (_edx and $01000000) = $01000000 then
info('FXSAVE & FXRSTOR Instructions ', 'Supported')
else
info('FXSAVE & FXRSTOR Instructions Not ', 'Supported');
//Bit 25 =? 1
if (_edx and $02000000) = $02000000 then
info('SSE ', 'Supported')
else
info('SSE ', 'Not Supported');
//Bit 26 =? 1
if (_edx and $04000000) = $04000000 then
info('SSE2 ', 'Supported')
else
info('SSE2 ', 'Not Supported');
info('', '');
asm //execute the extended CPUID inst.
mov eax,$80000000 //sub. func call
db $0F,$A2
mov _eax,eax
end;
if _eax > $80000000 then //any other sub. funct avail. ?
begin
info('Extended CPUID: ', 'Supported');
info(' - Largest Function Supported: ', IntToStr(_eax - $80000000));
asm //get brand ID
mov eax,$80000002
db $0F
db $A2
mov _eax,eax
mov _ebx,ebx
mov _ecx,ecx
mov _edx,edx
end;
s := '';
s1 := '';
s2 := '';
s3 := '';
for i := 0 to 3 do
begin
b := lo(_eax);
s3:= s3 + chr(b);
b := lo(_ebx);
s := s + chr(b);
b := lo(_ecx);
s1 := s1 + chr(b);
b := lo(_edx);
s2 := s2 + chr(b);
_eax := _eax shr 8;
_ebx := _ebx shr 8;
_ecx := _ecx shr 8;
_edx := _edx shr 8;
end;
s_all := s3 + s + s1 + s2;
asm
mov eax,$80000003
db $0F
db $A2
mov _eax,eax
mov _ebx,ebx
mov _ecx,ecx
mov _edx,edx
end;
s := '';
s1 := '';
s2 := '';
s3 := '';
for i := 0 to 3 do
begin
b := lo(_eax);
s3 := s3 + chr(b);
b := lo(_ebx);
s := s + chr(b);
b := lo(_ecx);
s1 := s1 + chr(b);
b := lo(_edx);
s2 := s2 + chr(b);
_eax := _eax shr 8;
_ebx := _ebx shr 8;
_ecx := _ecx shr 8;
_edx := _edx shr 8;
end;
s_all := s_all + s3 + s + s1 + s2;
asm
mov eax,$80000004
db $0F
db $A2
mov _eax,eax
mov _ebx,ebx
mov _ecx,ecx
mov _edx,edx
end;
s := '';
s1 := '';
s2 := '';
s3 := '';
for i := 0 to 3 do
begin
b := lo(_eax);
s3 := s3 + chr(b);
b := lo(_ebx);
s := s + chr(b);
b := lo(_ecx);
s1 := s1 + chr(b);
b := lo(_edx);
s2 := s2 + chr(b);
_eax := _eax shr 8;
_ebx := _ebx shr 8;
_ecx := _ecx shr 8;
_edx := _edx shr 8;
end;
info('Brand String: ', '');
if s2[Length(s2)] = #0 then setlength(s2, Length(s2) - 1);
info('', ' - ' + s_all + s3 + s + s1 + s2);
end
else
info(' - Extended CPUID ', 'Not Supported.');
end;
Salve o projeto e em seguida execute-o, visualizando as informações obtidas.
Abraço e até o próximo post.
Para começar, crie uma nova aplicação Windows Forms, altere o nome do formulário principal para frmCPU e a propriedade Caption para "Informações da CPU". Arraste para a tela um componente TImage(img_info), vá para código e declare na seção public a seguinte procedure seguindo pela implementação da mesma com o código a seguir:
procedure TfrmCPU.info(s1, s2: string);begin
if s1 <> '' then
begin
img_info.Canvas.Brush.Color := clblue;
img_info.Canvas.Font.Color := clyellow;
img_info.Canvas.TextOut(gn_text_x, gn_text_y, s1);
end;
if s2 <> '' then
begin
img_info.Canvas.Brush.Color := clblue;
img_info.Canvas.Font.Color := clWhite;
img_info.Canvas.TextOut(gn_text_x + img_info.Canvas.TextWidth(s1), gn_text_y, s2);
end;
Inc(gn_text_y, 13);
end;
Declare também junto a seção de variáveis do formulário a seguinte lista de objetos e constantes:
varfrmCPU: TfrmCPU;
gn_speed_y: Integer;
gn_text_y: Integer;
const
gn_speed_x: Integer = 8;
gn_text_x: Integer = 15;
gl_start: Boolean = True;
Por fim, para coletar e mostrar as informações da CPU no componente de imagem, adicione a seguinte codificação ao evento OnShow do formulário. O código é responsável por disparar rotinas que coletam as informações da CPU de acordo com as categorias estabelecidas:
procedure TfrmCPU.FormShow(Sender: TObject);var
_eax, _ebx, _ecx, _edx: Longword;
i: Integer;
b: Byte;
b1: Word;
s, s1, s2, s3, s_all: string;
begin
//Set the startup colour of the image
img_info.Canvas.Brush.Color := clblue;
img_info.Canvas.FillRect(rect(0, 0, img_info.Width, img_info.Height));
gn_text_y := 5; //position of the 1st text
asm //asm call to the CPUID inst.
mov eax,0 //sub. func call
db $0F,$A2 //db $0F,$A2 = CPUID instruction
mov _ebx,ebx
mov _ecx,ecx
mov _edx,edx
end;
for i := 0 to 3 do //extract vendor id
begin
b := lo(_ebx);
s := s + chr(b);
b := lo(_ecx);
s1:= s1 + chr(b);
b := lo(_edx);
s2:= s2 + chr(b);
_ebx := _ebx shr 8;
_ecx := _ecx shr 8;
_edx := _edx shr 8;
end;
info('CPU', '');
info(' - ' + 'Vendor ID: ', s + s2 + s1);
asm
mov eax,1
db $0F,$A2
mov _eax,eax
mov _ebx,ebx
mov _ecx,ecx
mov _edx,edx
end;
//06B1
//|0000| |0000 0000| |0000| |00| |00| |0110| |1011| |0001|
b := lo(_eax) and 15;
info(' - ' + 'Stepping ID: ', IntToStr(b));
b := lo(_eax) shr 4;
info(' - ' + 'Model Number: ', IntToHex(b, 1));
b := hi(_eax) and 15;
info(' - ' + 'Family Code: ', IntToStr(b));
b := hi(_eax) shr 4;
info(' - ' + 'Processor Type: ', IntToStr(b));
//31. 28. 27. 24. 23. 20. 19. 16.
// 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
b := lo((_eax shr 16)) and 15;
info(' - ' + 'Extended Model: ', IntToStr(b));
b := lo((_eax shr 20));
info(' - ' + 'Extended Family: ', IntToStr(b));
b := lo(_ebx);
info(' - ' + 'Brand ID: ', IntToStr(b));
b := hi(_ebx);
info(' - ' + 'Chunks: ', IntToStr(b));
b := lo(_ebx shr 16);
info(' - ' + 'Count: ', IntToStr(b));
b := hi(_ebx shr 16);
info(' - ' + 'APIC ID: ', IntToStr(b));
//Bit 18 =? 1 //is serial number enabled?
if (_edx and $40000) = $40000 then
info(' - ' + 'Serial Number ', 'Enabled')
else
info(' - ' + 'Serial Number ', 'Disabled');
s := IntToHex(_eax, 8);
asm //determine the serial number
mov eax,3
db $0F,$A2
mov _ecx,ecx
mov _edx,edx
end;
s1 := IntToHex(_edx, 8);
s2 := IntToHex(_ecx, 8);
Insert('-', s, 5);
Insert('-', s1, 5);
Insert('-', s2, 5);
info(' - ' + 'Serial Number: ', s + '-' + s1 + '-' + s2);
asm
mov eax,1
db $0F,$A2
mov _edx,edx
end;
info('', '');
//Bit 23 =? 1
if (_edx and $800000) = $800000 then
info('MMX ', 'Supported')
else
info('MMX ', 'Not Supported');
//Bit 24 =? 1
if (_edx and $01000000) = $01000000 then
info('FXSAVE & FXRSTOR Instructions ', 'Supported')
else
info('FXSAVE & FXRSTOR Instructions Not ', 'Supported');
//Bit 25 =? 1
if (_edx and $02000000) = $02000000 then
info('SSE ', 'Supported')
else
info('SSE ', 'Not Supported');
//Bit 26 =? 1
if (_edx and $04000000) = $04000000 then
info('SSE2 ', 'Supported')
else
info('SSE2 ', 'Not Supported');
info('', '');
asm //execute the extended CPUID inst.
mov eax,$80000000 //sub. func call
db $0F,$A2
mov _eax,eax
end;
if _eax > $80000000 then //any other sub. funct avail. ?
begin
info('Extended CPUID: ', 'Supported');
info(' - Largest Function Supported: ', IntToStr(_eax - $80000000));
asm //get brand ID
mov eax,$80000002
db $0F
db $A2
mov _eax,eax
mov _ebx,ebx
mov _ecx,ecx
mov _edx,edx
end;
s := '';
s1 := '';
s2 := '';
s3 := '';
for i := 0 to 3 do
begin
b := lo(_eax);
s3:= s3 + chr(b);
b := lo(_ebx);
s := s + chr(b);
b := lo(_ecx);
s1 := s1 + chr(b);
b := lo(_edx);
s2 := s2 + chr(b);
_eax := _eax shr 8;
_ebx := _ebx shr 8;
_ecx := _ecx shr 8;
_edx := _edx shr 8;
end;
s_all := s3 + s + s1 + s2;
asm
mov eax,$80000003
db $0F
db $A2
mov _eax,eax
mov _ebx,ebx
mov _ecx,ecx
mov _edx,edx
end;
s := '';
s1 := '';
s2 := '';
s3 := '';
for i := 0 to 3 do
begin
b := lo(_eax);
s3 := s3 + chr(b);
b := lo(_ebx);
s := s + chr(b);
b := lo(_ecx);
s1 := s1 + chr(b);
b := lo(_edx);
s2 := s2 + chr(b);
_eax := _eax shr 8;
_ebx := _ebx shr 8;
_ecx := _ecx shr 8;
_edx := _edx shr 8;
end;
s_all := s_all + s3 + s + s1 + s2;
asm
mov eax,$80000004
db $0F
db $A2
mov _eax,eax
mov _ebx,ebx
mov _ecx,ecx
mov _edx,edx
end;
s := '';
s1 := '';
s2 := '';
s3 := '';
for i := 0 to 3 do
begin
b := lo(_eax);
s3 := s3 + chr(b);
b := lo(_ebx);
s := s + chr(b);
b := lo(_ecx);
s1 := s1 + chr(b);
b := lo(_edx);
s2 := s2 + chr(b);
_eax := _eax shr 8;
_ebx := _ebx shr 8;
_ecx := _ecx shr 8;
_edx := _edx shr 8;
end;
info('Brand String: ', '');
if s2[Length(s2)] = #0 then setlength(s2, Length(s2) - 1);
info('', ' - ' + s_all + s3 + s + s1 + s2);
end
else
info(' - Extended CPUID ', 'Not Supported.');
end;
Salve o projeto e em seguida execute-o, visualizando as informações obtidas.
Abraço e até o próximo post.
Assinar:
Postagens (Atom)


