СООБЩЕНИЯ ОПЕРАТОРУ, Сообщение о программе, Листинг программы - Руководство оператора

Сообщение о программе

Программа "AdressBook. ехе" выдает сообщение о программе, при выборе в главном меню пункта "О программе" во вкладке "Помощь" показанное на рис. 1

Рис.1

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

Unit Main;

Interface

Uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls, ComCtrls, CheckLst, Buttons, Mask, Menus, UC_AdrBook;

Type

TMainForm = class(TForm)

StatusBar: TStatusBar;

SpeedBarBottom: TPanel;

BtAdd: TButton;

BtModify: TButton;

BtClear: TButton;

BtDelete: TButton;

BtExit: TButton;

AdrPanel: TPanel;

LbGroup: TLabel;

LbBirth: TLabel;

LbComment: TLabel;

LbMonth: TLabel;

LbYear: TLabel;

EdSurname: TLabeledEdit;

EdName: TLabeledEdit;

EdPatrName: TLabeledEdit;

EdHomeTel: TLabeledEdit;

EdHomeAdr: TLabeledEdit;

EdWorkTel: TLabeledEdit;

EdWorkAdr: TLabeledEdit;

EdMobiTel: TLabeledEdit;

EdGroup: TComboBox;

EdCity: TLabeledEdit;

EdCountry: TLabeledEdit;

EdBirth: TMaskEdit;

EdComment: TMemo;

EdEMail: TLabeledEdit;

EdICQ: TLabeledEdit;

EdWeb: TLabeledEdit;

AdressList: TListBox;

SpeedBarTopAdr: TPanel;

Cancel: TSpeedButton;

OK: TSpeedButton;

EdGroupArr: TComboBox;

GroupsBox: TCheckListBox;

AdrSplitter: TSplitter;

MainMenu: TMainMenu;

FileMenu: TMenuItem;

FileNew: TMenuItem;

FileOpen: TMenuItem;

FileSave: TMenuItem;

FileSaveAs: TMenuItem;

N1: TMenuItem;

FileExit: TMenuItem;

BaseMenu: TMenuItem;

Add1: TMenuItem;

Modify1: TMenuItem;

ClearFields1: TMenuItem;

Delete1: TMenuItem;

Find1: TMenuItem;

HelpMenu: TMenuItem;

HelpAbout: TMenuItem;

OpenDialog: TOpenDialog;

SaveDialog: TSaveDialog;

N2: TMenuItem;

SortAdr: TMenuItem;

Procedure FileExitClick(Sender: TObject);

Procedure btAddClick(Sender: TObject);

Procedure AdressListClick(Sender: TObject);

Procedure FileOpenClick(Sender: TObject);

Procedure FileNewClick(Sender: TObject);

Procedure FileSaveClick(Sender: TObject);

Procedure FileSaveAsClick(Sender: TObject);

Procedure FormCreate(Sender: TObject);

Procedure btClearClick(Sender: TObject);

Procedure OKClick(Sender: TObject);

Procedure SortAdrClick(Sender: TObject);

Procedure btDeleteClick(Sender: TObject);

Procedure btModifyClick(Sender: TObject);

Procedure FormResize(Sender: TObject);

Procedure GroupsBoxClick(Sender: TObject);

Procedure HelpAboutClick(Sender: TObject);

Private

{ Private declarations }

Public

{ Public declarations }

AdressBook : TPeople;

Procedure UpdateCountBase;

End;

Var

MainForm: TMainForm;

Implementation

Uses About;

{$R *.dfm}

Procedure TMainForm. FileExitClick(Sender: TObject);

Begin

Close;

End;{procedure TMainForm. FileExitClick}

Procedure TMainForm. btAddClick(Sender: TObject);

Begin

AdressBook. Add(edName. Text, edPatrName. Text, edSurname. Text,

EdHomeTel. Text, edWorkTel. Text, edMobiTel. Text, edICQ. Text,

EdGroup. ItemIndex, edEMail. Text, edHomeAdr. Text, edWorkAdr. Text, edWeb. Text,

EdCountry. Text, edCity. Text, UC_StrToDate (edBirth. Text), edComment. Text);

AdressList. Items. Add(edSurname. Text+', '+edName. Text+' '+edPatrName. Text);

UpdateCountBase;

End;{procedure TMainForm. btAddClick}

Procedure TMainForm. AdressListClick(Sender: TObject);

Var

