Download do executável.
Download do programa.
unit DoisNiveisWin;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Menus, DBCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
editPulsos: TEdit;
editTaxa: TEdit;
editOffSet: TEdit;
editLargura: TEdit;
editOmega: TEdit;
Calcular: TButton;
Limpar: TButton;
CheckBoxTxt: TCheckBox;
CheckBoxDat: TCheckBox;
GroupBox1: TGroupBox;
Label9: TLabel;
Label10: TLabel;
CheckBoxEscalaH: TCheckBox;
ListBox1: TDBListBox;
MainMenu1: TMainMenu;
Arquivo1: TMenuItem;
Ferramentas1: TMenuItem;
Sair1: TMenuItem;
Cordacurva1: TMenuItem;
Espessuradacurva1: TMenuItem;
Azul1: TMenuItem;
Vermelha1: TMenuItem;
Verde1: TMenuItem;
N11: TMenuItem;
N21: TMenuItem;
N31: TMenuItem;
EditY1: TEdit;
EditY2: TEdit;
EditX1: TEdit;
EditX2: TEdit;
Sobre1: TMenuItem;
StaticText1: TStaticText;
StaticText2: TStaticText;
StaticText3: TStaticText;
StaticText4: TStaticText;
procedure CalcularClick(Sender: TObject);
procedure CondIniciais;
procedure RungeKutta;
procedure Decaimento;
procedure AmbienteGrafico;
procedure Dados;
procedure AdicionaDados;
procedure GerarArquivo;
procedure Bloch;
procedure LimparClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Azul1Click(Sender: TObject);
procedure Vermelha1Click(Sender: TObject);
procedure Verde1Click(Sender: TObject);
procedure N11Click(Sender: TObject);
procedure N21Click(Sender: TObject);
procedure N31Click(Sender: TObject);
procedure Sobre1Click(Sender: TObject);
procedure Sair1Click(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
q12, q2, gama, w, alpha, N, wL, w2: real;
dd, Omega, h, t, Tr, fr, phi: real;
Tp, a10, a20, x, y: real;
Pulsos, i, j, k, m, PassoRKfento, g, cor, espessura: integer;
a, b, c, k1, k2, k3, k4: array[1..5] of real;
nb, nt: real;
txt,dat: TextFile;
implementation
{$R *.dfm}
procedure Tform1.CondIniciais;
begin
AssignFile(txt,'dados.txt');
AssignFile(dat,'dados.dat');
ReWrite(txt);
ReWrite(dat);
Canvas.MoveTo(210,400);
Canvas.Brush.Color := $EEE9E9;
Canvas.FillRect(Rect(200,200,600,410));
gama:= 0.0025 * 1e9 * 0;
PassoRKfento:= 10;
q2:= (2*Pi) * 5e6;
q12:= 0.5 * q2;
fr:= StrToFloat(editTaxa.text) * 1e6;
Tp:= StrToFloat(editLargura.Text) * 1e-15;
Pulsos:= StrToInt(editPulsos.Text);
Omega:= StrToFloat(editOmega.Text) * q12 / (fr * Tp);
a10:= 1;
a20:= 0;
w2:= (2*Pi) * 384e12 + (2 * Pi) * 20e6 * 0;
wL:= (2*Pi) * 384e12 + (2 * Pi) * 40e6 * 0;
phi:= (2*Pi) * 0.4 * 0;
nb:= 0;nt:= 0;
b[1]:= 0;b[2]:= 0;
a[1]:= a10;
a[2]:= a20;
a[3]:= 0;
a[4]:= 0;
t:= 0; N:= -1;
dd:= StrToFloat(editOffSet.Text) * 1e6 * 2 * Pi;
Tr:= 1 / fr;
end;
function func(a1, a2, a12, b12: real; j: integer): real;
begin
if (j = 1) then func:= +2 * Omega * (b12 * Cos(alpha) - a12 * Sin(alpha)) + q2 * a2 - (a1 - a10) * gama;
if (j = 2) then func:= -2 * Omega * (b12 * Cos(alpha) - a12 * Sin(alpha)) - q2 * a2 - a2 * gama;
if (j = 3) then func:= -dd * b12 - Omega * (a2 - a1) * Sin(alpha) - 0.5 * q2 * a12 - a12 * gama;
if (j = 4) then func:= dd * a12 + Omega * (a2 - a1) * Cos(alpha) - 0.5 * q2 * b12 - b12 * gama;
end;
procedure Tform1.RungeKutta;
Begin
N:= N + 1;
g:= PassoRKfento;
h:= Tp / g;
alpha:= -N * wL * Tr + N * phi;
for k:= 1 to g do
begin
t:= t + h;
for j:= 1 to 4 do
k1[j]:= func(a[1], a[2], a[3], a[4], j);
for j:= 1 to 4 do
k2[j]:= func(a[1] + k1[1] * h / 2, a[2] + k1[2] * h / 2, a[3] + k1[3] * h / 2,
a[4] + k1[4] * h / 2, j);
for j:= 1 to 4 do
k3[j]:= func(a[1] + k2[1] * h / 2, a[2] + k2[2] * h / 2, a[3] + k2[3] * h / 2,
a[4] + k2[4] * h / 2, j);
for j:= 1 to 4 do
k4[j]:= func(a[1] + k3[1] * h, a[2] + k3[2] * h, a[3] + k3[3] * h,
a[4] + k3[4] * h, j);
for j:= 1 to 4 do
b[j]:= a[j] + h * (k1[j] / 6 + k2[j] / 3 + k3[j] / 3 + k4[j] / 6);
for m:= 1 to 4 do
a[m]:= b[m];
end;
end;
procedure Tform1.Decaimento;
begin
nb:= b[2];
nt:= t;
t:= t + (Tr - Tp);
x:= dd * (Tr - Tp);
y:= (Tr - Tp) * q2;
b[1]:= a[1] + a[2] * (1 - Exp(-y));
b[2]:= a[2] * Exp(-y);
b[3]:= (a[3] * Cos(x) - a[4] * Sin(x)) * Exp(-0.5 * y);
b[4]:= (a[3] * Sin(x) + a[4] * Cos(x)) * Exp(-0.5 * y);
for m:= 1 to 4 do
a[m]:= b[m];
end;
procedure TForm1.AmbienteGrafico;
var ex,ey:real;
z1,z2,z3,z4:real;
begin
Canvas.Pen.Color:=clred;
Canvas.Pen.Width:=2;
if (cor = 1) then
Canvas.Pen.Color:=clred;
if (cor = 2) then
Canvas.Pen.Color:=clblue;
if (cor = 3) then
Canvas.Pen.Color:=clgreen;
if (espessura = 1) then
Canvas.Pen.Width:=1;
if (espessura = 2) then
Canvas.Pen.Width:=2;
if (espessura = 3) then
Canvas.Pen.Width:=3;
ex:= 0.4e12 / StrToFloat(EditX2.Text);
ey:= 2e2 / StrToFloat(EditY2.Text);
z1:= ex * nt + 200;
//z2:=ex * t + 200;
z3:= 400 - ey * nb;
//z4:=400 - ey * b[2];
Canvas.LineTo(trunc(z1),trunc(z3));
end;
procedure TForm1.Dados;
begin
//Apaga listBox
listBox1.Items.Clear();
end;
procedure TForm1.AdicionaDados;
begin
//Soma das populações
w:= b[1] + b[2];
//Adiciona populações no listBox
listBox1.Items.Add(IntToStr(i) + ' '
+ FormatFloat('#,##0.0000000',b[1]) + ' '
+ FormatFloat('#,##0.0000000',b[2]));
end;
procedure TForm1.GerarArquivo;
begin
if FileExists('dados.txt') then
Append(txt) else
ReWrite(txt);
if FileExists('dados.dat') then
Append(dat) else
ReWrite(dat);
if (CheckBoxTxt.Checked = true) then
writeln(txt,t*1e9 - 0.99999,' ',b[1],' ',b[2]);
if (CheckBoxDat.Checked = true) then
writeln(dat,t*1e9 - 0.99999,' ',b[1],' ',b[2]);
closeFile(txt);
closeFile(dat);
end;
procedure TForm1.Bloch;
begin
nb:= b[2];
nt:= t;
if (i mod 2 = 0) then
RungeKutta();
if (i mod 2 = 1) then
Decaimento();
end;
procedure TForm1.CalcularClick(Sender: TObject);
begin
//Preparação do listBox
Dados;
//Condições iniciais
CondIniciais;
//Início da Interação
for i:= 1 to 2*Pulsos + 1 do
begin
//Resolve as equações de Bloch
Bloch;
//Adiciona dados no listBox
AdicionaDados;
//Gera arquivo .txt com os dados
GerarArquivo();
//Inicia ambiente gráfico e plota a curva
AmbienteGrafico();
end;
end;
procedure TForm1.LimparClick(Sender: TObject);
begin
//Limpa o listBox
listBox1.Items.Clear();
//Limpa o ambiente gráfico
Canvas.Brush.Color := $EEE9E9;
Canvas.FillRect(Rect(200,200,600,410));
end;
procedure TForm1.Button1Click(Sender: TObject);
var r:integer;
begin
for r:=1 to 100 do
begin
Canvas.LineTo(r*r,10*r);
end;
end;
procedure TForm1.Azul1Click(Sender: TObject);
begin
cor:=1;
end;
procedure TForm1.Vermelha1Click(Sender: TObject);
begin
cor:=2;
end;
procedure TForm1.Verde1Click(Sender: TObject);
begin
cor:=3;
end;
procedure TForm1.N11Click(Sender: TObject);
begin
espessura:=1;
end;
procedure TForm1.N21Click(Sender: TObject);
begin
espessura:=2;
end;
procedure TForm1.N31Click(Sender: TObject);
begin
espessura:=3;
end;
procedure TForm1.Sobre1Click(Sender: TObject);
begin
showMessage('Criado em 11/07/2011. marcopolo@df.ufpe.br');
end;
procedure TForm1.Sair1Click(Sender: TObject);
begin
close;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var m1,m2: real;
begin
m1:= StrToFloat(editPulsos.Text);
m2:= StrToFloat(editTaxa.Text);
if (checkBoxEscalaH.Checked = true) then
editX2.Text:= FloatToStr(1200*m1/m2);
if (editY2.Text = '') then
editY2.Text:= '1';
if (StrToFloat(editY2.Text) > 1) then
editY2.Text:= '1';
if (StrToFloat(editY2.Text) <= 0) then
editY2.Text:= '0.5';
if (editX2.Text = '') then
editX2.Text:= FloatToStr(1200 * m1 / m2);
if (StrToFloat(editX2.Text) <= 0) then
editY2.Text:= FloatToStr(1200 * m1 / m2);
end;
end.
