Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001

withTPaintBox(Sender).Canvas do begin

{ Рисуем задний фон }

Brush.color:= clWhite;

FillRect(ClipRect);

{ Рисуем ось }

MoveTo(0, ClipRect.Bottom div2);

LineTo(ClipRect.Right, ClipRect.Bottom div2);

MoveTo(LMarg, 0);

LineTo(LMarg, ClipRect.Bottom);

{ Печатаем текст левого поля }

TextOut(0, 0, IntToStr(Norm));

TextOut(0, ClipRect.Bottom div2, '0');

TextOut(0, ClipRect.Bottom + Font.Height, IntToStr(-Norm));

TextOut(0, ClipRect.Bottom div2, '0');

TextOut(0, ClipRect.Bottom div2, '0');

TextOut(0, ClipRect.Bottom div2, '0');

{ Печатаем текст оси X }

{ Теперь рисуем бары на основе нормализованного значения. Вычисляем ширину баров (чтобы они все вместились в окне) и ширину пробела между ними, который приблизительно равен 20% от их ширины. }

{ SelectObject(PaintDC, CreateSolidBrush(RGB(255, 0, 0)));

SetBkMode(PaintDC, Transparent);}

ARect := ClipRect;

Wd := (ARect.Right - LMarg) divNumValues;

Step := Wd div5;

Wd := Wd - Step;

withARect do begin

Left := LMarg + (Step div2);

Top := ClipRect.Bottom div2;

end; { with }

{ Выводим бары и текст для оси X }

Fori := Low(DataSample) toHigh(DataSample) do begin

withARect do begin

Right := Left + Wd;

Bottom:= Top - Round((Top-5) * (DataSample[I] / Norm));

end; { with }

{ Заполняем бар }

Brush.color:= clFuchsia;

FillRect(ARect);

{ Выводим текст для горизонтальной оси }

Brush.color:= clWhite;

TextOut(ARect.Left, ClipRect.Bottom div2 - Font.Height, StrPas(DataItemNames[i]));

withARect doLeft := Left + Wd + Step;

end; { for }

end; { with }

end;

end.{ *** КОНЕЦ КОДА DDEMLCLU.PAS *** }

{ *** НАЧАЛО КОДА DDEMLSVR.DPR *** }

programDdemlsvr;

usesForms,Ddesvru in'DDESVRU.PAS' {Form1}, Ddedlg in'\DELPHI\BIN\DDEDLG.PAS' {DataEntry};

{$R *.RES}

begin

Application.CreateForm(TForm1, Form1);

Application.CreateForm(TDataEntry, DataEntry);

Application.Run;

end.

{ *** КОНЕЦ КОДА DDEMLSVR.DPR *** }

{ *** НАЧАЛО КОДА DDESVRU.DFM *** }

objectForm1: TForm1

Left = 712

Top = 98

Width = 307

Height = 162

Caption = 'Демонстрация DDEML, Серверное приложение'

Color = clWhite

Font.Color = clWindow

TextFont.Height = -13

Font.Name = 'System'

Font.Style = []

Menu = MainMenu1

PixelsPerInch = 96

OnCreate = FormCreate

OnDestroy = FormDestroy

OnShow = FormShow

TextHeight = 16

objectLabel1: TLabel

Left = 0

Top = 0

Width = 99

Height = 16

Caption = 'Текущие значения:'

end

objectLabel2: TLabel

Left = 16

Top = 24

Width = 74

Height = 16

Caption = 'Data Item1:'

end

objectLabel3: TLabel

Left = 16

Top = 40

Width = 74

Height = 16

Caption = 'Data Item2:'

end

objectLabel4: TLabel

Left = 16

Top = 56

Width = 74

Height = 16

Caption = 'Data Item3:'

end

objectLabel5: TLabel

Left = 0

Top = 88

Width = 265

Height = 16

Caption = 'Выбор данных | Ввод данных для изменения значений.'

end

objectLabel6: TLabel

Left = 96

Top = 24

Width = 8

Height = 16

Caption = '0'

end

objectLabel7: TLabel

Left = 96

Top = 40

Width = 8

Height = 16

Caption = '0'

end

objectLabel8: TLabel

Left = 96

Top = 56

Width = 8

Height = 16

Caption = '0'

end

objectMainMenu1: TMain

MenuLeft = 352

Top = 24

object File1: TMenuItem

Caption = '&Файл'

objectExit1: TMenuItem

Caption = '&Выход'

OnClick = Exit1Click

end

end

objectData1: TMenuItem

Caption = '&Данные'

objectEnterData1: TMenuItem

Caption = '&Ввод данных'

OnClick = EnterData1Click

end

objectClear1: TMenuItem

Caption = '&Очистить'

OnClick = Clear1Click

end

end

end

end

{ *** КОНЕЦ КОДА DDESVRU.DFM *** }

{ *** НАЧАЛО КОДА DDESVRU.PAS *** }

{***************************************************}

{ }

{ Delphi 1.0 DDEML Демонстрационная программа }

{ Copyright (c) 1996 by Borland International }

{ }

{***************************************************}

{ Данный демонстрационный пример использует библиотеку DDEML на стороне сервера кооперативного приложения. Данный сервер является простым приложением для ввода данных и позволяет оператору осуществлять ввод трех элементов данных, которые становятся доступными через DDE "заинтересованным" клиентам.

Данный сервер предоставляет свои услуги (сервисы) для данных со следующими именами:

Service: 'DataEntry'

Topic : 'SampledData'

Items : 'DataItem1', 'DataItem2', 'DataItem3'

В-принципе, в качестве сервисов могли бы быть определены и другие темы. Полезными темами, на наш взгляд, могут быть исторические даты, информация о сэмплах и пр..

Вы должны запустить этот сервер ПЕРЕД тем как запустите клиента (DDEMLCLI.PAS), в противном случае клиент не сможет установить связь.

Интерфейс для этого сервера определен как список имен (Service, Topic и Items) в отдельном модуле с именем DataEntry (DATAENTR.TPU). Сервер делает Items доступными в формате cf_Text; они преобразовываются и хранятся у клиента локально как целые. }

unitDdesvru;

interface

usesSysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Menus, DDEML, { DDE APi }ShellApi;

const

NumValues = 3;

DataItemNames : array[1..NumValues] ofPChar = ('DataItem1', 'DataItem2', 'DataItem3');

type

TDataString = array[0..20] ofChar; { Размер элемента как текста }

TDataSample = array[1..NumValues] ofInteger;

{type

{ Структура данных, составляющих образец }

{ TDataSample = array [1..NumValues] of Integer;

{ TDataString = array [0..20] of Char; { Размер элемента как текста }

const

DataEntryName: PChar = 'DataEntry';

DataTopicName: PChar = 'SampledData';

typeTForm1 = class(TForm)

MainMenu1: TMainMenu;

File1: TMenuItem;

Exit1: TMenuItem;

Data1: TMenuItem;

EnterData1: TMenuItem;

Clear1: TMenuItem;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

Label5: TLabel;

Label6: TLabel;

Label7: TLabel;

Label8: TLabel;

procedureExit1Click(Sender: TObject);

functionMatchTopicAndService(Topic, Service: HSz): Boolean;