28. Тугенгольд А.К., Лукьянов Е.А., Прус В.А. Интеллектуальное управление сложным мехатронным объектом с использованием нейронных сетей // Вестник ДГТУ. Т. 3. № 3 (17). 2003.

29. Тугенгольд А.К., Лукьянов Е.А., Прус В.А. Интеллектуальное управление сложным мехатронным объектом // Математические методы в технике и технологиях - ММТТ-16: Сб. тр. XVI междунар. науч. конф. В 10 т. Т. 4. Секция 4, 6 / Под общ. ред. В.С. Балакирева / РГАСХМ ГОУ, Ростов-н/Д, 2003. - 244 с. С. 131-134.

30. Тугенгольд А.К., Лукьянов Е.А., Носенков Д.А., Прус В.А. Нейросетевое управление сложными траекторными движениями технологического оборудования // Материалы IV межрегиональной научно-практической конференции «Инновационные и двойные технологии регионального производства». Ростов-н/Д, ФГУП ВНИИ «Градиент». 2003. С. 98-103.

31. Тугенгольд А.К., Лукьянов Е.А., Прус В.А. Моделирование работы привода постоянного тока с нечётким контроллером // Математические методы в технике и технологиях - ММТТ-17: Сб. тр. XVII междунар. науч. конф. В 10 т. Т. 6. Секция 6, 13 / Под общ. ред. В.С. Балакирева - Кострома: Изд-во Костромского гос. технол. ун-та, 2004. - 183 с. С. 126-129.

32. Захаров В.Н., Ульянов С.В. Нечёткие модели интеллектуальных промышленных регуляторов и систем управления. I-IV // Изв. РАН. Техническая кибернетика, 1992. № 5; 1993. № 4, 5; 1994. № 4.

33. Тимофеев А.В., Юсупов Р.М. Интеллектуализация систем автоматического управления // Изв. РАН. Техническая кибернетика, 1994. № 5. С. 211-224.

34. Захаров В.Н. Интеллектуальные системы управления: основные понятия и определения // Изв. РАН. Техническая кибернетика, 1997. № 3. С. 138-145.

35. Васильев В.И., Ильясов Б.Г. Интеллектуальные системы управления с использованием генетических алгоритмов // Приложение к журналу «Информационные технологии», 2000. № 12.

36. Лохин В.М., Мадыгулов Р.У., Макаров И.М., Тюрин К.В. Применение экспертных регуляторов для систем управления динамическими объектами // Изв. РАН. Теория и системы управления, 1995. № 1. С. 5-21.

37. Takagi T., Sugeno M. Fuzzy Identification of Systems and its Applications to Modeling and Control // IEEE Trans on Systems, Man, Cybern., 15(1), 1985. P. 116-132.

38. Курейчик В.М. Генетические алгоритмы. Состояние. Проблемы. Перспективы // Изв. Академии наук. Теория и системы управления, 1999. № 1. С. 144-160.

39. Hollstien R.B. Artificial genetic adaptation in computer control systems, Ph D. thesis - University of Michigan, Ann Arbor, 1971.

40. De Jong K.A. Analysis of the behavior of a class of genetic adaptive systems, Ph D. thesis - University of Michigan, Ann Arbor, 1975.

41. Holland J.H. Adaptation in Natural and Artificial Systems - The University of Michigan Press, University of Michigan, Ann Arbor, 1975.

42. Goldberg D.E. Genetic Algorithms in Search, Optimization and Machine Learning - Addison-Wesley, Reading, M. A., 1989. 412 p.

43. Thithi I. Control System Parameter Identification Using the Population Based Incremental Learning (PBIL) // Proc. of Intern. Conf. on Control'96, 2-5 Sept., 1996, Vol. 2 P. 1309-1314.

44. Neubauer A. On-Line System Identification Using The Modified Genetic Algorithm // Proc. Of EUFIT'97, Archen, Germany, 1997, Sept. 8-11. P. 764-768.

45. Fukuda N., Ueyama N. Cellular Robotics and Micro Robotic Systems. - World Scientific Pub., 1994. 263 p.

46. Zalrala A.M.S., Fleming P.J. Genetic Algorithms: Principles and Application in Engineering Systems // Neural Networks, Vol. 6, N 5, 1996. P. 803-820.

47. Karr C.L., Freeman L.M. Genetic - algorithm - based Fuzzy Control of Spacecraft Autonomous Rendezvous // Engineering Application of Artificial Intelligence, Vol. 10, N 3, June, 1997. P. 293-300.

48. Ono O., Kobayashi B., Kato H. Optimal Dynamic Motion Planning of Autonomous Vehicles be a Structured Genetic Algorithm // Proc. of the 13^th World Congress of IFAC, Vol. Q., San Francisco, USA, 1996. P. 435-440.

49. Норенков И.П. Генетические методы структурного синтеза проектных решений // Информационные технологии, 1998. № 1. С. 9-13.

50. Агамалов О.Н. Оценка технического состояния электрооборудования в реальном масштабе времени методом нейро-нечёткой идентификации // ExponentaPro. Математика в приложениях, 2003. № 2. С. 36-44.

51. Головко В.А. Нейронные сети: обучение, организация и применение. - М.: ИПРЖР, 2001. - 256 с.

52. Бутаков С.В., Рубцов Д.В. Разработка оболочки гибридной интеллектуальной системы // Информационные технологии, 2002. № 1.

53. Рыбина Г.В. Современные экспертные системы: тенденции к интеграции и гибридизации // Приборы и системы: управление, контроль, диагностика, 2001. № 8. С. 18-21.

54. Гончарова С.Г. Интеллектуальная система управления процессом механической обработки с оперативным использованием нечёткой нейросетевой модели знаний. Автореф. дис. канд. тех. наук / Уфимский гос. авиац. техн. ун-т. - Уфа, 2001. - 16 с.

55. Тугенгольд А.К., Лукьянов Е.А. Интеллектуальное управление мехатронными технологическими системами. - Ростов н/Д: Издательский центр ДГТУ, 2004. - 117 с.

56. N. Xu, S. H. Huang, and J. Snyder, “Systematic Investigation of Tool Wear Monitoring in Turning Operations,” 2005 ASME International Mechanical Engineering Congress and Exposition, November 5-11, Orlando, FL, 2005.

57. S. H. Huang, Q. Liu, and R. Musa, “Tolerance-based Process Plan Evaluation Using Monte Carlo Simulation,” International Journal of Production Research, Vol. 42, No. 23, pp. 2004, pp. 4871-4891.

58. Laperriere L, and ElMaraghy, H. A., (2000), "Tolerance Analysis and Synthesis Using Jacobian Transforms," Annals of CIRP, Vol. 49, No. 1, pp. 359-362.

59. СТИН, статья по тепловым деформациям станков

60. EServer TC Library. S1000d^ A Standard for Technical Documentation, : Dieter Weidenbrueck. [электронный ресурс]http://tc.eserver.org/28083.html.

61. Тугенгольд А.К., Лукьянов Е.А. Интеллектуальное управление мехатронными технологическими системами. - Ростов н/Д: Издательский центр ДГТУ, 2004. - 117 с.

62. Siemens PLM Software, раздел Teamcenter. [электронный ресурс] http://www.plm.automation.siemens.com/ru_ru/products/teamcenter/.

63. Teamcenter 2007: «новая эра» на рынке PLM.// CAD/CAM/CAE Observer. -- 2007. -- № #6 (36). -- С. 32-35.

64. Презентация PLM-системы Teamcenter 2007. // САПР и графика. -- 2008. -- № 1. -- С. 46-47.

65. ИРИСОФТ. Автоматизация процессов Windchill. [электронный ресурс] http://www.irisoft.ru/windchill.html

66. Bee-pitron. Раздел Dassault Systemes. [электронный ресурс] http://www.bee-pitron.ru/ru/left/mash/DassaultSystemes/ENOVIA-SmarTeam/.

67. ArasCorp. Официальный сайт. [электронный ресурс] http://www.aras.com/solutions/version-9.aspx

68. Система управления инженерными данными и жизненным циклом изделия Лоцман: PLM. [электронный ресурс] http://dds.dn.ua/products/documents/lotsman_plm/index.php?print=Y

69. ИРИСОФТ. Arbortext [электронный ресурс] http://www.irisoft.ru/arbortext.html

70. 3DVIAComposer + ENOVIASmarTeam - PLM решение для разработки интерактивной технической документации. // САПР и графика. -- 2008. -- № 6. -- С. 99-102.

71. ITstan. OLAP-технологии. [электронный ресурс] http://www.itstan.ru/it-i-is/olap-on-line-analytical-processing.html

72. Base Group. Раздел Data Mining. [электронный ресурс] http://www.basegroup.ru/library/methodology/data_mining/

73. SPSS: An IBM Company. [электронный ресурс] http://www.spss.ru/2009/software.htm

74. IBM Product Naming Guide. [электронныйресурс] http://www.spss.com/software/product-name-guide/index.htm?tab=0

75. Пациорковский В. В., Пациорковская В. В. SPSS для социологов. Учебное пособие. -- М.: ИСЭПН РАН, 2005. -- С. 9.



