[pic]

Рисунок 2. 2 – Вложенное меню

Теперь можно выделить мышкой пункт вложенного меню и вводить его параметры, как и для главного.

Вложенным меню, в свою очередь, можно также назначать вложенные.
Самый удобный способ – нажать правую кнопку мышки и выбрать из появившегося меню пункт «Create Submenu». После этих манипуляций наше меню примет такой вид, как показано на рис. 2. 3.

[pic]

Рисунок 2. 3 – Вложенные меню второго уровня

Создавать вложенные меню Windows позволяет до бесконечности (на практике – сколько хватит памяти или пока не надоест).

2. 1. 3 Дополнительные возможности

Вместо обычного выполнения действия при выборе пункта меню, можно сделать так, чтобы он отмечался «птичкой» (Рис. 2. 4). В этом случае данный пункт действует подобно элементу интерфейса CheckBox. Чтобы в программе узнать, «включен» ли пункт, надо проверить свойство Checked.

[pic]

Рисунок 2. 4 – Меню, отмеченное “птичкой”

Во многих приложениях также применяется возможность закрытия доступа к определенному пункту меню, есло в данный момент он не может выполнится.
Для этого служит свойство Enabled. Оно, как и Checked, имеет тип Boolean.

На рис. 2.4 видно, что пункт «Меню2» выделен жирным шрифтом. Это результат установки еще одного логического свойства объекта – Default.

Еще одна важная возможность – вставка разделительной линии. На рис. 2.5 (стр. 16) она размещена между «Меню1» и «Меню2»:

Рисунок 2. 5 – Меню с разделительной линией

Эту «примочку» используют в основном для отдления различных типов действия, вызываемого меню, например, часто в меню «Файл» помещают список нескольких открывавшихся ранее файлов, отделенный от остального меню такими линиями. Прекрасным примером использования разделительных линий также может служить меню «Файл» программы Microsoft Word. Оно приведено для наглядности на рис. 2. 6.

Рисунок 2. 6 – Меню «Файл» Word'a

Одной из самых удобных возможностей системы меню является возможность использования клавиш быстрого доступа, например, в меню на рис. 2. 6 при одновременном нажатии клавиш Ctrl и Р текущий документ отправлется на печать. И не нужно отвлекаться, тратить время, снимать руку с клавиатуры…

Рассматриваемый нами компонент TMainMenu также обладает возможностью назначения клавиш быстрого доступа. Для этого служит свойство ShortCut.

В инспекторе объектов оно имеет раскрывающийся список, из которого можно выбрать нужную комбинацию клавиш. Пример такого списка представлен на рис. 2. 7.

Рисунок 2. 7. – Раскрывающийся список комбинаций клавиш быстрого доступа

Если кому-то захочется сделать уж очень «крутую» программу, тут ему поможет возможность вставки картинок.

2. 2 TPopupMenu

Это всплывающее меню, оно вызывается нажатием правой кнопки мыши. В палитре компонентов его значок такой: . Как и MainMenu, этот компонент следует поместить на форму, для редактирования два раза щелкнуть. Во всем, что касается создания пунктов, этот компонент идентичен MainMenu. Ну, разве что, сразу строится вертикальное меню.

Для того, чтобы меню «всплывало», нужно в свойстве PopupMenu формы указать его (меню) имя.

3 Пример программы

Ниже будут представлены примеры программ, использующие такие компоненты, как меню. Кроме исходного кода будут иллюстрации.

Пример представляет собой несложную программу, позволяющую просматривать и редактировать текстовые файлы. Окно этой программы показано на рис. 2. 8.

[pic]

Рисунок 2. 8 – Окно программы-примера

Ниже будет представлен листинг программы:

unit Unit1;

{Главный модуль программы}

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, StdCtrls;

type
TForm1 = class(TForm)

MainMenu1: TMainMenu; {Главное меню}

N1: TMenuItem; {Меню “Файл”}

N2: TMenuItem; {Меню “Открыть”}

N3: TMenuItem; {Меню “Сохранить”}

N4: TMenuItem; {Меню “Выход”}

N5: TMenuItem; {Разделительная линия}

N6: TMenuItem; {Меню “Помощь”}

N7: TMenuItem; {Меню “О программе”}

Memo1: TMemo;

OpenDialog1: TOpenDialog;

SaveDialog1: TSaveDialog;

PopupMenu1: TPopupMenu; {Всплывающее меню} procedure N4Click(Sender: TObject); procedure N7Click(Sender: TObject); procedure N2Click(Sender: TObject); procedure N3Click(Sender: TObject); private

