Диплом - Разработка системы компьютерного контроля знаний по дисциплинам кафедры

initialization

TComponentFactory.Create(ComServer, TMyServ,

Class_MyServ, ciMultiInstance, tmApartment);

ClientList:=TThreadList.Create;

finalization

Clientlist.Free;

end.

Модуль настроек серверной части Nastr_Path.

unit Nastr_Path;

interface

uses

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

Dialogs, StdCtrls, ExtCtrls;

type

TForm2 = class(TForm)

RadioGroup1: TRadioGroup;

GroupBox1: TGroupBox;

Label1: TLabel;

Label2: TLabel;

Edit1: TEdit;

Edit2: TEdit;

GroupBox2: TGroupBox;

Button1: TButton;

Button2: TButton;

procedure FormCreate(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure RadioGroup1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form2: TForm2;

implementation

uses Serv;

{$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);

var Path,Name:String;

L:Boolean;

102

begin

Form1.Readini(Path,Name,L);

Edit1.Text:=Path;

Edit2.Text:=Name;

if L then RadioGroup1.ItemIndex:=1

else RadioGroup1.ItemIndex:=0;

end;

procedure TForm2.Button2Click(Sender: TObject);

begin

Close;

end;

procedure TForm2.Button1Click(Sender: TObject);

begin

Form1.WriteIni(Edit1.Text,Edit2.Text,Boolean(RadioGroup1.ItemIndex));

Form1.PathNastr;

Close;

end;

procedure TForm2.RadioGroup1Click(Sender: TObject);

begin

Case Radiogroup1.ItemIndex of

0:begin

Label1.Caption:='Путь к данным';

Label2.Caption:='Имя файла данных';

end;

1:begin

Label1.Caption:='Имя сервера';

Label2.Caption:='Имя базы данных';

end;

end.

Модуль TrayNotifyIcon, реализует компонент TTrayNotifyIcon.

Предназначен для сворачивания окна сервера в иконку на панели

задач.

unit TrayNotifyIcon;

interface

uses

Windows, SysUtils, Messages, ShellAPI, Classes,

Graphics, Forms, Menus, ExtCtrls;

type

ENotifyIconError=class(Exception);

103

TTrayNotifyIcon = class(TComponent)

private

FDefaultIcon:THAndle;

FIcon:TIcon;

FHideTask:Boolean;

FHint:String;

FIconVisible:Boolean;

FPopupMenu:TPopupMenu;

FOnClick:TNotifyEvent;

FOnDblClick:TNotifyEvent;

FNoShowClick:Boolean;

FTimer:TTimer;

Tnd:TNotifyIconData;

procedure SetIcon(Value:TIcon);

procedure SetHideTask(Value:Boolean);

procedure SetHint(Value:String);

procedure SetIconVisible(Value:Boolean);

procedure SetPopupMenu(Value:TPopupMenu);

procedure SendTrayMessage(Msg:DWORD;Flags:UINT);

function ActiveIconHandle:THandle;

procedure OnButtonTimer(Sender:TObject);

protected

procedure Loaded;override;

procedure LoadDefaultIcon;virtual;

procedure Notification(AComponent:TComponent;

Operation:TOperation);override;

public

constructor Create(AOwner:TComponent);override;

destructor Destroy;override;

published

property Icon:TIcon read FIcon write SetIcon;

property HideTask:Boolean read FHideTask write SetHideTask

default false;

property Hint:String read FHint write SetHint;

property IconVisible:Boolean read FIconVisible write SetIconVisible

default false;

property PopupMenu:TPopupMenu read FPopupMenu write SetPopupMenu;

property OnClick:TNotifyEvent read FOnClick write FOnClick;

property OnDblClick:TNotifyEvent read FOnDblClick write FOnDblClick;

end;

procedure Register;

implementation

type

TIconManager = class

private

FHWindow:HWnd;

procedure TrayWndProc(var Message:TMessage);

public

constructor Create;

destructor Destroy;override;

104

property HWindow:HWnd read FHWindow write FHWindow;

end;

var

IconMgr:TIconManager;

MY_TRAYICON:Integer;

constructor TIconManager.Create;

begin

FHWindow:=AllocateHWnd(TrayWndProc);

end;

destructor TIconManager.Destroy;

begin

if FHWindow<>0 then DeallocateHWnd(FHWindow);

inherited Destroy;

end;

procedure TIconManager.TrayWndProc(var Message:TMessage);

var

Pt:TPoint;

TheIcon:TTrayNotifyIcon;

begin

with Message do

begin

if (Msg=MY_TRAYICON) then

begin

TheIcon:=TTrayNotifyIcon(wParam);

case lParam of

WM_LBUTTONDOWN : TheIcon.FTimer.Enabled:=True;

WM_LBUTTONDBLCLK :

begin

TheIcon.FNoShowClick:=True;

if Assigned(TheIcon.FOnDblClick) then TheIcon.FOnDblClick(Self);

end;

WM_RBUTTONDOWN :

begin

if Assigned(TheIcon.FPopupMenu) then

begin

SetForegroundWindow(IconMgr.HWindow);

GetCursorPos(Pt);

TheIcon.FPopupMenu.Popup(Pt.X,Pt.Y);

PostMessage(IconMgr.HWindow,WM_USER,0,0);

end;

end;//case

end

else result:=DefWindowProc(FHWindow,Msg,wParam,lParam);

end;

constructor TTrayNotifyIcon.Create(AOwner:TComponent);

105

begin

inherited Create(AOwner);

FIcon:=TIcon.Create;

FTimer:=TTimer.Create(Self);

with FTimer do

begin

Enabled:=False;

Interval:=GetDoubleClickTime;

OnTimer:=OnButtonTimer;

end;

LoadDefaultIcon;

end;

destructor TTrayNotifyIcon.Destroy;

begin

if FIconVisible then SetIconVisible(False);

FIcon.Free;

FTimer.Free;

inherited Destroy;

end;

function TTrayNotifyIcon.ActiveIconHandle:THandle;

begin

if FIcon.Handle<>0 then result:=FIcon.Handle

else result:=FDefaultIcon;

end;

procedure TTrayNotifyIcon.LoadDefaultIcon;

begin

FDefaultIcon:=LoadIcon(0,IDI_WINLOGO);

end;

procedure TTrayNotifyIcon.Loaded;

begin

inherited Loaded;

if FIconVisible then

SendTrayMessage(NIM_ADD,NIF_MESSAGE or NIF_ICON or NIF_TIP);

end;

procedure TTrayNotifyIcon.Notification(AComponent:TComponent;

Operation:TOperation);

begin

inherited Notification(AComponent,Operation);

if (Operation=opRemove) and (AComponent=PopupMenu) then

PopupMenu:=nil;

end;

procedure TTrayNotifyIcon.OnButtonTimer(Sender:TObject);

begin

FTimer.Enabled:=false;

if (not FNoShowClick) and Assigned(FOnClick) then FOnClick(Self);

FNoShowClick:=False;

106

end;

procedure TTrayNotifyIcon.SendTrayMessage(Msg:DWORD;Flags:UINT);

begin

with Tnd do

begin

cbSize:=SizeOf(Tnd);

StrPLCopy(szTip,PChar(FHint),SizeOf(szTip));

uFlags:=Flags;

uID:=UINT(Self);

Wnd:=IconMgr.HWindow;

uCallbackMessage:=MY_TRAYICON;

hIcon:=ActiveIconHandle;

end;

Shell_NotifyIcon(Msg,@Tnd);

end;

procedure TTrayNotifyIcon.SetHideTask(Value:Boolean);

const

ShowArray:array[Boolean] of integer = (sw_ShowNormal,sw_Hide);

begin

if FHideTask<>Value then

begin

FHideTask:=Value;

if not (csDesigning in ComponentState) then

ShowWindow(Application.Handle,ShowArray[FHideTask]);

end;

procedure TTrayNotifyIcon.SetHint(Value:String);

begin

if FHint<>Value then

begin

FHint:=Value;

if FIconVisible then SendTrayMessage(NIM_MODIFY,NIF_TIP);

end;

procedure TTrayNotifyIcon.SetIcon(Value:TIcon);

begin

FIcon.Assign(Value);

if FIconVisible then SendTrayMessage(NIM_MODIFY,NIF_ICON);

end;

procedure TTrayNotifyIcon.SetIconVisible(Value:Boolean);

const

MsgArray: array[Boolean] of DWORD = (NIM_DELETE,NIM_ADD);

begin

if FIconVisible<>Value then

begin

FIconVisible:=Value;

if not (csDesigning in ComponentState) then

107

SendTrayMessage(MsgArray[Value],NIF_MESSAGE or NIF_ICON or NIF_TIP);

end;

procedure TTrayNotifyIcon.SetPopupMenu(Value:TPopupMenu);

begin

FPopupMenu:=Value;

if Value<>nil then Value.FreeNotification(Self);

end;

const

TrayMsgStr='MY.TrayNotifyIconMsg';

procedure Register;

begin

RegisterComponents('Samples', [TTrayNotifyIcon]);

end;

initialization

MY_TRAYICON:=RegisterWindowMessage(TrayMsgStr);

IconMgr:=TIconManager.Create;

finalization

IconMgr.Free;

end.

Исходный код административной части программного комплекса.

program Project1;

uses

Forms,

Unit1 in 'Unit1.pas' {Form1},

Nastr_Connect in 'Nastr_Connect.pas' {Form2},

UserLogin in 'UserLogin.pas' {Form3},

UserList in 'UserList.pas' {UserListFrm},

Add_Edit_User in 'Add_Edit_User.pas' {AddEditUserFrm},

Find_Komp in 'Find_Komp.pas' {FindKompFrm},

AddNewPredmet in 'AddNewPredmet.pas' {AddPredmetFrm},

AddNewVopros in 'AddNewVopros.pas' {VoprosOtvetListFrm},

AddStudents in 'AddStudents.pas' {AddStudentsFrm},

AddLectors in 'AddLectors.pas' {AddLectorsFrm},

StudentList in 'StudentList.pas' {StudentsListFrm},

FrmAbout in 'FrmAbout.pas' {AboutFrm},

DldVoprosAdd in 'DldVoprosAdd.pas' {DlgFrmAddVopros},

DlgPredmet in 'DlgPredmet.pas' {PredmetAdd},

NewVopros in 'NewVopros.pas' {NewVoprosFrm},

LectorList in 'LectorList.pas' {FrmLectorList};

{$R *.res}

108

begin

Application.Initialize;

Application.Title := 'Администрирование';

Application.CreateForm(TForm1, Form1);

Application.Run;

end.

Главный модуль приложения.

unit Unit1;

interface

uses

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

Dialogs, StdCtrls,DB, DBClient, MConnect, Menus, XPMan,

ComCtrls, ToolWin, ExtCtrls, Sockets, SConnect, jpeg, ImgList, RzBHints,

RzPanel, RzStatus, RzGroupBar;

//Grids, DBGrids,

type

TForm1 = class(TForm)

MainMenu1 : TMainMenu;

Administ : TMenuItem;

test_vopros : TMenuItem;

App_Edit_User : TMenuItem;

Con_ct_Server : TMenuItem;

Podkluch : TMenuItem;

Nastr : TMenuItem;

MListStudents : TMenuItem;

MPredmet : TMenuItem;

MVopros : TMenuItem;

Exit_Prog : TMenuItem;

MListLectors : TMenuItem;

ToolBttnAddUser : TToolButton;

ToolBttnStudents : TToolButton;

ToolBttnLectors : TToolButton;

ToolButton4 : TToolButton;

ToolBttnPredmet : TToolButton;

ToolBttnVopros : TToolButton;

ClientDataSetUser : TClientDataSet;

ClientDataSetPredmet : TClientDataSet;

ClientDataSetTema : TClientDataSet;

ClientDataSetVopros : TClientDataSet;

ClientDataSetVariant : TClientDataSet;

ClientDataSetQuery : TClientDataSet;

ClientDataSetStudents : TClientDataSet;

ClientDataSetLectors : TClientDataSet;

109

ClientDataSetOcenki : TClientDataSet;

TcpServer1 : TTcpServer;

DCOMConnection1 : TDCOMConnection;

SocketConnection1 : TSocketConnection;

ConnectionBroker1 : TConnectionBroker;

PredmetSource : TDataSource;

TemaSource : TDataSource;

VoprosSource : TDataSource;

VariantSource : TDataSource;

StudentsSource : TDataSource;

LectorsSource : TDataSource;

OcenkiSource : TDataSource;

ToolBar1 : TToolBar;

ImageList1 : TImageList;

RzBalloonHints1 : TRzBalloonHints;

RzStatusBar1 : TRzStatusBar;

RzClockStatus1 : TRzClockStatus;

RzKeyStatus1 : TRzKeyStatus;

RzKeyStatus2 : TRzKeyStatus;

RzGlyphStatus1 : TRzGlyphStatus;

RzMarqueeStatus1 : TRzMarqueeStatus;

Timer1 : TTimer;

ToolButton1 : TToolButton;

MAbout : TMenuItem;

RzGroupBar1 : TRzGroupBar;

RzGroup1 : TRzGroup;

Bevel1 : TBevel;

RzGroup2 : TRzGroup;

RzGroup3 : TRzGroup;

Image1 : TImage;

procedure NastrClick(Sender: TObject);

procedure PodkluchClick(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure FormCreate(Sender: TObject);

procedure App_Edit_UserClick(Sender: TObject);

procedure Exit_ProgClick(Sender: TObject);

procedure MPredmetClick(Sender: TObject);

procedure MVoprosClick(Sender: TObject);

procedure MListStudentsClick(Sender: TObject);

procedure MListLectorsClick(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

procedure ClientDataSetPredmetBeforeDelete(DataSet: TDataSet);

procedure ClientDataSetTemaBeforeDelete(DataSet: TDataSet);

procedure ClientDataSetTemaBeforeRefresh(DataSet: TDataSet);

procedure ClientDataSetPredmetBeforeRefresh(DataSet: TDataSet);

procedure MAboutClick(Sender: TObject);

procedure ClientDataSetVoprosBeforeRefresh(DataSet: TDataSet);

procedure ClientDataSetVoprosAfterPost(DataSet: TDataSet);

110

procedure ClientDataSetVariantAfterPost(DataSet: TDataSet);

procedure ClientDataSetPredmetBeforeInsert(DataSet: TDataSet);

procedure ClientDataSetTemaBeforeInsert(DataSet: TDataSet);

procedure ClientDataSetVoprosAfterInsert(DataSet: TDataSet);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

uses Nastr_Connect, UserLogin,IniFiles,ComObj, UserList,

AddNewPredmet, AddNewVopros, AddStudents, StudentList, FrmAbout,

DldVoprosAdd, DlgPredmet, LectorList;

{$R *.dfm}

procedure TForm1.NastrClick(Sender: TObject);

begin

if ConnectionBroker1.Connected then ConnectionBroker1.Connected:=False;

Form2:=TForm2.Create(Self);

Form2.ShowModal;

Form2.Free;

//настройка соеденения

end;

procedure TForm1.PodkluchClick(Sender: TObject);

var S1,S2,S3:string;

procedure MenuEnable;

begin

Administ.Enabled:=not Administ.Enabled;

test_vopros.Enabled:=not test_vopros.Enabled;

Nastr.Enabled:=not Nastr.Enabled;

// Desk.Enabled:=not Desk.Enabled;

ToolBttnAddUser.Enabled:=not ToolBttnAddUser.Enabled;

ToolBttnStudents.Enabled:=not ToolBttnStudents.Enabled;

ToolBttnLectors.Enabled:=not ToolBttnLectors.Enabled;

ToolBttnPredmet.Enabled:=not ToolBttnPredmet.Enabled;

ToolBttnVopros.Enabled:=not ToolBttnVopros.Enabled;

RzGroup1.Items.Items[0].Enabled:= not RzGroup1.Items.Items[0].Enabled;

RzGroup1.Items.Items[1].Enabled:= not RzGroup1.Items.Items[1].Enabled;

RzGroup1.Items.Items[2].Enabled:= not RzGroup1.Items.Items[2].Enabled;

RzGroup2.Items.Items[0].Enabled:= not RzGroup2.Items.Items[0].Enabled;

RzGroup2.Items.Items[1].Enabled:= not RzGroup2.Items.Items[1].Enabled;

RzGroup3.Items.Items[1].Enabled:= not RzGroup3.Items.Items[1].Enabled;

end;

begin

//подключение\отключение к серверу

111

Диплом - Разработка системы компьютерного контроля знаний по дисциплинам кафедры

Подождите немного. Документ загружается.