Приложение А

Листинг базы данных

Passport.sql:

# SQL Manager 2007 for MySQL 4.3.3.2

# ---------------------------------------

# Host : localhost

# Port : 3306

# Database : Passport

/*!40101 SET @OLD_CHARACTER_SET_CLIENT=@@CHARACTER_SET_CLIENT */;

/*!40101 SET @OLD_CHARACTER_SET_RESULTS=@@CHARACTER_SET_RESULTS */;

/*!40101 SET @OLD_COLLATION_CONNECTION=@@COLLATION_CONNECTION */;

/*!40101 SET NAMES utf8 */;

SET FOREIGN_KEY_CHECKS=0;

CREATE DATABASE `Passport`

CHARACTER SET 'latin1'

COLLATE 'latin1_swedish_ci';

USE `passport`;

#

# Structure for the `table_1` table :

#

CREATE TABLE `table_1` (

`Номерпараметра` INTEGER(11) NOT NULL AUTO_INCREMENT,

`Значение` INTEGER(11) DEFAULT NULL,

PRIMARY KEY (`Номерпараметра`)

)ENGINE=InnoDB

AUTO_INCREMENT=160 CHARACTER SET 'latin1' COLLATE 'latin1_swedish_ci';

#

# Structure for the `table_2` table :

#

CREATE TABLE `table_2` (

`Номерпараметров` INTEGER(11) NOT NULL AUTO_INCREMENT,

`Назначение` TEXT COLLATE latin1_swedish_ci,

`Координаты` CHAR(20) COLLATE latin1_swedish_ci DEFAULT NULL,

PRIMARY KEY (`Номерпараметров`)

)ENGINE=InnoDB

AUTO_INCREMENT=160 CHARACTER SET 'latin1' COLLATE 'latin1_swedish_ci';

#

# Structure for the `table_3` table :

#

CREATE TABLE `table_3` (

`Номерпараметров` INTEGER(11) NOT NULL AUTO_INCREMENT,

`Примечание` TEXT COLLATE latin1_swedish_ci,

PRIMARY KEY (`Номерпараметров`)

)ENGINE=InnoDB

AUTO_INCREMENT=18 CHARACTER SET 'latin1' COLLATE 'latin1_swedish_ci';

#

# Data for the `table_1` table (LIMIT 0,500)

#

INSERT INTO `table_1` (`Номерпараметра`, `Значение`) VALUES

(1,-480000),

(2,1),

(3,-470000),

(4,1),

(5,-480000),

(6,1),

(7,0),

(8,0),

(9,0),

(10,0),

(11,0),

(12,0),

(13,0),

(14,0),

(15,0),

(16,0),

(17,0),

(18,0),

(19,0),

(20,0),

(21,0),

(22,0),

(23,0),

(24,0),

(25,0),

(26,0),

(27,0),

(28,-30000),

(29,0),

(30,0),

(31,0),

(32,0),

(33,0),

(34,0),

(35,0),

(36,0),

(37,0),

(38,0),

(39,0),

(40,0),

(41,0),

(42,0),

(43,0),

(44,0),

(45,0),

(46,0),

(47,0),

(48,0),

(49,0),

(50,0),

(51,0),

(52,0),

(53,0),

(54,0),

(55,0),

(56,0),

(57,0),

(58,0),

(59,0),

(60,0),

(61,0),

(62,0),

(63,0),

(64,0),

(65,0),

(66,0),

(67,0),

(68,0),

(69,0),

(70,0),

(71,0),

(72,0),

(73,-5000),

(74,28500),

(75,-5000),

(76,0),

(77,0),

(78,0),

(79,0),

(80,0),

(81,0),

(82,0),

(83,0),

(84,0),

(85,0),

(86,0),

(87,0),

(88,0),

(89,0),

(90,0),

(91,0),

(92,1850),

(93,85),

(94,190),

(95,0),

(96,0),

(97,8000),

(98,8000),

(99,8000),

(100,0),

(101,0),

(102,0),

(103,0),

(104,1000),

(105,20),

(106,100),

(107,0),

(108,4000),

(109,600),

(110,600),

(111,600),

(112,0),

(113,0),

(114,0),

(115,0),

(116,100),

(117,2),

(118,5),

(119,0),

(120,500),

(121,500),

(122,200),

(123,6000),

(124,903),

(125,896),

(126,14000),

(127,22000),

(128,0),

(129,20),

(130,500),

(131,2500),

(132,150),

(133,60),

(134,10),

(135,10),

(136,10),

(137,0),

(138,0),

(139,0),

(140,0),

(141,10),

(142,5),

(143,10),

(144,0),

(145,500),

(146,10),

(147,10),

(148,10),

(149,0),

(150,0),

(151,0),

(152,0),

(153,10),

(154,40),

(155,100),

(156,0),

(157,0),

(158,16848),

(159,21845);

COMMIT;

#

# Data for the `table_2` table (LIMIT 0,500)

#

INSERT INTO `table_2` (`Номер параметров`, `Назначение`, `Координаты`) VALUES

(1,NULL,'-x'),

(2,NULL,'+x'),

(3,NULL,'-y'),

(4,NULL,'+y'),

(5,NULL,'-z'),

(6,NULL,'+z'),

(7,NULL,''),

(8,NULL,''),

(9,NULL,''),

(10,NULL,''),

(11,NULL,''),

(12,NULL,''),

(13,NULL,''),

(14,NULL,''),

(15,NULL,'-B'),

(16,NULL,'+B'),

(17,NULL,'-C'),

(18,NULL,'+C'),

(19,NULL,'-T'),

(20,NULL,'+T'),

(21,NULL,NULL),

(22,NULL,NULL),

(23,NULL,NULL),

(24,NULL,NULL),

(25,NULL,'-x'),

(26,NULL,'+x'),

(27,NULL,'-y'),

(28,NULL,'+y'),

(29,NULL,'-z'),

(30,NULL,'+z'),

(31,NULL,NULL),

(32,NULL,NULL),

(33,NULL,NULL),

(34,NULL,NULL),

(35,NULL,NULL),

(36,NULL,NULL),

(37,NULL,NULL),

(38,NULL,NULL),

(39,NULL,'-B'),

(40,NULL,'+B'),

(41,NULL,'-C'),

(42,NULL,'+C'),

(43,NULL,'-T'),

(44,NULL,'+T'),

(45,NULL,NULL),

(46,NULL,NULL),

(47,NULL,NULL),

(48,NULL,NULL),

(49,NULL,'x'),

(50,NULL,'y'),

(51,NULL,'z'),

(52,NULL,NULL),

(53,NULL,NULL),

(54,NULL,NULL),

(55,NULL,NULL),

(56,NULL,'B'),

(57,NULL,'C'),

(58,NULL,'T'),

(59,NULL,NULL),

(60,NULL,NULL),

(61,NULL,'x'),

(62,NULL,'y'),

(63,NULL,'z'),

(64,NULL,NULL),

(65,NULL,NULL),

(66,NULL,NULL),

(67,NULL,NULL),

(68,NULL,'B'),

(69,NULL,'C'),

(70,NULL,'T'),

(71,NULL,NULL),

(72,NULL,NULL),

(73,NULL,'x'),

(74,NULL,'y'),

(75,NULL,'z'),

(76,NULL,NULL),

(77,NULL,NULL),

(78,NULL,NULL),

(79,NULL,NULL),

(80,NULL,'B'),

(81,NULL,'C'),

(82,NULL,'T'),

(83,NULL,NULL),

(84,NULL,NULL),

(85,NULL,'x'),

(86,NULL,'y'),

(87,NULL,'z'),

(88,NULL,NULL),

(89,NULL,NULL),

(90,NULL,NULL),

(91,NULL,NULL),

(92,NULL,'B'),

(93,NULL,'C'),

(94,NULL,'T'),

(95,NULL,NULL),

(96,NULL,NULL),

(97,NULL,'x'),

(98,NULL,'y'),

(99,NULL,'z'),

(100,NULL,NULL),

(101,NULL,NULL),

(102,NULL,NULL),

(103,NULL,NULL),

(104,NULL,'B'),

(105,NULL,'C'),

(106,NULL,'T'),

(107,NULL,NULL),

(108,NULL,'contour'),

(109,NULL,'x'),

(110,NULL,'y'),

(111,NULL,'z'),

(112,NULL,NULL),

(113,NULL,NULL),

(114,NULL,NULL),

(115,NULL,NULL),

(116,NULL,'B'),

(117,NULL,'C'),

(118,NULL,'T'),

(119,NULL,NULL),

(120,NULL,NULL),

(121,NULL,NULL),

(122,NULL,NULL),

(123,NULL,NULL),

(124,NULL,NULL),

(125,NULL,NULL),

(126,NULL,NULL),

(127,NULL,NULL),

(128,NULL,NULL),

(129,NULL,NULL),

(130,NULL,NULL),

(131,NULL,NULL),

(132,NULL,NULL),

(133,NULL,NULL),

(134,NULL,'x'),

(135,NULL,'y'),

(136,NULL,'z'),

(137,NULL,NULL),

(138,NULL,NULL),

