// *******************************************************//
// Declaration of CoClasses defined in Type Library
// (NOTE: Here we map each CoClass to its Default Interface)
// *********************************************************//
Integral = IIntegral;
// *******************************************************//
// Interface: IIntegral
// Flags: (0)
// GUID: {2877719B-94E7-45FB-82BE-7F9CD8A6017C}
// *****************************************************//
IIntegral = interface(IUnknown)
['{2877719B-94E7-45FB-82BE-7F9CD8A6017C}']
function Func(x: Double): Double; stdcall;
end;
// **********************************************************//
// The Class CoIntegral provides a Create and CreateRemote method to
// create instances of the default interface IIntegral exposed by
// the CoClass Integral. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// ***********************************************************//
CoIntegral = class
class function Create: IIntegral;
class function CreateRemote(const MachineName: string): IIntegral;
end;
implementation
uses ComObj;
class function CoIntegral.Create: IIntegral;
begin
Result := CreateComObject(CLASS_Integral) as IIntegral;
end;
class function CoIntegral.CreateRemote(const MachineName: string): IIntegral;
begin
Result := CreateRemoteComObject(MachineName, CLASS_Integral) as IIntegral;
end;
end.
unit uFunc;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
Windows, ActiveX, Classes, ComObj, pServer_TLB, StdVcl;
type
TIntegral = class(TTypedComObject, IIntegral)
protected
function Func(x: Double): Double; stdcall;
end;
implementation
uses ComServ;
// Вычисление значения уравнения
function TIntegral.Func(x: Double): Double;
begin
Result := (x + 0.8) / sqrt (x * x + 1.2);
end;
initialization
TTypedComObjectFactory.Create(ComServer, TIntegral, Class_Integral,
ciMultiInstance, tmApartment);
end.
Клиент:
unit uMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls, TeEngine, Series, TeeProcs, Chart,
Grids, Menus, ToolWin, ComCtrls, ImgList;
type
TfrmMain = class(TForm)
GroupBox1: TGroupBox;
edtA: TEdit;
Label1: TLabel;
edtB: TEdit;
Label2: TLabel;
edtN: TEdit;
Label3: TLabel;
btnApply: TBitBtn;
pnlRes: TPanel;
Chart1: TChart;
Series1: TAreaSeries;
grdAll: TStringGrid;
MainMenu1: TMainMenu;
N1: TMenuItem;
Excel: TMenuItem;
N2: TMenuItem;
nExit: TMenuItem;
N3: TMenuItem;
NApply: TMenuItem;
N5: TMenuItem;
NSave: TMenuItem;
NLoad: TMenuItem;
OpenDialog: TOpenDialog;
SaveDialog: TSaveDialog;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
ToolButton7: TToolButton;
ToolButton8: TToolButton;
ToolButton9: TToolButton;
N4: TMenuItem;
nAbout: TMenuItem;
ToolButton10: TToolButton;
NHelp: TMenuItem;
N6: TMenuItem;
ImageList1: TImageList;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure nExitClick(Sender: TObject);
procedure ExcelClick(Sender: TObject);
procedure NApplyClick(Sender: TObject);
procedure NLoadClick(Sender: TObject);
procedure NSaveClick(Sender: TObject);
procedure nAboutClick(Sender: TObject);
procedure NHelpClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
uses uLogo, uIntegral, uAbout;
var
Integral: TIntegral;
{$R *.dfm}
// Создание формы
procedure TfrmMain.FormCreate(Sender: TObject);
var
// Объявляем объект формы логотипа
logo: TfrmLogo;
begin
// Создаем форму
logo := TfrmLogo.Create(self);
// Отображаем форму
logo.ShowModal;
// Создаем объект Integral
Integral := TIntegral.Create(1.6, 2.7, 95);
pnlRes.Caption := 'Результат = ' + FloatToStr(Integral.Calculate);
Integral.Draw(Series1);
Chart1.ZoomPercent(90);
Integral.FillTable(grdAll);
end;
procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
// Очищаем память
Integral.Destroy;
end;
procedure TfrmMain.nExitClick(Sender: TObject);
begin
Close;
end;
procedure TfrmMain.ExcelClick(Sender: TObject);
begin
Integral.ExcelExport(grdAll);
end;
procedure TfrmMain.NApplyClick(Sender: TObject);
begin
Integral.A := StrToFloat(edtA.Text);
Integral.B := StrToFloat(edtB.Text);
Integral.N := StrToInt(edtN.Text);
pnlRes.Caption := 'Результат = ' + FloatToStr(Integral.Calculate);
Integral.Draw(Series1);
Integral.FillTable(grdAll);
end;
procedure TfrmMain.NLoadClick(Sender: TObject);
begin
if (OpenDialog.Execute) then begin
Integral.LoadFromFile(OpenDialog.FileName);
edtA.Text := FloatToStr(Integral.A);
edtB.Text := FloatToStr(Integral.B);
edtN.Text := IntToStr(Integral.N);
pnlRes.Caption := 'Результат = ' + FloatToStr(Integral.Calculate);
Integral.Draw(Series1);
Integral.FillTable(grdAll);
end;
end;
procedure TfrmMain.NSaveClick(Sender: TObject);
begin
if (SaveDialog.Execute) then begin
Integral.SaveToFile(SaveDialog.FileName);
end;
end;
procedure TfrmMain.nAboutClick(Sender: TObject);
begin
frmAbout.ShowModal;
end;
procedure TfrmMain.NHelpClick(Sender: TObject);
begin
Application.HelpCommand(0,0);
end;
end.
unit uLogo;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
type
TfrmLogo = class(TForm)
Panel1: TPanel;
Label1: TLabel;
Label3: TLabel;
Label2: TLabel;
Image1: TImage;
Timer1: TTimer;
procedure Panel1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmLogo: TfrmLogo;
implementation
{$R *.dfm}
// Нажатие мышкой где-либо
procedure TfrmLogo.Panel1Click(Sender: TObject);
begin
// Закрываем форму
Close;
end;
procedure TfrmLogo.FormClose(Sender: TObject; var Action: TCloseAction);
begin
// Очистить память
Action := caFree;
end;
// Кода таймер сработает
procedure TfrmLogo.Timer1Timer(Sender: TObject);
begin
// Закрыть форму
Close;
end;
end.
unit uIntegral;
interface
uses pServer_TLB, Series, Chart, SysUtils, grids,
ComObj, ActiveX, Windows, StdCtrls;
{Класс TIntegral}
type
TIntegral = class
private
_A, _B: real;
_N: integer;
// Методы записи для property-значений
procedure SetA(const Value: real);
procedure SetB(const Value: real);
procedure SetN(const Value: integer);
public
// Конструктор (принимает все необходимые для вычислений значения)
constructor Create(ANew, BNew: real; NNew: integer);
// Необходимые property
property A: real read _A write SetA; // начало интегрирования
property B: real read _B write SetB; // конец интенрирования
property N: integer read _N write SetN; // кол-во разбиений
// Вычисление интеграла (возвращаем интегральную сумму)
function Calculate: real;
// Загрузка данных из файла
procedure LoadFromFile(fName: string);
// Сохранение данных в файл
procedure SaveToFile(fName: string);
// Рисование графика
procedure Draw(Series: TAreaSeries);
// Процедура заполнения таблицы
procedure FillTable(Stg: TStringGrid);
// Экспорт в Excel
procedure ExcelExport (Stg: TStringGrid);
end;
implementation
uses Dialogs;
// Вычисление интеграла (возвращаем интегральную сумму)
function TIntegral.Calculate: real;
var
i: Integer;
tmp, h, s: real;
{Объявляем объект интерфейса}
Func: IIntegral;
begin
s := 0;
{Создаем объект интерфейса}
Func := CoIntegral.Create;
h := (_B - _A)/_N; // Вычисляем шаг
for i := 0 to _N do
begin
tmp := i * h;
s := s + h * Func.Func(_A + tmp); // релизация метода
end;
Result := s; // возвращаем результат
Func._Release;
end;
// Конструктор (принимает все необходимые для вычислений значения)
constructor TIntegral.Create(ANew, BNew: real; NNew: integer);
begin
_A := ANew;
_B := BNew;
_N := NNew;
end;
// Рисование графика
procedure TIntegral.Draw(Series: TAreaSeries);
var
i: Integer;
tmp, h: real;
{Объявляем объект интерфейса}
Func: IIntegral;
begin
Series.Clear;
{Создаем объект интерфейса}
Func := CoIntegral.Create;
h := (_B - _A)/_N; // Вычисляем шаг
for i := 0 to _N do
begin
tmp := i * h;
{добавляем в график}
Series.AddXY(_A + tmp, h*Func.Func(_A + tmp));
end;
Func._Release;
end;
// Экспорт в Excel
procedure TIntegral.ExcelExport (Stg: TStringGrid);
var
j : Integer;
Unknown : IUnknown;
Result : HResult;
AppProgID : String;
App, Ch : Variant;
begin
// Указать программный идентификатор приложения-сервера
AppProgID := 'Excel.Application';
Result := GetActiveObject(ProgIDToClassID(AppProgID),nil,Unknown);
if (Result = MK_E_UNAVAILABLE) then
// Создать один экземпляр сервера
App := CreateOleObject(AppProgID)
else
// Соединиться с уже запущенной копией сервера
App := GetActiveOleObject(AppProgID);
//------------------------------------------------------
App.Workbooks.Add();
j:=App.Workbooks.Count;
App.Workbooks[j].Activate;
//Обращение к страницам
App.ActiveWorkbook.WorkSheets[1].Name := 'Результат';
//Подготовка данных для построения графика
For j:=1 to _N-1 do
begin
App.ActiveWorkbook.WorkSheets[1].Cells[j,1].Value :=StrToFloat(Stg.Cells[1,j+1]);
App.ActiveWorkbook.WorkSheets[1].Cells[j,2].Value := StrToFloat(Stg.Cells[2,j+1]);
end;
App.DisplayAlerts:=False;
// показать окно приложения на экране
App.Visible := True;
end;
procedure TIntegral.FillTable(Stg: TStringGrid);
var
i: Integer;
tmp, h: real;
{Объявляем объект интерфейса}
Func: IIntegral;
begin
{Создаем объект интерфейса}
Func := CoIntegral.Create;
Stg.RowCount := _N + 1;
Stg.Cells[0,0] := 'N';
Stg.Cells[1,0] := 'X';
Stg.Cells[2,0] := 'Y';
h := (_B - _A)/_N; // Вычисляем шаг
for i := 0 to _N-1 do
begin
tmp := i * h;
{добавляем в таблицу}
Stg.Cells[0,i+1] := IntToStr(i+1);
Stg.Cells[1,i+1] := FloatToStr(_A + tmp);
Stg.Cells[2,i+1] := FloatToStr(h*Func.Func(_A + tmp));
end;
Func._Release;
end;
// Загрузка данных из файла
procedure TIntegral.LoadFromFile(fName: string);
var
f: file of real;
fa, fb, fn: real;
res: boolean;
begin
{$I-}
{Открываем файл}
AssignFile(f, fName);
Reset(f);
{Читаем данные из файла}
Read(f, fa);
Read(f, fb);
Read(f, fn);
{Закрываем файл}
CloseFile(f);
{$I+}
{Проверяем на ошибку}
res := (IOResult = 0) and (fName <> '');
if (res = false) then
ShowMessage('Неправильное чтение из файла')
else begin {Записываем данные в класс}
_A := fa;
_B := fb;
_N := Round(fn);
end;
end;
// Сохранение данных в файл
procedure TIntegral.SaveToFile(fName: string);
var
f: file of real;
fn: real;
res: boolean;
begin
{$I-}
{Открываем файл или создаем}
AssignFile(f, fName);
Rewrite(f);
{$I+}
{Проверяем на ошибку}
res := (IOResult = 0) and (fName <> '');
if (res = false) then
ShowMessage('Неправильное чтение')
else begin {Записываем данные в файл}
{Пишем данные в файл}
Write(f, _A);
Write(f, _B);
fn := _N;
Write(f, fn);
end;
{Закрываем файл}
CloseFile(f);
end;
// Описание методов записи для property-значений
procedure TIntegral.SetA(const Value: real);
begin
_A := Value;
end;
procedure TIntegral.SetB(const Value: real);
begin
_B := Value;
end;
procedure TIntegral.SetN(const Value: integer);
begin
_N := Value;
end;
end.
unit uAbout;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TfrmAbout = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmAbout: TfrmAbout;
implementation
{$R *.dfm}
procedure TfrmAbout.Button1Click(Sender: TObject);
begin
Close;
end;
end.