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.

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.

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.

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.

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.

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

Exibir 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.

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 (10⁶)? 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.

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

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.

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:

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

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.

Dias da semana presentes no mês

Bom, pelo assunto da postagem fica meio estranho de entender, mas pense em uma rotina que diga todos os dias de determinado mês que são segunda-feira. Se tiver um calendário ao lado é moleza, mas e se quiser mostrar a rotina no Delphi?

Bom, pensando nisso que resolvi implementar um rotina que faça essa avaliação e me retorne toda a lista de dias com determinado dia da semana presentes no mês, e isso é bem simples de fazer. Veja o código a seguir que se encontra comentado de acordo com a ação que está acontecendo para assim facilitar o entendimento.
procedure TForm1.Button1Click(Sender: TObject);
var
DiasMes : Integer;
i : integer;
DiaSemana : Integer;{1 Dom, 2 Seg, 3 Ter, 4 Qua, 5 Qui, 6 Sex, 7 Sab}
{Use a uses DateUtils}
Dias : String;
begin
DiasMes := DaysInMonth(Date);//Pega a quantidade de dias do mês de acordo com a data
DiaSemana := 2;//Defino dia semana para seg. feira
for I := 1 to DiasMes do//Percorre todos os dias do mês
begin
{Verifica os dias que são segunda-feira e adiciona a data na lista}
if DayOfWeek(StrToDate(IntToStr(i)+FormatDateTime('/MM/yyyy',Date))) = DiaSemana then
Dias := Dias + IntToStr(i)+FormatDateTime('/MM/yyyy',Date) + #13;
end;
ShowMessage(Dias);//Mostra a lista na tela
end;

Pronto, agora a partir da data atual ou poderá também adicionar um campo que solicite ao data ao usuário, você poderá saber quantas segundas-feiras há no mês, ou qualquer outro dia da semana. Abraço e até o próximo post.

Resolvendo expressões matemáticas no Delphi

Para aqueles que gostam de matemática, ou para você que tem um sistema comercial e faz inúmeras situações de cálculos para encontrar um resultado, que faz soma, divisão, multiplicação e subtração tudo separado, escrevendo várias linhas de código, o post de hoje lhe dará uma ajuda e ensinará como poderá resolver este problema mais facilmente. Já pensou em executar uma expressão matemática e ao final receber seu resultado, por exemplo:
(97+25)*(14/2+0.98)

Veremos que a partir da criação de uma rotina fixa através de uma function será possível executar toda esta expressão de uma única vez. No Delphi crie uma nova aplicação, altere o caption do formulário principal para "Resolvendo Expressões Matemáticas" e salva os arquivos em um diretório do seu computador. Arraste ao formulário dois componentes Label alterando suas propriedade caption para "Expressão Matemática" e "Dígitos após a vírgula". Arraste também dois componentes Edit (edtExpressao, edtDigitos) e remova o texto presente na propriedade Text. Por último adicione também um Button alterando o caption para "Resolver Expressão".

Acessando o código do formulário, declare na seção private a seguinte function, que será a responsável por resolver a expressão:
function CalculaExpressao(expressao: string; digitos: Byte): string;

Utilizando as teclas de atalho Shift + Ctrl + C crie a implementação para a função onde deverá incluir a seguinte codificação:
function TForm1.CalculaExpressao(expressao: string; digitos: Byte): string;
// Calculo de expressoes matematicas simples
// Suporta numeros inteiros, numeros reais, parenteses
var
z: Char;
ipos: Integer;

function StrToReal(chaine: string): Real;
var
r: Real;
Pos: Integer;
begin
Val(chaine, r, Pos);
if Pos > 0 then Val(Copy(chaine, 1, Pos - 1), r, Pos);
Result := r;
end;

function RealToStr(inreal: Extended; digits: Byte): string;
var
S: string;
begin
Str(inreal: 0: digits, S);
realToStr := S;
end;

procedure NextChar;
var
s: string;
begin
if ipos > Length(expressao) then
begin
z := #9;
Exit;
end
else
begin
s := Copy(expressao, ipos, 1);
z := s[1];
Inc(ipos);
end;
if z = ' ' then nextchar;
end;

function Expression: Real;
var
w: Real;

function Factor: Real;
var
ws: string;
begin
Nextchar;
if z in ['0'..'9'] then
begin
ws := '';
repeat
ws := ws + z;
nextchar
until not (z in ['0'..'9', '.']);
Factor := StrToReal(ws);
end
else if z = '(' then
begin
Factor := Expression;
nextchar
end
else if z = '+' then Factor := +Factor
else if Z = '-' then Factor := -Factor;
end;

function Term: Real;
var
W: Real;
begin
W := Factor;
while Z in ['*', '/'] do
if z = '*' then w := w * Factor
else
w := w / Factor;
Term := w;
end;
begin
w := term;
while z in ['+', '-'] do
if z = '+' then w := w + term
else
w := w - term;
Expression := w;
end;
begin
ipos := 1;
Result := RealToStr(Expression, digitos);
end;

Nesta codificação, a função recebe a expressão por completa e vai verificando a prioridade das operações de sinais a serem executadas bem como resolvendo parenteses e cálculos até que o resultado final seja obtido. A quantidade de dígitos após a virgula também pode ser controlada passando o valor como parâmetro para a função. Para utilizar a função, adicione ao evento OnClick do botão o seguinte código responsável por passar a expressão e quantidade de digitos informados nos campos Edit e retornar o resultado através de uma mensagem na tela do usuário.


A partir deste post, faça a implementação da rotina em seus sistemas ou implemente novos recursos. Abraço e até a próxima.