(139,NULL,NULL),

(140,NULL,NULL),

(141,NULL,'B'),

(142,NULL,'C'),

(143,NULL,'T'),

(144,NULL,NULL),

(145,NULL,NULL),

(146,NULL,'x'),

(147,NULL,'y'),

(148,NULL,'z'),

(149,NULL,NULL),

(150,NULL,NULL),

(151,NULL,NULL),

(152,NULL,NULL),

(153,NULL,'B'),

(154,NULL,'C'),

(155,NULL,'T'),

(156,NULL,NULL),

(157,NULL,NULL),

(158,NULL,NULL),

(159,NULL,'21845');

COMMIT;

#

# Data for the `table_3` table (LIMIT 0,500)

#

INSERT INTO `table_3` (`Номерпараметров`, `Примечание`) VALUES

(1,NULL),

(2,NULL),

(3,NULL),

(4,'0');

COMMIT;

/*!40101 SET CHARACTER_SET_CLIENT=@OLD_CHARACTER_SET_CLIENT */;

/*!40101 SET CHARACTER_SET_RESULTS=@OLD_CHARACTER_SET_RESULTS */;

/*!40101 SET COLLATION_CONNECTION=@OLD_COLLATION_CONNECTION */;

tables.sql:

#

# Structure for the `table_1` table :

#

CREATE TABLE `table_1` (

`Номер параметра` INTEGER(11) NOT NULL AUTO_INCREMENT,

`Значение` INTEGER(11) DEFAULT NULL,

PRIMARY KEY (`Номер параметра`),

KEY `Значение` (`Значение`)

)ENGINE=InnoDB

AUTO_INCREMENT=160 CHARACTER SET 'latin1' COLLATE 'latin1_swedish_ci';

#

# Structure for the `table_2` table :

#

CREATE TABLE `table_2` (

`Номер параметров` INTEGER(11) NOT NULL AUTO_INCREMENT,

`Назначение` TEXT COLLATE latin1_swedish_ci,

`Координаты` CHAR(20) COLLATE latin1_swedish_ci DEFAULT NULL,

PRIMARY KEY (`Номер параметров`)

)ENGINE=InnoDB

AUTO_INCREMENT=160 CHARACTER SET 'latin1' COLLATE 'latin1_swedish_ci';

#

# Structure for the `table_3` table :

#

CREATE TABLE `table_3` (

`Номер параметров` INTEGER(11) NOT NULL AUTO_INCREMENT,

`Примечание` TEXT COLLATE latin1_swedish_ci,

PRIMARY KEY (`Номер параметров`)

)ENGINE=InnoDB

AUTO_INCREMENT=18 CHARACTER SET 'latin1' COLLATE 'latin1_swedish_ci';

механический обработка изделие программный



Приложение Б

Листинг программного средства

Mikro_1.dpr :

program Mikro_1;

uses

Forms,

Unit_micro_1 in 'Unit_micro_1.pas' {Form1},

CommunicationObj in 'CommunicationObj.pas';

{$R *.RES}

begin

Application.Initialize;

Application.CreateForm(TForm1, Form1);

Application.Run;

end.

CommunicationObj.pas :

{ модуль работы с последовательным портом }

unit CommunicationObj;

interface

uses windows;

{ Сообщения об ошибках в модуле Communication }

type

CommNames=(com1,com2,com3,com4);

BA30=array[1..30] of byte;

TVirtualPort=class

{ код последней ошибки COM - порта }

ComErr : byte;

{ число записанных последней записью в порт байтов }

Wrbytes : dword;

{ число считанных последним чтением из порта байтов }

Rdbytes : dword;

{ Имя COM -порта }

ComN:CommNames;

{ виртуальный приёмный буфер Com - порта}

VirtualInBuffer:BA30;

{ виртуальный выходной буфер Com - порта}

VirtualOutBuffer:BA30;

{ Вывести байт в виртуальный порт }

{ байт во виртуальном входном буфере }

BIVIB:byte;

{ байт в виртуальном выходном буфере }

BIVOB:byte;

VirtualError:byte;

{ Ввести байт с виртуального порта }

procedure SendByte(outbyte:byte);

{ значение ошибки виртуального порта }

function ReceiveByte:byte;

{ Установить ошибку виртуального порта }

procedure SetVirtualError(ErrNum:byte);

{ Com - портужеоткрыт }

class function Opened(nm:CommNames):boolean;

{ открыть COM -порт }

constructor Open(name:CommNames);

{ закрыть COM - порт }

destructor Close;

{ настроить COM - порт }

function Init(writebuf,readbuf,BR,BS,Pr,SB:word):boolean;

{ Вывестив COM - порт }

function writeb(DB:byte):boolean;

{ Вывести n-байт в COM - порт }

function write(outdata:pointer;n:word):boolean;

{ Ввести байт из COM- порта }

function readb(var indata:byte):boolean;

{ Ввести n-байт из COM - порта }

function read(indata:pointer):boolean;

{ Возвращает число байт во входном буфере }

function GetReadQue(var number:dword):boolean;

{ Возвращает число байт во выходном буфере}

function GetWriteQue(var number:dword):boolean;

{ Возвращает код ошибки COM - порта }

function Err:string;

end;

TSerialPort=class(TVirtualPort)

{ код последней ошибки COM - порта }

ComErr : byte;

{ дескритор COM - порта }

hCom : tHandle;

{ device control block -блокконтроляустройства }

DCB : tDCB;

{ Status Com-порта}

Stat : tComStat;

{ число записанных последней записью в порт байтов }

Wrbytes : dword;

{ число считанных последним чтением из порта байтов }

Rdbytes : dword;

{ Com - порт уже открыт }

ComN:CommNames; { номер }

{ Начальное значение времени }

TOInitvalue:cardinal;

{ величина Tайм - аута }

TimeOut:cardinal;

{ открыть COM -порт }

class function Opened(nm:CommNames):boolean;

constructor Open(name:CommNames);

{ закрыть COM - порт }

destructor Close;

{ настроить COM - порт }

function Init(writebuf,readbuf,BR,BS,Pr,SB:word):boolean;

{ Вывестив COM - порт }

function writeb(DB:byte):boolean;

{ задатьТайм-аут }

procedure TimeOutSet(T:cardinal);

{ проверитьнаступлениеТайм-аута }

function TimeoutCheck:boolean;

{ Вывести n-байт в COM - порт }

function write(outdata:pointer;n:word):boolean;

{ Ввести байт из COM- порта }

function readb(var indata:byte):boolean;

{ Ввести n-байт из COM - порта }

function readN(indata:pointer;n:word):boolean;

{ Ввести все байты из буфера COM - порта }

function read(indata:pointer):boolean;

{ Возвращает число байт во входном буфере }

function GetReadQue(var number:dword):boolean;

{ Возвращает число байт во выходном буфере}

function GetWriteQue(var number:dword):boolean;

{ Возвращает код ошибки COM - порта }

function Err:string;

private

procedure TimeOutReset;

end;

implementation

uses SysUtils;

var

OCP:set of CommNames; { множествооткрытых COM - портов }

{ РЕАЛИЗАЦИЯ КЛАССА VIRTUALPORT }

{ открыть COM -порт }

constructor TVirtualPort.Open(name:CommNames);

begin

If TSerialPort.Opened(name) then exit;

inherited Create;

If VirtualError=1 then

begin

ComErr:=1; { Ошибка инициализации порта}

exit;

end;

end;

{ настроить COM - порт }

function TVirtualPort.Init(writebuf,readbuf,BR,BS,Pr,SB:word):boolean;

begin

result:=false;

If VirtualError=2 then

begin

ComErr:=2; { Ошибка выделения буферов обмена }

exit;

end;

result:=true;

end;

{ записатьданныевпорт }

function TVirtualPort.write(outdata:pointer;n:word):boolean;

type pba=^ba30;

var i:byte;

begin

result:=false;

If VirtualError=3 then

begin

ComErr:=3; {Ошибкафункции ClearCommState }

exit;

end;

If VirtualError=4 then

begin

ComErr:=4; { ошибкаканаласвязи }

exit;

end;

{For i:=1 to n do}

VirtualInBuffer:=pba(outdata)^;

BIVIB:=n;

Wrbytes:=n;

result:=true;

end;

{ записать один байт в порт }

function TVirtualPort.Writeb(DB:byte):boolean;

begin

result:=false;

If VirtualError=3 then

begin

ComErr:=3; {Ошибкафункции ClearCommState }

exit;

end;

If VirtualError=4 then { ошибкаканаласвязи }

begin

ComErr:=4; { Запись невозможна}

exit;

end;

If BIVIB>=30 then exit;

inc(BIVIB);

VirtualInBuffer[BIVIB]:=DB;

wrbytes:=1;

result:=true;

end;

{ считать данные из порта }

function TVirtualPort.Read(indata:pointer):boolean;

type pba=^ba30;

begin

result:=false;

repeat { ожидаем данные во входном буфере }

If VirtualError=3 then

begin

ComErr:=3; {Ошибкафункции ClearCommState }

exit;

end;

If VirtualError=4 then { ошибкаканаласвязи }

begin

