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

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

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

 
 Ответить  Открыть новую тему 
> Немогу розабраться с мышкой + еще пара проблем
BRS
сообщение 12.12.2004 16:57
Сообщение #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 - 16.11.2010 17:09
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
APAL
сообщение 12.12.2004 17:06
Сообщение #2


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

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

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


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


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


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


Гость






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


Бывалый
***

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

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


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


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


Новичок
*

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

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


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

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

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

 

- Текстовая версия 23.07.2025 4:27
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"