Name, PatrName, Surname : NamString;

HomeTel, WorkTel, MobiTel, ICQ : TelString;

Group : GrpType;

EMail, HomeAdress, WorkAdress, Web : AdrString;

Country, City : PlcString;

BirthDay : TUC_Date;

Comments : CusString;

K : Integer;

P : pointer;

Year, Month : string;

Begin

K := AdressList. ItemIndex;

If (k >= 0) and (AdressList. Items. Count > 0) then begin

P := AdressBook. FindItem(AdressList. Items. Strings[k]);

If p <> nil then AdressBook. GetItem(p, Name, PatrName, Surname,

HomeTel, WorkTel, MobiTel, ICQ, Group, EMail, HomeAdress, WorkAdress, Web,

Country, City, BirthDay, Comments);

EdName. Text := Name;

EdPatrName. Text := PatrName;

EdSurname. Text := Surname;

EdHomeTel. Text := HomeTel;

EdWorkTel. Text := WorkTel;

EdMobiTel. Text := MobiTel;

EdICQ. Text := ICQ;

EdGroup. ItemIndex := Group;

EdHomeAdr. Text := HomeAdress;

EdWorkAdr. Text := WorkAdress;

EdWeb. Text := Web;

EdEMail. Text := EMail;

EdCountry. Text := Country;

EdCity. Text := City;

EdBirth. Text := UC_DateToStr(BirthDay);

EdComment. Text := Comments;

If (Birthday. Day = 1) and (Birthday. Month = 1) and (Birthday. Year = 1000) then begin

LbYear. Caption := 'Год по китайскому гороскопу: ?';

LbMonth. Caption := 'Знак зодиака: ?';

End else begin

Zodiac(BirthDay, Month, Year);

LbYear. Caption := 'Год по китайскому гороскопу: ' + Year;

LbMonth. Caption := 'Знак зодиака: ' + Month;

End;

End;{if (AdressListBox. ItemIndex>=0) and (AdressListBox. Items. Count>0)}

End;{procedure TMainForm. AdressListBoxClick}

Procedure TMainForm. FileOpenClick(Sender: TObject);

Begin

If OpenDialog. Execute then begin

Case OpenDialog. FilterIndex of

1: begin

FAdrWay := OpenDialog. FileName;

AssignFile(FAdr, FAdrWay);

Reset(FAdr);

AdressBook. Clear;

AdressList. Items. Clear;

AdressBook. ReadFromFile(FAdr);

AdressList. Items := AdressBook. FillTStrings;

OKClick(FileOpen);

CloseFile(FAdr);

End;

End;{case OpenDialog. FilterIndex}

End;{if OpenDialog. Execute}

UpdateCountBase;

End;{procedure TMainForm. FileOpenClick}

Procedure TMainForm. FileNewClick(Sender: TObject);

Var

I : Integer;

Begin

AdressList. Items. Clear;

AdressBook. Clear;

For I := 0 to 8 do GroupsBox. Checked[I] := True;

BtClearClick(nil);

OKClick(nil);

FAdrWay := '';

UpdateCountBase;

End;{procedure TMainForm. FileNewClick}

Procedure TMainForm. FileSaveClick(Sender: TObject);

Begin

If FAdrWay <> '' then begin

AssignFile(FAdr, FAdrWay);

Rewrite(FAdr);

AdressBook. SaveToFile(FAdr);

CloseFile(FAdr);

AdressList. SetFocus;

End else FileSaveAsClick(nil);

UpdateCountBase;

End;{procedure TMainForm. FileSaveClick}

Procedure TMainForm. FileSaveAsClick(Sender: TObject);

Begin

If SaveDialog. Execute then begin

Case SaveDialog. FilterIndex of

1 : begin

FAdrWay := SaveDialog. FileName;

If Copy(FAdrWay, Length(FAdrWay)-3,1)<>'.' then FAdrWay:= FAdrWay +'.adb';

End;

End;{case SaveDialog. FilterIndex}

End;{if SaveDialog. Execute}

FileSaveClick(nil);

End;{procedure TMainForm. FileSaveAsClick}

Procedure TMainForm. FormCreate(Sender: TObject);

Var

I : Integer;

Begin

AdressBook := TPeople. Create;

UpdateCountBase;

OKClick(nil);

BtClearClick(nil);

For I := 0 to 8 do GroupsBox. Checked[I] := True;

End;{procedure TMainForm. FormCreate}