ComErr:=4; { Запись невозможна}

exit;

end;

until BIVOB<>0;

pba(indata)^:=VirtualOutBuffer;

Rdbytes:=BIVOB;

BIVOB:=0;

result:=true;

end;

{ считать один байт из порта }

function TVirtualPort.Readb(var indata:byte):boolean;

var i:byte;

begin

result:=false;

repeat { ожидаем данные во входном буфере }

If VirtualError=3 then

begin

ComErr:=3; {Ошибкафункции ClearCommState }

exit;

end;

If VirtualError=4 then

begin

ComErr:=4; { ошибка канала связи }

exit;

end;

until BIVOB<>0;

indata:=VirtualOutBuffer[1];

dec(BIVOB);

i:=2;

while i<=BIVOB do

begin

VirtualOutBuffer[i-1]:=VirtualOutBuffer[i];

inc(i);

end;

rdbytes:=1;

result:=true;

end;

{ Возвращает число байт во входном буфере }

function TVirtualPort.GetReadQue(var number:dword):boolean;

var Cerr:dword;

begin

result:=false;

If VirtualError=3 then

begin

ComErr:=3; {Ошибкафункции ClearCommState }

exit;

end;

If VirtualError=4 then

begin

ComErr:=4; { ошибка канала связи }

exit;

end;

number:=BIVOB;

result:=true;

end;

{ Возвращает число байт во выходном буфере}

function TVirtualPort.GetWriteQue(var number:dword):boolean;

var Cerr:dword;

begin

result:=false;

If VirtualError=3 then

begin

ComErr:=3; {Ошибкафункции ClearCommState }

exit;

end;

If VirtualError=4 then

begin

ComErr:=4; { ошибка канала связи }

exit;

end;

number:=0;

result:=true;

end;

{ закрытьпорт }

destructor TVirtualPort.Close;

begin

If ComN in OCP then OCP:=OCP-[ComN];

end;

{ функция возвращает строку ошибки }

function TVirtualPort.Err:string;

const

ComErrMessage : array [1..4] of string[40]=('Ошибкаинициализациипорта',

'Ошибканастройкипорта','ClearCommState,WriteFile идр. ошибка ',

'Ошибка канала связи');

begin

result:='';

If ComErr=0 then exit;

result:='Com'+inttostr(ord(ComN)+1)+':'+ComErrMessage[ComErr];

end;

class function TVirtualPort.Opened(nm:CommNames):boolean;

begin

result:=true;

If NM in OCP then exit;

result:=false;

OCP:=OCP+[NM];

end;

procedure TVirtualPort.SetVirtualError(ErrNum:byte);

begin

VirtualError:=ErrNum;

end;

procedure TVirtualPort.SendByte(outbyte:byte);

begin

inc(BIVOB);

VirtualOutBuffer[BIVOB]:=outbyte;

end;

function TVirtualPort.ReceiveByte:byte;

var i:byte;

begin

result:=0;

If BIVIB=0 then exit;

result:=VirtualInBuffer[1];

For i:=2 to BIVIB do VirtualInBuffer[i-1]:=VirtualInBuffer[i];

dec(BIVIB);

end;

{ РЕАЛИЗАЦИЯКЛАССА TSERIALPORT }

{ открыть COM -порт }

constructor TSerialPort.Open(name:CommNames);

begin

If TSerialPort.Opened(name) then exit;

inherited Create;

ComN:=name;

hCom:=CreateFile(PChar(string('COM')+InttoStr(ord(ComN)+1)), GENERIC_READ or GENERIC_WRITE,

0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);

if hCom=INVALID_HANDLE_VALUE then

begin

ComErr:=1; { Ошибка инициализации порта}

exit;

end;

TimeOut:=1000; { тайм-аут по умолчанию - 1 сек }

end;

{ настроить COM - порт }

function TSerialPort.Init(writebuf,readbuf,BR,BS,Pr,SB:word):boolean;

begin

result:=false;

If not(SetupComm(hCom,readbuf,writebuf))then

begin

ComErr:=2; { Ошибка выделения буферов обмена }

exit;

end;

{ зададим блок контроля устройства }

with DCB do

begin

BaudRate:=Br{9600};

ByteSize:=BS{8};

Parity:=Pr{noParity};

StopBits:=SB{TwoStopBits};

end;

If not(SetCommState(hCom,DCB))then

begin

ComErr:=2; { Ошибка настройки порта}

exit;

end;

result:=true;

end;

{ записатьданныевпорт }

function TSerialPort.write(outdata:pointer;n:word):boolean;

var Cerr:dword;

begin

result:=false;

repeat { ожидаем полного освобождения выходного буфера }

If not ClearCommError(hCom,CErr,@Stat) then

begin

ComErr:=3; {Ошибкафункции ClearCommState }

exit;

end;

If CErr<>0 then

begin

ComErr:=4; { ошибкаканаласвязи }

exit;

end;

until Stat.CbOutQue=0;

If Not(WriteFile(hCom,outdata^,n,wrbytes,nil)) then

begin

ComErr:=3; {Ошибкафункции WriteFile}

exit;

end;

result:=true;

end;

{ записать один байт в порт }

function TSerialPort.Writeb(DB:byte):boolean;

var Cerr:dword;

begin

result:=false;

repeat { ожидаем полного освобождения выходного буфера }

If not ClearCommError(hCom,CErr,@Stat) then

begin

ComErr:=3; {Ошибкафункции ClearCommState }

exit;

end;

If CErr<>0 then { ошибкаканаласвязи }

begin

ComErr:=4; { Запись невозможна}

exit;

end;

until (Stat.CbOutQue=0){ and (Stat.CbInQue=0)};

If not WriteFile(hCom,DB,1,wrbytes,nil) then

begin

ComErr:=3; {Ошибкафункции WriteFile}

exit;

end;

result:=true;

end;

{ считатьданныеизпорта }

function TSerialPort.Read(indata:pointer):boolean;

var Cerr:dword;

begin

TimeOutReset; { сброситьтайм-аут }

result:=false;

repeat { ожидаем данные во входном буфере }

If not ClearCommError(hCom,CErr,@Stat) then

begin

ComErr:=3; {Ошибкафункции ClearCommState }

exit;

end;

If CErr<>0 then { ошибкаканаласвязи }

begin

ComErr:=4; { Запись невозможна}

exit;

end;

If TimeOutCheck then

exit; { Ошибка}

until Stat.CbInQue<>0;

If not ReadFile(hCom,indata^,Stat.cbinQue,Rdbytes,nil) then

begin

ComErr:=3;{ ошибкафункции ReadFile }

exit;

end;

result:=true;

end;

{ считатьданныеизпорта }

function TSerialPort.ReadN(indata:pointer;N:word):boolean;

var Cerr:dword;

begin

result:=false;

TimeOutReset; { сбросить тайм-аут }

repeat { ожидаем данные во входном буфере }

If not ClearCommError(hCom,CErr,@Stat) then

begin

ComErr:=3; {Ошибкафункции ClearCommState }

exit;

end;

If CErr<>0 then { ошибкаканаласвязи }

begin

ComErr:=4; { Запись невозможна}

exit;

end;

If TimeOutCheck then

exit; { Ошибка}

until Stat.CbInQue>=N; { выходим из вертушки. когда число бит в очереди>=заданному для считывания }

If not ReadFile(hCom,indata^,N,Rdbytes,nil) then

begin

ComErr:=3;{ ошибкафункции ReadFile }

exit;

end;

result:=true;

end;

{ считать один байт из порта }

function TSerialPort.Readb(var indata:byte):boolean;

var Cerr:dword;

begin

result:=false;

TimeOutReset;

repeat { ожидаем данные во входном буфере }

If not ClearCommError(hCom,CErr,@Stat) then

begin

ComErr:=3; {Ошибкафункции ClearCommState }

exit;

end;

If CErr<>0 then

begin

ComErr:=4; { ошибкаканаласвязи }

exit;

end;

If TimeOutCheck then

exit; { ошибкатайм - аута }

until Stat.CbInQue<>0;

If not ReadFile(hCom,indata,1,Rdbytes,nil) then

begin

ComErr:=3; { Ошибкафункции ReadFile }

exit;

end;

result:=true;

end;

{ Возвращает число байт во входном буфере }

function TSerialPort.GetReadQue(var number:dword):boolean;

var Cerr:dword;

begin

result:=false;

If not ClearCommError(hCom,CErr,@Stat) then

begin

ComErr:=3; {Ошибкафункции ClearCommState }

exit;

end;

If CErr<>0 then

begin

ComErr:=4; { ошибкаканаласвязи }

exit;

end;

number:=Stat.CbInQue;

result:=true;

end;

{ Возвращает число байт во выходном буфере}

function TSerialPort.GetWriteQue(var number:dword):boolean;

var Cerr:dword;

begin

result:=false;

If not ClearCommError(hCom,CErr,@Stat) then

begin

ComErr:=3; { Ошибкафункции ClearCommState }

exit;

end;

If CErr<>0 then

begin

ComErr:=4; { ошибкаканаласвязи }

exit;

end;

number:=Stat.CbOutQue;

result:=true;