{ Private declarations } public

{ Public declarations } end;

var
Form1: TForm1;

implementation

uses Unit2;

{$R *.DFM}

procedure TForm1.N4Click(Sender: TObject); begin close; end;

procedure TForm1.N7Click(Sender: TObject); begin aboutbox.show end;

procedure TForm1.N2Click(Sender: TObject); begin if opendialog1.Execute then memo1.Lines.LoadFromFile(opendialog1.filename) end;

procedure TForm1.N3Click(Sender: TObject); begin if savedialog1.Execute then memo1.Lines.SaveToFile(savedialog1.filename) end;

end.

unit Unit2;

{Модуль, описывающий окно “О программе”}

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
Buttons, ExtCtrls;

type
TAboutBox = class(TForm)

Panel1: TPanel;

ProgramIcon: TImage;

ProductName: TLabel;

Comments: TLabel;

OKButton: TButton; procedure OKButtonClick(Sender: TObject); private

{ Private declarations } public

{ Public declarations } end;

var
AboutBox: TAboutBox;

implementation

{$R *.DFM}

procedure TAboutBox.OKButtonClick(Sender: TObject); begin

Hide end; end.

Данная программа демонстрирует использование меню. Она имеет главное меню и всплывающее, которое появляется при нажатии правой кнопки мышки.
Меню снабжены клавишами быстрого доступа, используется разделительная линия.

Меню «Открыть», «Сохранить», «Выход» и «О программе» снабжены клавишами быстрого доступа. Всплывающее меню, имеющее два пункта –
«Открыть» и «Сохранить». При их нажатии вызываются события соотвутствующих пунктов главного меню.

Выводы

В данной курсовой работе разработана система для психотестирования на
Borland Delphi 5. 0. Кроме основной программы, созданы две утилитные – для создания тестов, которые хранятся в отдельных файлах.

В процессе составления программы детально были изучены основные объекты графического интерфейсa Windows.

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

Список литературы

1. Культин Н. Delphi 4. Программирование на Object Pascal. BHV, Санкт-
Петербург, 1999. – 480 с., ил.

2. Дэн Оузьер и др. Delphi 3. Освой самостоятельно. М.: “Издательство
БИНОМ”, 1998 г. – 560 с.: ил.

3. Бондарев В. М., Рублинецкий В. И., Качко Е. Г. Основы программирования.
Харьков: Фолио; Ростов н/Д: Феникс, 1998 – 368 с.

Приложение А

Листинг программы.

unit Mainfrm;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Buttons, ExtCtrls, TestTypes;

type

TfrmMain = class(TForm)

Image1: TImage;

SpeedButton1: TSpeedButton;

SpeedButton2: TSpeedButton;

Image2: TImage;

SpeedButton3: TSpeedButton;

procedure runtest; procedure SpeedButton1Click(Sender: TObject); procedure SpeedButton2Click(Sender: TObject); procedure SpeedButton3Click(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction);

private

{ Private declarations } public

end;

var frmMain: TfrmMain; testcount:integer;

implementation

uses Testfrm;

{$R *.DFM}

procedure tfrmmain.runtest; var f:file of ttest; begin frmmain.hide; assignfile(f,testfilename); try reset(f); except showmessage('Файл теста не найден!'); exit end; testnum:=1; while not eof(f) do begin try read(f,test[testnum]); inc(testnum); except showmessage('Ошибка в файле теста'); frmmain.show; exit end end; closefile(f); frmTest.show; end;

procedure TfrmMain.SpeedButton1Click(Sender: TObject); begin testfilename:='Time.tst'; runtest end;

procedure TfrmMain.SpeedButton2Click(Sender: TObject); begin testfilename:='Agress.tst'; runtest end;

procedure TfrmMain.SpeedButton3Click(Sender: TObject); begin testfilename:='health.tst'; runtest end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction); begin if messagedlg('Вы действительно хотите выйти?',mtwarning,[mbyes,mbno],0)=mrno then action:=canone end;

end.

unit Testfrm;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, Buttons, testtypes;

type
TfrmTest = class(TForm)

Image1: TImage; rb1: TRadioButton; rb2: TRadioButton; rb3: TRadioButton;

Label1: TLabel;

SpeedButton1: TSpeedButton; procedure load; procedure rb1Click(Sender: TObject); procedure rb2Click(Sender: TObject); procedure rb3Click(Sender: TObject); procedure FormActivate(Sender: TObject); procedure SpeedButton1Click(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction);

private

{ Private declarations } public defque:byte; end;

var frmTest: TfrmTest;

implementation

