Создаём Offline FAQ , [Pascal] сбор статей и исходников

[Romtek]

Текущая версия: 0.3a
Скачать OfflineFAQa3.rar (~48кб)
Содержание Offline-FAQ

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

Основные топики:

1. Основы Паскаля (самый главный упор именно на него)
   • Строки
   • Типы данных
   • Работа с файлами
2. Математика и алгоритмы
   • численные методы
   • и т.д.
3. Графика и игры
4. ООП
5. Дата и время

Примеры должны быть ориентированы на сегодняшний день, поэтому не принимаются примеры по

• Interrupts (уже не актуально)
• Hardware (как правило, используются прерывания и ассемблер)
• TSR (уже не актуально)

Оформление:
Только в документах DOC, HTML, или в сообщении в форуме. И не забудьте о соответствующих комментариях к коду программ!
Если лень открывать редактор, то напишите описание прямо в своём сообщении. Выделите ключевые слова, подчеркните, где надо. Сам я не могу оформлять каждый присланный документ.
Дополнения к ФАКу прикрепляйте в архиве к своему сообщению.

А ещё неплохо собрать в HTML то, что лежит на сайте http://pascal.sources.ru/ :
Pascal FAQ и Russian SWAG

[Romtek]

Кто напишет задачку для Оффлайн-ФАК ?

Имеются сведения о студентах N учебных группах со своими реквизитами (имя, группа_номер, оценка по 4-ём предметам). Кол-во студентов заранее не известно.
Определить и вывести на экран группы с самым высоким средним баллом.

Оформить красиво (с отступами), комментариями и имеющими смысл именами переменных.
Использовать процедуры и функции, например
InputData;
CalcAverageMarks;
OutputHighMarks;

без модуля CRT.

[Romtek]

А ещё нужна програмка, отображающая меню при помощи модуля CRT.

• Меню должно состоять из заголовка и списка элементов, в котором активный элемент подсвечивается.
• Всего 2 типа меню: вертикальное и горизонтальное.
• Меню должно располагаться по центру экрана и иметь разные настройки цветов, по выбору (константные значения).
• При нажатии на стрелки изменяется цвет активного элемента.
  1. Элемент 1
  2. Элемент 2 <- активный элемент
  3. Элемент 3

Добавлено 21.12.04, 18:55
Функция Menu должна возвращать индекс выбранного элемента. Для начала, пусть при выборе выводится название элемента.

Не забыть предусмотреть выход...

[Romtek]

Вот навалял прогу для работы с записями и указателями. Также используется сортировка записей по двум критериям.
Зацените. Что нужно добавить/изменить? Хочу поместить в Offline-FAQ.

Есть идея написать тоже самое с использованием объектов, коллекций (ООП). Ну и добавить междумордие (интерфейс)...
Прикреплённый файлsortrec.rar (2.06 Кбайт, скачиваний: 265)

[Dima_R]

Меню
вертикальное
цвет выбирать нельзя
заголовок непишет
P.S.
Писал для других нужд, переделать и доработать лень, но хоть что-то.
Прикреплённый файлMENU.ZIP (0.94 Кбайт, скачиваний: 275)

[Vesper]

вот тебе прога про студентов
Прикреплённый файлSTUD.zip (1.31 Кбайт, скачиваний: 288)

[Romtek]

Цитата Dima_R @ 22.12.04, 10:33

Меню
вертикальное
цвет выбирать нельзя
заголовок непишет
P.S.
Писал для других нужд, переделать и доработать лень, но хоть что-то.

В общем, что-то высвечивает, конечно, но код немного непродуман. Можно сделать и компактнее, и понятнее, и красивее.
Сам могу написать, но хочется, чтобы и другие поучаствовали.
Но всё равно спасибо!


Vesper, хорошо. Только чего комменты на английском?

Чуток оформил программу и добавил функцию CalcStudAverage

Сообщение отредактировано: Romtek - 05.01.05, 22:31

Прикреплённый файлStud_avg.zip (1.67 Кбайт, скачиваний: 324)

[Vesper]

Romtek, не люблю транслит и кривые кодировки :-)))))
ладно, пришел еще админ, терь будет время динамическое меню наваять

[Romtek]

