Модераторы: volvo877, Snowy, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Меню на поскале, Перемещаться клавишами по меню 
:(
    Опции темы
InfectedM
  Дата 24.3.2008, 22:18 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 74
Регистрация: 21.10.2007

Репутация: нет
Всего: нет
Здравствуйте...
есть файл, из него считываеться текст,All хранит значение сколько всего строк в файле,
Нужно создать меню из этого файла,по каторому можно перемещаться клавишами вверх\вниз
выбранная строчка должна выделена другим цветом...

Я делал так:
когда жмем кнопки:
переменной flag присваиваеться "номер строки" далее опять открываем файл... и смотрим, если номер строки равен = flag2 то выделяем эту строку и продалжаем считывать файл,
Но что-то не работает,не понимаю почему
Подскажите как лудше сделать,заранее спасибо.
листинг процедуры:
Код

procedure DelData;
label
L1;
begin
l1:clrscr;
seek(f,0);
writeln('+--------------------------------------------------------------------------+');

 while not eof(f) do begin
   if filepos(f)+1= flag2  then begin
   textcolor(27);
   flag2:=-999;
   end;

  read(f,reg);
  writeln('+',reg.nick:16,'|',reg.Password:20,'|',reg.Icq:16,'|',reg.mail:19,'+');
  textcolor(white);
 end;   {while}
writeln('+--------------------------------------------------------------------------+');

  repeat
  choise:=readkey;
      if choise=#80 then begin
      {down}
      flag2:=flag2+1;
      if flag2=all+1 then flag2:=1;
      goto l1;
      end;

        if choise=#72 then begin
        {up}
        flag2:=flag2-1;
        if flag2=0 then flag2:=all;
        goto l1;
        end;

  until readkey=#27;
end;{procedure del}


Листинг всей программы:
Код

program bd;
uses crt;

type
Treg =record
nick:string[16];
password:string[20];
icq:string[9];
mail:string[19] ;
end;

var
f:file of treg;
Reg:Treg;
choise:char;
flag,all:integer;
flag2:integer;


procedure DelData;
label
L1;
begin
l1:clrscr;
seek(f,0);
writeln('+--------------------------------------------------------------------------+');
writeln('+      Nick      |      Password      |      Icq       |       mail        +');
writeln('+--------------------------------------------------------------------------+');
 while not eof(f) do begin
   if filepos(f)+1= flag2  then begin
   textcolor(27);
   flag2:=-111;
   end;

  read(f,reg);
  writeln('+',reg.nick:16,'|',reg.Password:20,'|',reg.Icq:16,'|',reg.mail:19,'+');
  textcolor(white);
 end;   {while}
writeln('+--------------------------------------------------------------------------+');

  repeat
  choise:=readkey;
      if choise=#80 then begin
      {down}
      flag2:=flag2+1;
      if flag2=all+1 then flag2:=1;
      goto l1;
      end;

        if choise=#72 then begin
        {up}
        flag2:=flag2-1;
        if flag2=0 then flag2:=all;
        goto l1;
        end;

  until readkey=#27;
end;{procedure del}

   procedure readData;
   begin
   clrscr;
   seek(f,0);
   writeln('+--------------------------------------------------------------------------+');
   writeln('+      Nick      |      Password      |      Icq       |       mail        +');
   writeln('+--------------------------------------------------------------------------+');
      while not eof(f) do begin
      read(f,reg);
      writeln('+',reg.nick:16,'|',reg.Password:20,'|',reg.Icq:16,'|',reg.mail:19,'+');
      end;
   writeln('+--------------------------------------------------------------------------+');
     repeat until readkey=#27;

   end;

   procedure addData;
   begin
   inc(all);
   clrscr;
   seek(f,filesize(f));

   write('Nick:');readln(reg.nick);
   write('Password:');readln(reg.password);
   write('Icq:');readln(reg.icq);
   write('Mail:');readln(reg.mail);

   write(f,reg) ;


   end;

begin

all:=0;
flag:=1;
flag2:=3;
clrscr;


assign(f,'C:\bd1.dat');
{$I-}
reset(f);
{$I+}
if IOresult <>0 then rewrite(f);


seek(f,0);

   while not eof(f) do begin {need all strings}
   inc(all);
   read(f,reg);
   end;

repeat {begin 1}

clrscr;

if flag=1 then begin
textcolor(23);
writeln('AddData ');
textcolor(white);
writeln('ReadData ');
writeln('DelData ');
writeln('4. ');
writeln('5. ');

end;

if flag=2 then begin
textcolor(white);
writeln('AddData ');
textcolor(23);
writeln('ReadData ');
textcolor(white);
writeln('DelData ');
writeln('4. ');
writeln('5. ');
end;

 if flag=3 then begin
 textcolor(white);
 writeln('AddData ');
 writeln('ReadData ');
textcolor(23);
writeln('DelData ');
textcolor(white);
 writeln('4. ');
 writeln('5. ');
end;

if flag=4 then begin
textcolor(white);
 writeln('AddData ');
 writeln('ReadData ');
  writeln('DelData ');
textcolor(23);
writeln('4. ');
textcolor(white);
 writeln('5. ');
end;

if flag=5 then begin
textcolor(white);
 writeln('AddData ');
 writeln('ReadData ');
  writeln('DelData ');
       writeln('4. ');
textcolor(23);
writeln('5. ');
textcolor(white);

end;
 writeln('_________________');
writeln('Press ESC -> Exit');
writeln('stroka: ',flag);
writeln('CTPOK B BD:',all);

repeat until keypressed;
choise:=readkey;

      if choise=#80 then begin
      {down}
        flag:=flag+1;
        if flag=6 then flag:=1;
      end;

       if choise=#72 then begin
       {up}
        flag:=flag-1;
        if flag=0 then flag:=5;
      end;

       if choise=#13 then begin
       {enter}
       if flag=1 then adddata;
       if flag=2 then readdata;
       if flag=3 then Deldata;
       end;

      {case}
until choise=#27;{end 1 ESC}

close(f);
end.



Скачать исходник:http://depositfiles.com/files/4317503




Это сообщение отредактировал(а) InfectedM - 24.3.2008, 22:27
PM MAIL   Вверх
profispb
Дата 24.3.2008, 22:42 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 220
Регистрация: 27.12.2005
Где: Санкт - Петербург

Репутация: нет
Всего: 1
В прикрепленном файле реализация меню, я сделал так потому что у меня было всего пару часов для того чтобы написать эту лабу с нуля.))
Я писал этот кусок работоспособной программы на втором курсе терема, поздно ночью.....
Перемещение по меню осуществляется с помощью рамки, думаю заменить рамку на движущийся закрашенный прямоугольник труда не составит...
Удачи в освоении

