Листинг программы

1. Движение кривошипно-ползунного механизма. Скорость вращения кривошипа изменяется клавишами PgDn, PgUp.

program krivoship;

USES WinTypes,WinProcs,Strings,OWindows;

const KeyCount: Integer = 0;

var Brush,OldBrush:HBrush;Pen,OldPen:HPen;font,oldfont:hfont;

R:TRect;PS:TPaintStruct;

LogFont:TLogFont;LogBrush:TLogBrush;LogPen:TLogPen;

x0,y0,a:integer; v:longint;

matrix:array[1..30]of tpoint;

gg:tpoint;

type

PointerPaintInWindow=^TPaintInWindow;

TPaintInWindow=object(TWindow)

constructor Init;

destructor Done;

virtual;

procedure wMPaint(var Msg:TMessage);

virtual wm_First + wm_Paint;

procedure wmKeyDown(var Msg:TMessage);

virtual wm_First + wm_KeyDown;

end;

TPaintApp=Object(TApplication)

procedure InitMainWindow;

virtual;

end;

var PaintApp:TPaintApp;

t:integer;

i,j:longint;

ff:integer;

constructor TPaintInWindow.Init;

begin

TWindow.Init(nil,'ТЕОРИЯ МЕХАНИЗМОВ И МАШИН');

Attr.X:=0;

Attr.Y:=0;

Attr.W:=798;

Attr.H:=598;

end;

destructor TPaintInWindow.Done;

begin

TWindow.Done;

end;

function KeyPr: Boolean;

var

M: TMsg;

begin

while PeekMessage(M, 0, 0, 0, pm_Remove) do

begin

if M.Message=wm_Quit then halt(255);

TranslateMessage(M);

DispatchMessage(M);

end;

KeyPr := KeyCount > 0;

end;

{Удаление шрифта}

procedure delete_font(cont:hdc);

begin

SelectObject(cont,OldFont);

DeleteObject(Font);

end;

{создание нового шрифта}

procedure create_font(height:integer; italic:byte;underline:byte;weight:integer;FaceName:pchar;cont:hdc);

begin

FillChar(LogFont,SizeOf(LogFont),0);

with logFont do

begin

lfheight:=height;

lfItalic:=italic;

lfunderline:=underline;

lfweight:=weight;

StrCopy(lfFaceName,FaceName)

end;

Font := CreateFontIndirect(LogFont);

OldFont := SelectObject(cont,Font);

end;

procedure delete_pen(cont:hdc);

begin

selectobject(cont,oldpen);

deleteobject(pen);

end;

procedure create_pen(style:word;color:longint;cont:hdc;SDF:INTEGER);

var dd:tpoint;

begin

fillchar(logpen,sizeof(logpen),0);

with gg do

begin

gg.x:=sdf;

gg.y:=sdf;

end;

with logpen do

begin

lopnstyle:=style;

lopnwidth:=gg;

lopncolor:=color;

end;

pen:=createpenindirect(logpen);

oldpen:=selectobject(cont,pen);

end;

{Удаление кисти}

procedure delete_brush(cont:hdc);

begin

SelectObject(cont,OldBrush);

DeleteObject(Brush);

end;

{создание новой кисти}

procedure create_brush(style:word; color:longint; hatch:integer; cont:hdc);

begin

FillChar(Logbrush,SizeOf(LogBrush),0);

with logbrush do

begin

lbStyle:=style;

lbColor:=color;

lbHatch:=hatch;

end;

Brush := CreateBrushIndirect(LogBrush);

OldBrush := SelectObject(cont,Brush);

end;

procedure TPaintInWindow.WMKeyDown(var Msg:TMessage);

begin

if Getkeystate(vk_Escape)<0 then halt(255);

if GetKeyState(vk_next)<0 then

begin

if v>100000 then v:=v-10000 else v:=100000; {Увеличиваем скорость перемещения}

end;

if GetKeyState(vk_prior)<0 then

begin

if v<2000000 then v:=v+10000; {Уменьшаем скорость перемещения}

end;

end;

procedure TPaintInWindow.WMPaint(var Msg:TMessage);

var rr,ll,dx,dy,dllx:integer;

alfa:real;

begin

beginPaint(HWindow,PS);

{Прорисовка фона}

create_brush(bs_solid, rgb(0,155,155),hs_fdiagonal,ps.hdc);

r.top:=0; r.bottom:=598;r.right:=798;r.left:=0;

fillrect(ps.hdc,r,brush);

delete_brush(ps.hdc);

setbkcolor(ps.hdc,rgb(0,155,155));

{Прорисовка начального статического положения корпуса и опоры кривошипа}

create_brush(bs_hatched, rgb(200,0,0),hs_fdiagonal,ps.hdc);

create_pen(ps_solid, rgb(200,0,0),ps.hdc,3);

matrix[1].x:=x0-24*a;

matrix[1].y:=y0-6*a;

matrix[2].x:=x0-24*a;

matrix[2].y:=y0-10*a;

matrix[3].x:=x0-96*a;

matrix[3].y:=y0-10*a;

matrix[4].x:=x0-96*a;

matrix[4].y:=y0-6*a;

polygon(ps.hdc,matrix,4);

matrix[1].x:=x0-96*a;

matrix[1].y:=y0+6*a;

matrix[2].x:=x0-96*a;

matrix[2].y:=y0+10*a;

matrix[3].x:=x0-24*a;

matrix[3].y:=y0+10*a;

matrix[4].x:=x0-24*a;

matrix[4].y:=y0+6*a;