Пример базы данных с использованием ООП (продолжение от SortRec)
При первом запуске создаёт коллекцию и сохраняет в файл, и при повторном выводит её в отсортированном виде.
Примечательно то, что с использованием объектов уменьшился код програмы.
К тому же, легче понять, что делает программа.

unit Shop_obj;
 
interface
uses Objects;
 
type
    TInfo = record
      Product: string [40]; { наименование товара }
      Price:  integer; { цена }
    end;
    PInfo = ^TInfo;
 
    TProductInfo = object (TObject)
      TransferRecord: TInfo;
      constructor Load (var S: TStream);
      procedure   Store(var S: TStream);
    end;
    PProductInfo = ^TProductInfo;
 
    TProductColl = object (TSortedCollection)
      function Compare (Key1, Key2: Pointer): Integer; virtual;
    end;
    PProductColl = ^TProductColl;
 
procedure ListAll (C: PCollection);
 
implementation
 
Const
    RProductInfo: TStreamRec = (
       ObjType: 54321;
       VmtLink: Ofs(TypeOf(TProductInfo)^);
       Load:    @TProductInfo.Load;
       Store:   @TProductInfo.Store
     );
 
constructor TProductInfo.Load(var S: TStream);
begin
  inherited Init;
  S.Read(TransferRecord, SizeOf(TransferRecord));
end;
 
procedure TProductInfo.Store(var S: TStream);
begin
  S.Write(TransferRecord, SizeOf(TransferRecord));
end;
 
