IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Немогу розабраться с мышкой + еще пара проблем
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 45
Пол: Мужской

Репутация: -  0  +


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

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

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

Проблема номер три - аппаратная. На компе два компилятора 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.



Сообщение отредактировано: volvo -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Смотрю...
*****

Группа: Пользователи
Сообщений: 1 055
Пол: Мужской
Реальное имя: Пшеничный Алексей Анатольевич

Репутация: -  6  +


Прилагаю файлик граф. редактора, может поможет....
Писал не я.


Прикрепленные файлы
Прикрепленный файл  GRAPH.rar ( 28.22 килобайт ) Кол-во скачиваний: 151


--------------------
Если что-то не делает того, что вы запланировали ему делать - это еще не означает, что оно бесполезно.
--------------------
Прежде, чем задать вопрос - Правила :: FAQ :: Поиск
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Гость






Ну тока если совсем чуть чуть ))) Ибо ам две главные проблемы тоже есть exe-шник у меня не запускаеться и мммышку там не ставили
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Бывалый
***

Группа: Пользователи
Сообщений: 206
Пол: Мужской

Репутация: -  3  +


...по поводу мышки...


Прикрепленные файлы
Прикрепленный файл  MYSHA.ZIP ( 18.02 килобайт ) Кол-во скачиваний: 162
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Новичок
*

Группа: Пользователи
Сообщений: 45
Пол: Мужской

Репутация: -  0  +


По поводу мышки три вопроса появилось )))
С работой в целом разобрался... НО:

1) Как ограничить передвеения мыши в какой то области?
2) Как опредеять координаты мыши?
3) Как изменить вид курсора?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 27.09.2021 14:40
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name