{$R *.DFM}

uses mainfrm, Resfrm;

procedure tfrmtest.load;

begin label1.caption:=test[defque].text; rb1.Caption:=test[defque].quest[1]; rb2.Caption:=test[defque].quest[2]; rb3.Caption:=test[defque].quest[3]; speedbutton1.enabled:=false; rb1.Enabled:=true; rb2.Enabled:=true; rb3.Enabled:=true; rb1.Checked:=false; rb2.Checked:=false; rb3.Checked:=false; if rb3.caption='' then rb3.hide else rb3.Show end;

procedure TfrmTest.FormActivate(Sender: TObject); begin testcount:=0; defque:=1; load end;

procedure TfrmTest.rb1Click(Sender: TObject); begin speedbutton1.Enabled:=true; rb1.Enabled:=false; rb2.Enabled:=false; rb3.Enabled:=false; inc(testcount,test[defque].count[1]) end;

procedure TfrmTest.rb2Click(Sender: TObject); begin speedbutton1.Enabled:=true; rb1.Enabled:=false; rb2.Enabled:=false; rb3.Enabled:=false; inc(testcount,test[defque].count[2]) end;

procedure TfrmTest.rb3Click(Sender: TObject); begin speedbutton1.Enabled:=true; rb1.Enabled:=false; rb2.Enabled:=false; rb3.Enabled:=false; inc(testcount,test[defque].count[3]) end;

procedure TfrmTest.SpeedButton1Click(Sender: TObject); var f:file of TResult; r:tresult; begin inc(defque); if defque=testnum then begin assignfile(f,copy(testfilename,1,length(testfilename)-3)+'rts'); reset(f); while not eof(f) do begin read(f,r); if testcount in [r.min..r.max] then begin frmres.label1.Caption:=r.text; break end end; closefile(f); frmtest.hide; frmres.show; end; load end;

procedure TfrmTest.FormClose(Sender: TObject; var Action: TCloseAction); begin frmmain.show; action:=cahide end;

end.

unit Resfrm;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TfrmRes = class(TForm)

Label1: TLabel;

Button1: TButton; procedure Button1Click(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); private

{ Private declarations } public

{ Public declarations } end;

var frmRes: TfrmRes;

implementation

uses Mainfrm;

{$R *.DFM}

procedure TfrmRes.Button1Click(Sender: TObject); begin frmres.hide; frmmain.show end;

procedure TfrmRes.FormClose(Sender: TObject; var Action: TCloseAction); begin action:=cahide; frmmain.show end;

end.

unit TestTypes;

interface

type
TTest=record text:string[255]; quest:array[1..3] of string[100]; count:array[1..3] of byte; end;

var testfilename: string; test:array[1..100] of ttest; testnum:byte;

implementation

end.

Листинг программы ТС:

unit Mainfrm;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Spin, TestTypes;

type
TfrmMain = class(TForm) rb1: TRadioButton; rb2: TRadioButton; rb3: TRadioButton;

Edit1: TEdit;

Label1: TLabel;

SpinEdit1: TSpinEdit;

Label2: TLabel;

Edit2: TEdit;

Label3: TLabel;

Label4: TLabel;

Button1: TButton;

Button2: TButton;

SaveDialog1: TSaveDialog;

OpenDialog1: TOpenDialog;

StaticText1: TStaticText;

Label5: TLabel;

SpinEdit2: TSpinEdit;

Button3: TButton; procedure Button2Click(Sender: TObject); procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure Edit1Change(Sender: TObject); procedure Edit2Change(Sender: TObject); procedure rb1Click(Sender: TObject); procedure rb2Click(Sender: TObject); procedure rb3Click(Sender: TObject); procedure SpinEdit1Change(Sender: TObject); procedure SpinEdit2Change(Sender: TObject); procedure Button3Click(Sender: TObject); private

{ Private declarations } public variant:^tradiobutton; nq:byte; end;

var frmMain: TfrmMain;

implementation

{$R *.DFM}

procedure TfrmMain.Button2Click(Sender: TObject); var f:file of TTest; i:byte; begin if savedialog1.execute then begin assignfile(f,savedialog1.Filename); rewrite(f); for i:=1 to testnum do write(f,test[i]); closefile(f) end end;

procedure TfrmMain.Button1Click(Sender: TObject); var f:file of ttest; begin if opendialog1.execute then begin assignfile(f,opendialog1.Filename); reset(f); testnum:=1; while not eof(f) do begin read(f,test[testnum]); inc(testnum) end; statictext1.Caption:='Всего вопросов '+inttostr(testnum); closefile(f); spinedit1.value:=1; spinedit1change(sender) end end;

