Помощь - Поиск - Пользователи - Календарь
Полная версия: Немогу розабраться с мышкой + еще пара проблем
Форум «Всё о Паскале» > 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) Как изменить вид курсора?
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.