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

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.

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

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.

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.

quarta-feira, 8 de abril de 2009

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.