понедельник, 14 февраля 2011 г.

Двухмерная графика в PascalABC


Программа для показа возможностей работы с двухмерной графикой в 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.

1 комментарий:

  1. Помню, подобной ерундой на уроках информатики занимались.. Были времена :)

    ОтветитьУдалить