polygon(ps.hdc,matrix,4);

matrix[1].x:=x0+12*a;

matrix[1].y:=y0+8*a;

matrix[2].x:=x0+12*a;

matrix[2].y:=y0+4*a;

matrix[3].x:=x0-8*a;

matrix[3].y:=y0+4*a;

matrix[4].x:=x0-8*a;

matrix[4].y:=y0+8*a;

polygon(ps.hdc,matrix,4);

ellipse(ps.hdc,x0+2*a-a,y0-a,x0+2*a+a,y0+a);

moveto(ps.hdc,x0+2*a,y0);

lineto(ps.hdc,x0,y0+4*a);

moveto(ps.hdc,x0+2*a,y0);

lineto(ps.hdc,x0+4*a,y0+4*a);

delete_pen(ps.hdc);

delete_brush(ps.hdc);

{Надпись в программе}

create_font(6*a,0,0,600,'Arial Cyr',ps.hdc);

r.top:=y0-50*a;

r.left:=x0-150*a;

r.right:=x0+50*a;

r.bottom:=100*a;

settextcolor(ps.hdc,rgb(200,0,0));

drawtext(ps.hdc,'КРИВОШИПНО-ПОЛЗУННЫЙ МЕХАНИЗМ',29,r,dt_center);

delete_font(ps.hdc);

rr:=a*10;

ll:=a*45;

repeat

i:=i+5; {дискрета изменения пераметра}

alfa:=i*2*6.28/360; {Расчет угла вращения кривошипа}

dx:=round(rr*cos(alfa)); {Проекция длины кривошипа на ось Х}

dy:=round(rr*sin(alfa)); {Проекция длины кривошипа на ось Y}

dllx:=round(sqrt(sqr(ll)-sqr(dy))); {расчет проекции водила ползуна на ось Х}

{ползун}

create_brush(bs_solid, rgb(100,100,0),hs_fdiagonal,ps.hdc);

r.top:=y0-3*a; r.bottom:=y0+3*a;r.right:=x0+2*a-dx-dllx+9*a;r.left:=x0+2*a-dx-dllx-9*a;

fillrect(ps.hdc,r,brush);

delete_brush(ps.hdc);

{шарнир кривошипа}

create_pen(ps_solid, rgb(20,200,0),ps.hdc,3);

ellipse(ps.hdc,x0+2*a-dx-1*a,y0-dy-1*a,x0+2*a-dx+1*a,y0-dy+1*a);

moveto(ps.hdc,x0+2*a,y0);

lineto(ps.hdc,x0+2*a-dx,y0-dy);

lineto(ps.hdc,x0+2*a-dx-dllx,y0);

delete_pen(ps.hdc);

create_pen(ps_solid, rgb(0,155,155),ps.hdc,6);

create_brush(bs_solid, rgb(0,155,155),hs_cross,ps.hdc);

for j:=1 to v do begin end; {задержка}

{закрашиваем движущиеся части под цвет фона}

ellipse(ps.hdc,x0+2*a-dx-1*a,y0-dy-1*a,x0+2*a-dx+1*a,y0-dy+1*a);

moveto(ps.hdc,x0+2*a,y0);

lineto(ps.hdc,x0+2*a-dx,y0-dy);

lineto(ps.hdc,x0+2*a-dx-round(dllx*4/5),y0-round(dy*1/5));

delete_brush(ps.hdc);

delete_pen(ps.hdc);

create_pen(ps_solid, rgb(0,155,155),ps.hdc,10);

create_brush(bs_solid, rgb(0,155,155),hs_cross,ps.hdc);

moveto(ps.hdc,x0+2*a-dx-dllx+10*a,y0-3*a);

{затираем ползун справа}

lineto(ps.hdc,x0+2*a-dx-dllx+10*a,y0+3*a);

moveto(ps.hdc,x0+2*a-dx-dllx-10*a,y0-3*a);

{затираем ползун слева}

lineto(ps.hdc,x0+2*a-dx-dllx-10*a,y0+3*a);

delete_brush(ps.hdc);

delete_pen(ps.hdc);

{восстанавливаем опору кривошипа после затирки}

create_brush(bs_hatched, rgb(190,190,190),hs_fdiagonal,ps.hdc);

create_pen(ps_solid, rgb(20,200,0),ps.hdc,3);

matrix[1].x:=x0+12*a;

matrix[1].y:=y0+8*a;

matrix[2].x:=x0+12*a;

matrix[2].y:=y0+4*a;

matrix[3].x:=x0-8*a;

matrix[3].y:=y0+4*a;

matrix[4].x:=x0-8*a;

matrix[4].y:=y0+8*a;

polygon(ps.hdc,matrix,4);

ellipse(ps.hdc,x0+2*a-a,y0-a,x0+2*a+a,y0+a);

moveto(ps.hdc,x0+2*a,y0);

lineto(ps.hdc,x0,y0+4*a);

moveto(ps.hdc,x0+2*a,y0);

lineto(ps.hdc,x0+4*a,y0+4*a);

delete_pen(ps.hdc);

delete_brush(ps.hdc);

until keypr;

endPaint(HWindow,PS);

end;

procedure TPaintApp.InitMainWindow;

begin

MainWindow:=New(PointerPaintInWindow,Init);

end;

{главная программа}

begin

PaintApp.Init('программа рисования');

x0:=550; {Положение механизма по x}

y0:=350; {Положение механизма по y}

a:=4; {Масштабный коэффициент}

v:=1000000; {Скорость перемещения}

i:=0;

PaintApp.Run;

PaintApp.Done;

end.