Помощь - Поиск - Пользователи - Календарь
Полная версия: Немогу розабраться с мышкой + еще пара проблем
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
BRS
Вобщем написал я прогу - графический редактор, хочу сдать ее как курсовую... но есть проблемы...

Проблема номер раз - немогу разобраться с модулем мыши, непонимаю вообще как с ней работать - а хотелось бы чтоб курсор двигался не стрелками а мышкой...

Проблема номер два (не слишком важная) - немогу сохранять и загружать нарисованное.

Проблема номер три - аппаратная. На компе два компилятора Borland и Turbo. Второй не компилит (хз почему) в исполняемый файл, а первый ругаеться на все подряд...

Вобщем может кто нить помочь доделать прогу так чтобы использовалась мышь, и скомпилить в ехе?

Код программы :

program Paint;

uses
   screen, myunit, crt, graph, imfile;

var
   x, y,color, size  : integer;
   key               : char;
   brush,save        : boolean;

begin
IG;
logo;
userscreen;
brush := false;x := (getmaxx + 120) div 2; y := getmaxy div 2; size := 1; color := 15;
repeat
   cursor(x,y);
   key := readkey;
   case ord(key) of
      72: begin
    if (brush = true) and (y <> 16) then
       begin
       y := y - 1;
       putpoint(x,y,size,color);
       end;
    if (brush <> true) and (y <> 16) then
       y := y - 1;
    end;
      75: begin
    if (brush = true) and (x <> 131) then
       begin
       x := x - 1;
       putpoint(x,y,size,color);
       end;
    if (brush <> true) and (x <> 131) then
       x := x - 1;
    end;
      80: begin
    if (brush = true) and (y <> getmaxy  - 16) then
       begin
       y := y + 1;
       putpoint(x,y,size,color);
       end;
    if (brush <> true) and (y <> getmaxy  - 16) then
       y := y + 1;
    end;
      77: begin
    if (brush = true) and (x <> getmaxx - 16) then
       begin
       x := x + 1;
       putpoint(x,y,size,color);
       end;
    if (brush <> true) and (x <> getmaxx  - 16) then
       x := x + 1;
    end;
      49: color :=  1;
      50: color :=  9;
      51: color :=  2;
      52: color :=  4;
      53: color :=  5;
      54: color :=  6;
      55: color := 14;
      56: color := 15;
      57: color :=  0;
{    102: }
{     115: begin
   save := saveimage('file1',120,5,aaa,aaa);
   if save = false then OutTextXY(20,getmaxy-5,'Error');
   end;
     108: begin
   loadimage('file1',120,5);
   end; }
      99: begin
      cleardevice;
      userscreen;
      brush := false;x := (getmaxx + 120) div 2; y := getmaxy div 2; size := 1; color := 15;
   end;
      9: begin
    brush := not brush;
    if brush = true then putpoint(x,y,size,color);
    end;
      61: if size < 10 then size := size + 1;
      45: if size > 1 then size := size - 1;
   end;
until ord(key) = 27;
closeGraph;
end.



Модули:


unit ImFile;

interface
   uses graph;
   function SaveImage(name: string; x1, y1, x2, y2: integer ): boolean;
   procedure LoadImage(name: string; x, y: integer );

implementation


function SaveImage( name: string; x1, y1, x2, y2: integer ): boolean;
   var
      size: integer;
      p: pointer;
      f: file;
   begin
      size := ImageSize(x1, y1, x2, y2);
      getMem(p, size);
      getImage(x1, y1, x2, y2, p^);
      saveImage := false;
      assign(f, name);
      rewrite(f, size);
      if IOResult <> 0 then exit;
   blockWrite(f, p^, 1);
   close(f);
   freemem(p, size);
   saveimage := True;
   end;

procedure LoadImage( name: string; x, y: integer );
   var
      f: file;
      size: longInt;
      p: pointer;
   begin
      assign(f, name);
      reset(f, 1);
      if IOresult <> 0 then exit;
      size := filesize(f);
      reset(f, size);
      getmem(p, size);
      blockread(f, p^, 1);
      putimage(x, y, p^, CopyPut);
      freemem(p, size);
   end;

end.




unit 
   MyUnit;

interface
   uses graph,crt;
   procedure IG;
   procedure PutPoint(x,y,size,color : integer);
   function Grade(a,x : real) : real;

implementation

procedure IG;
      var GD, GM, Error : integer;
   begin
   GD := Detect;
   InitGraph(GD, GM,'');
   Error := GraphResult;
   if Error <> grOk then
      begin
      writeln('Graphics error:', GraphErrorMsg(Error));
      writeln('Press any key...');
      readkey;
      clrscr;
      halt;
      end;
   end;

procedure PutPoint(x,y,size,color : integer);
      var i,j,k, center : integer;
   begin
   if size > 10 then size := 10;
   if size < 1 then size := 1;
   j := 1;
   for i := 1 to size do
      begin
      k := j;
      j := j + 2;
      end;
   size := k; center := size div 2 + 1;
   for i := 1 to size do
      for j := 1 to size do
         putpixel(i + x - center, j + y - center, color);
   end;

function Grade(a, x: real): real;
   begin
   grade := Exp(a*Ln(x));
   end;

end.




unit screen;

interface
   uses crt, graph;
   var x, y : integer;
   procedure logo;
   procedure userscreen;
   procedure cursor(x,y : integer);

implementation

