Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001
end;
if (ServiceHSz <> 0) and (TopicHSz <> 0) and InitOK then begin
ConvHdl := DdeConnect(Inst, ServiceHSz, TopicHSz, nil);
if ConvHdl = 0 then begin
ShowMessage('Не могу инициализировать диалог!');
Close;
end
end else begin
ShowMessage('Не могу создать строки!');
Close;
end
end else begin
ShowMessage('Не могу осуществить инициализацию!');
Close;
end;
end;
end;
procedure TForm1.AdviseofChanges1Click(Sender: TObject);
{ Переключаемся на режим DDE Advise с помощью пункта меню DDE | Advise (уведомление). При выборе этого пункта меню все три элемента переключаются на уведомление. }
var
I: Integer;
TransType: Word;
TempResult: Longint;
begin
with TMenuITem(Sender) do begin
Checked := not Checked;
if Checked then TransType:= (xtyp_AdvStart or xtypf_AckReq)
else TransType:= xtyp_AdvStop;
end; { with }
for I := Low(ItemHSz) to High(ItemHSz) do
if DdeClientTransaction(nil, 0, ConvHdl, ItemHSz[I], cf_Text,TransType, 1000, @TempResult) = 0 then ShowMessage('Не могу выполнить транзакцию-уведомление');
if TransType and xtyp_AdvStart <> 0 then Request(ConvHdl);
end;
procedure TForm1.PokeSomeDataClick(Sender: TObject);
{ Генерируем DDE-Poke транзакцию в ответ на выбор пункта меню DDE | Poke. Запрашиваем значение у пользователя, которое будем "проталкивать" в DataItem1 в качестве иллюстрации Poke-функции.}
var
DataStr: pChar;
S: String;
begin
S := '0';
if InputQuery('PokeData', 'Задайте проталкиваемую (Poke) величину', S) then begin
S := S + #0;
DataStr := @S[1];
DdeClientTransaction(DataStr, StrLen(DataStr) + 1, ConvHdl, ItemHSz[1], cf_Text, xtyp_Poke, 1000, nil);
Request(ConvHdl);
end;
end;
procedure TForm1.exit1Click(Sender: TObject);
begin
close;
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
{ После запроса обновляем окно. Рисуем график объема текущих продаж.}
const
LMarg = 30; { Левое поле графика }
var
I,Norm: Integer;
Wd: Integer;
Step : Integer;
ARect: TRect;
begin
Norm := 0;
for I := Low(DataSample) to High(DataSample) do begin
if abs(DataSample[I]) > Norm then Norm := abs(DataSample[I]);
end; { for }
if Norm = 0 then Norm := 1; { В случае если у нас все нули }
with TPaintBox(Sender).Canvas do begin
{ Рисуем задний фон }
Brush.color:= clWhite;
FillRect(ClipRect);
{ Рисуем ось }
MoveTo(0, ClipRect.Bottom div 2);
LineTo(ClipRect.Right, ClipRect.Bottom div 2);
MoveTo(LMarg, 0);
LineTo(LMarg, ClipRect.Bottom);
{ Печатаем текст левого поля }
TextOut(0, 0, IntToStr(Norm));
TextOut(0, ClipRect.Bottom div 2, '0');
TextOut(0, ClipRect.Bottom + Font.Height, IntToStr(-Norm));
TextOut(0, ClipRect.Bottom div 2, '0');
TextOut(0, ClipRect.Bottom div 2, '0');
TextOut(0, ClipRect.Bottom div 2, '0');
{ Печатаем текст оси X }
{ Теперь рисуем бары на основе нормализованного значения. Вычисляем ширину баров (чтобы они все вместились в окне) и ширину пробела между ними, который приблизительно равен 20% от их ширины. }
{ SelectObject(PaintDC, CreateSolidBrush(RGB(255, 0, 0)));
SetBkMode(PaintDC, Transparent);}
ARect := ClipRect;
Wd := (ARect.Right - LMarg) div NumValues;
Step := Wd div 5;
Wd := Wd - Step;
with ARect do begin
Left := LMarg + (Step div 2);
Top := ClipRect.Bottom div 2;
end; { with }
{ Выводим бары и текст для оси X }
For i := Low(DataSample) to High(DataSample) do begin
with ARect 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 div 2 - Font.Height, StrPas(DataItemNames[i]));
with ARect do Left := Left + Wd + Step;
end; { for }
end; { with }
end;
end.{ *** КОНЕЦ КОДА DDEMLCLU.PAS *** }
{ *** НАЧАЛО КОДА DDEMLSVR.DPR *** }
program Ddemlsvr;
uses Forms,Ddesvru in 'DDESVRU.PAS' {Form1}, Ddedlg in 'DELPHIBINDDEDLG.PAS' {DataEntry};
{$R *.RES}
begin
Application.CreateForm(TForm1, Form1);
Application.CreateForm(TDataEntry, DataEntry);
Application.Run;
end.
{ *** КОНЕЦ КОДА DDEMLSVR.DPR *** }
{ *** НАЧАЛО КОДА DDESVRU.DFM *** }
object Form1: 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
object Label1: TLabel
Left = 0
Top = 0
Width = 99
Height = 16
Caption = 'Текущие значения:'
end
object Label2: TLabel
Left = 16
Top = 24
Width = 74
Height = 16
Caption = 'Data Item1:'
end
object Label3: TLabel
Left = 16
Top = 40
Width = 74
Height = 16
Caption = 'Data Item2:'
end
object Label4: TLabel
Left = 16
Top = 56
Width = 74
Height = 16
Caption = 'Data Item3:'
end
object Label5: TLabel
Left = 0
Top = 88
Width = 265
Height = 16
Caption = 'Выбор данных | Ввод данных для изменения значений.'
end
object Label6: TLabel
Left = 96
Top = 24
Width = 8
Height = 16
Caption = '0'
end
object Label7: TLabel
Left = 96
Top = 40
Width = 8
Height = 16
Caption = '0'
end
object Label8: TLabel
Left = 96
Top = 56
Width = 8
Height = 16
Caption = '0'
end
object MainMenu1: TMain
MenuLeft = 352
Top = 24
object File1: TMenuItem
Caption = '&Файл'
object Exit1: TMenuItem
Caption = '&Выход'
OnClick = Exit1Click
end
end
object Data1: TMenuItem
Caption = '&Данные'
object EnterData1: TMenuItem
Caption = '&Ввод данных'
OnClick = EnterData1Click
end
object Clear1: TMenuItem
Caption = '&Очистить'
OnClick = Clear1Click
end
end
end
end
{ *** КОНЕЦ КОДА DDESVRU.DFM *** }
{ *** НАЧАЛО КОДА DDESVRU.PAS *** }
{***************************************************}
{ }
{ Delphi 1.0 DDEML Демонстрационная программа }
{ Copyright (c) 1996 by Borland International }
{ }
{***************************************************}
{ Данный демонстрационный пример использует библиотеку DDEML на стороне сервера кооперативного приложения. Данный сервер является простым приложением для ввода данных и позволяет оператору осуществлять ввод трех элементов данных, которые становятся доступными через DDE "заинтересованным" клиентам.