{$I sortfunc.inc}
function TProductColl.Compare(Key1, Key2: Pointer): Integer;
begin
{     Compare :=
       PProductInfo(Key2)^.TransferRecord.Price -
       PProductInfo(Key1)^.TransferRecord.Price;
{}
     Compare := StrCmp (
       PProductInfo(Key1)^.TransferRecord.Product,
       PProductInfo(Key2)^.TransferRecord.Product
     )
{}
end;
 
procedure ListAll (C: PCollection);
var
 i: word;
 
 procedure ShowItem (P : PProductInfo); far;
 begin
     with P^.TransferRecord do
     begin
          inc (i);
          write   ( I : 2 );
          write   ( ' ' : 4, Product );
          writeln ( Price : 44 - Length (Product) );
     end;
 end;
 
begin
  writeln;
  writeln ('Product' : 13, 'Price' : 37);
  for I := 1 to 50 do write ('=');
  writeln;
 
  i := 0;
  C^.ForEach(@ShowItem);
  readln;
end;
 
begin
  RegisterType (RProductInfo)
end.

program Shop_OOP;
uses Objects, shop_obj;
 
Const
    Max = 5;
var
    ProductColl: PProductColl;
    Info: PProductInfo;
 
procedure InputData;
var
  i, qnt: integer;
begin
  repeat
        write ('Enter quantity of products: '); readln (qnt);
        if qnt = 0 then
           writeln ('Quantity must be > 0');
  until qnt <> 0;
 
  {Randomize;}
  for i := 1 to qnt do
  begin
    Info := New (PProductInfo,Init);
    with Info^.TransferRecord do
    begin
      write ('Enter product name (up to 40 chars): '); readln (Product);
      write ('Enter price of product: '); readln (Price);
      {write ('Enter Name: '); readln (Product);
      Price := 1 + Random (20);}
    end;
    ProductColl^.Insert (Info);
  end;
end;
 
procedure Save;
var F: TBufStream;
begin
  F.Init ('shop_oop.dat', stCreate, 1024);
  ProductColl^.Store (F);
  if F.status <> stOk then
     writeln ('Error while writing to file.');
  F.Done;
end;
 
function Loaded: boolean;
var F: TBufStream;
begin
  F.Init ('shop_oop.dat', stOpenRead, 1024);
  if F.status = stOk then
  begin
       ProductColl^.Load (F);
       Loaded := (F.status = stOk);
  end;
  F.Done;
end;
 
begin
  ProductColl := New (PProductColl, Init (20, 5));
 
  if not Loaded then
     InputData; { заполнение коллекции }
 
  { форматированный вывод коллекции на экран }
  ListAll (ProductColl);
 
  { сохранение коллекции }
  Save;
 
  Dispose (ProductColl, Done);
end.

Прикреплённый файлshop_oop.zip (2.23 Кбайт, скачиваний: 266)

[Romtek]

Цитата Romtek @ 21.12.04, 20:52

А ещё нужна програмка, отображающая меню при помощи модуля CRT.

Всё ещё нужна. см. (сообщ. #78)

Также нужна программа, которая выводит текстовый файл на экран. При нажатии на пробел окно должно прокручиваться на размер экрана (без лишних наворотов, просто и понятно).

[Dima_R]

Ура! Сдал первый экзамен. Вот написал, правда, снова не идеал, но намного лучше чем в прошлый раз. Плюс программка для чтения файлов.
Прикреплённый файлMenu_View.zip (2.29 Кбайт, скачиваний: 301)

[Romtek]

Спасибо! Именно то, что надо.

Замечания к программе MENU.PAS :

1. 
   
   

       Case ScanCode Of
    
   #77 : Begin
           PrintElementMenu((St - 1) * Length(Menu[St]) + 2,3,St,False);
           If St <> 7 Then
            Inc(St)
           Else
            St := 1;
           PrintElementMenu((St - 1) * Length(Menu[St]) + 2,3,St,True);
         End;
    
   #75 : Begin
           PrintElementMenu((St - 1) * Length(Menu[St]) + 2,3,St,False);
           If St <> 1 Then
            Dec(St)
           Else
            St := 7;
           PrintElementMenu((St - 1) * Length(Menu[St]) + 2,3,St,True);
         End
       End;
   
   лучше упростить с помошью введения дополнительной функции, в которую будем передавать параметр True или False
   

   ...
   procedure ShowMenu (Active: boolean);
   begin
     PrintElementMenu((St - 1) * Length(Menu[St]) + 2,3,St,Active);
   end;
   ...
       Case ScanCode Of
    
   #77 : Begin
           ShowMenu (False);
           If St <> 7 Then
            Inc(St)
           Else
            St := 1;
           ShowMenu (True);
         End;
    
   #75 : Begin
           ShowMenu (False);
           If St <> 1 Then
            Dec(St)
           Else
            St := 7;
           ShowMenu (True);
         End
       End;
   
   
2. 
   
   

     Case MainMenuHorizontal Of
   1 : Begin
         ClrScr;
         WriteLn('Режим ј1');
       End;
   2 : Begin
         ClrScr;
         WriteLn('Режим ј2');
       End;
   3 : Begin
         ClrScr;
         WriteLn('Режим ј3');
       End;
   4 : Begin
         ClrScr;
         WriteLn('Режим ј4');
       End;
   5 : Begin
         ClrScr;
         WriteLn('Режим ј5');
       End;
   6 : Begin
         ClrScr;
         WriteLn('Режим ј6');
       End;
   7 : Halt;
     End;
   
   по-моему, проще переписать в
   

   i := MainMenuVertical;
   if i in [1..6] then
     Menu[i];
   else
     Halt;
   аналогично и с MainMenuHorizontal
   
   
3. Куски типа
   
   

     MainWindow(35,8,44,16,'Name');
    
     PrintElementMenu(35,9,1,True);
    
     For i := 2 to 7 do
      Begin
        PrintElementMenu(35,8 + i,i,False);
      end;
   меня смущают. Никогда не пиши программу с константными значениями, максимум - значения высоты и ширины экрана (MaxX=80, MaxY=25). Остальное заменяй на общий код. Хочешь выставить значение центра по X - пиши так:
   
   

   (Hi (WindMin) - Lo (WindMin)) div 2;
   
   В крайнем случае, если не пишешь, то хотя бы одинаковые значения в программе обозначь одной константой.
   Например, значения 10, 9 желательно заменить на CX, CX-1

[Romtek]

Цитата Vesper @ 30.11.04, 19:27

есть у меня прога, которая двигает крест в графике по экрану как прицел от курсорных клавиш, но там юзается модуль, который обрабатывает INT09, соответственно не подходит в принципе переделать под обычный readkey не проблема, завтра займусь

А прога где ?

[Romtek]

Неотёсанные топики (Сообщ. #22) "Определение принадлежности точки к многоугольнику"
Кто может, проверьте почему при некоторых значениях выдаётся неверный результат.

[Vesper]

Romtek, завис если не подвалят ченить ща будет

[Vesper]

вот, только без комментов
Прикреплённый файлCONTMOV2.zip (0.42 Кбайт, скачиваний: 271)