Программа для показа возможностей работы с двухмерной графикой в PascalABC.
Представлены возможности:
- Масштабирования
- Относительного масштабирования
- Перемещения
- Поворота
- Поворота вокруг точки
- Смещения
- Отражения по всем осям
Так же в программе представлены работа с мышью, приближение графика, работа с окном. Наверняка пригодиться тем кто изучает основы компьютерной графики.
Uses Graphabc,Events; var mx: array[0..2,0..2] of real; x1,y1,x2,y2,x3,y3:integer; bx1,by1,bx2,by2,bx3,by3,i,step,count,j,xpos,ypos:integer; Px, Py: real; abcissa,ordinatus:integer; zoom,mousecount:integer; winheight,winwidth:integer; s:string; // function Grad(gradus : real) : real; //Градусы в грады begin Grad := gradus*Pi/180; end; // procedure getmx(m,n:real;numer:integer); // выбор матрицы begin case numer of 1: //fzoom begin mx[0,0]:=1; mx[0,1]:=0; mx[0,2]:=0; mx[1,0]:=0; mx[1,1]:=1; mx[1,2]:=0; mx[2,0]:=0; mx[2,1]:=0; mx[2,2]:=m; end; 2: //turn begin mx[0,0]:=cos(Grad(m)); mx[0,1]:=sin(Grad(m)); mx[0,2]:=0; mx[1,0]:=-sin(Grad(m)); mx[1,1]:=cos(Grad(m)); mx[1,2]:=0; mx[2,0]:=0; mx[2,1]:=0; mx[2,2]:=1; end; 3: //zoom begin mx[0,0]:=m; mx[0,1]:=0; mx[0,2]:=0; mx[1,0]:=0; mx[1,1]:=n; mx[1,2]:=0; mx[2,0]:=0; mx[2,1]:=0; mx[2,2]:=1; end; 4: //transfer begin mx[0,0]:=1; mx[0,1]:=0; mx[0,2]:=0; mx[1,0]:=0; mx[1,1]:=1; mx[1,2]:=0; mx[2,0]:=m; mx[2,1]:=n; mx[2,2]:=1; end; 5: //mirror_yx begin mx[0,0]:=0; mx[0,1]:=1; mx[0,2]:=0; mx[1,0]:=-1; mx[1,1]:=0; mx[1,2]:=0; mx[2,0]:=0; mx[2,1]:=0; mx[2,2]:=1; end; 6: //mirror_x0 begin mx[0,0]:=-1; mx[0,1]:=0; mx[0,2]:=0; mx[1,0]:=0; mx[1,1]:=1; mx[1,2]:=0; mx[2,0]:=0; mx[2,1]:=0; mx[2,2]:=1; end; 7: //mirror_y0 begin mx[0,0]:=1; mx[0,1]:=0; mx[0,2]:=0; mx[1,0]:=0; mx[1,1]:=-1; mx[1,2]:=0; mx[2,0]:=0; mx[2,1]:=0; mx[2,2]:=1; end; 8: //mirror_x0y0 begin mx[0,0]:=-1; mx[0,1]:=0; mx[0,2]:=0; mx[1,0]:=0; mx[1,1]:=-1; mx[1,2]:=0; mx[2,0]:=0; mx[2,1]:=0; mx[2,2]:=1; end; end; end; // function gety(x,y:integer;m,n:real;numer:integer): integer; // получение y begin getmx(m,n,numer); gety:=round((mx[0,1]*x+mx[1,1]*y+mx[2,1])/(mx[0,2]*x+mx[1,2]*y+mx[2,2])); end; // function getx(x,y:integer;m,n:real;numer:integer): integer; // получение x begin getmx(m,n,numer); getx:=round((mx[0,0]*x+mx[1,0]*y+mx[2,0])/(mx[0,2]*x+mx[1,2]*y+mx[2,2])); end; // procedure draw_grid; //рисовать сетку begin SetFontStyle(fsBold); setpencolor(clBlack); line(20,ordinatus,winwidth-20,ordinatus); line(winwidth-20,ordinatus,winwidth-30,ordinatus-10); line(winwidth-20,ordinatus,winwidth-30,ordinatus+10); line (abcissa,20,abcissa,winheight-20); line (abcissa,20,abcissa-10,30); line (abcissa,20,abcissa+10,30); TextOut(abcissa+10,ordinatus+10,'0'); TextOut(winwidth-30,ordinatus-20,'x'); TextOut(abcissa+10,20,'y'); step:=abcissa; while step>50 do begin step:=step-10*zoom; line(step,ordinatus-3,step,ordinatus+3); end; step:=abcissa; while step<winwidth-30 do begin step:=step+10*zoom; line(step,ordinatus-3,step,ordinatus+3); end; step:=abcissa; count:=0; while step>110 do begin count:=count-100; step:=step-100*zoom; line(step,ordinatus-7,step,ordinatus+7); TextOut(step,ordinatus+15,IntToStr(count)); end; step:=abcissa; count:=0; while step<winwidth-120 do begin count:=count+100; step:=step+100*zoom; line(step,ordinatus-7,step,ordinatus+7); TextOut(step,ordinatus+15,IntToStr(count)); end; step:=20; step:=ordinatus; while step>30 do begin step:=step-10*zoom; line(abcissa-3,step,abcissa+3,step); end; step:=ordinatus; while step<winheight-30 do begin step:=step+10*zoom; line(abcissa-3,step,abcissa+3,step); end; step:=ordinatus; count:=0; while step>100 do begin count:=count+100; step:=step-100*zoom; line(abcissa-7,step,abcissa+7,step); TextOut(abcissa-27,step,IntToStr(count)); end; step:=ordinatus; count:=0; while step<winheight-120 do begin count:=count-100; step:=step+100*zoom; line(abcissa-7,step,abcissa+7,step); TextOut(abcissa-35,step,IntToStr(count)); end; SetFontStyle(fsNormal); end; // function rx(x:integer):integer; // относительность х begin rx:=(x*zoom+abcissa); end; // function ry(y:integer):integer; // относительность y begin ry:=(-y*zoom+ordinatus); end; // procedure getcenter(x1, y1, x2, y2, x3, y3: real); // íàéòè öåíòð òðåóãîëüíèêà begin Px := (x1+x2+x3) / 3; Py := (y1+y2+y3) / 3; end; // procedure draw_triangle(xx1,yy1,xx2,yy2,xx3,yy3,bordercolor,fillcolor:integer); // рисовать треугольник begin SetFontSize(5*zoom); TextOut(rx(xx1-10),ry(yy1-10),'('+IntToStr(xx1)+','+IntToStr(yy1)+')'); TextOut(rx(xx2-10),ry(yy2+10),'('+IntToStr(xx2)+','+IntToStr(yy2)+')'); TextOut(rx(xx3-10),ry(yy3+10),'('+IntToStr(xx3)+','+IntToStr(yy3)+')'); SetFontSize(10); setpencolor(clBlack); if bordercolor<>0 then setpencolor(bordercolor); line (rx(xx1),ry(yy1),rx(xx2),ry(yy2)); line (rx(xx2),ry(yy2),rx(xx3),ry(yy3)); line (rx(xx3),ry(yy3),rx(xx1),ry(yy1)); if fillcolor<>-1 then begin getcenter(rx(xx1),ry(yy1),rx(xx2),ry(yy2),rx(xx3),ry(yy3)); FloodFill(round(Px),round(Py),fillcolor); SetPixel(round(Px),round(Py),clBlack); end; end; // procedure work_triangle(x1,y1,x2,y2,x3,y3,bordercolor,fillcolor:integer;m,n:real;numer:integer); // работа с треугольника var xx1,xx2,xx3,yy1,yy2,yy3:integer; begin xx1:=getx(x1,y1,m,n,numer); xx2:=getx(x2,y2,m,n,numer); xx3:=getx(x3,y3,m,n,numer); yy1:=gety(x1,y1,m,n,numer); yy2:=gety(x2,y2,m,n,numer); yy3:=gety(x3,y3,m,n,numer); SetFontSize(5*zoom); TextOut(rx(xx1-10),ry(yy1-10),'('+IntToStr(xx1)+','+IntToStr(yy1)+')'); TextOut(rx(xx2-10),ry(yy2+10),'('+IntToStr(xx2)+','+IntToStr(yy2)+')'); TextOut(rx(xx3-10),ry(yy3+10),'('+IntToStr(xx3)+','+IntToStr(yy3)+')'); SetFontSize(10); setpencolor(clBlack); if bordercolor<>0 then setpencolor(bordercolor); line (rx(xx1),ry(yy1),rx(xx2),ry(yy2)); line (rx(xx2),ry(yy2),rx(xx3),ry(yy3)); line (rx(xx3),ry(yy3),rx(xx1),ry(yy1)); if fillcolor<>-1 then begin getcenter(rx(xx1),ry(yy1),rx(xx2),ry(yy2),rx(xx3),ry(yy3)); FloodFill(round(Px),round(Py),fillcolor); SetPixel(round(Px),round(Py),clBlack); end; end; // procedure change_coords(ox1,oy1,ox2,oy2,ox3,oy3,m,n,numer:integer); // смена нужных координат begin bx1:=getx(ox1,oy1,m,n,numer); bx2:=getx(ox2,oy2,m,n,numer); bx3:=getx(ox3,oy3,m,n,numer); by1:=gety(ox1,oy1,m,n,numer); by2:=gety(ox2,oy2,m,n,numer); by3:=gety(ox3,oy3,m,n,numer); end; // procedure turn_triangle(xx1,yy1,xx2,yy2,xx3,yy3,m,n,angle,bordercolor,fillcolor:integer); //поворот треуголньк вокруг точки begin change_coords(xx1,yy1,xx2,yy2,xx3,yy3,-m,-n,4); change_coords(bx1,by1,bx2,by2,bx3,by3,angle,0,2); change_coords(bx1,by1,bx2,by2,bx3,by3,m,n,4); draw_triangle(bx1,by1,bx2,by2,bx3,by3,bordercolor,fillcolor); end; {procedure MouseMove(x,y,mb: integer); begin writeln(x,y); ClearWindow; abcissa:=x+30; ordinatus:=y+30; draw_grid; redraw; end; } // procedure Draw; //всё что рисовать сюда begin //1: fzoom (m) //2: turn (m) //3: zoom (m,n) //4: transfer (m,n) //5: mirror_yx - //6: mirror_x0 - //7: mirror_y0 - //8: mirror_x0_y0 - draw_triangle(x1,y1,x2,y2,x3,y3,clblue,clMaroon); work_triangle(x1,y1,x2,y2,x3,y3,clblue,clYellow ,60,60,6); work_triangle(x1,y1,x2,y2,x3,y3,clblue,clGreen ,60,60,7); work_triangle(x1,y1,x2,y2,x3,y3,clblue,clCream ,60,60,8); work_triangle(x1,y1,x2,y2,x3,y3,clBlack ,clSilver,-100,-40,4); work_triangle(x1,y1,x2,y2,x3,y3,clBlack ,clYellow,0.5,0,1); work_triangle(x1,y1,x2,y2,x3,y3,clBlack ,clMoneyGreen ,3,0,1); work_triangle(x1,y1,x2,y2,x3,y3,clBlack ,clYellow,2,2,3); turn_triangle(x1,y1,x2,y2,x3,y3,-30,-30,60,clGreen ,clFuchsia ); //writeln(px); //writeln(py); Line(rx(100),ry(50),rx(500),ry(40)); end; // procedure draw_cursor(x,y:integer); begin setpencolor(clSkyBlue); line(0,y,winwidth,y); line (x,0,x,winheight); // s:="("+IntToStr(x)+","+IntToStr(y)+")"; SetFontSize(round(7*zoom*0.8)); SetFontColor(clSkyBlue); TextOut(x+15,y-15,('('+IntToStr(round((x-abcissa)/zoom))+','+IntToStr(round((ordinatus-y)/zoom))+')')); SetFontColor(clBlack); SetFontSize(10); end; // procedure MouseMove(x,y,mb: integer); var x2,y2:integer; begin ClearWindow; if mb=1 then begin if x>x2 then abcissa:=abcissa+3; if x<x2 then abcissa:=abcissa-3; if y>y2 then ordinatus:=ordinatus+3; if y<y2 then ordinatus:=ordinatus-3; x2:=x; y2:=y; end; draw; draw_grid; draw_cursor(x,y); redraw; end; // procedure MouseDown(x,y,mb: integer); begin if mb=2 then begin case mousecount of 1: begin zoom:=2; mousecount:=2; abcissa:=abcissa-round((x-abcissa)); ordinatus:=ordinatus+round((ordinatus-y)); end; 2: begin zoom:=3; mousecount:=3; abcissa:=abcissa-round((x-abcissa)); ordinatus:=ordinatus+round((ordinatus-y)); end; 3: begin zoom:=4; mousecount:=4; abcissa:=abcissa-round((x-abcissa)); ordinatus:=ordinatus+round((ordinatus-y)); end; 4: begin zoom:=1; mousecount:=1; abcissa:=round(winwidth/2); ordinatus:=round(winheight/2); end; end; end; ClearWindow; draw; draw_grid; redraw; end; procedure Resize; begin winheight:=WindowHeight; winwidth:=WindowWidth; ClearWindow; Draw; Draw_grid; Redraw; end; //>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> begin mousecount:=1; zoom:=1; //ScrollingOff; //TextBold; winheight:=500; winwidth:=500; abcissa:=round(winwidth/2); ordinatus:=round(winheight/2); setwindowheight(winheight); SetWindowWidth(winwidth); CenterWindow; SetWindowCaption('2D'); x1:=67; y1:=70; x2:=95; y2:=111; x3:=127; y3:=84; draw; draw_grid; LockDrawing; OnMouseDown:= MouseDown; OnMouseMove:= MouseMove; OnResize:=Resize; end.
Помню, подобной ерундой на уроках информатики занимались.. Были времена :)
ОтветитьУдалить