45286 (664587), страница 2
Текст из файла (страница 2)
Пример: Const Max: integer=200
2. 2 Константы-массивы
Чтобы задать какую-либо константу-массив, нужно описать значения всех элементов. Значения описываются в круглых скобках, через запятую. Например:
Const Digits: array[1..5] of byte=(1, 2, 3, 4, 5)
В данном примере объявляется константа-массив Digits типа Byte. Ей сразу присваиваются числа от 1 до 5.
Константы-массивы часто используются для задания строк, оканчивающихся символом #0. В этом случае описание выглядит так:
Const Stroka: array[1..5] of char=(‘Hello’)
Константой может быть и многомерный массив. Для этого каждое его измерение помещается в круглые скобки. Пример:
type TCube = array[0..1, 0..1, 0..1] of Integer;
const Maze: TCube = (((0, 1), (2, 3)), ((4, 5), (6,7)))
Создается массив Maze, где:
Maze[0,0,0] = 0
Maze[0,0,1] = 1
Maze[0,1,0] = 2
Maze[0,1,1] = 3
Maze[1,0,0] = 4
Maze[1,0,1] = 5
Maze[1,1,0] = 6
Maze[1,1,1] = 7
Все константы-массивы не могут содержать файловых переменных ни на каком уровне.
2. 3 Константы-записи
Для задания константы-записи необходимо заполнить ее поля согласно синтаксису: Имя_поля: значение. Значения разделяются точками с запятой и все выражение помещается в круглые скобки. Значения должны быть представлены константами. Поля должны быть перечисленны в том порядке, в каком они размещены в описании записи. Поле-описатель, если такое есть, должно быть заполнено; в случае записи с вариантами только вариант, выбранный описателем может использоваться.
Примеры:
type
TPoint = record
X, Y: Single;
end;
TVector = array[0..1] of TPoint;
TMonth = (Jan, Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec);
TDate = record
D: 1..31;
M: TMonth;
Y: 1900..1999;
end;
const
Origin: TPoint = (X: 0.0; Y: 0.0);
Line: TVector = ((X: -3.1; Y: 1.5), (X: 5.8; Y: 3.0));
SomeDay: TDate = (D: 2; M: Dec; Y: 1960);
Все константы-записи не могут содержать файловых переменных ни на каком уровне.
2. 4 Процедурные константы
Для определения процедурной константы нужна процедура с подходящими параметрами. Например:
function Calc(X, Y: Integer): Integer;
begin
...
end;
type TFunction = function(X, Y: Integer): Integer;
const MyFunction: TFunction = Calc;
После такого описания, функция вызывается:
I := MyFunction(5, 7)
Вы также можете присвоить константе значение nil.
2. 5 Константы-указатели
Такие константы содержат адрес в памяти переменной или подпрограммы. При их объявлении констант нужно следить за тем, чтобы адрес, на который она указывает, использовался. Примеры:
Константа содержит адрес переменной:
const PI: ^Integer = @I;
Константа содержит адрес подпрограммы:
const PF: Pointer = @MyFunction;
Вы можете объявить константу типа PChar со строчным значением, т. к. литералы хранятся в памяти как глобальные константы.
Адреса локальных (размещенных в стеке) и динамических переменных не могут быть помещены в подобную константу.
2. 6 Примеры программ
Ниже приведены примеры программ, использующих типизированные константы. Они написаны в Delphi, но в виде консольного приложения – чтобы не загромождать текст программ описанием форм и других объектов, к которым данная задача не имеет отношения.
Тексты программ-примеров помещены на дискете с курсовой работой в директории EXAMPLES.
Пример 1.
program Example1;
{$APPTYPE CONSOLE}
{Данная программа-пример демонстрирует применение констант-массивов. Преобразует численный формат даты в обычный, с названием месяца}
uses
SysUtils;
const month:array[1..12] of string[20]=('January','February','March','April','May', 'June','July','August','September','October','November', 'December');
var d:string[10];
s:string[30];
s1:string[3];
begin
write('Enter date (dd:mm:yyyy): ');
readln(d);
s:='';
if copy(d,1,1)<>'1' then begin
if copy(d,2,1)='1' then s1:='`st' else
if copy(d,2,1)='2' then s1:='`nd' else
if copy(d,2,1)='3' then s1:='`rd'
end else s1:='`th';
s:=copy(d,1,2)+s1+' of '+month[strtoint(copy(d,4,2))]+' ' +copy(d,7,4);
writeln(s);
readln
end.
Пример 2.
unit Example2frm;
{Этот пример показывает,как применяются константы-записи. Здесь строится многоугольник (с применением метода Polyline объекта Canvas),а координаты вершин многоугольника содержатся в массиве констант-записей.}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
PolyLines:array[1..4] of tpoint=((x:170;y:20),(x:320;y:320),(x:20;y:320), (x:170;y:20));
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
form1.Canvas.Pen.Width:=3;
form1.canvas.Polyline(polylines)
end;
end.
Окно этой программы-примера приведено на рис. 2. 1 (стр. 20):
Рисунок 2. 1 – Окно программы-примера
Выводы
В данной работе представлена образовательная программа, разработанная в среде программирования Borland Delphi 5. К ней прилагается файл урока, описывающего основы Delphi. Но вообще, эту систему обучения можно «заставить» обучать какой-угодно дисциплине – для этого достаточно создать файлы уроков и записать их имена в файл конфигурации.
В процессе разработки программы детально изучены графические возможности Делфи и объекта Canvas.
Во второй части работы рассмотрены типизированные константы в Паскале, их применение. Даны примеры программ.
Перечень ссылок
1. Культин Н. Delphi 4. Программирование на Object Pascal. BHV, Санкт-Петербург, 1999. – 480 с., ил.
2. Дэн Оузьер и др. Delphi 3. Освой самостоятельно. М.: “Издательство БИНОМ”, 1998 г. – 560 с.: ил.
3. Бондарев В. М., Рублинецкий В. И., Качко Е. Г. Основы программирования. Харьков: Фолио; Ростов н/Д: Феникс, 1998 – 368 с.
4. Справочная система Delphi
5. Фаронов В. В. Delphi 4. Учебный курс. М.: «Нолидж», 1999 – 464 с., ил.
Приложение А
Ниже дан исходный код всех модулей программы
unit Mainfrm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls;
type
TfrmMain = class(TForm)
Image1: TImage;
Timer1: TTimer;
Button1: TButton;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
uses runfrm;
{$R *.DFM}
var x:integer;
procedure TfrmMain.Timer1Timer(Sender: TObject);
var r:trect;
begin
r.Left:=x;
r.Top:=150;
r.Bottom:=170;
r.Right:=frmmain.Width;
frmmain.canvas.fillrect(r);
frmmain.canvas.TextOut(x,151,'Добро пожаловать в программу "Learn Delphi" !!!');
dec(x,3);
if x<-720 then x:=frmmain.width
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
frmmain.canvas.Brush.Color:=clsilver;
frmmain.canvas.pen.color:=clblue;
x:=frmmain.width;
frmmain.canvas.font.name:='Times New Roman';
frmmain.canvas.font.size:=19;
frmmain.canvas.font.color:=clblue
end;
procedure TfrmMain.Button1Click(Sender: TObject);
begin
frmmain.hide;
frmrun.show;
end;
end.
unit runfrm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, checklst;
type
Tfrmrun = class(TForm)
lblessons: TListBox;
Label1: TLabel;
Button1: TButton;
Button2: TButton;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure lblessonsDblClick(Sender: TObject);
procedure lblessonsKeyPress(Sender: TObject; var Key: Char);
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmrun: Tfrmrun;
lessonname:string[40];
implementation
uses Mainfrm, lessonfrm;
{$R *.DFM}
type
tconfig=record
name:string[50];
filename:string[40];
end;
var names:array[1..100] of string[40];
procedure loadlesson;
begin
lessonname:=names[frmrun.lblessons.itemindex+1];
frmrun.hide;
frmlesson.show
end;
procedure Tfrmrun.FormClose(Sender: TObject; var Action: TCloseAction);
begin
halt;
end;
procedure Tfrmrun.FormCreate(Sender: TObject);
var f:file of tconfig;
lesson:tconfig;
n:byte;
begin
n:=0;
assignfile(f,'ld.cfg');
reset(f);
while not eof(f) do begin
inc(n);
read(f,lesson);
names[n]:=lesson.filename;
lblessons.Items.Add('Урок '+inttostr(n)+' '+lesson.name);
end;
closefile(f);
end;
procedure Tfrmrun.lblessonsDblClick(Sender: TObject);
begin
loadlesson;
end;
procedure Tfrmrun.lblessonsKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then loadlesson
end;
procedure Tfrmrun.Button2Click(Sender: TObject);
begin
close
end;
procedure Tfrmrun.Button1Click(Sender: TObject);
begin
loadlesson;
end;
end.
unit lessonfrm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, Buttons, StdCtrls;
type
TfrmLesson = class(TForm)
pic1:timage;
pic2:timage;
pic3:timage;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
cmdYes: TButton;
cmdNo: TButton;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure SpeedButton3Click(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormDeactivate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure cmdYesClick(Sender: TObject);
procedure cmdNoClick(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
private
{ Private declarations }
public
nq,npq:byte;
end;
var
frmLesson: TfrmLesson;
implementation
{$R *.DFM}
uses runfrm, resfrm;
var f:textfile;
textY:integer;
first,nopaint:boolean;
strpage:array[1..80] of string[80];
numpage,ap,np,sp,pp:byte; {прав. ответ; кол-во вопросов; правильных ответов}
pages:array[0..100] of byte;
fontemp:tfont;
pagefonts:array[1..100] of tfont;
procedure loadpage;
begin
pagefonts[numpage]:=frmlesson.canvas.font;
sp:=1;
inc(pp);
pages[pp]:=pages[pp-1];
while not eof(f) do begin
readln(f,strpage[sp]);
inc(sp);
inc(pages[pp]);
if strpage[sp-1]='/:newpage' then exit
end;
end;
procedure drawpage;
label 1;
var s:string;
x,y:integer;
npic:^timage;
q:tcolor;
i,n:byte;
w:tfontstyles;
r:trect;
temp:tfont;
begin
{ frmlesson.pic1.left:=0;}
frmlesson.Canvas.TextOut(3,3,'');
np:=1;
r.Left:=0;
r.Top:=0;
r.Right:=frmlesson.Width;
r.Bottom:=frmlesson.Height-80;
frmlesson.Canvas.FillRect(r);
if not nopaint then begin
npic:=@frmlesson.pic1;
frmlesson.pic1.hide;
frmlesson.pic2.hide;
frmlesson.pic3.hide
end;
frmlesson.canvas.fillrect(r);
i:=1;
while i s:=strpage[i]; inc(i); if s='/:question' then begin temp:=frmlesson.Canvas.Font; frmlesson.Canvas.Font.Color:=clred; frmlesson.Canvas.pen.Color:=clred; r.Top:=texty; r.Left:=3; r.Right:=frmlesson.Width-10; r.Bottom:=texty+38; frmlesson.Canvas.Rectangle(r); frmlesson.cmdyes.top:=texty+6; frmlesson.cmdYes.Left:=frmlesson.width-170; frmlesson.cmdno.top:=texty+6; frmlesson.cmdno.Left:=frmlesson.width-90; frmlesson.cmdYes.Show; frmlesson.cmdno.show; frmlesson.Canvas.Font:=temp; s:=strpage[i]; frmlesson.Canvas.TextOut(5,texty+3,s); ap:=strtoint(strpage[i+1]); inc(texty,40); inc(i,2) end else if s='/:picture' then begin inc(i,3); if nopaint then goto 1; x:=strtoint(strpage[i-3]); y:=strtoint(strpage[i-2]); s:=strpage[i-1]; npic^.Enabled:=true; npic^.Picture.LoadFromFile(s); npic^.left:=x; npic^.top:=y; npic^.visible:=true; if np=1 then begin np:=2; npic:=@frmlesson.pic2; end else npic:=@frmlesson.pic3; 1: end else if s='/:size' then begin n:=strtoint(strpage[i]); inc(i); frmlesson.canvas.Font.Size:=n end else if s='/:font' then begin s:=strpage[i]; inc(i); frmlesson.canvas.Font.Name:=s end else if s='/:style' then begin n:=strtoint(strpage[i]); inc(i); case n of 1:w:=[]; 2:w:=[fsbold]; 4:w:=[fsitalic]; 3:w:=[fsunderline]; 5:w:=[fsstrikeout]; end; frmlesson.canvas.Font.Style:=w end else if s='/:color' then begin s:=strpage[i]; inc(i); if s='black' then q:=clblack; if s='red' then q:=clred; if s='blue' then q:=clblue; if s='green' then q:=clgreen; if s='gray' then q:=clgray; if s='yellow' then q:=clyellow; frmlesson.canvas.font.Color:=q end else if s='/:newpage' then exit else begin frmlesson.Canvas.TextOut(2,texty,s); inc(texty,frmlesson.Canvas.Font.Size+10) end; end end; procedure TfrmLesson.FormClose(Sender: TObject; var Action: TCloseAction); begin closefile(f); if nq>0 then frmresult.show else frmrun.Show end; procedure TfrmLesson.SpeedButton3Click(Sender: TObject); begin frmlesson.hide; frmresult.show end; procedure TfrmLesson.FormPaint(Sender: TObject); begin texty:=2; if first then begin first:=false; fontemp:=frmlesson.canvas.font; drawpage end else begin nopaint:=true; drawpage; nopaint:=false end end; procedure TfrmLesson.FormShow(Sender: TObject); var s,name:string; begin nq:=0; first:=true; nopaint:=true; assignfile(f,lessonname); reset(f); while not eof(f) do begin readln(f,s); if s='/:question' then inc(nq) end; closefile(f); reset(f); readln(f,name); frmlesson.Caption:=name; textY:=2; loadpage; frmlesson.Canvas.textout(20,20,''); end; procedure TfrmLesson.FormDeactivate(Sender: TObject); begin nopaint:=true end; procedure TfrmLesson.Timer1Timer(Sender: TObject); var q:tcolor; x,y:integer; begin { if not frmlesson.Visible then exit; x:=random(frmlesson.Width); y:=random(frmlesson.Height); if (x in [pic1.Left..pic1.Left+pic1.Width]) or (y in [pic1.Top..pic1.Top+pic1.Height]) then exit; q:=frmlesson.canvas.pixels[x,y]; if q<>clwhite then begin nopaint:=true; texty:=1; drawpage end; frmlesson.canvas.pixels[x,y]:=clred;} end; procedure TfrmLesson.FormCreate(Sender: TObject); begin npq:=0; ap:=1; pp:=0; numpage:=1; end; procedure TfrmLesson.cmdYesClick(Sender: TObject); begin if ap=1 then inc(npq); frmlesson.cmdYes.enabled:=false; frmlesson.cmdno.enabled:=false; end; procedure TfrmLesson.cmdNoClick(Sender: TObject); begin if ap=2 then inc(npq); frmlesson.cmdYes.enabled:=false; frmlesson.cmdno.enabled:=false; end; procedure TfrmLesson.SpeedButton2Click(Sender: TObject); begin canvas.Rectangle(0,0,width,height); pic1.Hide; pic2.Hide; pic3.Hide; frmlesson.Repaint; { pic1.show; pic1.hide; } inc(numpage); if not speedbutton1.enabled then speedbutton1.Enabled:=true; frmlesson.cmdYes.hide; frmlesson.cmdno.hide; { frmlesson.pic1.hide;} frmlesson.pic2.hide; frmlesson.pic3.hide; texty:=1; sp:=0; loadpage; drawpage; if eof(f) then speedbutton2.Enabled:=false end; procedure TfrmLesson.SpeedButton1Click(Sender: TObject); var i:byte; q:integer; s:string[100]; begin pic1.Hide; pic2.Hide; pic3.Hide; frmlesson.Repaint; dec(numpage); if not speedbutton2.enabled then speedbutton2.Enabled:=true; closefile(f); reset(f); canvas.Font:=pagefonts[numpage]; if numpage=1 then begin readln(f); speedbutton1.Enabled:=false end else begin i:=0; while i readln(f,s); if s='/:color' then begin readln(f,s); if s='black' then q:=clblack; if s='red' then q:=clred; if s='blue' then q:=clblue; if s='green' then q:=clgreen; if s='gray' then q:=clgray; if s='yellow' then q:=clyellow; frmlesson.canvas.font.Color:=q end; if s='/:name' then begin readln(f,s); canvas.Font.Name:=s end; if s='/:size' then begin readln(f,q); canvas.Font.Size:=q end; if s='/:newpage' then inc(i) end end; { for i:=1 to pages[pp-2] do readln(f); for i:=1 to pp do pages[pp]:=0; dec(pp,2); if pp=0 then begin readln(f); frmlesson.canvas.Font:=fontemp; end;} frmlesson.cmdYes.hide; frmlesson.cmdno.hide; frmlesson.pic1.hide; frmlesson.pic2.hide; frmlesson.pic3.hide; texty:=1; sp:=0; loadpage; if pp=1 then speedbutton1.enabled:=false; drawpage; end; procedure TfrmLesson.FormActivate(Sender: TObject); begin formcreate(sender); end; end. unit resfrm; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Grids; type TfrmResult = class(TForm) StringGrid1: TStringGrid; Button1: TButton; procedure FormActivate(Sender: TObject); procedure Button1Click(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); private { Private declarations } public { Public declarations } end; var frmResult: TfrmResult; implementation uses runfrm, lessonfrm; {$R *.DFM} procedure TfrmResult.FormActivate(Sender: TObject); begin with stringgrid1 do begin colwidths[0]:=150; cells[1,0]:='Количество'; cells[0,1]:='Вопросов'; cells[0,2]:='Правильных ответов'; cells[1,1]:=inttostr(frmlesson.nq); cells[1,2]:=inttostr(frmlesson.npq); end end; procedure TfrmResult.Button1Click(Sender: TObject); begin frmresult.Hide; frmrun.Show end; procedure TfrmResult.FormClose(Sender: TObject; var Action: TCloseAction); begin action:=cahide; frmrun.Show end; end.