Присоединённый файл ( Кол-во скачиваний: 16 )
Присоединённый файл  KNIGA2.PAS 5,37 Kb
--------------------
В жизни, я люблю делать, то что я люблю. А не то что модно, престижно и выгодноЛюблю когда начинает работать, то что без меня не работало!
PM MAIL ICQ   Вверх
InfectedM
Дата 25.3.2008, 08:19 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 74
Регистрация: 21.10.2007

Репутация: нет
Всего: нет
спс конечно) 
я немного подумал и сделал)
1)только почему всевремя надо 2 раза нажимать на кнопку чтобы перемещалось?
2) и чтобы выйти из этой процедуры надо нажимать 2 раза ESC а мне надо 1

потомучто файл всегда читаеться и не успевает обрабатывать нажатие клавишь?




Код

procedure DelData;
label
L1;
begin
l1:
clrscr;
seek(f,0);
writeln('+--------------------------------------------------------------------------+');
writeln('+      Nick      |      Password      |      Icq       |       mail        +');
writeln('+--------------------------------------------------------------------------+');
 while not eof(f) do begin
   if filepos(f)+1= flag2  then begin
   textcolor(27);
   flag2:=flag2;
   end;

  read(f,reg);
  writeln('+',reg.nick:16,'|',reg.Password:20,'|',reg.Icq:16,'|',reg.mail:19,'+');
  textcolor(white);
 end;   {while}
writeln('+--------------------------------------------------------------------------+');

  repeat
  write(flag2);

      if readkey=#80 then begin
      {down}
      flag2:=flag2+1;


      if flag2=all+1 then flag2:=1;
        goto l1;

      end;

        if readkey=#72 then begin
        {up}
     
        flag2:=flag2-1;

        if flag2=0 then flag2:=all;
          goto l1;
        end;

  until readkey=#27; {ESC}


end;{procedure del}


Это сообщение отредактировал(а) InfectedM - 25.3.2008, 08:20
PM MAIL   Вверх
profispb
Дата 25.3.2008, 08:24 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 220
Регистрация: 27.12.2005
Где: Санкт - Петербург

Репутация: нет
Всего: 1
Ты не смотрел тот файл, что я прикрипил, иначе бы у тебя не возникло этих вопросов... я их тогда обошел..)))
--------------------
В жизни, я люблю делать, то что я люблю. А не то что модно, престижно и выгодноЛюблю когда начинает работать, то что без меня не работало!
PM MAIL ICQ   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi"
THandle
Rrader
volvo877

Запрещается!

1. Обсуждать и делится взломанными компонентами или программным обеспечением

2. Публиковать ссылки на варез

3. Оффтопить

  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, THandle, Rrader, volvo877.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Object Pascal: кроссплатформенные технологии | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0673 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.