procedure TfrmMain.FormCreate(Sender: TObject); var i:byte; begin testnum:=1; variant:=@rb1; nq:=1; for i:=1 to 100 do begin test[i].quest[1]:='Вариант1'; test[i].quest[2]:='Вариант2'; test[i].quest[3]:='Вариант3'; test[i].count[1]:=0; test[i].count[2]:=0; test[i].count[3]:=0; test[i].text:='Текст вопроса' end; end;

procedure TfrmMain.Edit1Change(Sender: TObject); begin label2.Caption:=edit1.Text; test[spinedit1.value].text:=edit1.text end;

procedure TfrmMain.Edit2Change(Sender: TObject); begin variant^.Caption:=edit2.Text; test[spinedit1.value].quest[nq]:=edit2.text end;

procedure TfrmMain.rb1Click(Sender: TObject); begin variant:=@rb1; nq:=1; edit2.Text:=rb1.Caption; spinedit2.Value:=test[spinedit1.Value].count[1]; edit2.SetFocus end;

procedure TfrmMain.rb2Click(Sender: TObject); begin variant:=@rb2; nq:=2; edit2.Text:=rb2.Caption; spinedit2.Value:=test[spinedit1.Value].count[2]; edit2.SetFocus end;

procedure TfrmMain.rb3Click(Sender: TObject); begin variant:=@rb3; nq:=3; edit2.Text:=rb3.Caption; spinedit2.Value:=test[spinedit1.Value].count[3]; edit2.SetFocus end;

procedure TfrmMain.SpinEdit1Change(Sender: TObject); begin if spinedit1.value>testnum then begin inc(testnum); statictext1.caption:='Всего вопросов '+inttostr(testnum) end; label2.Caption:=test[spinedit1.value].text; rb1.Caption:=test[spinedit1.value].quest[1]; rb2.Caption:=test[spinedit1.value].quest[2]; rb3.Caption:=test[spinedit1.value].quest[3]; rb1.Checked:=true; variant:=@rb1; edit1.Text:=test[spinedit1.value].text; edit2.text:=test[spinedit1.value].quest[1]; edit2.setfocus end;

procedure TfrmMain.SpinEdit2Change(Sender: TObject); begin test[spinedit1.value].count[nq]:=spinedit2.value end;

procedure TfrmMain.Button3Click(Sender: TObject); var i:byte; begin if spinedit1.value=testnum then begin dec(testnum); spinedit1.value:=spinedit1.value-1; exit end; if testnum=1 then exit; for i:=spinedit1.value to testnum-1 do test[i]:=test[i+1]; dec(testnum); spinedit1change(sender); statictext1.Caption:='Всего вопросов '+inttostr(testnum) end;

end.

Листинг программы RС:

unit Mainfrm;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, testtypes, StdCtrls, Spin;

type
TfrmMain = class(TForm)

Memo1: TMemo;

SpinEdit1: TSpinEdit;

Label1: TLabel;

SpinEdit2: TSpinEdit;

Label2: TLabel;

Button1: TButton;

Button2: TButton;

SpinEdit3: TSpinEdit;

Label3: TLabel;

OpenDialog1: TOpenDialog;

SaveDialog1: TSaveDialog; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure SpinEdit1Change(Sender: TObject); procedure SpinEdit2Change(Sender: TObject); procedure Memo1Change(Sender: TObject); procedure FormCreate(Sender: TObject); procedure SpinEdit3Change(Sender: TObject); private

{ Private declarations } public res:array[1..100] of tresult; varnum:byte; no:boolean; end;

var frmMain: TfrmMain;

implementation

{$R *.DFM}

procedure TfrmMain.Button1Click(Sender: TObject); var f:file of tresult; i:byte; begin if savedialog1.execute then begin assignfile(f,savedialog1.filename); rewrite(f); for i:=1 to varnum-1 do write(f,res[i]); closefile(f) end end;

procedure TfrmMain.Button2Click(Sender: TObject); var f:file of tresult; begin if opendialog1.execute then begin assignfile(f,opendialog1.filename); reset(f); varnum:=1; while not eof(f) do begin read(f,res[varnum]); inc(varnum) end; memo1.text:=res[1].text; spinedit1.value:=res[1].min; spinedit2.value:=res[1].max; spinedit3.value:=1; closefile(f) end end;

procedure TfrmMain.SpinEdit1Change(Sender: TObject); begin if no then exit; res[spinedit3.value].min:=spinedit1.value; if spinedit2.value

Страницы: 1, 2