end;

{ закрытьпорт }

destructor TSerialPort.Close;

begin

If ComN in OCP then OCP:=OCP-[ComN];

inherited Destroy;

end;

{ функция возвращает строку ошибки }

function TSerialPort.Err:string;

const

ComErrMessage : array [1..4] of string[40]=('Ошибкаинициализациипорта',

'Ошибканастройкипорта','ClearCommState,WriteFile идр. ошибка ',

'Ошибка канала связи');

begin

result:='';

If ComErr=0 then exit;

result:='Com'+inttostr(ord(ComN)+1)+':'+ComErrMessage[ComErr];

end;

class function TSerialPort.Opened(nm:CommNames):boolean;

begin

result:=true;

If NM in OCP then exit;

result:=false;

OCP:=OCP+[NM];

end;

procedure TSerialPort.TimeOutSet(T: cardinal);

begin

TimeOut:=T;

end;

procedure TSerialPort.TimeOutReset;

begin

TOInitValue:=GetTickCount; { получитьтекущеесистемноевремя (числотиков) }

end;

function TSerialPort.TimeoutCheck: boolean;

begin

result:=false;

If (GetTickCount-TOInitvalue)<Timeout then exit;

result:=true;

ComErr:=5; { ошибкатайм-аута }

end;

end.

ddkint.pas :

{$A-,H-}

unit ddkint;

interface

uses windows,winsvc;

function CTL_CODE(const DeviceType,Func,Method,Access:Cardinal):cardinal;

const

FILE_DEVICE_BEEP = $00000001;

FILE_DEVICE_CD_ROM = $00000002;

FILE_DEVICE_CD_ROM_FILE_SYSTEM = $00000003;

FILE_DEVICE_CONTROLLER = $00000004;

FILE_DEVICE_DATALINK = $00000005;

FILE_DEVICE_DFS = $00000006;

FILE_DEVICE_DISK = $00000007;

FILE_DEVICE_DISK_FILE_SYSTEM = $00000008;

FILE_DEVICE_FILE_SYSTEM = $00000009;

FILE_DEVICE_INPORT_PORT = $0000000a;

FILE_DEVICE_KEYBOARD = $0000000b;

FILE_DEVICE_MAILSLOT = $0000000c;

FILE_DEVICE_MIDI_IN = $0000000d;

FILE_DEVICE_MIDI_OUT = $0000000e;

FILE_DEVICE_MOUSE = $0000000f;

FILE_DEVICE_MULTI_UNC_PROVIDER = $00000010;

FILE_DEVICE_NAMED_PIPE = $00000011;

FILE_DEVICE_NETWORK = $00000012;

FILE_DEVICE_NETWORK_BROWSER = $00000013;

FILE_DEVICE_NETWORK_FILE_SYSTEM= $00000014;

FILE_DEVICE_NULL = $00000015;

FILE_DEVICE_PARALLEL_PORT = $00000016;

FILE_DEVICE_PHYSICAL_NETCARD = $00000017;

FILE_DEVICE_PRINTER = $00000018;

FILE_DEVICE_SCANNER = $00000019;

FILE_DEVICE_SERIAL_MOUSE_PORT = $0000001a;

FILE_DEVICE_SERIAL_PORT = $0000001b;

FILE_DEVICE_SCREEN = $0000001c;

FILE_DEVICE_SOUND = $0000001d;

FILE_DEVICE_STREAMS = $0000001e;

FILE_DEVICE_TAPE = $0000001f;

FILE_DEVICE_TAPE_FILE_SYSTEM = $00000020;

FILE_DEVICE_TRANSPORT = $00000021;

FILE_DEVICE_UNKNOWN = $00000022;

FILE_DEVICE_VIDEO = $00000023;

FILE_DEVICE_VIRTUAL_DISK = $00000024;

FILE_DEVICE_WAVE_IN = $00000025;

FILE_DEVICE_WAVE_OUT = $00000026;

FILE_DEVICE_8042_PORT = $00000027;

FILE_DEVICE_NETWORK_REDIRECTOR = $00000028;

FILE_DEVICE_BATTERY = $00000029;

FILE_DEVICE_BUS_EXTENDER = $0000002a;

FILE_DEVICE_MODEM = $0000002b;

FILE_DEVICE_VDM = $0000002c;

FILE_DEVICE_MASS_STORAGE = $0000002d;

FILE_DEVICE_SMB = $0000002e;

FILE_DEVICE_KS = $0000002f;

FILE_DEVICE_CHANGER = $00000030;

FILE_DEVICE_SMARTCARD = $00000031;

FILE_DEVICE_ACPI = $00000032;

FILE_DEVICE_DVD = $00000033;

FILE_DEVICE_FULLSCREEN_VIDEO = $00000034;

FILE_DEVICE_DFS_FILE_SYSTEM = $00000035;

FILE_DEVICE_DFS_VOLUME = $00000036;

FILE_DEVICE_SERENUM = $00000037;

FILE_DEVICE_TERMSRV = $00000038;

FILE_DEVICE_KSEC = $00000039;

FILE_DEVICE_KRNLDRVR = $80ff;

METHOD_BUFFERED = 0;

METHOD_IN_DIRECT = 1;

METHOD_OUT_DIRECT = 2;

METHOD_NEITHER = 3;

FILE_ANY_ACCESS = 0;

FILE_SPECIAL_ACCESS = (FILE_ANY_ACCESS);

FILE_READ_ACCESS = ( $0001 ); // file & pipe

FILE_WRITE_ACCESS = ( $0002 ); // file & pipe

{$IFDEF VER100 or VER110}

const

SERVICE_KERNEL_DRIVER = $00000001;

SERVICE_DEMAND_START = $00000003;

SERVICE_ERROR_NORMAL = $00000001;

{$ENDIF}

function driverstart(const name:pchar):integer;

function driverstop(const name:pchar):integer;

function driverinstall(const path,name:pchar):integer;

function driverremove(const name:pchar):integer;

function messagestring(const error:integer):string;

implementation

function CTL_CODE(const DeviceType,Func,Method,Access:Cardinal):cardinal;

begin

Result := DeviceType shl 16 or Access shl 14 or Func shl 2 or Method;

end;

function driverinstall(const path,name:pchar):integer;

var hService: SC_HANDLE;

hSCMan : SC_HANDLE;

begin

Result := 0;

hSCMan := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);

if hSCMan = 0 then begin

result := getlasterror;

exit;

end;

hService := CreateService(hSCMan, name,name,

SERVICE_ALL_ACCESS, SERVICE_KERNEL_DRIVER, SERVICE_DEMAND_START,

SERVICE_ERROR_NORMAL, path,

nil, nil, nil, nil, nil);

if (hService = 0) then begin

result := getlasterror;

CloseServiceHandle(hSCMan);

exit;

end

else

CloseServiceHandle(hService);

CloseServiceHandle(hSCMan);

end;

function driverstart(const name:pchar):integer;

var

hService: SC_HANDLE;

hSCMan : SC_HANDLE;

args:pchar;

begin

hSCMan := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);

if hSCMan = 0 then begin

result := getlasterror;

exit;

end;

hService := OpenService(hSCMan, name, SERVICE_START);

if hService <> 0 then Begin

// start the driver

args := nil;

Result := 0;

if integer(StartService(hService, 0, args ))=0 then

result := getlasterror;

CloseServiceHandle(hService);

end

else

result := getlasterror;

CloseServiceHandle(hSCMan);

end;

function driverstop(const name:pchar):integer;

Var

serviceStatus: TServiceStatus;

hService: SC_HANDLE;

hSCMan : SC_HANDLE;

begin

hSCMan := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);

if hSCMan = 0 then begin

result := getlasterror;

exit;

end;

hService := OpenService(hSCMan, Name, SERVICE_STOP);

if hService <> 0 then Begin

// start the driver

Result := 0;

if integer(ControlService(hService, SERVICE_CONTROL_STOP, serviceStatus))=0 then

result := getlasterror;

CloseServiceHandle(hService);

end

else

result := getlasterror;

CloseServiceHandle(hSCMan);

end;

function driverremove(const name:pchar):integer;

Var

hService: SC_HANDLE;

hSCMan : SC_HANDLE;

begin

hSCMan := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);

if hSCMan = 0 then begin

result := getlasterror;

exit;

end;

hService := OpenService(hSCMan, Name, SERVICE_ALL_ACCESS);

if hService <> 0 then Begin

Result := 0;

if integer(DeleteService(hService)) = 0 then

result := getlasterror;

CloseServiceHandle(hService);

end

else

result := getlasterror;

CloseServiceHandle(hSCMan);

end;

function messagestring(const error:integer):string;

var p:pchar;

begin

GetMem(p, 200);

FillChar(p^, 200, 0);

formatmessage(FORMAT_MESSAGE_FROM_SYSTEM,nil,error,0,p,199,nil);

Result := p;

freemem(p,200);

end;

end.

Unit_micro_1.pas :

unit Unit_micro_1;

interface

uses

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

StdCtrls,zlportio, ComCtrls, shellapi, ExtCtrls ;

{rdtsc,StdCtrls}

type

