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.