turbo Pascal 7,0, Нужны проги... Либо со списками ... Либо с графикой... Опции

[MaX]

Гыыы А вот и время сессии

У кого нить есть на компе проги написанные на паскале ??? Иль сайтик какой нить хороший знаете, где их можно слить, заделитесь Плиз )



Нужно....

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

Графика ( т.е. какие нить сложная фигура, да ещё чтоб она двигались ... )

функции ( тока не элементарные ... а замудреные...


Вот, вообщем, если кто нить чем нить может помоч, отпишитесь ....

Сообщение отредактировал MaX - Nov 30 2006, 12:47

[Tassadar]

найди какую нить зверскую прогу на дельфи в опенсоурсе и сдай ему....все будут в восторге

[MaX]

http://borlpasc.narod.ru/silk.htm
http://t-b-pascal.narod.ru/links.html


нормальные вродь такие сайтики ....


Tassadar
в п**у заморачивацца

[drusha]

Гыыы А вот и время сессии

У кого нить есть на компе проги написанные на паскале ??? Иль сайтик какой нить хороший знаете, где их можно слить, заделитесь Плиз )
Нужно....

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

Графика ( т.е. какие нить сложная фигура, да ещё чтоб она двигались ... )

функции ( тока не элементарные ... а замудреные...
Вот, вообщем, если кто нить чем нить может помоч, отпишитесь ....

Прога со списком - это, наверное, с использованием библиотеки TurboVision... Ну, вообще-то, к самому турбопаскалю и библиотеке TurboVision прилагались примеры...

Графика. Есть там такой модуль Graph. Позволял рисовать точки, линии, текст а графическом режиме... Закрашивать контуры... Но графика там, максимум, под VGA 640х480 16 цв (или под XGA IBM 8514 1024х768 256 цв), короче, прошлый век, режим MS-DOS... А нафига это сейчас? Просто, сейчас, под виндами, все методы и подходы - другие.

Функции - это проще... Это нечто такое, что и сейчас может быть актуально. А какие это "замудрённые"? Поиск и сортировка? Оптимизация? Или что?

Мож, всё-тки не Турбо-Паскаль, а Дельфи? Или хотя бы Борланд Паскаль под Windows (хотя бы Win16 - то есть, 3.0, 3.10, 3.11)?

[MaX]

drusha


НЕТ, нужно именно то, что я написал ... Вот ...

Какое там разрешение и где это используется ( точнее не используется) мне неособо интересно, т.к. НАДО на зачет, а не для собственной гордости ....

[ismolnik]

program primer_194_v2;
const n=4;
r=2;
var
nom,i,k,s,j:integer;
min,xm,xy:real;
Begin
k:=0;
i:=1;
writeln('--------------NEW DATA:----------------');
repeat
write('Точка A',i,' скоорд. [');read(xm);
write(' , ');read(ym);write('];');
writeln('');
for i:=1 to n do
if ((xm<=3)and(xm>=-3)and(ym<=1)and(ym>=-1)and(xm*xm+ym*ym<=r*r))
then k:=k+1;
writeln('------VIVOD REZULT------- ')
until(i<=5);
writeln(k); readln;
end.

[drusha]

Так, там на самом деле под DOS или под Windows? Просто, там используются совершенно разные библиотеки. И для графики, и даже для кнопочек-менюшек.

[aler]

Turbo Pascal - компилятор для доса только

[drusha]

А был же ещё TPW - под Windows (Win-16)... Или в компиляторе Turbo была опция, какого типа экзешник делать... Не помню уже... А может, это уже не Turbo, а Borland Pascal... Не, вроде, у меня валяется книжка Turbo Pascal for Windows...

Но в любом случае надо бы определиться
- самому ли всё писать, или юзать Turbo Vision
и т.п.

[aler]

Turbo Pascal 7.0 - для DOS только
Turbo Pascal for Windows - для Windows, но и название у него другое как видно
Borland Pascal 7.0 - для DOS, DPMI и Windows может программы делать
А еще TPX был, который программы для DPMI делает

[ismolnik]

Я ТРХ стёр, так как студентам
места на винчестере одной из многочисленных машин не хватало

подлинее предыдущей?

program main;
uses
crt,graph;
var
i,x,y,b,dr,md:integer;
procedure rline(x1,y1,a:integer);
begin
if x+20>GetMaxX then a:=2;
if y-20<0 then a:=3;
if x-20<0 then a:=0;
if y+20>GetMaxY then a:=1;
case a of
0:begin
line(x1,y1,x1,y1-10);
line(x1,y1-10,x1+10,y1-10);
line(x1+10,y1-10,x1+10,y1);
line(x1+10,y1,x1+20,y1);
x:=x+20;
end;
1:begin
line(x1,y1,x1,y1-10);
line(x1,y1-10,x1+10,y1-10);
line(x1+10,y1-10,x1+10,y1-20);
line(x1+10,y1-20,x1,y1-20);
y:=y-20;
end;
2:begin
line(x1,y1,x1,y1-10);
line(x1,y1-10,x1-10,y1-10);
line(x1-10,y1-10,x1-10,y1);
line(x1-10,y1,x1-20,y1);
x:=x-20;
end;
3:begin
line(x1,y1,x1,y1+10);
line(x1,y1+10,x1+10,y1+10);
line(x1+10,y1+10,x1+10,y1+20);
line(x1+10,y1+20,x1,y1+20);
y:=y+20;
end;
end;
end;
begin
clrscr;
dr:=0; md:=0;
InitGraph(dr,md,'D:\BP\BGI\');

x:=GetMaxX div 2;
y:=GetMaxY div 2;
randomize;
setbkcolor(15);
for i:=0 to 50 do begin
setcolor(random(13)+1);
delay(500);
rline(x,y,random(4));
end;

readln;
end.

[MaX]

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

Кину че он дал... можт поймете че нить , че он от нас хочет ...

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

Так все запущенно




Паскаль

http://alf.org.ru/index.php?act=Attach&type=post&id=965

[drusha]

Вот накопал свой модуль RealGraf. Это не программа, а юнит. Делает RealGraf.TPU, который можно USES в своих прогах. Он работает через GRAPH

Что он делает?

Определяет СВОИ процедуры и функции рисования точек, линий и т.п. в РЕАЛЬНЫХ координатах (типа Real). Позволяет задавать масштаб (по умолчению, кажись, высота экрана принимается за 1 - не помню уже), но там есть процедуры на тему ZOOM...

Ещё он умеет рисовать координатные оси с автоматической разметкой. Кстати, ось Y направлена снизу вверх.

Код

{$N+}{$E+}{$A+}{$D-}{$O-}
Unit RealGraf;
InterFace
Procedure initrg;
Function getmaxxw:Integer;
Function getmaxyw:Integer;
Procedure getzoom (Var z,px,py,a:Real);
Function scrx(x:Real):Integer;
Function scry(y:Real):Integer;
Function scrl(l:Real):Integer;
Function onscr(x,y:Real):Boolean;
Function maxrx:Real;
Function minrx:Real;
Function maxry:Real;
Function minry:Real;
Function getrx:Real;
Function getry:Real;
Procedure setrx(x:Real);
Procedure setry(y:Real);
Procedure zoomw(x1,y1,x2,y2:Real);
Procedure zoomx(n:Real);
Procedure zoomc(n:Real);
Procedure zooml(n:Real);
Procedure panc(x,y:Real);
Procedure panl(x,y:Real);
Procedure zoom1;
Procedure zoom0;
Procedure axis(c:Byte;x,y:Real);
Implementation
Uses Dos,Graph,Crt;
{$R-}{$V-}{$S-}{$F+}{$I-}{-$G+}{$B-}
Var
zoom,panx,pany,aspect:Real;
Procedure initrg;
Label again;
Var
ds:DirStr;
gn,ns:NameStr;
es:ExtStr;
gd,gm:Integer;
f:SearchRec;
c:Char;
errorcode:Integer;
Begin
DetectGraph(gd,gm);
again:Case gd of
1,2:gn:='CGA';
3,4,5,9:gn:='EGAVGA';
6:gn:='IBM8514';
7:gn:='HERC';
8:gn:='ATT';
10:gn:='PC3270';
Else gn:='*';
End;
FindFirst(gn+'.bgi',AnyFile,f);
If DosError=0 Then
ds:=''
Else
Begin
Fsplit(ParamStr(0),ds,ns,es);
FindFirst(ds+'\'+gn+'.bgi',Anyfile,f);
While DosError<>0 Do
Begin
Writeln;
Writeln('‚ ⥪г饬 Ё бв ав®ў®¬ ¤ЁаҐЄв®аЁпе BGI-¤а ©ўҐал ­Ґ ­ ©¤Ґ­л.');
Write('‚ўҐ¤ЁвҐ ¤ЁаҐЄв®аЁ© а бЇ®«®¦Ґ­Ёп ¤а ©ўҐа (®ў) ',gn,'.BGI: ');
While keypressed Do
c:=ReadKey;
ds:='';
Readln(ds);
If ds='' Then
Readln(ds);
If ds='' Then Halt(1);
FindFirst(ds+'\'+gn+'.bgi',AnyFile,f);
If DosError<>0 Then
Writeln('‚ ¤ЁаҐЄв®аЁЁ ',ds,' Ёе ⮦Ґ ­Ґв.');
End;
End;
InItGraph(gd,gm,ds);
errorcode:=GraphResult;
If errorcode<>0 Then
Begin
Write('‘¤Ґ« ­  Ї®ЇлвЄ  ЁбЇ®«м§®ў вм ¤а ©ўҐа ');
If ds<>'' Then Write(ds,'\');
Writeln(gn,'.BGI');
Writeln('ќв®в BGI-¤а ©ўҐа ­Ґ Ј®¤Ёвбп.');
Writeln('‘®®ЎйҐ­ЁҐ ®Ў ®иЁЎЄҐ N ',errorcode,': ',GraphErrorMsg(errorcode),'.');
Write('‡ ¤ ©вҐ ¤агЈ®© ­®¬Ґа BGI-¤а ©ўҐа  Ё Ї®ўв®аЁвҐ Ї®ЇлвЄг гбв ­®ўЁвм ०Ё¬: ');
While KeyPressed Do c:=ReadKey;
ds:='';
Readln(ds);
If ds='' Then
Readln(ds);
If ds='' Then Halt(1);
Val(ds,gd,gm);
If gm<>0 Then gd:=0;
GoTo again;
End;
zoom0;
End;
Function getmaxxw{:Integer};
Var v:ViewPortType;
Begin
GetViewSettings(v);
getmaxxw:=v.x2-v.x1;
End;
Function getmaxyw{:Integer};
Var v:ViewPortType;
Begin
GetViewSettings(v);
getmaxyw:=v.y2-v.y1;
End;
Procedure getzoom;
Begin
z:=zoom;
px:=panx;
py:=pany;
a:=aspect;
End;
Function scrx;
Begin
scrx:=Round((x-panx)*zoom*(getmaxxw+1)/aspect);
End;
Function scry;
Begin
scry:=Round((maxry-y)*zoom*(getmaxyw+1));
End;
Function onscr;
Var sx,sy:Integer;
Begin
sx:=scrx(x);
sy:=scry(y);
onscr:=(sx>-1)And(sx<=getmaxxw)And(sy>-1)And(sy<=getmaxyw);
End;
Function scrl;
Begin
scrl:=Round(l*zoom*(getmaxxw+1)/aspect);
End;
Function maxrx;
Begin
maxrx:=panx+aspect/zoom;
End;
Function minrx;
Begin
minrx:=panx;
End;
Function maxry;
Begin
maxry:=pany+1.0/zoom;
End;
Function minry;
Begin
minry:=pany;
End;
Function getrx;
Begin
getrx:=GetX*aspect/(zoom*(getmaxxw+1))+panx;
End;
Function getry;
Begin
getry:=maxry-GetY/(zoom*(getmaxyw+1));
End;
Procedure setrx;
Begin
MoveTo(scrx(x),GetY);
End;
Procedure setry;
Begin
MoveTo(GetX,scry(y));
End;
Procedure zoomw;
Var ax,ay:Word;
Begin
If x1<x2 Then
Begin
panx:=x1;
x2:=x2-x1;
End
Else
Begin
panx:=x2;
x2:=x1-x2;
End;
If y1<y2 Then
Begin
pany:=y1;
y2:=y2-y1;
End
Else
Begin
pany:=y2;
y2:=y1-y2;
End;
If y2>0 Then
zoom:=1.0/y2
Else
zoom:=1.0;
If x2>0 Then
aspect:=x2/y2
Else
aspect:=1;
x1:=(getmaxxw+1.0)/aspect;
If x1>65535.0 Then
Begin
ay:=Round(0.1*x1);
ax:=Round(0.1*(getmaxyw+1.0));
End
Else
If x1<100.0 Then
Begin
ay:=Round(15.0*x1);
ax:=15*(getmaxyw+1);
End
Else
Begin
ay:=Round(x1);
ax:=getmaxyw+1;
End;
SetAspectRatio(ax,ay);
End;
Procedure zoomc(n:Real);
Var x,y:Real;
Begin
x:=0.5*(Maxrx+Minrx);
y:=0.5*(maxry+minry);
panx:=x-(x-panx)/n;
pany:=y-(y-pany)/n;
zoom:=zoom*n;
End;
Procedure zoomx(n:Real);
Var
ax,ay:Word;
x:Real;
Begin
aspect:=aspect*n;
x:=(getmaxxw+1.0)/aspect;
If x>65535.0 Then
Begin
ay:=Round(0.1*x);
ax:=Round(0.1*(getmaxyw+1.0));
End
Else
If x<100.0 Then
Begin
ay:=Round(15.0*x);
ax:=15*(getmaxyw+1);
End
Else
Begin
ay:=Round(x);
ax:=getmaxyw+1;
End;
SetAspectRatio(ax,ay);
x:=0.5*(Maxrx+minrx);
panx:=x-(x-panx)*n;
End;
Procedure zooml(n:Real);
Begin
zoom:=zoom*n;
End;
Procedure panc(x,y:Real);
Begin
panx:=x-0.5*aspect/zoom;
pany:=y-0.5/zoom;
End;
Procedure panl(x,y:Real);
Begin
panx:=x;
pany:=y;
End;
Procedure zoom1;
Var x,y:Real;
Begin
x:=0.5*(minrx+maxrx);
y:=0.5*(minry+maxry);
zoomw(x-0.5,y-0.5,x+0.5,y+0.5);
End;
Procedure zoom0;
Begin
aspect:=(getmaxxw+1)/(getmaxyw+1);
panx:=0.0;
pany:=0.0;
zoom:=1.0;
SetAspectRatio(1,1);
End;
Procedure axis;
Var
lx,ly:Integer;
cc:TextSettingsType;
ix,iy,i,n,z:Integer;
b,d,l,h:Real;
s:String;
Begin
lx:=GetX;
ly:=GetY;
GetTextSettings(cc);
Case c of
1:Begin ix:=Round(x); iy:=Round(y); End;
0:Begin
If x<minrx Then x:=minrx;
If y<minry Then y:=minry;
If x>maxrx Then x:=maxrx;
If y>maxry Then y:=maxry;
ix:=scrx(x);
iy:=scry(y);
End;
3:Begin ix:=getmaxxw; iy:=getmaxyw; End;
6:Begin ix:=Round(0.5*getmaxxw); iy:=Round(0.5*getmaxyw); End;
2:Begin ix:=0; iy:=getmaxyw; End;
4:Begin ix:=0; iy:=0; End;
5:Begin ix:=getmaxxw; iy:=0; End;
7:Begin ix:=36; iy:=getmaxyw-12; End;
Else
Begin
x:=0.0;
y:=0.0;
If x<minrx Then x:=minrx;
If y<minry Then y:=minry;
If x>maxrx Then x:=maxrx;
If y>maxry Then y:=maxry;
ix:=scrx(x);
iy:=scry(y);
End;
End;
SetTextStyle(0,0,1);
SetTextJustify(0,2);
If ix<0 Then ix:=0;
If iy<0 Then iy:=0;
If ix>getmaxxw Then ix:=getmaxxw;
If iy>getmaxyw Then iy:=getmaxyw;
Line (ix,0,ix,getmaxyw);
Line (0,iy,getmaxxw,iy);
b:=maxrx-minrx;
d:=ln(b)/ln(10.0);
If d<Trunc(d) Then z:=Trunc(d)-1 Else z:=Trunc(d);
d:=exp(ln(10.0)*z);
If d>=(b*0.2) Then
Begin
If d>(0.99*b) Then
d:=0.1*d
Else
If d>=(0.5*b) Then
d:=d*0.2
Else d:=d*0.5;
z:=z-1;
End;
If z>=0 Then z:=0 Else z:=-z;
l:=Round(minrx/d)*d;
If l<minrx Then l:=l+d;
h:=Round(maxrx/d)*d;
If h>maxrx Then h:=h-d;
n:=Round((h-l)/d);
For i:=0 To n Do
Begin
b:=l+i*d;
Str(b:1:z,s);
If d<1 Then
Begin
While Copy(s,Length(s),1)='0' Do
s:=Copy(s,1,Length(s)-1);
If Copy(s,Length(s),1)='.' Then
s:=Copy(s,1,Length(s)-1);
End;
Line(scrx(b),iy-1,scrx(b),iy+1);
If iy<=getmaxyw-10 Then
OutTextXY(scrx(b)+2,iy+2,s)
Else
OutTextXY(scrx(b)+2,iy-9,s);
End;
b:=maxry-minry;
d:=ln(b)/ln(10.0);
If d<Trunc(d) Then z:=Trunc(d)-1 Else z:=Trunc(d);
d:=exp(ln(10.0)*z);
If d>=(b*0.2) Then
Begin
If d>(0.99*b) Then
d:=0.1*d
Else
If d>=(0.5*b) Then
d:=d*0.2
Else d:=0.5*d;
z:=z-1;
End;
If z>=0 Then z:=0 Else z:=-z;
l:=Round(minry/d)*d;
If l<minry Then l:=l+d;
h:=Round(maxry/d)*d;
If h>maxry Then h:=h-d;
n:=Round((h-l)/d);
For i:=0 To n Do
Begin
b:=l+i*d;
Str(b:1:z,s);
If d<1 Then
Begin
While Copy(s,Length(s),1)='0' Do
s:=Copy(s,1,Length(s)-1);
If Copy(s,Length(s),1)='.' Then
s:=Copy(s,1,Length(s)-1);
End;
Line(ix-1,scry(b),ix+1,scry(b));
If ix>=8*Length(s)+4 Then
OutTextXY(ix-8*Length(s)-2,scry(b)-9,s)
Else
OutTextXY(ix+2,scry(b)-9,s);
End;
MoveTo(lx,ly);
SetTextStyle(cc.font,cc.direction,cc.charsize);
SetTextJustify(cc.horiz,cc.vert);
End;
Begin
directvideo:=False;
End.

Ещё.
Примитивная делалка меню и сканирование диска. Что-то вроде опендиалога.

Это тоже модуль. То есть, не программа, а, типа, библиотечка такая.

Код

{                         Шапка комментариев.
   Библиотека BSMENU содержит подпрограммы CLEARBUF, CHECKBUF, WTLN, EDIR,
EDISK, MENU и SELFNAME, а также переменные DIRGET и INMENU. Эти объекты ста-
новятся доступны в программах и библиотеках пользователя после определения
USES BSMENU; .
   Подпрограммы этой библиотеки работают со специальным буфером в оперативной
памяти (переменная buffer типа массив байтов длиной 65520), который явля-
ется внутренним объектом этой библиотеки и непосредственно пользователю не
доступен (доступен только через подпрограммы этой библиотеки). В него можно
записывать строки символов, заполнять его именами файлов диска или директо-
рия, очищать его, а также вызывать меню над содержимым этого буфера. При
этом предролагается что буфер заполнен строками символов (неважно откуда).
При этом суммарная длина всех строк (символов) + 2*(количество строк) не
должно превышать 65520 (что, впрочем, трудно достигнуть).
   В начале работы любой программы с использованием библиотеки BSMENU буфер
чист, переменные DIRGET=2, INMENU=NIL. При любой записи в буфер (неважно ка-
кой подпрограммой) запись строк ведется в конец буфера до его очистки
CLEARBUF, поэтому можно несколько раз подряд вызвать подпрограммы EDIR или
(и) EDISK (например для разных масок файлов) и WTLN (вписать свои строки),
а потом вызвать меню. Исключение составляет подпрограмма SELFNAME, которая
может много раз заполнять и очищать буфер, она всегда оставляет буфер пустой.
   Может быть определена подпрограмма быстрой автоматической обработки теку-
щей строки меню. Это должна быть подпрограмма, написанная пользователем по
определенным соглашениям (один параметр-строка, передаваемый по ссылке, по-
бочный эффект не должен входить в конфликт с вызывающей подпрограммой: все
параметры окон, текущий аттрибут символа и т.п. после завершения должны быть
восстановлены такими же как и в начале (если менялись)). Для того чтобы та-
кая подпрограмма стала автоматически работать, надо установить ссылку @INMENU
на нее: @INMENU:=ADDR(имя_подпрограммы); после чего подпрограмма INMENU ста-
нет синонимом этой подпрограммы. Присвоение @INMENU:=NIL отменит эту уста-
новку. По умолчанию подпрограмма быстрой обработки отсутствует.
}


{$N-}{$E-}{$D+}{$A+}
Unit bsmenu;
InterFace
{$F+}
Var dirget:Byte; {Флаг для сканирования директория или диска (для EDIR, EDISK): }
                 {0 - выбирать только файлы, но не диектоии (поддиектоии);      }
                 {1 - выбирать только директории (поддиректории), но не файлы;  }
                 {2 - выбирать и файлы, и директории, подходящие под маску.     }
                 {Дpугие значения недопустимы. Начальное значение (авт.) 2      }

    inmenu:Procedure(Var currsel:String);
                 { Процедура, выполняемая каждый раз при изменении текущей пози-}
                 { ции меню. Использует строку (текущую), передаваемую по ссылке}
                 { Если @inmenu=NIL, то не вызывается (так и по умолчанию)      }
                 { Если в программе есть описание процедуры вида                }
                 { Procedure имя (Var currsel:String);                          }
                 {  ...                                                         }
                 {  Begin                                                       }
                 {   ...                                                        }
                 {  End;                                                        }
                 { то установить ее в качестве inmenu можно так:                }
                 { @inmenu:=Addr(имя);                                          }
                 { а отменить эту установку:                                    }
                 { @inmenu:=NIL;                                                }
                 { Если она меняет параметр, в меню строка будет изменена.      }

Procedure clearbuf;             { Очистить буфер                                }

Function checkbuf:Boolean;      { Проверка буфера на наличие в нем чего-либо    }

Procedure wtln(s:String);       { Записать в буфер строку                       }

Procedure edir(ps,mask:String); { Сканировать директорий                        }

Procedure edisk(ps,mask:String);{ Сканировать ветку директориев или весь диск   }

Function menu(Var prompt:String; x1,y1,x2,y2,tc,tbg,rc,rbg,hc,hbg:Byte):Word;
                                { Вызвать меню на содержимом буфера. Вернуть    }
                                { номер выбранной строки в буфере. Параметру    }
                                { prompt, передаваемому по ссылке, присвоить    }
                                { значение выбранной строки.                    }
                                { Входнеые параметры:                           }
                                { prompt  - Строка - надпись вверху рамки       }
                                { x1,y1  - координаты первого угла окна         }
                                { x2,y2  - координаты второго угла окна         }
                                { tc,tbg - цвета букв и фона основного поля     }
                                { rc,rbg - цвет и фон рамки                     }
                                { hc,hbg - цвета букв и фона выделенного поля   }

Function selfname(paths,prompt:String; x1,y1,x2,y2,tc,tbg,rc,rbg,hc,hbg:Byte):String;
                                { Позволить пользователю полазить по            }
                                { директориям начиная со стартового (параметр   }
                                { paths, если это пустая строка-то с текущего)  }
                                { остальные параметры - как в MENU. Возвраща-   }
                                { ет выбранное имя файла. Параметров не меня-   }
                                { ет. Если нет выбора, возвращает пустую строку.}
                                { Paths может содержать одну или несколько масок}
                                { имен файлов, перечисляемых последовательно,   }
                                { через разделитель: пробел, запятую, точку с   }
                                { запятой или любое их сочетание. Путь стартово-}
                                { го директория берется из первой маски, осталь-}
                                { ные (если есть) должны содержать только маски }
                                { имени и расширения файла без путя. Маски не   }
                                { следует повторять или перекрывать, иначе один }
                                { и тот же файл может быть выбран многократно.  }
                                { Эта функция не меняет текущего директория даже}
                                { если файл был выбран где-то в другом.         }

Implementation
Uses Dos,Crt;
{$F+}
{$V-}
{$S-}
{$R-}
{$I-}
{$B-}
Type
MaskStr=String[12];
videobuf=Array[0..65519] of Byte;
Var
mms:^Word;
r:Registers;
psp:Word;
oswmem:LongInt;
mn:Word;
eod:Boolean;
buffer:^videobuf;
sn,sh:Word;
Procedure clearbuf;
Begin
  sn:=0;
  sh:=0;
  eod:=False;
End;
Function checkbuf{:Boolean};
Begin
  checkbuf:=sn<>sh;
End;
Procedure wtln{(s:String)};
Var l:Word;
Begin
  s:=s[0]+s+s[0];
  l:=sh;
  While
   (s<>'') and Not eod
   Do
   Begin
    buffer^[sh]:=Byte(s[1]);
    s:=Copy(s,2,Length(s)-1);
    sh:=sh+1;
    If
     sh>=mn
     Then
      sh:=0;
    If sh=sn Then
       Begin
        sh:=l;
        eod:=True;
       End;
   End;
End;
Procedure edir{(ps,mask:String)};
Var srf:SearchRec;
Begin
  If (ps<>'') and (ps[Length(ps)]<>':') and (ps[Length(ps)]<>'\') Then ps:=ps+'\';
  srf.name:='';
  Findfirst(ps+mask,AnyFile,srf);
   Repeat
   If
    (srf.name<>'.')And
    (srf.name<>'')And
    ((srf.attr mod 16)<8)And
    (((srf.attr mod 32)<16) or (dirget<>0))And
    (((srf.attr mod 32)>15) or (dirget<>1))
    Then
    Begin
     If (srf.attr mod 32)>15 Then
      wtln(ps+srf.name+'\')
      Else
       wtln(ps+srf.name);
    End;
   FindNext(srf);
  Until
   DosError<>0;
End;
Procedure edisk{(ps,mask:String)};
Var
    srf:SearchRec;
Begin
  srf.name:='';
  Findfirst(ps+'\'+mask,AnyFile,srf);
  Repeat
   If
    (srf.name<>'.')And
    (srf.name<>'..')And
    (srf.name<>'')And
    ((srf.attr mod 16)<8)And
    (((srf.attr mod 32)<16) or (dirget<>0))And
    (((srf.attr mod 32)>15) or (dirget<>1))
    Then
    Begin
     If (srf.attr mod 32)>15 Then
       wtln(ps+'\'+srf.name+'\')
      Else
       wtln(ps+'\'+srf.name);
    End;
   FindNext(srf);
  Until
   DosError<>0;
  srf.name:='';
  Findfirst(ps+'\????????.???',Directory,srf);
  Repeat
   If
    (srf.name<>'')And
    (srf.name<>'.')And
    (srf.name<>'..')And
    ((srf.attr mod 32)>=16)
    Then
    Begin
     edisk(ps+'\'+srf.name,mask);
    End;
   Findnext(srf);
  Until
   DosError<>0;
End;
Function menu{(Var prompt:String; x1,y1,x2,y2,tc,tbg,rc,rbg,hc,hbg:Byte):Word};
Label
  l1,l2,plan1,plan2;
Type pvbuf=^videobuf;
Var
  lastX,lastY:Byte;
  tatar:Byte;
  owmx,owmn:Word;
  screen:pvbuf;
  lastscr:Array[0..7] of pvbuf;
  scrmode:Byte Absolute 0:$0449;
  scroffs:Word Absolute 0:$044e;
  scrsize:Word Absolute 0:$044c;
  scrtxts:Word Absolute 0:$044a;
  windsize:Word;
  typeofscr:Byte Absolute 0:$0410;
  scrcols:Word Absolute 0:$044A;
  scrpage:Byte Absolute 0:$0462;
  egarows:Byte Absolute 0:$0484;
  egascan:Word Absolute 0:$0485;
  scrsegm:Word;
  i,j,k,l,m,n:Word;
  nnx,nny,nx,ny,kx,ky,d,p:Word;
  nplan:Byte;
  snn,wrd:Word;
  ctr:^String;
  c:Char;
Begin
  lastX:=WhereX;
  lastY:=WhereY;
  tatar:=TextAttr;
  owmx:=Windmax;
  owmn:=Windmin;
  If
   x2>scrtxts
   Then
   Begin
    If
     x1>(x2-scrtxts)
     Then
      x1:=x1-x2+scrtxts
     Else
      x1:=1;
    x2:=scrtxts;
   End;
  If (egarows>4) and (egarows<96) Then
   wrd:=egarows+1
   Else
    wrd:=25;
  If
   y2>wrd
   Then
   Begin
    If
     y1>(y2-wrd)
     Then
      y1:=y1-y2+wrd
     Else
      y1:=1;
    y2:=wrd;
   End;
  If
   x1<1
   Then
   Begin
    If
     (x2-x1)<=scrtxts
     Then
      x2:=x2-x1
     Else
      x2:=scrtxts;
    x1:=1;
   End;
  If
   y1<1
   Then
   Begin
    If
     (y2-y1)<=wrd
     Then
      y2:=y2-y1
     Else
      y2:=wrd;
    y1:=1;
   End;
  If
   ((x1+2)>=x2)or
   ((y1+2)>=y2)or
   (x1<1)or(y1<1)or
   (x2>scrtxts)or(y2>wrd)
   Then
    GoTo l2;
  {***}
  Case scrmode of
   0..3,$50,$51:Begin
                 kx:=2;
                 ky:=1;
                 d:=1;
                 p:=0;
                 scrsegm:=$B800;
                End;
   7:Begin
      kx:=2;
      ky:=1;
      d:=1;
      p:=0;
      scrsegm:=$B000;
     End;
   4,5:Begin
        kx:=2;
        ky:=4;
        d:=2;
        p:=0;
        scrsegm:=$B800;
       End;
   6:Begin
      kx:=1;
      ky:=4;
      d:=2;
      p:=0;
      scrsegm:=$B800;
     End;
   13..18,$52:Begin
               kx:=1;
               ky:=egascan;
               d:=1;
               p:=4;
               scrsegm:=$A000;
              End;
   19:Begin
       kx:=8;
       ky:=egascan;
       d:=1;
       p:=0;
       scrsegm:=$A000;
      End;
   Else
    Begin
     kx:=1;
     If (egascan<8) or (egascan>24) Then
      ky:=8
      Else
       ky:=egascan;
     d:=1;
     p:=0;
     scrsegm:=$A000;
    End;
  End;
  nx:=scrcols*kx;
  ny:=scrsize div d;
  screen:=Ptr(scrsegm,scroffs);
  nplan:=p;
  nnx:=kx*((x2+1)-x1);
  nny:=nnx*ky*((y2+1)-y1);
  windsize:=d*nny;
  {****}
  For i:=0 To 7 Do
   lastscr[i]:=NIL;
  If (MaxAvail-oswmem)>windsize Then
   Begin
    If nplan>0 Then
     Begin
      For i:=0 To nplan-1 Do
       If (MaxAvail-oswmem)>windsize Then
        GetMem(lastscr[i],windsize);
     End
     Else
      GetMem(lastscr[0],windsize);
    {***}
    If p>0 Then
     Begin
      plan1:
      p:=p-1;
      Port[$03CE]:=5;
      Port[$03CF]:=0;
      Port[$03CE]:=4;
      Port[$03CF]:=p;
     End;
    If lastscr[p]<>NIL Then
     For k:=0 To d-1 Do
      For i:=y1-1 To y2-1 Do
       For l:=0 To ky-1 Do
        Move(screen^[k*ny+nx*(i*ky+l)+(x1-1)*kx],lastscr[p]^[k*nny+nnx*(((i+1)-y1)*ky+l)],(x2+1-x1)*kx);
    If p>0 Then
     GoTo plan1;
    {****}
   End;
  n:=0;
  If (rc<>0) or (rbg<>0) Then
   Begin

    TextColor(rc);
    TextBackGround(rbg);
    Window(x1,y1,x2,y2);
    GoToXY(1,y2-y1+1);
    Write('+');
    For
     i:=1
     To
     x2-1-x1
     Do
      Write('-');
    Write('+');
    GoToXY(1,1);
    InsLine;
    Write('+');
    For
     i:=1
     To
     x2-1-x1
     Do
      Write('-');
    Write('+');
    For
     i:=1
     To
     y2-1-y1
     Do
     Begin
      GoToXY(1,1+i);
      Write('¦');
      GoToXY(x2-x1+1,1+i);
      Write('¦');
     End;
    If
     (x2-x1)>2
     Then
     Begin
      Window(x1+1,y1,x2-1,y1);
      If
       Length(prompt)>(x2-x1-2)
       Then
        prompt:=Copy(prompt,1,x2-x1-2);
      Write(prompt);
     End;
   End
   Else
    Begin
     x1:=x1-1;
     y1:=y1-1;
     x2:=x2+1;
     y2:=y2+1;
    End;
  TextColor(tc);
  TextBackGround(tbg);
  Window(x1+1,y1+1,x2-1,y2-1);
  ClrScr;
  Window(x1+1,y1+1,x2,y2);
  wrd:=Seg(buffer^);
  snn:=Ofs(buffer^);
  j:=1;
  l:=0;
  i:=1;
  While
   (i<y2-y1) and (l+buffer^[l]+1<sh)
   Do
   Begin
    ctr:=Ptr(wrd,snn+l);
    GoToXY(1,i);
    If
     buffer^[l]>(x2-x1-1)
     Then
      Write(Copy(ctr^,1,x2-x1-1))
      Else
       Write(ctr^);
    l:=l+buffer^[l]+2;
    i:=i+1;
   End;
  i:=1;
  l:=0;
  n:=1;
  Repeat
   GoToXY(1,i);
   TextColor(hc);
   TextBackGround(hbg);
   ctr:=Ptr(wrd,snn+l);
   prompt:=ctr^;
   If @inmenu<>NIL Then
    inmenu(prompt);
   If j<=Length(prompt) Then
    prompt:=Copy(prompt,j,255)
    Else
     prompt:='';
   If
    Length(prompt)>(x2-x1-1)
    Then
     Write(Copy(prompt,1,x2-x1-1))
     Else
      Write(prompt);
   TextColor(tc);
   TextBackGround(tbg);
   GoToXY(1,i);
   l1:c:=Readkey;
   If
    (c=#0)
    Then
    Begin
     c:=Readkey;
     If
      (c='H')And(n>1)And(l>1)
      Then
       Begin
        prompt:=ctr^;
        If j<=Length(prompt) Then
         prompt:=Copy(prompt,j,255)
         Else
          prompt:='';
        If
         Length(prompt)>(x2-x1-1)
         Then
          Write(Copy(prompt,1,x2-x1-1))
          Else
           Write(prompt);
        GoToXY(1,i);
        n:=n-1;
        l:=l-buffer^[l-1]-2;
        If i>1 Then
           i:=i-1
           Else
            Begin
                 Window(x1+1,y1+1,x2-1,y2-1);
                 InsLine;
                 Window(x1+1,y1+1,x2,y2);
            End;
       End
      Else
      Begin
       If
        (c='P')And((l+buffer^[l]+3)<sh)
        Then
         Begin
          prompt:=ctr^;
          If j<=Length(prompt) Then
           prompt:=Copy(prompt,j,255)
           Else
            prompt:='';
          If
           Length(prompt)>(x2-x1-1)
           Then
            Write(Copy(prompt,1,x2-x1-1))
            Else
             Write(prompt);
          GoToXY(1,i);
          n:=n+1;
          l:=l+buffer^[l]+2;
          If i<y2-y1-1 Then
             i:=i+1
             Else
              Begin
                   Window(x1+1,y1+1,x2-1,y2-1);
                   Delline;
                   Window(x1+1,y1+1,x2,y2);
              End;
         End
        Else
         If (c='K') or (c='M') Then
          Begin
           If (c='K') Then
            Begin
             If (j>1) Then
              j:=j-1
              Else
               GoTo l1;
            End
            Else
             If (c='M') Then
              Begin
               If (j<255) Then
                j:=j+1
                Else
                 GoTo l1;
              End
              Else
               GoTo l1;
           m:=l;
           If i>1 Then
            For k:=1 To i-1 Do
             If (m>0) and (m>=(buffer^[m-1]+2)) Then
              m:=m-buffer^[m-1]-2
              Else
               m:=0;
           Window(x1+1,y1+1,x2-1,y2-1);
            ClrScr;
           Window(x1+1,y1+1,x2,y2);
           k:=1;
           While
            (k<y2-y1) and (m+buffer^[m]+1<sh) Do
             Begin
              ctr:=Ptr(wrd,snn+m);
              GoToXY(1,k);
              prompt:=ctr^;
              If j<=Length(prompt) Then
               prompt:=Copy(prompt,j,255)
               Else
                prompt:='';
              If
               Length(prompt)>(x2-x1-1)
               Then
                Write(Copy(prompt,1,x2-x1-1))
                Else
                 Write(prompt);
              m:=m+buffer^[m]+2;
              k:=k+1;
             End;
           ctr:=Ptr(wrd,snn+l);
          End
          Else
           GoTo l1;
      End;
    End
    Else
   If
    (c<>#13)And(c<>#27)
    Then
     GoTo l1;
  until
   (c=#13)or(c=#27);
  If
   c=#27
   Then
    n:=0;
  prompt:=ctr^;
  If (rc=0) and (rbg=0) Then
   Begin
    x1:=x1+1;
    y1:=y1+1;
    x2:=x2-1;
    y2:=y2-1;
   End;
  If lastscr[0]<>NIL Then
   Begin
    {***}
    p:=nplan;
    If p>0 Then
     Begin
      plan2:
      p:=p-1;
      Port[$03CE]:=8;
      Port[$03CF]:=255;
      Port[$03CE]:=5;
      Port[$03CF]:=0;
      Port[$03CE]:=3;
      Port[$03CF]:=0;
      Port[$03CE]:=1;
      Port[$03CF]:=0;
      Port[$03CE]:=0;
      Port[$03CF]:=0;
      Port[$03C4]:=2;
      Port[$03C5]:=1 shl p;
     End;
    If lastscr[p]<>NIL Then
     For k:=0 To d-1 Do
      For i:=y1-1 To y2-1 Do
       For l:=0 To ky-1 Do
        Move(lastscr[p]^[k*nny+nnx*(((i+1)-y1)*ky+l)],screen^[k*ny+nx*(i*ky+l)+(x1-1)*kx],(x2+1-x1)*kx);
    If p>0 Then
     GoTo plan2;
    {****}
    If nplan>0 Then
     Begin
      For i:=0 To nplan-1 Do
       If lastscr[i]<>NIL Then
        FreeMem(lastscr[i],windsize);
     End
     Else
      If lastscr[0]<>NIL Then
       FreeMem(lastscr[0],windsize);
   End;
  l2:
  TextAttr:=tatar;
  Window(Lo(owmn)+1,Hi(owmn)+1,Lo(owmx)+1,Hi(owmx)+1);
  GoToXY(lastx,lasty);
  If n=0 Then
     prompt:='';
  menu:=n;
End;
Function selfname{(paths,prompt:String; x1,y1,x2,y2,tc,tbg,rc,rbg,hc,hbg):String};
Label dalee;
Var mask,path:String;
     olddg:Byte;
     ds:DirStr;
     ns:NameStr;
     es:ExtStr;
     i,j,k:Byte;
Begin
  i:=Pos(',',paths);
  j:=Pos(' ',paths);
  k:=Pos(';',paths);
  If i=0 Then
   i:=j
   Else
    If (j>0) and (j<i) Then
     i:=j;
  If i=0 Then
   i:=k
   Else
   If (k>0) and (k<i) Then
    i:=k;
  If i=0 Then
   Begin
    mask:=paths;
    path:='';
   End
   Else
    Begin
     mask:=Copy(paths,1,i-1);
     path:=Copy(paths,i+1,255);
     While (path<>'') and (path[1] in [' ',',',';']) Do
      path:=Copy(path,2,255);
    End;
  mask:=Fexpand(mask);
  Fsplit(mask,ds,ns,es);
  If ds='' Then
   GetDir(0,ds);
  If ns='' Then
   Begin
    ns:='*';
    If es='' Then
     es:='.*';
   End;
  {?}
  If path='' Then
   paths:=ns+es
   Else
    paths:=ns+es+','+path;
  {?}

--------------------

Теперь всё, я сюда больше не приду. Никогда.

[dron]

Тут можно скачать Turbo Pascal 7.1 и примеры:

http://mgceit.narod.ru/1kurs.htm

[drusha]

Гад! Форум нагло режет длинные мессаги не предупреждая даже!
Ладно, продолжение после
{?}

Код

  olddg:=dirget;
  dalee:
  If ds='' Then
   ds:='\';
  If ds[Length(ds)]=':' Then
   ds:=ds+'\';
  clearbuf;
  dirget:=1;
  edir(ds,'*.*');
  dirget:=0;

  path:=paths;
  While path<>'' Do
   Begin
    i:=Pos(',',path);
    j:=Pos(' ',path);
    k:=Pos(';',path);
    If i=0 Then
     i:=j
     Else
      If (j>0) and (j<i) Then
       i:=j;
    If i=0 Then
     i:=k
     Else
     If (k>0) and (k<i) Then
      i:=k;
    If i=0 Then
     Begin
      mask:=path;
      path:='';
     End
     Else
      Begin
       mask:=Copy(path,1,i-1);
       path:=Copy(path,i+1,255);
       While (path<>'') and (path[1] in [' ',',',';']) Do
        path:=Copy(path,2,255);
      End;
    Fsplit(mask,mask,ns,es);
    If ns='' Then
     Begin
      ns:='*';
      If es='' Then
       es:='.*';
     End;
    edir(ds,ns+es);
   End;
  mask:=prompt;
  If CheckBuf Then
   Begin
    If menu(mask,x1,y1,x2,y2,tc,tbg,rc,rbg,hc,hbg)<>0 Then
     Begin
      If mask[Length(mask)]='\' Then
       Begin
        mask:=Copy(mask,1,Length(mask)-1);
        If Length(mask)>1 Then
         If Copy(mask,Length(mask)-1,2)='..' Then
          Begin
           mask:=Copy(mask,1,Length(mask)-2);
           If mask[Length(mask)]='\' Then
            mask:=Copy(mask,1,Length(mask)-1);
           While (mask[Length(mask)]<>'\')And(mask[Length(mask)]<>':')And(mask<>'') Do
            mask:=Copy(mask,1,Length(mask)-1);
           If mask[Length(mask)]='\' Then
            mask:=Copy(mask,1,Length(mask)-1);
          End;
        ds:=mask;
        GoTo dalee;
       End
       Else
        selfname:=mask;
     End
     Else
      selfname:='';
   End
   Else
    selfname:='';
  dirget:=olddg;
  clearbuf;
End;
Var s:String;
    i:Integer;
Begin
r.ah:=$62;
Intr($21,r);
psp:=r.bx;
oswmem:=0;
mms:=Ptr(psp,2);

mn:=65520;
sn:=0;
While sn<=ParamCount Do
  Begin
   sn:=sn+1;
   s:=ParamStr(sn);
   For sh:=1 To Length(s) Do
    s[sh]:=UpCase(s[sh]);
   If Copy(s,1,2)='/B' Then
    Begin
     s:=Copy(s,3,255);
     sh:=0;
     Val(s,sh,i);
     If (i=0) and (sh>15) Then
      Begin
       mn:=sh;
       sn:=ParamCount+1;
      End;
    End
    Else
     If (Copy(s,1,2)='/M') and (oswmem=0) Then
      Begin
        s:=Copy(s,3,255);
        Val(s,oswmem,i);
        If oswmem<0 Then
         oswmem:=0;
        If (i=0) and (oswmem>0) and ((mms^-psp-20)<(oswmem shl 6)) Then
         Begin
          Writeln('Слишком много памяти хотите оставить. Столько нет. Берется вся.');
          oswmem:=0;
         End;
    If (i=0) and (oswmem>0) Then
     Begin
      r.es:=psp;
      r.bx:=mms^-psp-(oswmem shl 6)-1;
      r.ah:=$4a;
      Intr($21,r);
      mms^:=mms^-(oswmem shl 6)-1;
     End;
        oswmem:=(oswmem shl 10)+32;
      End;
  End;
If oswmem+16>MaxAvail Then
  Begin
   Writeln('Не хватает памяти для размещения буфера');
   Halt(1);
  End;
If (MaxAvail-oswmem)<mn Then
  Begin
   mn:=(MaxAvail-oswmem);
   Writeln('Мало памяти. Размер буфера уменьшен до ',mn,' байт.');
   Writeln('А сохранения видеообласти окон не будет вообще.');
  End;
GetMem(buffer,mn);
sn:=0;
sh:=0;
eod:=False;
dirget:=2;
@inmenu:=NIL;
DirectVideo:=False;
End.

Ах да, нюанс. Тут в модулях (а не программах) есть раздел
InterFace
где идут описания (объявления) процедур, функций и глобальных переменных, а также типов и т.п., которые экспортируются из модуля

Дальше идёт раздел
Implementation
где, собственно, реализация всего (а так же типы, переменные, процедуры и функции только для внутреннего употребления)

Так вот, если в разделе Interface, положим, объявление функции выглядит так:

Function selfname(paths,prompt:String; x1,y1,x2,y2,tc,tbg,rc,rbg,hc,hbg):String;

то есть, с указанием её параметров и типа, то в Implementation при её описании в заголовке указывается только имя.

Function selfname;

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

Function selfname{(paths,prompt:String; x1,y1,x2,y2,tc,tbg,rc,rbg,hc,hbg):String};

Если писать свою прогу (именно как прогу, а не подключаемый модуль), то есть маза копировать описения функций из раздела Implementation, но чтобы со всеми параметрами. То есть, убрать фигурные скобки и ещё раз свериться с объявлением в разделе Interface (которого у программ просто нет).

[ismolnik]

Подробнее о нюансах! Какись он здесь не один, Андрей

[MaX]

ВАХ..

[drusha]

Подробнее о нюансах! Какись он здесь не один, Андрей

А какие именно?
Структура модуля? Опции компилятора? Или ликбез по всему Турбо-Паскалю?

[ismolnik]

Структура модуля

[drusha]

Вкратце, на Турбо (Борланд) - Паскале можно писать программы, а можно модули (Unit). В результате компиляции программ получаются ЕХЕ, а модулей - TPU (Turbo Pascal Unit). Эти модули можно применять в программах, если напрсать оператор USES, в котором перечисляются имена модулей. Можно перечислить их в одном операторе Uses, а можно в отдельных. Именно так подключаются модули DOS, CRT, GRAPH или GRAPH3...

Модули позволяют
а) создавать программы, код и данные которых больше чем 64 Кб. В Турбо-Паскале есть ограничение, что у каждого модуля сегмент кода и сегмент данных (каждый по отдельности) не может превышать 64 Кб. Но если программа компонуется из нескольких модулей, то это ограничение снимается. Только тогда надо указать опцию компилятора
{$F+}
или в насторйках компилятора указать Force Far Calls

б) модули могут быть сделаны оверлейными. Для этого там указывается опция компилятора
{$V+}
На применение оверлейных модулей имеются ограичения (например, один оверлейный модуль не может прямо или косвенно вызывать процедуры и функции, реализованные в другом оверлейном модуле). Они позволяют преодолеть ограничение на 640 Кб базовой пмяти. Но жто только для сегментов кода (данных это не касается)

Модули Турбо-Паскаля (TPUшники) напоминают объектные модули (OBJ) как это принято в других языках (или другими разработчиками того же Паскаля). Но есть и отличия
- TPUшник распознаётся компилятором на этапе компиляции, когда как объектник обычно компонуется на этапе сборки проекта
- TPUшник содержит в себе всю инфомцию, которая обычно выделяется в заголовочные файлы (типа H в С, INC в Ассемблере и т.п.). То есть, TPUшник использется даже без каких-либо фрагментов исходного кода. И компилятор его воспринимает. Там могут содержаться описания типов (структур и т.п.), данных, процедур и функций.

Исходный код для модуля (Unit) состоит из разделов
- Заголовок - там заявляется его имя. В отличие от того, как у програм пишется
Program имя;
для модуля пишется
Unit имя;
где имя, как правило, совпадает с именем файла (без расширения .PAS)
Дальше идёт раздел интерфейса модуля. Он начинается словом

Interface

Там могут быть объявлены типы данных, глобльные переменные, процедуры и функции, которые будут доступны в программе, испльэующей данный модуль. Процедуры и функции здесь только объявляются: аналогично тому как если бы за объявлением сразу шло ключевое слово Forward;, но здесь оно подразумевается неявно.

Дальше следует раздел реализации

Implementation

Там определяются типы (например, структуры), переменные, процедуры и функции "для внутреннего употребления", а так же содерится ревлизация процедур и функций, объявленных в разделе Interface. Но для них здесь уже не надо повторять описание параметров и тип (компиятор это уже знает), а только имя подпрограммы.

В конце модуля может идти блок на внешнем ровне (вне описания какой-либо процедуры или функции)
Begin
...
End.

или просто End.

Если блок Begin...End. там есть, то это код инициализации модуля.
Коды инициализации модулей исполняются в программе, использующей данный модуль, до того как получит управление самый первый оператор самой программы. Коды инициализации разных модулей исполняются в том порядке, как эти модули были укаpаны в операторе(ах) Uses.