Procedure TMainForm. btClearClick(Sender: TObject);

Begin

EdName. Text:='';

EdPatrName. Text:='';

EdSurname. Text:='';

EdHomeTel. Text:='';

EdWorkTel. Text:='';

EdMobiTel. Text:='';

EdHomeAdr. Text:='';

EdWorkAdr. Text:='';

EdGroup. ItemIndex:=8;

EdEMail. Text:='';

EdComment. Text:='';

EdBirth. Text:='01.01.1000';

EdCity. Text:='';

EdCountry. Text:='';

UpdateCountBase;

End;{procedure TMainForm. btClearClick}

Procedure TMainForm. OKClick(Sender: TObject);

Var

I : Byte;

Begin

If Sender <> FileOpen then

For I := 0 to 5 do GroupArr[I] := edGroupArr. Items. Strings[I];

For I := 0 to 8 do begin

GroupsBox. Items. Strings[I] := GroupArr[I];

EdGroup. Items. Strings[I] := GroupArr[I];

End;{for I := 0 to 8}

End;{procedure TMainForm. OKClick}

Procedure TMainForm. SortAdrClick(Sender: TObject);

Begin

SortAdr. Checked := not SortAdr. Checked;

AdressList. Sorted := SortAdr. Checked;

End;{procedure TMainForm. SortClick}

Procedure TMainForm. btDeleteClick(Sender: TObject);

Var

Ind : Integer;

Begin

Ind := AdressList. ItemIndex;

If (AdressList. Items. Count>0) and (Ind>=0) then begin

If AdressBook. Delete(AdressBook. FindItem(AdressList. Items. Strings[Ind]))

Then AdressList. Items. Delete(Ind);

If Ind = 0 then AdressList. ItemIndex := 0 else AdressList. ItemIndex :=Ind-1;

End;{if (AdressList. Items. Count>0) and (Ind>=0)}

AdressList. SetFocus;

UpdateCountBase;

End;{procedure TMainForm. btDeleteClick}

Procedure TMainForm. UpdateCountBase;

Begin

StatusBar. Panels. Items[0].Text := 'Count in base: ' + IntToStr(AdressBook. Count) +

', count in list: ' + IntToStr(AdressList. Items. Count);

End;{procedure TMainForm. UpdateCountBase}

Procedure TMainForm. btModifyClick(Sender: TObject);

Var

K : Integer;

Begin

K := AdressList. ItemIndex;

If (AdressList. Items. Count > k) and (k >= 0) then begin

AdressBook. Modify(AdressBook. FindItem(AdressList. Items. Strings[k]),

EdName. Text, edPatrName. Text, edSurname. Text, edHomeTel. Text,

EdWorkTel. Text, edMobiTel. Text, edICQ. Text, edGroup. ItemIndex,

EdEMail. Text, edHomeAdr. Text, edWorkAdr. Text, edWeb. Text, edCountry. Text,

EdCity. Text, UC_StrToDate(edBirth. Text), edComment. Text);

AdressList. Items. Strings[k] := edSurname. Text+', '+edName. Text+' '+edPatrName. Text;

End;

UpdateCountBase;

End;{procedure TMainForm. btModifyClick}

Procedure TMainForm. FormResize(Sender: TObject);

Var

I : Integer;

Begin

I := Trunc(SpeedBarBottom. Width/5);

BtAdd. Left := 1; btAdd. Width := I;

BtModify. Left := I; btModify. Width := I;

BtClear. Left := I*2; btClear. Width := I;

BtDelete. Left := I*3; btDelete. Width := I;

BtExit. Left := I*4; btExit. Width := I;

End;{procedure TMainForm. FormResize}

Procedure TMainForm. GroupsBoxClick(Sender: TObject);

Var

I : Integer;

Grp : GrpArr;

Begin

AdressList. Items. Clear;

For I := 0 to 8 do Grp[I] := GroupsBox. Checked[I];

AdressList. Items := AdressBook. FillItemsByGroup(Grp);

UpdateCountBase;

AdressList. SetFocus;

End;{procedure TMainForm. GroupsBoxClick}

Procedure TMainForm. HelpAboutClick(Sender: TObject);

Begin

AboutBox. Show;

End;

End.

Похожие статьи




СООБЩЕНИЯ ОПЕРАТОРУ, Сообщение о программе, Листинг программы - Руководство оператора

Предыдущая | Следующая