Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 22.11.2008, 16:30   #1
kasta
 
Регистрация: 09.11.2008
Сообщений: 7
По умолчанию Помогите срочно с блок-схемой.....

помогите пожалуйста с блок-схемой немогу сам расчихлить......а сроки сдачи поджимают..........
kasta вне форума Ответить с цитированием
Старый 22.11.2008, 16:30   #2
kasta
 
Регистрация: 09.11.2008
Сообщений: 7
По умолчанию

Код:
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls,math;
type
    TForm1 = class(TForm)
    Timer1: TTimer;
    Edit1: TEdit;
    Button1: TButton;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
const
  D2R_COEF = 57.3243; //degrees to radian
  RATIO = 0.3602;
  RATIO2= 0.018;//амперы в градусы
var
  Form1: TForm1;
  amp, buffer: TBitmap;
  radius: integer = 205;
  radius2:integer = 100; //радиусы стрелок
  p,h: real; //высота полеиа
  prev: real; //предыдущая величина
  razn,ost  : real;
  max:byte; //для плавного хода с замедлением
  anim: boolean; //включает и выключает анимацию
  damper: real; //высота для отрисовки
  k,n: integer;
implementation
{$R *.DFM}

procedure DrawAmp(var bm: TBitmap);
var
i,lx,ly,kx,ky,jx,jy: integer;
begin
bm.Width:=800;
bm.Height:=800;
with bm.Canvas do
  begin
    Pen.Width:=2;
    Brush.Color := clblack;
    RoundRect(10,10,529, 529, 150, 150);
    pen.Color := clblue;
    brush.Color := clwhite;
    Ellipse(45,45,485,485);
    Ellipse(160,160,370,370);
  font.height:=20;
  TextOut(261, 75,'0 ');
  TextOut(376, 106,'1 ');
  TextOut(444, 200,'2 ');
  TextOut(444, 317,'3 ');
  TextOut(376, 410,'4 ');
  TextOut(262, 446,'5 ');
  TextOut(152, 410,'6 ');
  TextOut(80, 317,'7 ');
  TextOut(80, 200,'8 ');
  TextOut(152, 106,'9 ');
  TextOut(220, 120,'1 0б. X 1000м ');
  TextOut(261, 180,'0 ');
  TextOut(310, 190,'2 ');
  TextOut(340, 233,'4 ');
  TextOut(340, 282,'6 ');
  TextOut(310, 320,'8 ');
  TextOut(257, 340,'10 ');
  TextOut(212, 320,'12 ');
  TextOut(185, 282,'14 ');
  TextOut(185,  233,'16 ');
  TextOut(215, 190,'18 ');

  TextOut(570, 500,'ВЫСОТА ПОДЪЕМА: ');
  TextOut(570, 330,'ВВЕДИТЕ ДАВЛЕНИЕ:  ');
  for i:=0 to 19 do
    begin
    Pen.Width:=2;
    lx:=265+round(cos((round(i*(360/20))+180)/D2R_COEF)*(220));
    ly:=265+round(sin((round(i*(360/20))+180)/D2R_COEF)*(220));
    MoveTo(lx,ly);
    lx:=265+round(cos((round(i*(360/20))+180)/D2R_COEF)*(203));
    ly:=265+round(sin((round(i*(360/20))+180)/D2R_COEF)*(203));
    LineTo(lx,ly);
    kx:=265+round(cos((round(i*(360/20))+180)/D2R_COEF)*(95));
    ky:=265+round(sin((round(i*(360/20))+180)/D2R_COEF)*(95));
    MoveTo(kx,ky);
    kx:=265+round(cos((round(i*(360/20))+180)/D2R_COEF)*(105));
    ky:=265+round(sin((round(i*(360/20))+180)/D2R_COEF)*(105));
    LineTo(kx,ky);
     end;
   for i:=0 to 99 do
     begin
     pen.Color := clgreen;
     Pen.Width:=1;
    jx:=265+round(cos((round(i*(360/100))+180)/D2R_COEF)*(220));
    jy:=265+round(sin((round(i*(360/100))+180)/D2R_COEF)*(220));
    MoveTo(jx,jy);
    jx:=265+round(cos((round(i*(360/100))+180)/D2R_COEF)*(208));
    jy:=265+round(sin((round(i*(360/100))+180)/D2R_COEF)*(208));
    LineTo(jx,jy);
   end;
   end;
end;

procedure Strelka(a: integer);
var
sx,sy,grad: integer;
radian: double;
begin
grad:=a+270;
radian:=grad /D2R_COEF;
buffer.Canvas.Pen.Width:=1;
buffer.Canvas.pen.color:=clgreen;
sx:=265+round(cos(radian)*radius);
sy:=265+round(sin(radian)*radius);
buffer.Canvas.MoveTo(265,265);
buffer.Canvas.LineTo(sx,sy);
end;

procedure Strelka2(a: integer);
var
sx,sy,grad: integer;
radian: double;
begin
grad:=a+270;
radian:=grad /D2R_COEF;
buffer.Canvas.pen.color:=clred;
sx:=265+round(cos(radian)*radius2);
sy:=265+round(sin(radian)*radius2);
buffer.Canvas.MoveTo(265,265);
buffer.Canvas.LineTo(sx,sy);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
edit1.Text:='';

buffer:=TBitmap.Create;
buffer.Width:=800;
buffer.Height:=530;
buffer.Canvas.Pen.Width:=1; //толщина стрелки
amp:=TBitmap.Create;
DrawAmp(amp); // процедура - программная отрисовка
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
buffer.Canvas.Draw(0,0,amp);
if anim then
  begin
    if ost <> 0 then
      begin
      if razn < 0 then damper:=damper-ost else damper:=damper+ost;
      ost:=0;
      end
    else
      begin
      if razn < 0 then damper:=damper-max else damper:=damper+max;
      dec(max);
      if max < 1 then anim:=false;
      end;
  end
else damper:=h;
Strelka(round(damper*RATIO));
Strelka2(round(damper*RATIO2));
Canvas.Draw(10,10,buffer); 
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
k:=0;
n:=0;
prev:=h;
   p:=strtoint(Edit1.Text);
if p >154.3 then  H:= (1-power((p/760),(0.0065*29.27)))*(273/0.0065)
            else H:=11000+(29.27*(273/0.0065)*ln(154.3/p));
   label1.Caption:=floattostr(round(H));
if prev <> h then
  begin
  razn:=h - prev;
  anim:=true;
  end;
while n < abs(razn)-k do
  begin
  inc(k);
  n:=n+k;
  end;
max:=k;
ost:=abs(razn)-n;
end;
end.

Последний раз редактировалось kasta; 22.11.2008 в 16:32.
kasta вне форума Ответить с цитированием
Старый 24.11.2008, 23:11   #3
kasta
 
Регистрация: 09.11.2008
Сообщений: 7
По умолчанию

это прога высотомера..
kasta вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
[срочно] нарисовать блок схему masima Фриланс 3 29.05.2008 13:34
Помогите с блок схемой Juhn Паскаль, Turbo Pascal, PascalABC.NET 4 25.01.2008 15:50
Помогите с блок схемой (срочно) sergeyfsd Паскаль, Turbo Pascal, PascalABC.NET 1 24.12.2007 08:48