![]() |
|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
![]() |
|
Опции темы | Поиск в этой теме | Опции просмотра |
|
#1
|
|||
|
|||
![]() Есть программа в которой мельница вращается с заданной скоростью. Необходимо убрать одну лопасть и уравнять расстояние между другими тремя лопастями, что бы были симметричные.
Вот исходник программного кода: Код:
unit Main; interface uses SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Menus; const n = 8; type TMainForm = class(TForm) Button1: TButton; Stop: TButton; Label1: TLabel; Edit1: TEdit; Timer1: TTimer; Start: TButton; Clear: TButton; procedure Button1Click(Sender: TObject); procedure StopClick(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure StartClick(Sender: TObject); procedure ClearClick(Sender: TObject); end; mas=array[1..n] of integer; var MainForm: TMainForm; x,y:mas; Radius,Alfa,Alfa2,dl:integer; implementation {$R *.DFM} procedure TMainForm.StopClick(Sender: TObject); begin if timer1.Enabled=true then timer1.Enabled:=false; end; procedure TMainForm.Timer1Timer(Sender: TObject); const xc:integer=150; yc:integer=150; var dx,dy,dx2,dy2,dx3,dy3,dx4,dy4,scale:real; begin // Стираемо лопасті with MainForm, Canvas do begin Pen.Width:=3; Pen.Color:=clGreen; Brush.Color:=clGreen; Polygon([Point(xc,yc),Point(x[1],y[1]), Point(x[5],y[5]), Point(x[7],y[7]), Point(x[3],y[3]), Point(xc,yc), Point(x[2],y[2]), Point(x[6],y[6]), Point(x[8],y[8]), Point(x[4],y[4]), Point(xc,yc)]); end; // Малюємо основу млина with MainForm, Canvas do begin Pen.Width:=2; Pen.Color:=clBlack; Brush.Color:=clGray; Polygon([Point(100,250), Point(150,110), Point(200,250)]); end; // Знаходимо дійсні координати точок dx := Radius * cos((Pi/180)*Alfa); dy := Radius * sin((Pi/180)*Alfa); dx2 := Radius * cos((Pi/180)*Alfa2); dy2 := Radius * sin((Pi/180)*Alfa2); dx3 := Radius * cos((Pi/180)*(Alfa - 30)); dy3 := Radius * sin((Pi/180)*(Alfa - 30)); dx4 := Radius * cos((Pi/180)*(Alfa2 - 30)); dy4 := Radius * sin((Pi/180)*(Alfa2 - 30)); // Знаходимо екранні координати точок x[1] := Round(xc + dx); y[1] := Round(yc - dy); x[2] := Round(xc + dx2); y[2] := Round(yc - dy2); x[3] := Round(xc - dx); y[3] := Round(yc + dy); x[4] := Round(xc - dx2); y[4] := Round(yc + dy2); x[5] := Round(xc + dx3); y[5] := Round(yc - dy3); x[6] := Round(xc + dx4); y[6] := Round(yc - dy4); x[7] := Round(xc - dx3); y[7] := Round(yc + dy3); x[8] := Round(xc - dx4); y[8] := Round(yc + dy4); // Малюємо лопасті по координатах with MainForm, Canvas do begin Pen.Width := 3; Pen.Color := clBlack; Brush.Color := clWhite; Polygon([Point(xc,yc), Point(x[1],y[1]), Point(x[5],y[5]), Point(x[7],y[7]), Point(x[3],y[3]), Point(xc,yc), Point(x[2],y[2]), Point(x[6],y[6]), Point(x[8],y[8]), Point(x[4],y[4]), Point(xc,yc)]); end; // До кожного значення кута додаємо значення введене користувачем в поле Edit Alfa := Alfa + dl; Alfa2 := Alfa2 + dl; end; procedure TMainForm.StartClick(Sender: TObject); var s: string; begin s := Edit1.Text; if Length(s) > 0 then begin dl := StrToInt(S); if (dl >= 0)and(dl <= 20) then begin Radius := 70; timer1.Enabled := true; end else ShowMessage('Скорость ветра: [0,20]'); Alfa:=0; Alfa2:=90; end; end; procedure TMainForm.ClearClick(Sender: TObject); begin Refresh; Timer1.Enabled:=false; end; procedure TMainForm.Button1Click(Sender: TObject); begin Close; end; end. Спасибо всем за своевременную помощь. Последний раз редактировалось Admin, 20.02.2011 в 20:48. |
#2
|
|||
|
|||
![]() n = 6 в начале программы и соотв. Alfa := 120.
А вообще проще полностью переписать на динамический расчет лопастей. Больно много менять. |
#3
|
|||
|
|||
![]() Снимок.JPG
вот такое получается, помогите пож, на завтра надо. |
#4
|
||||
|
||||
![]() Я бы лопасти нарисовал в общ. виде так:
Код:
Const N = 3; // к-во лопастей Xo = 150; // Центр вентилятора Yo = 150; // Центр вентилятора R = 100; // Радиус лопасти v = 20; // Толщина лопасти Var M1, M2: TPoint; W, u: Real; procedure TForm1.FormActivate(Sender: TObject); begin Form1.Canvas.Pen.Width:= 3; end; procedure TForm1.Button1Click(Sender: TObject); begin Timer1.Enabled:= Not(Timer1.Enabled); end; procedure TForm1.Timer1Timer(Sender: TObject); Var i: Integer; begin W:= W + 5; u:= 0; Form1.Canvas.Pen.Color:= clBtnFace; Form1.Canvas.Brush.Color:= clBtnFace; Form1.Canvas.Rectangle(Xo-R-5, Yo-R-5, Xo+R+5, Yo+R+5); For i:= 0 To N - 1 Do begin u:= u + 360/N; M1.X:= Xo+Round(R*Cos((Pi/180)*(W+u))); M1.Y:= Yo+Round(R*Sin((Pi/180)*(W+u))); M2.X:= Xo+Round(R*Cos((Pi/180)*(W+u+v))); M2.Y:= Yo+Round(R*Sin((Pi/180)*(W+u+v))); Form1.Canvas.Pen.Color:= clBlack; Form1.Canvas.Brush.Color:= clRed; Form1.Canvas.Polygon([ Point(Xo,Yo), Point(M1.X,M1.Y), Point(M2.X,M2.Y)]); end; end; If end Then begin; Последний раз редактировалось AND_REY, 21.02.2011 в 02:12. |
#5
|
|||
|
|||
![]() Спасибо огромное, а вы бы не могли бы выложить архив с программой, а то у меня чего то не работает(маловато опыта).
|
#6
|
||||
|
||||
![]() Вот исходник откуда я брал вышеприведенный код: Мельница v1.0 5.10.09.rar.
If end Then begin; |
#7
|
|||
|
|||
![]() Спасибо за помощь, очень помогли.
Тему можно закрывать. |