Модераторы: Poseidon
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> [Pascal] Реализация прокрутки 
:(
    Опции темы
Максимус
  Дата 9.1.2005, 17:41 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

Репутация: нет
Всего: нет
Здравствуйте! Весьма вам благодарен за столи щедрую помощ, но видимо мы не совсем правильно друг другу поняли.
Я работаю не со строками, а с записями(структурами).
Пожалуйста, помогите ещё разок.

Если вас на затруднит, посмотрите, что не так с этой прогой!!!

Не работает только процедура Vivod_SKLAD.

Пожалуйста, сделайте с ней что нибуть, или перепишите заново под мою
прогу. А то я уже запарился с ней мучатся.
(исходники отдаю в вечное пользование. Они рабочие, за исключением Vivod_SKLAD).

Код

program Schetchik;
uses Graph,crt,DOS,Printer;
type
 kol=record
 name:string[40];
 amount:real;
 coast:real;
end;
 Fil=File of kol;
label 1,2;
var
 F,Fs,F_2,F200,F300,F400,F500:Fil;
 a,b,First,Last:kol;

PROCEDURE Vvod(var F:Fil);
var
 graphic,graphics:integer;
 c:char;
begin
 CloseGraph;
 ClrScr;
 Rewrite(F);
 c:=#13;
 while (c=#13) do begin
   With a do begin
     writeln('Введите наименование:');
     readln(name);
     writeln('Введите количество:');
     readln(amount);
     writeln('Введите цену:');
     readln(coast);
     write(F,a);
   end;
 writeln('Press ENTER to continue, ESC-exit');
 c:=readkey;
end;
 Close(F);
end;

PROCEDURE Vivod(var F:Fil);
label 1,2;
var
 graphic,graphics,i,x,y:integer;
 n:real;
 s1:string[5];
 c:char;
begin
 CloseGraph;
 Clrscr;
 y:=17;x:=100;
 graphic:=detect;
 InitGraph(graphic,graphics,'C:\BP\BGI');
 SetColor(7);
 Line(0,0,639,0);
 Line(0,0,0,479);
 Line(0,479,639,479);
 Line(639,0,639,479);
 Line(0,18,639,18);
 SetColor(15);
 MoveTo(78,9);
 SetTextStyle(0,0,1);
 Outtext('Название');
 MoveTo(245,9);
 Outtext('Количество');
 MoveTo(335,9);
 Outtext('Стоймость');
 SetColor(7);
 for i:=1 to 33 do begin
   y:=y+14;
   Line(1,y,639,y);
 end;
 Line(240,0,240,479);
 Line(330,0,330,479);
 SetColor(14);
 y:=7;x:=0;i:=0;
 SetTextStyle(0,0,0);
 Reset(F);
 While not Eof(F) do begin
   y:=y+15;
   read(F,a);
   With a do begin
   i:=i+1;
     MoveTo(0,y-i);
     Outtext(name);
     MoveTo(240,y-i);
     n:=amount;
     Str(n:2:0,s1);
     SetTextStyle(0,0,0);
     Outtext(s1);
     n:=coast;
     Str(n:2:0,s1);
     MoveTo(330,y-i);
     Outtext(s1);
   end;
 end;
 Close(F);
2:c:=readkey;
 if c=#27 then
   Exit
 else goto 2;
end;

PROCEDURE Vvod_SKLAD(var Fs:Fil);
var
 c:char;
begin
 CloseGraph;
 clrscr;
 writeln('?  бЄ« ¤Ґ:');
 Reset(Fs);
 Seek(Fs,33);
 c:=#13;
 while (c=#13) do begin
   With b do begin
     writeln('Введите наименование:');
     readln(name);
     writeln('Введите количество:');
     readln(amount);
     writeln('Введите стоймость:');
     readln(coast);
     write(Fs,b);
   end;
 writeln('Press ENTER to continue, ESC-exit');
 c:=readkey;
end;
 Close(Fs);
end;

PROCEDURE Vivod_SKLAD(var Fs:Fil);
label 1,2,3;
var
 graphic,graphics,i,x,y,First,Last,n1,index_of_end:integer;
 n:real;
 s1:string[5];
 c:char;
begin
 CloseGraph;
 Clrscr;
 {Reset(Fs);
 Seek(Fs,22);
 Truncate(Fs);
 Close(Fs);}
 y:=17;x:=100;
 graphic:=detect;
 InitGraph(graphic,graphics,'C:\BP\BGI');
 SetColor(7);
 Line(0,0,639,0);
 Line(0,0,0,479);
 Line(0,479,639,479);
 Line(639,0,639,479);
 Line(0,18,639,18);
 SetColor(15);
 MoveTo(78,9);
 SetTextStyle(0,0,1);
 Outtext('Название');
 MoveTo(245,9);
 Outtext('Количество');
 MoveTo(335,9);
 Outtext('Стоймость');
 SetColor(7);
 for i:=1 to 33 do begin
   y:=y+14;
   Line(1,y,639,y);
 end;
 Line(240,0,240,479);
 Line(330,0,330,479);
 SetColor(14);
 y:=7;x:=0;i:=0;
 SetTextStyle(0,0,0);
 Reset(Fs);
 index_of_end:=Filesize(Fs);
 if index_of_end<33 then
   last:=index_of_end
 else
   last:=33;
   {n:=index_of_end;
   Str(n:2:0,s1);
   SetTextStyle(0,0,0);
   Outtext(s1);}
 First:=0;
Repeat
 Seek(Fs,First);
 for i:=0 to Last-First-1 do
 begin
   y:=y+14;
   Read(Fs,a);
   With a do
     begin
     {i:=i+1;}
     MoveTo(0,y);
     Outtext(name);
     MoveTo(240,y);
     n:=amount;
     Str(n:2:0,s1);
     SetTextStyle(0,0,0);
     Outtext(s1);
     n:=coast;
     Str(n:2:0,s1);
     MoveTo(330,y);
     Outtext(s1);
   end;
 end;
 c:=readkey;
 if (c=#72)and(first>0) then
 begin
   first:=first-8;
   last:=last-8;
 end;
 if (c=#80)and(last<Filesize(Fs)-1) then
 begin
   first:=first+8;
   last:=last+8;
 end;
 until c=#27;
 Close(Fs);
{2:c:=readkey;
 if c=#27 then
   Exit
 else goto 2;}
end;

PROCEDURE Change(var F:Fil);
var
 n:real;
 nam:string[30];
 x:integer;
 am:real;
begin
 CloseGraph;
 ClrScr;
 writeln('Введите наименование:');
 readln(nam);
 writeln('Введите новое количество');
 readln(am);
 Reset(F);
 repeat
   read(F,a);
 until (a.name=nam)or(eof(F));
 if nam=a.name then
 begin
   x:=FilePos(F);
   seek(F,Filepos(f)-1);
   a.amount:=am;
   write(F,a);
 end;
 Close(F);
end;

PROCEDURE Schet_1(var F,Fs:Fil);
var
 x:integer;
begin
 Reset(F);
 Reset(Fs);
 while  not  eof(F) do
   begin
     read(F,a);
     repeat
       read(Fs,b);
     until  (b.name=a.name)or(eof(Fs));
       if b.name=a.name then
         begin
           x:=FilePos(Fs);
           b.amount:=b.amount-a.amount;
           seek(Fs,x-1);
           write(Fs,b);
         end;
   end;
 Close(F);
 Close(Fs);
end;

PROCEDURE Schet(var F,Fs,F_2,F200,F300,F400,F500:Fil);
label 1,2;
var
 graphic,graphics:integer;
 c:char;
begin
1:CloseGraph;
 clrscr;
 graphic:=detect;
 InitGraph(graphic,graphics,'C:\BP\BGI');
 clrscr;
 Assign(F,'C:\Стаб 1КВт.txt');
 Assign(F_2,'C:\Стаб 2КВт.txt');
 Assign(F200,'C:\Преоб 200.txt');
 Assign(F300,'C:\Преоб 300.txt');
 Assign(F400,'C:\Преоб 400.txt');
 Assign(F500,'C:\Преоб 500.txt');
   Setcolor(1);
   SetFillStyle(1,1);
   FloodFill(50,50,1);
   Rectangle(0,0,638,478);
   Setcolor(14);
   SetTextStyle(0,0,2);
   OuttextXY(90,20,'Введите нужное изделие');
   Setcolor(15);
   SetTextStyle(0,0,1);
   OuttextXY(220,170,'1:Стабилизатор 1КВт');
   OuttextXY(220,190,'2:Стабилизатор2КВт');
   OuttextXY(220,210,'3:Преобразователь 200Вт');
   OuttextXY(220,230,'4:Преобразователь 300Вт');
   OuttextXY(220,250,'5:Преобразователь 400Вт');
   OuttextXY(220,270,'6:Преобразователь 500Вт');
 2:c:=readkey;
   case c of
     '1': Schet_1(F,Fs);
     '2': Schet_1(F_2,Fs);
     '3': Schet_1(F200,Fs);
     '4': Schet_1(F300,Fs);
     '5': Schet_1(F400,Fs);
     '6': Schet_1(F500,Fs)
   else if c=#27 then
     Exit
   else goto 2;
   end;
end;

PROCEDURE Vivoll(var F,Fs,F_2,F200,F300,F400,F500:Fil);
label 1,2;
var
 graphic,graphics:integer;
 c:char;
begin
1:CloseGraph;
 clrscr;
 graphic:=detect;
 InitGraph(graphic,graphics,'C:\BP\BGI');
 clrscr;
 Assign(F,'C:\Стаб 1КВт.txt');
 Assign(F_2,'C:\Стаб 2КВт.txt');
 Assign(F200,'C:\Преоб 200.txt');
 Assign(F300,'C:\Преоб 300.txt');
 Assign(F400,'C:\Преоб 400.txt');
 Assign(F500,'C:\Преоб 500.txt');
 Setcolor(1);
 SetFillStyle(1,1);
 FloodFill(50,50,1);
 Rectangle(0,0,638,478);
 Setcolor(14);
 SetTextStyle(0,0,2);
 OuttextXY(90,20,'‚лЎЁаҐвҐ ­г¦­®Ґ Ё§¤Ґ«ЁҐ');
 Setcolor(15);
 SetTextStyle(0,0,1);
 OuttextXY(220,170,'1:Стабилизатор 1КВт');
 OuttextXY(220,190,'2:Стабилизатор 2КВт');
 OuttextXY(220,210,'3:Преобразователь 200Вт');
 OuttextXY(220,230,'4:Преобразователь 300Вт');
 OuttextXY(220,250,'5:Преобразователь 400Вт');
 OuttextXY(220,270,'6:Преобразователь 500Вт');
 OuttextXY(220,290,'Esc:На главную');
2:c:=readkey;
 if c='1' then begin
   Vivod(F); goto 1; end
 else if c='2' then begin
   Vivod(F_2); goto 1; end
 else if c='3' then begin
    Vivod(F200);goto 1; end
 else if c='4' then begin
    Vivod(F300); goto 1; end
 else if c='5' then begin
    Vivod(F400); goto 1; end
 else if c='6' then begin
    Vivod(F500); goto 1; end
 else if c=#27 then
   Exit
 else goto 2;
end;

PROCEDURE Birth(var F,Fs,F_2,F200,F300,F400,F500:Fil);
label 1,2;
var
 graphic,graphics:integer;
 c:char;
begin
1:CloseGraph;
 clrscr;
 graphic:=detect;
 InitGraph(graphic,graphics,'C:\BP\BGI');
 clrscr;
 Assign(F,'C:\Стаб 1КВт.txt');
 Assign(F_2,'C:\Стаб 2КВт.txt');
 Assign(F200,'C:\Преоб 200.txt');
 Assign(F300,'C:\Преоб 300.txt');
 Assign(F400,'C:\Преоб 400.txt');
 Assign(F500,'C:\Преоб 500.txt');
 Setcolor(1);
 SetFillStyle(1,1);
 FloodFill(50,50,1);
 Rectangle(0,0,638,478);
 Setcolor(14);
 SetTextStyle(0,0,2);
 OuttextXY(90,20,'Введите оздаваемое изделие');
 Setcolor(15);
 SetTextStyle(0,0,1);
 OuttextXY(220,170,'1:Стабилизатор 1КВт‚в');
 OuttextXY(220,190,'2:Стабилизатор 2КВт‚в');
 OuttextXY(220,210,'3:Преобразователь 200‚в');
 OuttextXY(220,230,'4:Преобразователь 300‚в');
 OuttextXY(220,250,'5:Преобразователь400‚в');
 OuttextXY(220,270,'6:Преобразователь 500‚в');
 OuttextXY(220,290,'Esc:На главную');
2:c:=readkey;
 if c='1' then begin
   Vvod(F); goto 1; end
 else if c='2' then begin
   Vvod(F_2); goto 1; end
 else if c='3' then begin
    Vvod(F200);goto 1; end
 else if c='4' then begin
    Vvod(F300); goto 1; end
 else if c='5' then begin
    Vvod(F400); goto 1; end
 else if c='6' then begin
    Vvod(F500); goto 1; end
 else if c=#27 then
   Exit
 else goto 2;
end;
var
 graphic,graphics:integer;
 c:char;
BEGIN
1:CloseGraph;
 ClrScr;
 Assign(Fs,'C:\Склад.txt');
 Assign(F,'C:\Стаб 1КВт.txt');
 graphic:=detect;
 InitGraph(graphic,graphics,'C:\BP\BGI');
 Setcolor(1);
 SetFillStyle(1,1);
 FloodFill(50,50,1);
 Rectangle(0,0,638,478);
 Setcolor(14);
 SetTextStyle(0,0,2);
 OuttextXY(200,60,'Главное меню');
 SetTextStyle(0,0,1);
 Setcolor(15);
 OuttextXY(200,170,'1:Создание главного файла ');
 OuttextXY(200,190,'2:Созлание файлов для изделий');
 OuttextXY(200,210,'3:Изменение содержимого файла');
 OuttextXY(200,230,'4:Изменение содержимого изделий');
 OuttextXY(200,250,'5:На складе в данный момент');
 OuttextXY(200,270,'6: Посмотреть состояние изделий');
 OuttextXY(260,290,'Esc:Выход');
2:c:=readkey;
 if c='1' then begin
   Vvod_SKLAD(Fs); goto 1; end
 else if c='2' then begin
   Birth(F,Fs,F_2,F200,F300,F400,F500); goto 1; end
 else if c='3' then begin
     Change(F); goto 1; end
 else if c='4' then begin
    Schet(F,Fs,F_2,F200,F300,F400,F500); goto 1; end
 else if c='5' then begin
    Vivod_SKLAD(Fs); {goto 1;} end
 else if c='6' then begin
   Vivoll(F,Fs,F_2,F200,F300,F400,F500); goto 1; end
 else if c=#27 then
   Exit
 else goto 2;
 {Assign(F,'C:\Стаб 1КВт.txt');
 Vivod(F);
readln;}
END.


Зарание Большое спасибо!!!

Ответ пришлите на [email protected] smile smile

Это сообщение отредактировал(а) Максимус - 8.2.2005, 23:05
PM MAIL   Вверх
Alexandr87
Дата 9.1.2005, 19:02 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


дыкий псых
***


Профиль
Группа: Завсегдатай
Сообщений: 1459
Регистрация: 27.11.2004
Где: Алматы, Казахстан

Репутация: 1
Всего: 39
если работаешь с текстом, то есть такие функции вроде gotoxy.
вот таким макаром можно все строки записать в массив строк, и матать выводя текст используя gotoxy
Добавлено @ 19:03
ЗЫ
вернее текст выводиться стандартным методом, а курсор перемещается именно этой функцией
PM Jabber   Вверх
mvdr
Дата 10.1.2005, 15:55 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


физик
***


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

Репутация: 7
Всего: 42
1) прокрутка на весь экран: ставишь label'ы у строк, которые начинают страницу, и при нажатии <вниз> переходишь на соответствующий label. Процесс можно сократить до написания label через определенное кол-во строк.
2) прерзаписывать файл, но только смещенным на несколько строк.


--------------------
Появляюсь редко, но часто метко

Изображать идиота сложнее, чем изображать умного: полезнее и не каждому дано
PM ICQ   Вверх
Alexandr87
Дата 10.1.2005, 18:26 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


дыкий псых
***


Профиль
Группа: Завсегдатай
Сообщений: 1459
Регистрация: 27.11.2004
Где: Алматы, Казахстан

Репутация: 1
Всего: 39
Код


uses crt;
const
MAX=100;
PR=48;
var
mas:array[1..MAX] of string[50];
x:integer;
ch:char;
procedure writep(posit:integer);
var x:integer;
begin
if (posit-1<0)or(posit+PR>MAX) then exit;
clrscr;
gotoxy(1,1);
for x:=posit to posit+PR do
   writeln(mas[x]);
end;


begin
clrscr;
for x:=1 to MAX do
   mas[x]:=chr(x+32);
x:=1;
repeat
   writep(x);
   ch:=readkey;
   if (ch='P') and (x+PR<MAX) then x:=x+1;
   if (ch='H') and (x-1>0) then x:=x-1;
until ch=#27;

end.
PM Jabber   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Центр помощи"

ВНИМАНИЕ! Прежде чем создавать темы, или писать сообщения в данный раздел, ознакомьтесь, пожалуйста, с Правилами форума и конкретно этого раздела.
Несоблюдение правил может повлечь за собой самые строгие меры от закрытия/удаления темы до бана пользователя!


  • Название темы должно отражать её суть! (Не следует добавлять туда слова "помогите", "срочно" и т.п.)
  • При создании темы, первым делом в квадратных скобках укажите область, из которой исходит вопрос (язык, дисциплина, диплом). Пример: [C++].
  • В названии темы не нужно указывать происхождение задачи (например "школьная задача", "задача из учебника" и т.п.), не нужно указывать ее сложность ("простая задача", "легкий вопрос" и т.п.). Все это можно писать в тексте самой задачи.
  • Если Вы ошиблись при вводе названия темы, отправьте письмо любому из модераторов раздела (через личные сообщения или report).
  • Для подсветки кода пользуйтесь тегами [code][/code] (выделяйте код и нажимаете на кнопку "Код"). Не забывайте выбирать при этом соответствующий язык.
  • Помните: один топик - один вопрос!
  • В данном разделе запрещено поднимать темы, т.е. при отсутствии ответов на Ваш вопрос добавлять новые ответы к теме, тем самым поднимая тему на верх списка.
  • Если вы хотите, чтобы вашу проблему решили при помощи определенного алгоритма, то не забудьте описать его!
  • Если вопрос решён, то воспользуйтесь ссылкой "Пометить как решённый", которая находится под кнопками создания темы или специальным флажком при ответе.

Более подробно с правилами данного раздела Вы можете ознакомится в этой теме.

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

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


 




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


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

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