// 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.

Страницы: 1, 2