TForm1 = class(TForm)

Timer1: TTimer;

Button11: TButton; Button7: TButton;

Button8: TButton; Button12: TButton;

Button13: TButton;

Panel1: TPanel;

Panel2: TPanel;

Panel3: TPanel;

Ed1: TEdit;

Ed2: TEdit;

Shape1: TShape;

Edt3: TEdit;

Edt4: TEdit;

Shape2: TShape;

Edit5: TEdit;

Edit6: TEdit;

Edit1: TEdit;

Edit2: TEdit;

Button1: TButton;

Button2: TButton;

Button3: TButton;

Button4: TButton;

Button5: TButton;

Button6: TButton;

Button9: TButton;

Button10: TButton;

Button14: TButton;

Label2: TLabel;

Label1: TLabel;

Panel8: TPanel;

Panel4: TPanel;

Panel5: TPanel;

Panel6: TPanel;

Panel7: TPanel;

procedure FormCreate(Sender: TObject);

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

procedure Timer1Timer(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure Button7Click(Sender: TObject);

procedure Button11Click(Sender: TObject);

Procedure Clear_count;

Procedure Ind_x_plus;

Procedure Ind_x_minus;

Procedure Ind_y_plus;

Procedure Ind_y_minus;

procedure Button12Click(Sender: TObject);

procedure Button8Click(Sender: TObject);

procedure Button13Click(Sender: TObject);

procedure FormKeyPress(Sender: TObject; var Key: Char);

procedure Button2Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure Button4Click(Sender: TObject);

procedure Button5Click(Sender: TObject);

procedure Button6Click(Sender: TObject);

procedure Button9Click(Sender: TObject);

procedure Button10Click(Sender: TObject);

procedure Button14Click(Sender: TObject);

procedure X_minus;

procedure X_plus;

procedure Y_minus;

procedure Y_plus;

procedure Panel4Click(Sender: TObject);

procedure Panel5Click(Sender: TObject);

procedure Panel6Click(Sender: TObject);

procedure Panel7Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

jwr,jwr1,rb:byte;

flg_ind, flag_dir : boolean;

switch_timer, rbt, Port,data:byte;

n_byte:integer;

Buf_1,Buf_2: byte;

Buf_x,Buf_y: real;

mask_x,mask_y: byte;

count_x,count_y: longint;

x_l, x_m, x_h: byte;

y_l, y_m, y_h: byte;

x_1, x_2, x_3: longint;

y_1, y_2, y_3: longint;

str_x:string;

S,T: string;

implementation

uses CommunicationObj;

var

FileHandle : Integer;

port1:TserialPort;

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

begin

Port1:=TserialPort.Open(Com1);

Port1.Init(100,100,9600,8,Noparity,TwoStopBits);

Port1.TimeOutSet(2800);

jwr:=10; jwr1:=222; flg_ind:=false;

switch_timer:=0; n_byte:=0;

rb:=0; rbt:=200;

mask_x:=3; mask_y:=12;

Port:=0; flag_dir:=true;

count_x:=0; count_y:=0;

Ed1.Text:='000';

Ed2.Text:='000';

Edt3.Text:='0000';

Edt4.Text:='0000';

Timer1.Enabled:=true;

flg_ind:=false;

x_l:=0; x_m:=0; x_h:=240;

y_l:=0; y_m:=0; y_h:=240;

Label1.Caption:='';

Label2.Caption:='';

end;

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

begin

Port1.Close;

end;

procedure TForm1.Timer1Timer(Sender: TObject);

var i,b:byte;

rb:byte; rb1:byte; n1: integer; N:cardinal; T: cardinal;

begin

if not (flg_ind) then begin

{Timer1.Enabled:=false;{}

jwr:=4; {кодпроверкаканалас PIC }

Port1.writeb(jwr);

flg_ind:=true;

{X_minus;} {Y_minus;} {X_plus;} {Y_plus; }

if ((x_h and 15)<8) then Ind_x_plus

else Ind_x_minus;

if ((y_h and 15)<8) then Ind_y_plus

else Ind_y_minus;

end

else begin

flg_ind:=false;

Port1.GetReadQue(N);

If N<7 then exit;

Port1.readb(Buf_1);

Port1.readb(x_l);

Port1.readb(x_m);

Port1.readb(x_h);

Port1.readb(y_l);

Port1.readb(y_m);

Port1.readb(y_h);

end;

end;{begin procedure TForm1.Timer1Timer}

procedure TForm1.Button3Click(Sender: TObject);

var i :integer;

begin

i:=1;

while i<11 do begin

if (x_l=0) then begin

x_l:=255;

if x_m=0 then begin

x_m:=255;

if x_h=240 then x_h:=255

else x_h:=x_h-1;

end {if x_m=255 then begin}

else x_m:=x_m-1;

end {if (x_l=255) then begin}

else x_l:=x_l-1;

i:=i+1;

end;{while}

end; {procedure TForm1.Button3Click}

procedure TForm1.Button11Click(Sender: TObject);

var i,N:cardinal; k:integer; n1:real; rb:byte; j: byte;

begin

Clear_count;

end; {procedure TForm1.Button11Click}

procedure TForm1.Button7Click(Sender: TObject);

{ п\п генерации +1 х}

var nx: byte;

begin

if (x_l=255) then begin

x_l:=0;

if x_m=255 then begin

x_h:=x_h+1;

if x_h=0 then x_h:=240;

x_m:=0;

end

else x_m:=x_m+1;

end

else x_l:=x_l+1;

end; {procedure TForm1.Button7Click}

Procedure TForm1.Clear_count;

begin

jwr:=3; {сброссчетчиков }

Port1.writeb(jwr);

flg_ind:=true;

x_l:=0; x_m:=0; x_h:=240;

y_l:=0; y_m:=0; y_h:=240;

{}

end;

Procedure TForm1.Ind_x_plus;

begin

Edit1.Text:='+';

x_1:=x_l; x_2:=x_m; x_3:=x_h-240;

count_x:=x_1+256*(x_2+256*x_3);

Buf_x:=count_x*0.0005;

{Label1.Caption:='X:'+floattostrF(Buf_x,ffGeneral,8,4); }

if (Trunc(Buf_x)>=100) then str_x:=' ';

if (Trunc(Buf_x)<100) then str_x:=' 0';

if (Trunc(Buf_x)<10) then str_x:=' 00';

if (Trunc(Buf_x)=0) then str_x:=' 00';

Ed1.Text:=str_x+IntToStr(Trunc((Buf_x)));

Buf_y:=(Buf_x-Trunc(Buf_x))*10000;

{ R := Frac(123.456); { 0.456 }

{ R := Frac(-123.456); { -0.456 }

Buf_y:=Frac(Buf_x)*10000;

if (Trunc(Buf_y)>=999) then str_x:='';

if (Trunc(Buf_y)<1000) then str_x:='0';

if (Trunc(Buf_y)<100) then str_x:='00';

if (Trunc(Buf_y)<10) then str_x:='000';

if (Trunc(Buf_y)=0) then str_x:='000';

Edt3.Text:=str_x+IntToStr(Round(Buf_y));

Buf_y:= StrToInt(Ed1.Text);

Buf_y:=Buf_y+ (StrToFloat(Edt3.Text))/10000.0;

if Buf_y<>Buf_x then begin

{S :=' несовпадение '+ #13#10;

S :=S+' должнобыть '+FloatToStrF(Buf_x,ffGeneral,7,4)+' '+ #13#10;

S :=S+' наиндикации '+FloatToStrF(Buf_y,ffGeneral,7,4)+' '+ #13#10;

MessageDlg(S, mtInformation, [mbOk], 0);}

Label2.Caption:='ошибках: '+floattostrF(Buf_y,ffGeneral,8,4);

Label2.Caption:=Label2.Caption+' должнобыть - '+floattostrF(Buf_x,ffGeneral,8,4);

end;

end;{TForm1.Ind_x_plus;}

Procedure TForm1.Ind_x_minus;

begin

Edit1.Text:=' -';

x_1:=255-x_l+1; x_2:=255-x_m; x_3:=255-x_h;

count_x:=x_1+256*(x_2+256*x_3);

Buf_x:=count_x*0.0005;

if (Trunc(Buf_x)>=100) then str_x:=' ';

if (Trunc(Buf_x)<100) then str_x:=' 0';

if (Trunc(Buf_x)<10) then str_x:=' 00';

if (Trunc(Buf_x)=0) then str_x:=' 00';

Ed1.Text:=str_x+IntToStr(Trunc(Buf_x));

Buf_y:=(Buf_x-Trunc(Buf_x))*10000;

Buf_y:=Frac(Buf_x)*10000;

if (Trunc(Buf_y)>=999) then str_x:='';

if (Trunc(Buf_y)<1000) then str_x:='0';

if (Trunc(Buf_y)<100) then str_x:='00';

if (Trunc(Buf_y)<10) then str_x:='000';

if (Trunc(Buf_y)=0) then str_x:=' 000';

Edt3.Text:=str_x+IntToStr(Round(Buf_y));

Buf_y:= StrToInt(Ed1.Text);

Buf_y:=Buf_y+ StrToFloat(Edt3.Text)/10000.0;

if Buf_y<>Buf_x then begin

{S :=' несовпадение '+ #13#10;

S :=S+' должнобыть '+FloatToStrF(Buf_x,ffGeneral,7,4)+' '+ #13#10;

S :=S+' наиндикации '+FloatToStrF(Buf_y,ffGeneral,7,4)+' '+ #13#10;

MessageDlg(S, mtInformation, [mbOk], 0);}

Label2.Caption:='ошибках: '+floattostrF(Buf_y,ffGeneral,8,4);

Label2.Caption:=Label2.Caption+' должнобыть - '+floattostrF(Buf_x,ffGeneral,8,4);

end;

{Timer1.Enabled:=false;{}

end;{TForm1.Ind_x_plus;}

Procedure TForm1.Ind_y_plus;

begin

Edit2.Text:='+';

y_1:=y_l; y_2:=y_m; y_3:=y_h-240;

count_y:=y_1+256*(y_2+256*y_3);

Buf_y:=count_y*0.0005;

if (Trunc(Buf_y)>=100) then str_x:=' ';

if (Trunc(Buf_y)<100) then str_x:=' 0';

if (Trunc(Buf_y)<10) then str_x:=' 00';

if (Trunc(Buf_y)=0) then str_x:=' 00';

Ed2.Text:=str_x+IntToStr(Trunc(Buf_y));

Buf_x:=(Buf_y-Trunc(Buf_y))*10000;

Buf_x:=Frac(Buf_y)*10000;

if (Trunc(Buf_x)>=999) then str_x:='';

if (Trunc(Buf_x)<1000) then str_x:='0';

if (Trunc(Buf_x)<100) then str_x:='00';

if (Trunc(Buf_x)<10) then str_x:='000';

if (Trunc(Buf_x)=0) then str_x:='000';

Edt4.Text:=str_x+IntToStr(Round(Buf_x));

Buf_x:= StrToInt(Ed2.Text);

Buf_x:=Buf_x+ (StrToFloat(Edt4.Text))/10000.0;

if Buf_x<>Buf_y then begin

Label2.Caption:='ошибках: '+floattostrF(Buf_x,ffGeneral,8,4);

Label2.Caption:=Label2.Caption+' должнобыть - '

+floattostrF(Buf_y,ffGeneral,8,4);

end;

end;{TForm1.Ind_x_plus;}

Procedure TForm1.Ind_Y_minus;

begin

Edit2.Text:=' -';

y_1:=255-y_l+1; y_2:=255-y_m; y_3:=255-y_h;

count_y:=y_1+256*(y_2+256*y_3);

Buf_y:=count_y*0.0005;

if (Trunc(Buf_y)>=100) then str_x:=' ';

if (Trunc(Buf_y)<100) then str_x:=' 0';

if (Trunc(Buf_y)<10) then str_x:=' 00';

if (Trunc(Buf_y)=0) then str_x:=' 00';

Ed2.Text:=str_x+IntToStr(Trunc(Buf_y));

Buf_x:=(Buf_y-Trunc(Buf_y))*10000;

Buf_x:=Frac(Buf_y)*10000;

if (Trunc(Buf_x)>=999) then str_x:='';

if (Trunc(Buf_x)<1000) then str_x:='0';

if (Trunc(Buf_x)<100) then str_x:='00';

if (Trunc(Buf_x)<10) then str_x:='000';

if (Trunc(Buf_x)=0) then str_x:='000';

Edt4.Text:=str_x+IntToStr(Round(Buf_x));

Buf_x:= StrToInt(Ed2.Text);

Buf_x:=Buf_x+ (StrToFloat(Edt4.Text))/10000.0;

if Buf_x<>Buf_y then begin

Label2.Caption:='ошибках: '+floattostrF(Buf_x,ffGeneral,8,4);

Label2.Caption:=Label2.Caption+' должнобыть - '+floattostrF(Buf_y,ffGeneral,8,4);

end;

end;{TForm1.Ind_y_minus;}

procedure TForm1.Button12Click(Sender: TObject);

begin

if (x_l=0) then begin

x_l:=255;

if x_m=0 then begin

x_m:=255;

if x_h=240 then x_h:=255

else x_h:=x_h-1;

end {if x_m=255 then begin}

else x_m:=x_m-1;

end {if (x_l=255) then begin}

else x_l:=x_l-1;

end; { procedure TForm1.Button12Click }

procedure TForm1.X_plus;

var i: integer;

begin

i:=1;

while i<2 do begin

if (x_l=255) then begin

x_l:=0;

if x_m=255 then begin

x_h:=x_h+1;

if x_h=0 then x_h:=240;

x_m:=0;

end

else x_m:=x_m+1;

end

else x_l:=x_l+1;

i:=i+1;

end;

end; { procedure TForm1.X_plus }

procedure TForm1.X_minus;

var i: integer;

begin

i:=1;

while i<2 do begin

if (x_l=0) then begin

x_l:=255;

if x_m=0 then begin

x_m:=255;

if x_h=240 then x_h:=255

else x_h:=x_h-1;

end {if x_m=255 then begin}

else x_m:=x_m-1;

end {if (x_l=255) then begin}

else x_l:=x_l-1;

i:=i+1;

end;{while}

end; { procedure TForm1.X_minus }

procedure TForm1.Y_plus;

var i: integer;

begin

i:=1;

while i<2 do begin

if (y_l=255) then begin

y_l:=0;

if y_m=255 then begin

y_h:=y_h+1;

if y_h=0 then y_h:=240;

y_m:=0;

end

else y_m:=y_m+1;

end

else y_l:=y_l+1;

i:=i+1;

end;

end; { procedure TForm1.Y_plus }

procedure TForm1.Y_minus;

var i: integer;

begin

i:=1;

while i<2 do begin

if (y_l=0) then begin

y_l:=255;

if y_m=0 then begin

y_m:=255;

if y_h=240 then y_h:=255

else y_h:=y_h-1;

end {if x_m=255 then begin}

else y_m:=y_m-1;

end {if (x_l=255) then begin}

else y_l:=y_l-1;

i:=i+1;

end;{while}

end; { procedure TForm1.Y_minus }

procedure TForm1.Button8Click(Sender: TObject);

begin

if (y_l=255) then begin

y_l:=0;

if y_m=255 then begin

y_h:=y_h+1;

if y_h=0 then y_h:=240;

y_m:=0;

end

else y_m:=y_m+1;

end

else y_l:=y_l+1;

end; {procedure TForm1.Button8Click}

procedure TForm1.Button13Click(Sender: TObject);

begin

if (y_l=0) then begin

y_l:=255;

if y_m=0 then begin

y_m:=255;

if y_h=240 then y_h:=255

else y_h:=y_h-1;

end {if x_m=255 then begin}

else y_m:=y_m-1;

end {if (x_l=255) then begin}

else y_l:=y_l-1;

end; { procedure TForm1.Button13Click }

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);

begin

{if (Key=#27) then {VK_ESCAPE} { begin}

{ MessageDlg('Printing aborted', mtInformation, [mbOK],0);

end; }

case Key of

#27: Clear_count;

end;

end;

procedure TForm1.Button2Click(Sender: TObject);

var i: integer;

begin

i:=1;

while i<11 do begin

if (x_l=255) then begin

x_l:=0;

if x_m=255 then begin

x_h:=x_h+1;

if x_h=0 then x_h:=240;

x_m:=0;

end

else x_m:=x_m+1;

end

else x_l:=x_l+1;

i:=i+1;

end;

end; {procedure TForm1.Button2Click}

procedure TForm1.Button1Click(Sender: TObject);

var i: integer;

begin

i:=1;

while i<101 do begin

if (x_l=255) then begin

x_l:=0;

if x_m=255 then begin

x_h:=x_h+1;

if x_h=0 then x_h:=240;

x_m:=0;

end

else x_m:=x_m+1;

end

else x_l:=x_l+1;

i:=i+1;

end;

end; {procedure TForm1.Button1Click}

procedure TForm1.Button4Click(Sender: TObject);

var i: integer;

begin

i:=1;

while i<254 do begin

if (x_l=0) then begin

x_l:=255;

if x_m=0 then begin

x_m:=255;

if x_h=240 then x_h:=255

else x_h:=x_h-1;

end {if x_m=255 then begin}

else x_m:=x_m-1;

end {if (x_l=255) then begin}

else x_l:=x_l-1;

i:=i+1;

end;{while}

end; {procedure TForm1.Button4Click}

procedure TForm1.Button5Click(Sender: TObject);

var i: integer;

begin

i:=1;

while i<11 do begin

if (y_l=255) then begin

y_l:=0;

if y_m=255 then begin

y_h:=y_h+1;

if y_h=0 then y_h:=240;

y_m:=0;

end

else y_m:=y_m+1;

end

else y_l:=y_l+1;

i:=i+1;

end; {while}

end; {procedure TForm1.Button5Click}

procedure TForm1.Button6Click(Sender: TObject);

var i: integer;

begin

i:=1;

while i<101 do begin

if (y_l=255) then begin

y_l:=0;

if y_m=255 then begin

y_h:=y_h+1;

if y_h=0 then y_h:=240;

y_m:=0;

end

else y_m:=y_m+1;

end

else y_l:=y_l+1;

i:=i+1;

end; {while}

end; {procedure TForm1.Button6Click}

procedure TForm1.Button9Click(Sender: TObject);

var i: integer;

begin

i:=1;

while i<11 do begin

if (y_l=0) then begin

y_l:=255;

if y_m=0 then begin

y_m:=255;

if y_h=240 then y_h:=255

else y_h:=y_h-1;

end {if x_m=255 then begin}

else y_m:=y_m-1;

end {if (x_l=255) then begin}

else y_l:=y_l-1;

i:=i+1;

end; {while}

end; {procedure TForm1.Button9Click}

procedure TForm1.Button10Click(Sender: TObject);

var i:integer;

begin

i:=1;

while i<101 do begin

if (y_l=0) then begin

y_l:=255;

if y_m=0 then begin

y_m:=255;

if y_h=240 then y_h:=255

else y_h:=y_h-1;

end {if x_m=255 then begin}

else y_m:=y_m-1;

end {if (x_l=255) then begin}

else y_l:=y_l-1;

i:=i+1;

end; {while}

end; {procedure TForm1.Button10Click}

procedure TForm1.Button14Click(Sender: TObject);

begin

Timer1.Enabled:=true;{}

end;

procedure TForm1.Panel4Click(Sender: TObject);

begin

Ed1.Font.Color:=clRed;

Ed2.Font.Color:=clRed;

Edt3.Font.Color:=clRed;

Edt4.Font.Color:=clRed;

end;

procedure TForm1.Panel5Click(Sender: TObject);

begin

Ed1.Font.Color:=clBlue;

Ed2.Font.Color:=clBlue;

Edt3.Font.Color:=clBlue;

Edt4.Font.Color:=clBlue;

end;

procedure TForm1.Panel6Click(Sender: TObject);

begin

Ed1.Font.Color:=clBlack;

Ed2.Font.Color:=clBlack;

Edt3.Font.Color:=clBlack;

Edt4.Font.Color:=clBlack;

end;

procedure TForm1.Panel7Click(Sender: TObject);

begin

Ed1.Font.Color:=clGreen;

Ed2.Font.Color:=clGreen;

Edt3.Font.Color:=clGreen;

Edt4.Font.Color:=clGreen;

end;

end.

zlportio:

{$A-,H-}

unit zlportio;

interface

uses windows,sysutils,ddkint;

Const

ZLIO_BYTE = 0;

ZLIO_WORD = 1;

ZLIO_DWORD = 2;

var

ZlIOStarted:boolean = false;

ZlIODirect:boolean = false;

HZLIO:THandle;

function portreadb( const Port:dword ):byte;

function portreadw( const Port:dword ):word;

function portreadl( const Port:dword ):dword;

procedure portwriteb( const Port:Dword;const Data:byte );

procedure portwritew( const Port:dword;const Data:word );

procedure portwritel( const Port,Data:dword );

procedure zlioportwrite( const Port,DataType,Data:dword );

function zlioportread( const Port,DataType:dword ):dword;

procedure zliosetiopm( const Direct:boolean );

function zliostart:boolean;

procedure zliostop;

implementation

const

ZLIODriverName='zlportio';

var

IOCTL_ZLUNI_PORT_READ:cardinal;

IOCTL_ZLUNI_PORT_WRITE:cardinal;

IOCTL_ZLUNI_IOPM_ON:cardinal;

IOCTL_ZLUNI_IOPM_OFF:cardinal;

type

TzlIOData = record

Port,DataType,Data:dword;

end;

procedure zlioportwrite( const Port,DataType,Data:dword );

var resdata:TZLIOData;

cBR:cardinal;

begin

if (not ZLIODirect) then begin

resdata.Port := Port;

resdata.Data := Data;

resdata.DataType := DataType;

if ZLIOStarted then

DeviceIoControl(HZLIO,IOCTL_ZLUNI_PORT_WRITE,@resdata,sizeof(resdata),nil,0,cBR,nil );

end

else begin

Case DataType of

ZLIO_BYTE : asm mov edx,Port;mov eax,data;out dx,al; end;

ZLIO_WORD : asm mov edx,Port;mov eax,data;out dx,ax; end;

ZLIO_DWORD: asm mov edx,Port;mov eax,data;out dx,eax; end;

end;

end;

end;

function zlioportread(const Port,DataType:dword):dword;

var resdata:TZLIOData;

cBR:cardinal;i:dword;

begin

if (not ZLIODirect) then begin

resdata.Port := Port;

resdata.DataType := DataType;

if ZLIOStarted then

DeviceIoControl(HZLIO,IOCTL_ZLUNI_PORT_READ,@resdata,sizeof(resdata),@i,sizeof(dword),cBR,nil );

end

else begin

Case DataType of

ZLIO_BYTE : asm mov edx,Port;xor eax,eax;in al,dx;mov i,eax; end;

ZLIO_WORD : asm mov edx,Port;xor eax,eax;in ax,dx;mov i,eax; end;

ZLIO_DWORD: asm mov edx,Port;xor eax,eax;in eax,dx;mov i,eax end;

end;

end;

result := i;

end;

function portreadb( const Port:dword ):byte;

begin

Result := zlioportread(Port,ZLIO_BYTE);

end;

function portreadw( const Port:dword ):word;

begin

Result := zlioportread(Port,ZLIO_WORD);

end;

function portreadl( const Port:dword ):dword;

begin

Result := zlioportread(Port,ZLIO_DWORD);

end;

procedure portwriteb( const Port:Dword;const Data:byte );

begin

zlioportwrite(Port,ZLIO_BYTE,Data);

end;

procedure portwritew( const Port:dword;const Data:word );

begin

zlioportwrite(Port,ZLIO_WORD,Data);

end;

procedure portwritel( const Port,Data:dword );

begin

zlioportwrite(Port,ZLIO_DWORD,Data);

end;

procedure zliosetiopm( const Direct:boolean );

var cBR:cardinal;

begin

if Win32Platform=VER_PLATFORM_WIN32_NT then

if ZLIOStarted then begin

if Direct then

DeviceIoControl(HZLIO,IOCTL_ZLUNI_IOPM_ON,nil,0,nil,0,cBR,nil )

else

DeviceIoControl(HZLIO,IOCTL_ZLUNI_IOPM_OFF,nil,0,nil,0,cBR,nil );

ZLIODirect := Direct;

end

end;

function zliostart;

var dir:shortstring;

begin

if Win32Platform<>VER_PLATFORM_WIN32_NT then begin

result := true;

exit;

end;

zliostop;

dir := ExtractFileDir(ParamStr(0))+'\'+ZLIODriverName+'.sys'#0;

driverinstall(pchar(@dir[1]),ZLIODriverName+#0);

Result := driverstart(ZLIODriverName) = 0;

end;

procedure zliostop;

begin

if Win32Platform<>VER_PLATFORM_WIN32_NT then

exit;

driverstop(ZLIODriverName);

driverremove(ZLIODriverName);

end;

function zlioopen( var Handle:thandle):boolean;

var cERR:integer;

s:string;

begin

if Win32Platform<>VER_PLATFORM_WIN32_NT then begin

result := true;

exit;

end;

Result := false;

Handle := THandle(-1);

Handle := createFile('\\.\ZLPORTIO',

GENERIC_READ or GENERIC_WRITE,

0,

nil,

OPEN_EXISTING,

FILE_ATTRIBUTE_NORMAL,

0 );

cERR := getlasterror;

s := messagestring( cerr);

if (cERR = ERROR_ALREADY_EXISTS)or(cERR = ERROR_SUCCESS) then Result := True;

end;

procedure zlioclose( const Handle:thandle);

begin

if (Win32Platform=VER_PLATFORM_WIN32_NT) then

closehandle(Handle);

end;

initialization

IOCTL_ZLUNI_PORT_READ := CTL_CODE(FILE_DEVICE_KRNLDRVR, 1, METHOD_BUFFERED, FILE_ANY_ACCESS);

IOCTL_ZLUNI_PORT_WRITE := CTL_CODE(FILE_DEVICE_KRNLDRVR, 2, METHOD_BUFFERED, FILE_ANY_ACCESS);

IOCTL_ZLUNI_IOPM_ON := CTL_CODE(FILE_DEVICE_KRNLDRVR, 3, METHOD_BUFFERED, FILE_ANY_ACCESS);

IOCTL_ZLUNI_IOPM_OFF := CTL_CODE(FILE_DEVICE_KRNLDRVR, 4, METHOD_BUFFERED, FILE_ANY_ACCESS);

if Win32Platform<>VER_PLATFORM_WIN32_NT then begin

zliostarted := true;

zliodirect := true;

end

else begin

if not zlioopen(HZLIO) then begin

if zliostart then

ZLIOStarted := zlioopen(HZLIO) or (Win32Platform<>VER_PLATFORM_WIN32_NT);

end

else

ZLIOStarted := true;

end;

finalization

if ZLIOStarted then

zliostop;

end.

Размещено на Allbest.ru