MainTree.Delete(MainTree.SelectedItem); {удаление текущего узла дерева}
end;
end
else
If Application.MessageBox('Удалитьраздел ?','Удалениераздела',
mb_YesNo+mb_IconQuestion+MB_DEFBUTTON2) = IdYes then
begin
DBQuest.IndexName:= 'tema_ind';
DBQuest.SetKey;
DBQuest.Fields[0].AsInteger:= DBTema.Fields[0].AsInteger; // Fields[0] - Tema_Id
While DBQuest.GotoKey do ClearQuestion; // логическое удаление всех вопросов, принадлежащих теме
DBQuest.IndexName:= '';
DBTema.Delete; { Удаление выбранной темы }
{ DBTema.Edit; DBTema.Fields[1].Clear; DBTema.Post; // logical delete }
MainTree.Delete(MainTree.SelectedItem); {удалениетекущегоузладерева}
end;
end;
procedure TTreeForm.FullExpButClick(Sender: TObject);
begin
MainTree.FullExpand;
end;
procedure TTreeForm.FullColButClick(Sender: TObject);
begin
MainTree.FullCollapse;
end;
procedure TTreeForm.ExitButClick(Sender: TObject);
begin
TreeForm.Close;
end;
procedure TTreeForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:= caFree;
EditForm.DBAnswer.Active:= False;
DBQuest.Active:= False;
DBTema.Active:= False;
end;
procedure TTreeForm.AddTemaButClick(Sender: TObject);
var
index: Longint;
FoundEmpty: boolean;
begin
WinEditTema.ShowModal;
If WinEditTema.ModalResult = mrOk then begin
FoundEmpty:= False;
DBTema.First;
While (not DBTema.EOF) and (not FoundEmpty) do {поискзаписив DBTEMA спустымполем Tema_name}
begin
If DBTema.Fields[1].IsNull Then FoundEmpty:= True
else DBTema.Next;
end;
If FoundEmpty then DBTema.Edit
else DBTema.Append; {добавление новой темы в БД, если не найдено пустой}
DBTema['Tema_name']:= WinEditTema.TemaEdit.Text;
DBTema.Post;
AppendQuestion(DBTema.Fields[0].AsInteger); {добавлениеновоговопросавБД }
index:= MainTree.AddChildObject(1,
DBTema.Fields[1].AsString,
pointer(DBTema.Fields[0].AsInteger)); {добавление new темы}
MainTree.AddChildObject(index,'1',
pointer(DBQuest.Fields[1].AsInteger)); {добавлениепустоговопросавтему}
If not MainTree.Items[1].Expanded then
MainTree.Items[1].Expand; {раскрытиекорневогоузла}
MainTree.Items[index].Expand; {раскрытиеузлатемы}
MainTree.Selecteditem:= index; {установлениефокусана new тему}
end;
end;
procedure TTreeForm.FormShow(Sender: TObject);
Var
cur_node,i: Longint;
node_name: string;
begin
if CreateMainForm then
begin
ProcessForm.Show;
DBTema.Active:= True; {ОткрытиеБДтемивопросов}
DBQuest.Active:= True;
ProcessForm.ProgressBar.Max:= DBTema.RecordCount + DBQuest.RecordCount;
While not DBTema.EOF do begin {загрузкадереваизБД}
ProcessForm.ProgressBar.StepIt;
If not DBTema.Fields[1].IsNull then
begin
cur_node:= MainTree.AddChildObject(1,
DBTema.Fields[1].AsString,
pointer(DBTema.FieldByName('Tema_id').AsInteger)); {добавлениетемывдерево}
i:= 1;
While not DBQuest.EOF do begin
ProcessForm.ProgressBar.StepIt;
Str(i,node_name);
MainTree.AddChildObject(cur_node,node_name,
pointer(DBQuest.Fields[1].AsInteger));{добавлениевопросавтек.тему}
DBQuest.Next; inc(i);
end;
end;
DBTema.Next;
end; {while}
DBQuest.IndexName:= ''; {отключениесвязимежду DBTema и DBQuest}
DBQuest.MasterFields:= '';
ProcessForm.Close;
CreateMainForm:= False;
end;
EditForm.Show;
end;
procedure TTreeForm.FormResize(Sender: TObject);
begin
if TreeForm.Height >= 300 then
MainTree.Height:= TreeForm.ClientHeight - Maintree.Top - x1
else
TreeForm.Height:= 300;
IF TreeForm.Width >= 263 then
MainTree.Width:= TreeForm.ClientWidth - MainTree.Left - x2
else
TreeForm.Width:= 263;
end;
procedure TTreeForm.FormCreate(Sender: TObject);
begin
CreateMainForm:= True;
x1:= ClientHeight - MainTree.Top - MainTree.Height;
x2:= ClientWidth - MainTree.Left - Maintree.Width;
TreeForm.Height:= GetSystemMetrics(SM_CYMAXIMIZED) - 10;
end;
procedure TTreeForm.AppendQuestion(temaId: longint);
{ Добавляет в таблицу DBQuest новый вопрос.
temaId - содержит значение темы, которой принадлежит вопрос
}
begin
DBQuest.IndexName:= 'tema_ind'; {подключение вторичного индекса}
DBQuest.SetKey; {поиск записи с 0-ым значением DBQuest.Tema_id}
DBQuest.Fields[0].AsInteger:= 0;
If DBQuest.GotoKey then {если найдена запись, то редактируем ее поля}
begin
DBQuest.IndexName:= ''; {отключение вторичного индекса}
DBQuest.Edit;
end
else {если не найдена такая запись, то добавляем новую}
begin
DBQuest.IndexName:= ''; {отключение вторичного индекса}
DBQuest.Append;
end;
DBQuest['Tema_id']:= TemaId;
DBQuest.Post;
end;
procedure TTreeForm.ClearQuestion;
{осуществляет логическое удаление текущего вопроса из БД}
begin
{обнуление параметра Quest_id во всех связанных записях БД answer.db}
EditForm.DBAnswer.First;
While not EditForm.DBAnswer.Eof do EditForm.ClearAnswer;
{обнуление tema_id текущего вопроса}
DBQuest.Edit;
DBQuest.Fields[0].AsInteger:= 0; // DBQUEST.Tema_id
DBQuest.Fields[2].AsString:= ''; // DBQUEST.QUest_name
DBQuest.Post;
end;
end.
Текстмодуля DB_Unit
unit db_unit;
interface
uses
SysUtils, Windows, Messages, Classes, Graphics, Controls,
StdCtrls, Forms, Mask, Buttons,
DBTables, DB, DBCtrls;
type
TEditForm = class(TForm)
MemoQuest: TDBMemo;
QuestName: TLabel;
QuestLabel: TLabel;
DBEditTema: TDBEdit;
MemoScroll: TScrollBox;
AddAnswerBut: TSpeedButton;
DelAnswerBut: TSpeedButton;
DBAnswer: TTable;
AnswerSource: TDataSource;
DBAnswerOtvet_id: TAutoIncField;
DBAnswerQuest_id: TIntegerField;
DBAnswerOtvet_name: TMemoField;
DBAnswerTrued: TBooleanField;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure DBEditTemaChange(Sender: TObject);
procedure AddAnswerButClick(Sender: TObject);
procedure DelAnswerButClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure AppendAnswer(QuestId: longint);
procedure ClearAnswer;
procedure FormResize(Sender: TObject);
procedure MemoScrollResize(Sender: TObject);
private
x1,x2: integer; {вспомогательные переменные}
public
end;
TAnswer = Class(TObject)
memo: TMemo;
check: TCheckBox;
constructor Create(AOwner:TComponent;Height_: Integer);
procedure Free;
procedure CheckClick(Sender: TObject);
procedure MemoChange(Sender: TObject);
class procedure DeleteAnswer(AOwner: TComponent;Number: integer);
private
nocreate: boolean; {TRUE - if don't run the CREATE-constructor}
end;
var
EditForm: TEditForm;
implementation
uses S2;
{$R *.DFM}
procedure TEditForm.AppendAnswer(QuestId: longint);
{ Добавляет в таблицу DBQuest новый вопрос.
temaId - содержит значение темы, которой принадлежит вопрос
}
Var
i: integer;
Isinsert: boolean;
NewAnswer: TAnswer;
begin
IsInsert:= false; {True if NOT APPEND new record into database}
DBAnswer.MasterFields:= '';
DBAnswer.SetKey; {поискзаписис 0-ымзначением DBAnswer.Tema_id}
DBAnswer.Fields[1].AsInteger:= 0;
If DBAnswer.GotoKey then
begin
DBAnswer.Edit;
IsInsert:= True;
end
else DBAnswer.Append;{если не найдена запись, то добавляем новую}
DBAnswer.Fields[1].AsInteger:= QuestId;
DBAnswer.Post;
DBAnswer.MasterFields:= 'Quest_id';
NewAnswer:= TAnswer.Create(MemoScroll,100); {добавление new вариантаответавсписок}
If IsInsert then
begin
DBAnswer.First; i:=0;
While i < MemoScroll.ComponentCount do
begin
DBAnswer.Edit;
DBAnswerOtvet_name.Assign(Tmemo(MemoScroll.Components[i]).Lines);
DBAnswer.Fields[3].AsBoolean:= TCheckBox(MemoScroll.Components[i+1]).Checked;
DBAnswer.Post;
DBAnswer.Next; inc(i,2);
end;
end; {endif}
end;
procedure TEditForm.ClearAnswer;
{логическое удаление из БД текущего варианта ответа для текущнго вопроса}
begin
DBAnswer.Edit;
DBAnswer['Quest_id']:= 0;
DBAnswer.Fields[2].Clear; { Otvet_name }
DBAnswer['Trued']:= False;
DBAnswer.Post;
end;
constructor TAnswer.Create(AOwner:TComponent;Height_: Integer);
begin
NoCreate:= False;
memo:= TMemo.Create(Aowner);
memo.Parent:= TWinControl(AOwner);
With memo do begin
If ComponentIndex = 0 then
begin
Left:= 0; Top:= 0;
end
else
begin
Left:= 0;
Top:= TMemo(AOwner.Components[ComponentIndex-2]).Top +
TMemo(AOwner.Components[ComponentIndex-2]).Height;
end;
Width:= TScrollBox(AOwner).Width - 60;
Height:= Height_;
If (ComponentIndex div 2 + 1)*Height > TScrollBox(AOwner).VertScrollBar.Range
then TScrollBox(AOwner).VertScrollBar.Range:= (ComponentIndex div 2 + 1)*Height;
OnChange:= MemoChange;
SetFocus;
end; {end Init Memo}
check:= TCheckBox.Create(AOwner);
check.Parent:= TWinControl(AOwner);
With check do begin
Left:= Memo.Left + Memo.Width + 15;
Top:= Memo.Top + Memo.Height div 2;
Height:= 17;
Width:= 17;
OnClick:= CheckClick;
end;
NoCreate:= True;
end;
procedure TAnswer.Free;
begin
check.Free;
memo.Free;
end;
procedure TAnswer.CheckClick(Sender: TObject);
begin
If nocreate then begin
EditForm.DBAnswer.First;
EditForm.DBAnswer.MoveBy((Check.Componentindex-1) div 2);
EditForm.DBAnswer.Edit;
EditForm.DBAnswer['Trued']:= check.checked;
EditForm.DBAnswer.Post;
end;
end;
procedure TAnswer.MemoChange(Sender: TObject);
begin
If memo.Modified then
begin
EditForm.DBAnswer.First;
EditForm.DBAnswer.MoveBy(Memo.Componentindex div 2);
EditForm.DBAnswer.Edit;
EditForm.DBAnswerOtvet_name.Assign(Memo.Lines);
EditForm.DBAnswer.Post;
end;
end;
class procedure TAnswer.DeleteAnswer(AOwner: TComponent;Number: integer);
Var
i: integer;
{удаленние из списка объекта NUMBER и NUMBER+1}
begin
TCheckBox(AOwner.Components[number+1]).Free;
TMemo(AOwner.Components[number]).Free;
For i:= Number to AOwner.ComponentCount-1 do {перерисовкакомпонентовв ScrollBox}
If AOwner.Components[i] is TMemo then
TMemo(AOwner.Components[i]).Top:= TMemo(AOwner.Components[i]).Top -
TMemo(AOwner.Components[i]).Height
else
TCheckBox(AOwner.Components[i]).Top:= TCheckBox(AOwner.Components[i]).Top -
TMemo(AOwner.Components[i-1]).Height;
If AOwner.ComponentCount > 0 then
TScrollBox(AOwner).VertScrollBar.Range:= (AOwner.ComponentCount div 2)*
TMemo(AOwner.Components[0]).Height;
end;
procedure TEditForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
TreeForm.Close; {закрытьокно, содержащеедерево}
end;
procedure TEditForm.DBEditTemaChange(Sender: TObject);
begin
If DBEditTema.Modified Then
begin
TreeForm.DBTema.Post;
TreeForm.MainTree.Items[TreeForm.MainTree.SelectedItem].Text:= TreeForm.DBTema.Fields[1].AsString;
{модификация названия узла дерева, содержащего тему}
end;
end;
procedure TEditForm.AddAnswerButClick(Sender: TObject);
begin
AppendAnswer(TreeForm.DBQuest.Fields[1].AsInteger);
end;
procedure TEditForm.DelAnswerButClick(Sender: TObject);
var
CurAnswer,i: integer;
begin {удаленниеизспискаCURRENT ANSWER, еслинанемстоиткурсор}
i:= 0;
CurAnswer:= -1;
While i < MemoScroll.ComponentCount do
begin
If TMemo(MemoScroll.Components[i]).Focused then
CurAnswer:= TMemo(MemoScroll.Components[i]).ComponentIndex;
inc(i,2);
end;
if CurAnswer > -1 then
begin
EditForm.DBAnswer.First;
EditForm.DBAnswer.MoveBy(CurAnswer div 2);
ClearAnswer;
TAnswer.DeleteAnswer(MemoScroll,CurAnswer);
end;
end;
procedure TEditForm.FormCreate(Sender: TObject);
begin
EditForm.DBAnswer.Active:= True; {ОткрытиеБДответов}
x1:= ClientHeight - MemoScroll.Top - MemoScroll.Height;
x2:= ClientWidth - MemoScroll.Left - MemoScroll.Width;
EditForm.Height:= GetSystemMetrics(SM_CYMAXIMIZED) - 10;
end;
procedure TEditForm.FormResize(Sender: TObject);
begin
if EditForm.Height >= 300 then
MemoScroll.Height:= EditForm.ClientHeight - MemoScroll.Top - x1
else EditForm.Height:= 300;
IF EditForm.Width >= 300 then
begin
MemoScroll.Width:= EditForm.ClientWidth - MemoScroll.Left - x2;
MemoQuest.Width:= EditForm.ClientWidth - MemoQuest.Left - x2;
DBEditTema.Width:= EditForm.ClientWidth - DBEditTema.Left - x2;
end
else EditForm.Width:= 300;
end;
procedure TEditForm.MemoScrollResize(Sender: TObject);
var
i: integer;
begin
i:= 0;
While i < (MemoScroll.ComponentCount-1) do
begin
TMemo(MemoScroll.Components[i]).Width:= MemoScroll.Width - 60;
TCheckBox(MemoScroll.Components[i+1]).Left:=
TMemo(MemoScroll.Components[i]).Left + TMemo(MemoScroll.Components[i]).Width + 15;
inc(i,2);
end;
end;
end.
Текстмодуля AddTema
unit addtema;
interface
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
Buttons, ExtCtrls;
type
TWinEditTema = class(TForm)
TemaEdit: TEdit;
TemaNameLabel: TLabel;
OkBtn: TBitBtn;
CancelBtn: TBitBtn;
procedure butCancelClick(Sender: TObject);
procedure butOkClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
WinEditTema: TWinEditTema;
implementation
{$R *.DFM}
procedure TWinEditTema.butCancelClick(Sender: TObject);
begin
Modalresult:= mrCancel;
end;
procedure TWinEditTema.butOkClick(Sender: TObject);
begin
Modalresult:= mrOk;
end;
end.
Текстмодуля ProgrInd
unit progrInd;
interface
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
Buttons, ExtCtrls, ComCtrls;
type
TProcessForm = class(TForm)
Bevel1: TBevel;
ProgressBar: TProgressBar;
private
{ Private declarations }
public
{ Public declarations }
end;
var
ProcessForm: TProcessForm;
implementation
{$R *.DFM}
end.
Приложение 2
ТЕКСТПРОГРАММЫ TESTADMIN
program TestAdmin;
uses
Forms,
main in 'main.pas' {AdminForm},
TQDialog in 'TQDialog.pas' {CreateTickDlg},
ResultReport in 'ResultReport.pas' {ReportForm};
{$R *.RES}
begin
Application.Title:= 'TestAdmin';
Application.CreateForm(TAdminForm, AdminForm);
Application.CreateForm(TCreateTickDlg, CreateTickDlg);
Application.CreateForm(TReportForm, ReportForm);
Application.Run;
end.
Текстмодуля Main
unit main;
interface
uses
Dialogs,IniFiles,SysUtils,Forms, DB, DBTables, Classes, Controls, Grids, DBGrids,