FileNew;
Word.FileSaveAs (DocFileName);}
except
Word.AppClose;
Result := False;
end;
end;
Procedure TMSWord. SaveAs (FileName:string);
begin
DocFileName:=FileName;
Word.FileSaveAs (FileName);
end;
Procedure TMSWord. Show;
begin
Word.AppShow;
end;
Procedure TMSWord. InsertText (Text: string);
begin
Word.Insert (Text);
end;
Procedure TMSWord. New;
begin
Word.FileNew;
Word.Filepagesetup (2,1,60,60,60,60);
end;
Procedure TMSWord. Find (a:string);
begin
word.paraup (500,0);
Word.EditFind (a);
end;
Procedure TMSWord. Replace (a, b: string);
begin
word.paraup (500,0);
Word.EditReplace (a, b,0,0,0,0,0,1,0,1,0);
end;
Procedure TMSWord. InsertCenterText (Text: string);
begin
Word.CenterPara;
Word.Insert (Text);
Word.LeftPara;
end;
Procedure TMSWord. InsertPicture (FileName: string);
begin
Word.InsertPicture (FileName);
end;
Procedure TMSWord. InsertTable (Columns, Attributes: integer);
begin
Word.TableInsertTable (0,Columns, 2,50,0,Attributes);
end;
Procedure TMSWord. InsertTableHead (
Width: array of integer; Names: array of string);
var
i: integer;
begin
Word.TableColumnWidth (Width[0]);
Word.Insert (Names[0]);
for I := 1 to High (Names) do
begin
Word.CharRight;
Word.TableColumnWidth (Width[i]);
Word.Insert (Names[i]);
end;
Word.EndOfColumn;
end;
procedure TMSWord. InsertTableLine (Names: array of string;bold:boolean=false);
var
i: integer;
begin
Word.TableInsertRow;
for I := 0 to High (Names) do
begin
if i>0 then Word. CharRight;
word.bold (bold);
Word.Insert (Names[i]);
end;
Word.CharRight;
word.Insert (#13);
// Word. EndOfColumn;
end;
procedure TMSWord. EndOfTable;
begin
Word.TableDeleteRow;
Word.Insert (chr (13));
end;
Procedure TMSWord. Close;
begin
// Word. FileSave;
Word.AppClose;
end;
Procedure TMSWord. Save;
begin
Word.FileSave;
end;
end.
Модуль: Ancets. pas Всего строк: 67
unit Ancets;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, DB, DBCtrls, ADODB, Grids, DBGrids, Buttons;
type
TFrmData = class (TForm)
Panel1: TPanel;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
DBNavigator1: TDBNavigator;
TblData: TADOTable;
TblDataid: TAutoIncField;
TblDataDSDesigner: TIntegerField;
TblDataDSDesigner2: TWideStringField;
BtnNewAncet: TSpeedButton;
procedure TblDataNewRecord (DataSet: TDataSet);
procedure FormClose (Sender: TObject; var Action: TCloseAction);
procedure BtnNewAncetClick (Sender: TObject);
private
soc:integer;
{ Private declarations }
public
cnt:integer;
procedure PrepareData (s:integer);
{ Public declarations }
end;
var
FrmData: TFrmData;
implementation
uses main, test;
{$R *.dfm}
procedure TFrmData. PrepareData (s:integer);
begin
soc := s;
TblData.Close;
TblData.Filter := '[Код
Исследвания] = '+IntToStr (s);
TblData.Open;
end;
procedure TFrmData. TblDataNewRecord (DataSet: TDataSet);
begin
TblDataDSDesigner.Value := soc;
end;
procedure TFrmData. FormClose (Sender: TObject; var Action: TCloseAction);
begin
cnt := TblData. RecordCount;
TblData.Close;
end;
procedure TFrmData. BtnNewAncetClick (Sender: TObject);
begin
Application.CreateForm (TFrmTest, FrmTest);
FrmTest.PrepareData (TblDataid.Value, soc);
FrmTest.ShowModal;
end;
end.
Модуль: main. pas Всего строк: 298
unit main;
//Главный модуль
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Db, DBTables, ComCtrls, Grids, DBGrids, StdCtrls, Buttons, ExtCtrls,
editu, inifiles, ToolWin, Menus, ActnList, ImgList, Mask, DBCtrls,
ADODB, mapi, rusdlg, DBActns;
type
TFrmPh = class (TForm)
PanelFind: TPanel;
DataSource1: TDataSource;
Grid: TDBGrid;
Label1: TLabel;
Edit: TEdit;
Status: TStatusBar;
DataSource2: TDataSource;
Panel2: TPanel;
BitBtn1: TBitBtn;
ActionList1: TActionList;
ImageList1: TImageList;
MainMenu1: TMainMenu;
ActRepAnketa: TAction;
ActExit: TAction;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N7: TMenuItem;
ActAbout: TAction;
N9: TMenuItem;
N10: TMenuItem;
ToolBar1: TToolBar;
ToolButton4: TToolButton;
ToolButton8: TToolButton;
ToolButton10: TToolButton;
ToolButton11: TToolButton;
ActFind: TAction;
ToolButton12: TToolButton;
N12: TMenuItem;
PanelAdd: TPanel;
Panel3: TPanel;
DBMemo1: TDBMemo;
Label5: TLabel;
Splitter1: TSplitter;
ShowAdd: TAction;
ToolButton13: TToolButton;
N13: TMenuItem;
N14: TMenuItem;
N11: TMenuItem;
N15: TMenuItem;
ADOConnection1: TADOConnection;
ActQuest: TAction;
ToolButton15: TToolButton;
ToolButton17: TToolButton;
ActData: TAction;
ToolButton14: TToolButton;
ToolButton16: TToolButton;
TblSpec: TADOTable;
TblIssl: TADOTable;
repListPost1: TMenuItem;
N8: TMenuItem;
TblIsslid: TAutoIncField;
TblIsslDSDesigner: TWideStringField;
TblIsslDSDesigner2: TIntegerField;
TblIsslDSDesigner3: TIntegerField;
TblIsslDSDesigner4: TMemoField;
DataSetFirst1: TDataSetFirst;
DataSetPrior1: TDataSetPrior;
DataSetNext1: TDataSetNext;
DataSetLast1: TDataSetLast;
DataSetInsert1: TDataSetInsert;
DataSetDelete1: TDataSetDelete;
DataSetEdit1: TDataSetEdit;
DataSetPost1: TDataSetPost;
DataSetCancel1: TDataSetCancel;
DataSetRefresh1: TDataSetRefresh;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
ToolButton7: TToolButton;
ToolButton9: TToolButton;
ToolButton18: TToolButton;
ToolButton19: TToolButton;
ToolButton20: TToolButton;
ToolButton21: TToolButton;
ToolButton22: TToolButton;
ToolButton23: TToolButton;
First1: TMenuItem;
Prior1: TMenuItem;
Next1: TMenuItem;
Last1: TMenuItem;
Insert1: TMenuItem;
Delete1: TMenuItem;
Edit1: TMenuItem;
Post1: TMenuItem;
Cancel1: TMenuItem;
Refresh1: TMenuItem;
ToolButton1: TToolButton;
ActTabl: TAction;
ToolButton2: TToolButton;
procedure BtnEditClick (Sender: TObject);
procedure EditChange (Sender: TObject);
procedure DataSource1DataChange (Sender: TObject; Field: TField);
procedure FormCreate (Sender: TObject);
procedure FormClose (Sender: TObject; var Action: TCloseAction);
procedure ActExitExecute (Sender: TObject);
procedure ActAboutExecute (Sender: TObject);
procedure ActFindExecute (Sender: TObject);
procedure BitBtn1Click (Sender: TObject);
procedure ShowAddExecute (Sender: TObject);
procedure ActQuestExecute (Sender: TObject);
procedure ActDataExecute (Sender: TObject);
procedure TblIsslNewRecord (DataSet: TDataSet);
procedure ActTablExecute (Sender: TObject);
private
{ Private declarations }
public
procedure Refresh (ph:integer);
procedure ShowHint (Sender: TObject);
{ Public declarations }
end;
var
FrmPh: TFrmPh;
SortField: string;
implementation
uses about, ancets, stat, msword;
{$R *.DFM}
//Показать строку подсказки
procedure TFrmPh. ShowHint (Sender: TObject);
begin
status.Panels[1]. text:=Application.Hint;
end;
//Обновить таблицу данных
procedure TFrmPh. Refresh (ph:integer);
var s: string;
begin
status.Panels[0]. text:=format ('Всего %d абитуриента (ов)',[TblIssl.recordcount]);
end;
//Редактировать абитуриента
procedure TFrmPh. BtnEditClick (Sender: TObject);
var word: TMSWord;
i:integer;
begin
i:=0;
word:=TMSWord.Create; //создать класс TMSWord
if not word. Open then //открыть связь с Ole объектом
begin
Error ('Не могу открыть msWord');
exit;
end;
word.New; //новый документ
word.InsertCenterText ('Социологический опрос'#13#13); //вставить заголовок документа
Application.CreateForm (TFrmEdit, FrmEdit);
FrmEdit.PrepareData (TblIsslid.Value);
FrmEdit.TblQuest.First;
i:=1;
while not FrmEdit.TblQuest.Eof do
begin
word.InsertText (format ('%d. %s',[i, FrmEdit. TblQuestDSDesigner3.AsString]));
if FrmEdit. TblQuestDSDesigner2.value<>3 then
begin
word.InsertText (' _____________________'#13);
end else
begin
word.InsertText (#13);
while not FrmEdit.TblAlt.Eof do
begin
word.InsertText (format (' %d. %s'#13,[FrmEdit.TblAltDSDesigner2.Value, FrmEdit. TblAltDSDesigner3.Value]));
FrmEdit.TblAlt.Next;
end;
end;
FrmEdit.TblQuest.Next;
inc (i);
end;
word.Show; //показать Word
word.Free; //Освободить память
end;
//Удалить запись
//Поиск по началу слова
procedure TFrmPh. EditChange (Sender: TObject);
begin
//поиск без учета регистра и по неполному слову
TblIssl.Locate ('Название', edit. Text,[loCaseInsensitive, loPartialKey]);
end;
//При обновлении данных
procedure TFrmPh. DataSource1DataChange (Sender: TObject; Field: TField);
begin
//Кнопки удаления и редактирования доступны
//только если база не пустая
{ actedit. Enabled :=not TblAbit. IsEmpty;
actdel .Enabled :=not TblAbit. IsEmpty;
Refresh (-1); }
end;
//Создание формы
procedure TFrmPh. FormCreate (Sender: TObject);
var s: string;
begin
ADOConnection1.close;
ADOConnection1.Open;
TblIssl.Open;
Application.OnHint := ShowHint; //инициализация показа подсказок
end;
//Закрытие формы
procedure TFrmPh. FormClose (Sender: TObject; var Action: TCloseAction);
begin
ADOConnection1.Close; //закрыть соединение
end;
procedure TFrmPh. ActExitExecute (Sender: TObject);
begin
close;
end;
procedure TFrmPh. ActAboutExecute (Sender: TObject);
begin
Application.CreateForm (TAboutBox, AboutBox);
AboutBox.ShowModal;
AboutBox.free;
end;
procedure TFrmPh. ActFindExecute (Sender: TObject);
begin
PanelFind.Visible := ActFind. Checked;
end;
procedure TFrmPh. BitBtn1Click (Sender: TObject);
begin
ActFind.Checked:=False;
ActFindExecute (nil);
end;
procedure TFrmPh. ShowAddExecute (Sender: TObject);
begin
PanelAdd.Visible := ShowAdd. Checked;
end;
procedure TFrmPh. ActQuestExecute (Sender: TObject);
begin
Application.CreateForm (TFrmEdit, FrmEdit);
FrmEdit.PrepareData (TblIsslid.Value);
FrmEdit.ShowModal;
if TblIsslDSDesigner2. Value <> FrmEdit. Qcnt then
begin
TblIssl.Edit;
TblIsslDSDesigner2.Value := FrmEdit. Qcnt;
TblIssl.Post;
end;
FrmEdit.Free;
end;
procedure TFrmPh. ActDataExecute (Sender: TObject);
begin
Application.CreateForm (TFrmData, FrmData);
FrmData.PrepareData (TblIsslid.Value);
FrmData.ShowModal;
FrmData.Free;
if TblIsslDSDesigner3. Value <> FrmData. cnt then
begin
TblIssl.Edit;
TblIsslDSDesigner3.Value := FrmData. cnt;
TblIssl.Post;
end;
// Refresh (Qryid.Value);
end;
procedure TFrmPh. TblIsslNewRecord (DataSet: TDataSet);
begin
TblIsslDSDesigner2.Value := 0;
TblIsslDSDesigner3.Value := 0;
end;
procedure TFrmPh. ActTablExecute (Sender: TObject);
begin
Application.CreateForm (TFrmStat, FrmStat);
FrmStat.PrepareData (TblIsslid.Value);
FrmStat.ShowModal;
FrmStat.Free;
end;
end.
Модуль: Sociol. dpr Всего строк: 20
program Sociol;
uses
Forms,
Controls,
main in 'main.pas' {FrmPh},
editu in 'editu.pas' {FrmEdit},
about in 'about.pas' {AboutBox},
Ancets in 'Ancets.pas' {FrmData},
test in 'test.pas' {FrmTest},
Stat in 'Stat.pas' {FrmStat},
MSWord in 'MSWord.pas';
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm (TFrmPh, FrmPh);
Application.Run;
end.
Приложение 2
Результаты работы программы
Рис. 1. Главное окно БД Рис. 2. Вопросы Рис. 3. Анкеты Рис. 4.
Тестирование Рис. 5. Расчет минимума, среднего, максимума по числовому полю
Рис. 6. Построение столбчатой диаграммы