procedure logo;
      var i : integer;
   begin
   settextstyle(0,0,3);
   outtextxy(125,200, 'Turbo Brush v 1.0');
   repeat
   for i := 1 to 10 do
      begin
      arc(getmaxx div 2,460,360,180,i*20);
      delay(2000);
      end;
   setcolor(0);
   for i := 1 to 10 do
      begin
      arc(getmaxx div 2,460,360,180,i*20);
      delay(2000);
      end;
   setcolor(15);
   until keypressed;
   cleardevice;
   settextstyle(0,0,0);
   end;

procedure userscreen;
   begin
   y := 25; x := 15;
   line(120,5,120,getmaxy-5);
   line(120,5,getmaxx-5,5);
   line(getmaxx-5,5,getmaxx-5,getmaxy-5);
   line(getmaxx-5,getmaxy-5,120,getmaxy-5);
   setfillstyle(1,7);
   bar3d(10,y-15,100,y,4,true);setcolor(0);outtextxy(x,y-10,'Brush  TAB');y := y + 25;setcolor(15);
   bar3d(10,y-15,100,y,4,true);setcolor(0);outtextxy(x,y-10,'Left    <=');y := y + 25;setcolor(15);
   bar3d(10,y-15,100,y,4,true);setcolor(0);outtextxy(x,y-10,'Right   =>');y := y + 25;setcolor(15);
   bar3d(10,y-15,100,y,4,true);setcolor(0);outtextxy(x,y-10,'Up      /\');y := y + 25;setcolor(15);
   bar3d(10,y-15,100,y,4,true);setcolor(0);outtextxy(x,y-10,'Down    \/');y := y + 25;setcolor(15);
   bar3d(10,y-15,100,y,4,true);setcolor(0);outtextxy(x,y-10,'Size   +/-');y := y + 25;setcolor(15);
   bar3d(10,y-15,90,y,4,true);setcolor(0);outtextxy(x,y-10,'SetColor:');y := y + 25;setcolor(15);
    bar3d(10,y-15,20,y,4,true);
    bar3d(10+20,y-15,20+20,y,4,true);
    bar3d(10+40,y-15,20+40,y,4,true);
    setcolor(1);outtextxy(x-3,y-10, '1');
    setcolor(9);outtextxy(x+17,y-10, '2');
    setcolor(2);outtextxy(x+37,y-10, '3');
    y := y + 25;setcolor(15);
    bar3d(10,y-15,20,y,4,true);
    bar3d(10+20,y-15,20+20,y,4,true);
    bar3d(10+40,y-15,20+40,y,4,true);
    setcolor(4);outtextxy(x-3,y-10, '4');
    setcolor(5);outtextxy(x+17,y-10, '5');
    setcolor(6);outtextxy(x+37,y-10, '6');
    y := y + 25;setcolor(15);
    bar3d(10,y-15,20,y,4,true);
    bar3d(10+20,y-15,20+20,y,4,true);
    bar3d(10+40,y-15,20+40,y,4,true);
    setcolor(14);outtextxy(x-3,y-10, '7');
    setcolor(15);outtextxy(x+17,y-10, '8');
    setcolor(0);outtextxy(x+37,y-10, '9');
    y := y + 25;setcolor(15);
   bar3d(10,y-15,100,y,4,true);setcolor(0);outtextxy(x,y-10,'Clear    C');y := y + 25;setcolor(15);
   bar3d(10,y-15,100,y,4,true);setcolor(0);outtextxy(x,y-10,'Quit   ESC');y := y + 25;setcolor(15);
   end;

procedure cursor(x,y : integer);
      var pix_0,pix_11,pix_12,pix_21,pix_22,pix_31,pix_32,pix_41,pix_42 : word;
   begin
   pix_0  := getpixel(x,y);
   pix_11 := getpixel(x-1,y);pix_12 := getpixel(x-2,y);
   pix_21 := getpixel(x+1,y);pix_22 := getpixel(x+2,y);
   pix_31 := getpixel(x,y-1);pix_32 := getpixel(x,y-2);
   pix_41 := getpixel(x,y+1);pix_42 := getpixel(x,y+2);
   repeat
   putpixel(x,y,8);
   putpixel(x-1,y,8);putpixel(x,y+2,8);
   putpixel(x+1,y,8);putpixel(x,y-2,8);
   putpixel(x,y-1,8);putpixel(x,y+2,8);
   putpixel(x,y+1,8);putpixel(x,y-2,8);
   until keypressed;
   putpixel(x,y, pix_0);
   putpixel(x-1,y, pix_11);putpixel(x-2,y, pix_12);
   putpixel(x+1,y, pix_21);putpixel(x+2,y, pix_22);
   putpixel(x,y-1, pix_31);putpixel(x,y-2, pix_32);
   putpixel(x,y+1, pix_41);putpixel(x,y+2, pix_42);
   end;

end.

APAL
Прилагаю файлик граф. редактора, может поможет....
Писал не я.
Guest
Ну тока если совсем чуть чуть ))) Ибо ам две главные проблемы тоже есть exe-шник у меня не запускаеться и мммышку там не ставили
Бродяжник
...по поводу мышки...
BRS
По поводу мышки три вопроса появилось )))
С работой в целом разобрался... НО:

1) Как ограничить передвеения мыши в какой то области?
2) Как опредеять координаты мыши?
3) Как изменить вид курсора?
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.