TDBGrid с номером строки и пр.

Скомпилируйте это, и вы получите новый компонент с нужными свойствами:

unit RowGrid; interface uses WinTypes, WinProcs, Classes, Grids, DBGrids; type TRowDBGrid = class(TDBGrid) public Property Row; Property RowCount; Property VisibleRowCount; end; procedure Register; implementation procedure Register; begin RegisterComponents('Data Controls', [TRowDBGrid]); end; end.

{вот небольшой испытательный демо-проект.. мы поместили на форму нашу сетку-наследницу, 3 компонента EditBox и поместили следующий код в обработчик события ondrawdatacell вашего TRowGrid} procedure TForm1.RowDBGrid1DrawDataCell(Sender: TObject; const Rect: TRect;   Field: TField; State: TGridDrawState); begin eb_row.text := inttostr(rowdbgrid1.row); eb_rowcount.text := inttostr(rowdbgrid1.rowcount); eb_visiblerowcount.text := inttostr(rowdbgrid1.visiblerowcount); end;

- Mark Meyer [000813]

TDBGrid - свойства FixRows & FixCols

Сетки, не предназначенные для работы с данными, имеют свойства FixCols и FixRows, которые не позволяют данным прокручиваться, но эти свойства не были унаследованы TDBGrid.

Обходной путь для TDrawGrid:

TDrawGrid(DBGrid1).FixedCols := 2;

[000330]

Текстовое содержимое ячейки DBGrid

Я не нахожу никакого метода получения текстового значения ячейки сетки, кроме как назначения TField...

Вы можете сделать это с помощью простого наследника TDBGrid:

type TMyGrid = class(TDBGrid) public property InPlaceEditor; end;

...затем вы можете получить доступ к содержимому ячейки приблизительно таким способом:

Label1.Caption := DBGrid1.InPlaceEditor.Text;

...имейте в виду, что это работает только в случае, когда ячейка находится в состоянии редактирования или вставки.

- Eryk Bottomley [000957]

Улучшения

Здесь приведен улучшенный код по сравнению с предыдущей версией "Совета", он заключается в использовании в качестве имени индекса имя поля вместо заголовка.

Это улучшает гибкость. Изменения указаны наклонным курсивом.

procedure TfrmDoc.FormCreate(Sender: TObject); Var TheCap    : String; TheFn     : String; TheWidth  : Integer; a         : Integer; begin Dbgrid1.Options := DBGrid1.Options - [DGTitles]; Headercontrol1.sections.Add; Headercontrol1.Sections.Items[0].Width := 12; For a := 1 to DBGRID1.Columns.Count do begin with DBGrid1.Columns.Items[ a - 1 ] do begin TheFn    := FieldName; TheCap   := Title.Caption; TheWidth := Width; end; With Headercontrol1.Sections DO BEGIN Add; Items[a].Text     := TheCap; Items[a].Width    := TheWidth + 1; Items[a].MinWidth := TheWidth + 1; Items[a].MaxWidth := TheWidth + 1; END; (* WITH Headercontrol1.Sections *) try (* except *) { Используем индексы с тем же именем, что и имя поля } (DataSource1.Dataset as TTable).IndexName := TheFn;   { Пробуем задать имя индекса } except HeaderControl1.Sections.Items[a].AllowClick := False; { Индекс недоступен } end; (* EXCEPT *) END; (* FOR *) END; (* PROCEDURE *)

Используйте свойство FieldName компонента DBGrid для задания индекса с тем же именем, что и имя поля.

procedure TfrmDoc.HeaderControl1SectionClick(HeaderControl: THeaderControl; Section: THeaderSection); begin (DataSource1.Dataset as TTable).IndexName := DBGrid1.Columns.Items[ Section.Index - 1 ].FieldName; end;

[000066]

Улучшенный Dbgrid

{ Код улучшенного TDBGrid, имеющего свойства Col, Row и Canvas и метод CellRect. Это чрезвычайно полезно в случае, если вы, к примеру, хотите получить выпадающий список на месте редактируемой пользователем ячейки. } unit VUBComps; interface uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, Grids, DBGrids, DB, Menus; type TDBGridVUB = class(TDBGrid) private { Private declarations } protected { Protected declarations } public property Canvas; function CellRect(ACol, ARow: Longint): TRect; property Col; property Row; procedure Register; implementation procedure Register; begin RegisterComponents('VUBudget', [TDBGridVUB]); end; function TDBGridVUB.CellRect(ACol, ARow: Longint): TRect; begin Result := inherited CellRect(ACol, ARow); end; end.

[001167]

В Delphi 3 и выше ползунок TDBGrid

Nomadic отвечает:

Здесь отрывки из исходников VCL -

unit DBGrids; procedure TCustomDBGrid.UpdateScrollBar; var SIOld, SINew: TScrollInfo; begin [skipped] if IsSequenced then begin SINew.nMin := 1; SINew.nPage := Self.VisibleRowCount; SINew.nMax := RecordCount + SINew.nPage -1; if State in [dsInactive, dsBrowse, dsEdit] then SINew.nPos := RecNo; // else keep old pos end else begin SINew.nMin := 0; SINew.nPage := 0; SINew.nMax := 4; if BOF then SINew.nPos := 0 else if EOF then SINew.nPos := 4 else SINew.nPos := 2; end; [skipped] unit dbtables; function TBDEDataSet.IsSequenced: Boolean; begin Result := (FRecNoStatus = rnParadox) and (not Filtered); end;

То есть, к примеру, все будет работать "красиво" на таблицах BDE, если они: таблицы Paradox; на них не установлен фильтр. TClientDataSet в режиме single-tier (briefcase) также работает "красиво". [001340]

Вертикальная полоса прокрутки Dbgrid

Это небольшое исправление к исходному коду VCL, позволяющее поддерживать перемещение по таблице с помощью изменения позиции движка вертикальной полосы прокрутки.

(Примечание: это работает только с таблицами Paradox и BDE. Для использования этого кода с другими таблицами/движками вам необходимо заменить DBIGetSeqNo на функцию, надежно возвращающую текущую позицию записи вне зависимости от того, использует ли таблица индекс или нет.)

В DBGRID.PAS измените две следующих процедуры:

procedure TCustomDBGrid.UpdateScrollBar; var Pos: Integer; mPos, mMax: longint; begin if FDatalink.Active and HandleAllocated then with FDatalink.DataSet do begin UpdateCursorPos; if (DBIGetSeqNo(Handle,mPos) = DBIERR_NONE) then begin mMax := RecordCount; while mMax > 1000 do begin mMax := mMax div 10; mPos := mPos div 10; end; SetScrollRange(Self.Handle, SB_VERT, 1, mMax, False); end else begin if BOF then mPos := 0 else if EOF then mPos := 4 else mPos := 2; SetScrollRange(Self.Handle, SB_VERT, 0, 4, False); end;   (**) if GetScrollPos(Self.Handle, SB_VERT) <> mPos then SetScrollPos(Self.Handle, SB_VERT, mPos, True); end; end; procedure TCustomDBGrid.WMVScroll(var Message: TWMVScroll); var mMin, mMax: integer; RecCount, RecNo, NewRecNo: longint; begin if not AcquireFocus then Exit; if FDatalink.Active then with Message, FDataLink.DataSet, FDatalink do case ScrollCode of SB_LINEUP: MoveBy(-ActiveRecord - 1); SB_LINEDOWN: MoveBy(RecordCount - ActiveRecord); SB_PAGEUP: MoveBy(-VisibleRowCount); SB_PAGEDOWN: MoveBy(VisibleRowCount); SB_THUMBPOSITION: if (DBIGetSeqNo(Handle,RecNo) = DBIERR_NONE) then begin GetScrollRange(self.Handle, SB_VERT, mMin, mMax); NewRecNo := Pos*(FDataLink.DataSet.RecordCount div mMax); MoveBy(NewRecNo-RecNo); end else case Pos of 0: First; 1: MoveBy(-VisibleRowCount); 2: Exit; 3: MoveBy(VisibleRowCount); 4: Last; end; SB_BOTTOM: Last; SB_TOP: First; end; end;

Имейте в виду, что из-за небольшой ошибки в VCL (MoveBy использует integer-параметр вместо longint), могут быть проблемы с большими таблицами (RecordCount>MaxInt). Объяснение этому факту я нашел в журнале Delphi Magazine. Для больших таблиц вы должны заменить вызовы MoveBy на DBISetToSeqNo или DBIGetRelativeRecord. Не забудьте после данного вызова вызвать Resnyc([]) или Refresh!

P.S. Пока вы ковыряетесь в DBGRIDS.PAS: найдите и замените TitleColor на FixedColor в TCustomDBGrid.Create и в TCustomDBGrid.DrawCell. Значение свойства FixedColor влияет на показ заголовков колонок, и они будут выводится как и ожидалось.

- Reinhard Kalinke [001019]

Включение ComboBox в TDBGrid

Вот основные шаги чтобы сделать это: Создавайте и рисуйте TComboBox (CB) при получении ввода ячейки необходимой колонки табличной сетки Получайте текущее значение поля (если имеется) и помещайте его в CB После всех манипуляций, поместите новое значение обратно в поле Избавляемся от CB [001540]

Проблема хранения TDBImage

Исходный код компонента DBImage содержит ошибку, поскольку пробует загрузить данные буфера обмена, ища CF_PICTURE. А это несовместимо с хранящимися в поле данными.

Я исправил эту ошибку, изменив исходный код таким образом, чтобы данные буфера обмена сначала читались во временный TBitmap. TBitmap регистрируется как CF_PICTURE. Временное изображение затем назначалось полю и, поскольку оно также работает с изображениями, то и данным поля.

Все это потребует от вас изменений в исходном коде VCL, конкретно - в модуле DBCTRLS.PAS. Затем, естественно, это необходимо перекомпилить и пересобрать:

procedure TDBImage.PasteFromClipboard; var ClipBrdBmp: TBitmap; begin ClipBrdBmp := TBitmap.Create; if Clipboard.HasFormat(CF_BITMAP) and FDataLink.Edit then begin ClipBrdBmp.Assign(Clipboard); Picture.Assign(ClipBrdBmp); end; ClipBrdBmp.Free; end;

Это все. Проблема решена.

- Steve Flynn [000869]

Две колонки в DBLookupComboBox

Попробуйте использовать что-то типа этого:

DBLookupCombo1.LookupDisplay := 'Company;City;Country';

Т.е., для того, чтобы выводить более одного поля, разделите имя каждого поля точкой с запятой. [001632]

Показываемое DBLookupComboBox значение

Cледующая строка в обработчике события OnActivate:

DBLookupCombox1.Perform(WM_KeyDown,38,0);

заполняет показываемое в dblookupcombox значение. Вы посылаете сообщение индекса непосредственно в dblookupcombox.

- Michael Pratt [000971]

Предустановка DBLookupComboBox

Вы можете редактировать ваш источник данных. Говорят, вы хотите сохранить ваши lookuping-данные из таблицы customer в таблицу sales - 'Cust No'? Вы можете просто проинициализировать поля (задать значение по умолчанию), редактируя таблицу sales "Cust No"

with tbSales do begin Edit; FieldByName('Cust No').AsInteger := 1; Post; end;

[001319]

Сортировка DBLookupComboBox по вторичному индексу

Одним из способов вывести выши данные в другом порядке сортировки является использование TQuery и включение в SQL-запрос ключевого слова "order by". После чего вы можете установить этот запрос как DataSource в вашем DBLookupComboBox.

ПРИМЕР:

Если у вас имеется таблица Customer, содержащая "Customer_No" и "Customer_Name", и индексированная по Customer_No, то ваш запрос должен содержать в редакторе списка строк (свойство SQL) для вашего TQuery следующую строку: select Customer_No, Customer_Name from Customer order by Customer_Name [001350]

Значение DBLookupComboBox

Я думаю что у меня есть то, что вы хотите. Если вы обратитесь к свойству LookUpValue, то вы получите поле, которое .... ищете.

Я надеюсь что помог вам.

unit clookup; interface uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, DB, DBLookup; type TDBJustLookupCombo = class(TDBLookupCombo) private { Private declarations } protected { Protected declarations } function GetLValue: TField; public { Public declarations } property LookUpValue: TField read GetLValue; published { Published declarations } end; TDBJustLookupList = class(TDBLookupList) private { Private declarations } protected { Protected declarations } function GetLValue: TField; public { Public declarations } property LookUpValue: TField read GetLValue; published { Published declarations } end; procedure Register; implementation procedure Register; begin RegisterComponents('Data Controls', [TDBJustLookupList, TDBJustLookupCombo]); end; function TDBJustLookupCombo.GetLValue: TField; begin Result := LookupSource.DataSet.FieldByName(LookUpField); end; function TDBJustLookupList.GetLValue: TField; begin Result := LookupSource.DataSet.FieldByName(LookUpField); end; end.

[001380]

Копирование содержимого DBMemo в DBMemo другого поля

Попробуй:

DBMemo6.Lines:=DBMemo5.Lines.Assign;

[001231]

Копирование текста DBMemo

...да, вы забыли упомянуть перед этим о TMemoField. Звучит зловеще (как вы заметили), но это не трудно. Вся хитрость заключается в создании TStringList и перекачивания в него данных для последующего использования. Вот простая процедура без проверок и уведомлений об ошибках, использующая модуль WinCRT:

procedure TForm1.Button1Click(Sender: TObject); var I: integer; StringList: TStringList; begin StringList := TStringList.Create; try StringList.Assign(Table1Memo); for I := 0 to StringList.Count-1 do writeln(StringList[I]) finally StringList.Free end end;

[000374]

Поиск текста в DBMemo

Попробуйте так:
"Подключите" следующую процедуру к событию OnFind для FindDialog. Единственная проблема заключается в том, что в DBMemo я не могу получить выделенный текст, тем не менее в стандартном Memo такой проблемы нет.

procedure TMainForm.FindDialog1Find(Sender: TObject); var Buff, P, FT : PChar; BuffLen     : Word; begin With Sender as TFindDialog do begin GetMem(FT, Length(FindText) + 1); StrPCopy(FT, FindText); BuffLen:= DBMemo1.GetTextLen + 1; GetMem(Buff,BuffLen); DBMemo1.GetTextBuf(Buff,BuffLen); P:= Buff + DBMemo1.SelStart + DBMemo1.SelLength; P:= StrPos(P, FT); if P = NIL then MessageBeep(0) else begin DBMemo1.SelStart:= P - Buff; DBMemo1.SelLength:= Length(FindText); end; FreeMem(FT, Length(FindText) + 1); FreeMem(Buff,BuffLen); end; end;

Попробуйте так:
"Подключите" следующую процедуру к событию OnFind для FindDialog. Единственная проблема заключается в том, что в DBMemo я не могу получить выделенный текст, тем не менее в стандартном Memo такой проблемы нет.

begin DBMemo1.SelStart:= P - Buff; DBMemo1.SelLength:= Length(FindText); end; FreeMem(FT, Length(FindText) + 1); FreeMem(Buff,BuffLen); DBMemo1.SetFocus; end;

[001344]

TDBMemo в TDBCtrlGrid?

Из-за непонятных причин, компоненты TDBImage и TDBMemo не могут быть размещены в DBCtrlGrid.

Обойти данное препятствие можно путем создания наследника TDBImage (или TDBMemo), позволяющего его помещать в DBCtrlGrid. Перекройте конструктор Create следующим образом:

constructor TMYDBImage.Create(AOwner:TComponent); begin inherited Create(AOWner); ControlStyle := ControlStyle + [csReplicatable]; end;

- Pat Ritchey [000900]

DBNavigator без иконок

Я хочу создать DBNavigator, который бы всесто стандартных иконок имел бы текст.

Я думаю этот код вам поможет:

var c: shortint; s: string; begin s := 'A'; with DBNavigator1 do for c := 0 to ControlCount -1 do if Controls[c] is TNavButton then with TNavButton(Controls[c]) do begin ListBox1.Items.Add(Name); Glyph := nil; Caption := s; Inc(s[1]); end; end;

Ralph Friedman [000752]

Настройки всплывающих подсказок в DBNavigator во время выполнения приложения

Возможно ли изменение свойства Hints компонента TDBNavigator во время выполнения программы?

Это должно работать:

procedure TForm1.Button1Click(Sender: TObject); var ix : integer; begin With DBNavigator1 do for ix := 0 to ControlCount - 1 do if Controls[ix] is TNavButton then with Controls[ix] as TNavButton do case index of nbFirst : Hint := 'Подсказка для кнопки First'; nbPrior : Hint := 'Подсказка для кнопки Prior'; nbNext : Hint := 'Подсказка для кнопки Next'; nbLast : Hint := ''; {......} end; end;

- Freddy Hansson [001008]

KeyDown компонента DBNavigator

"Dmitry" <dimon@diogen.nstu.nsk.su>

Есть некоторое решение для создания "горячих клавиш" в DBNavigator. Установите свойство TForm.KeyPreview в TRUE и напишите обработчик события onkeydown. Примерно так:

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); const (* Классный участок кода от Graphical Gnome *) KeyBtn: array[TNavigateBtn] of record Key: Word; Btn: TNavigateBtn; end = ( (Key: VK_F1; Btn: nbFirst), (Key: VK_F2; Btn: nbPrior), (Key: VK_F3; Btn: nbNext), (Key: VK_F4; Btn: nbLast), (Key: VK_F5; Btn: nbInsert), (Key: VK_F6; Btn: nbDelete), (Key: VK_F7; Btn: nbEdit), (Key: VK_F8; Btn: nbPost), (Key: VK_F9; Btn: nbCancel), (Key: VK_F10; Btn: nbRefresh) ); var i: TNavigateBtn; begin for i := nbFirst to nbRefresh do if KeyBtn[i].Key = Key then begin DBNavigator1.BtnClick(KeyBtn[i].Btn); Exit; end; end;

[000145]

Работа в коде с кнопками DBNavigator

Я думаю вам поможет следующий пример (взят из электронной справки по DELPHI), показывающий код нажатой кнопки. Я видел пару вопросов о том, как изменять кнопки навигатора в зависимости от состояния редактируемой вами записи. Если вам необходимо подтверждение действий пользователя, то необходимо каким-то образом организовать дополнительный перехватчик. Как это сделать, я, честно говоря, еще не думал.

Прежде, чем вы сделаете любой постинг или изменение данных, убедитесь, что таблица находится в режиме редактирования. Посмотрите описание свойства state в электронной справке по DELPHI. Там подробно рассказано как работать с ним.

Следующий код определяет нажатую кнопку навигатора и выводит сообщение с ее именем.

procedure TForm1.DBNavigator1Click(Sender: TObject; Button: TNavigateBtn); var BtnName: string; begin case Button of nbFirst  : BtnName := 'nbFirst'; nbPrior  : BtnName := 'nbPrior'; nbNext   : BtnName := 'nbNext'; nbLast   : BtnName := 'nbLast'; nbInsert : BtnName := 'nbInsert'; nbDelete : BtnName := 'nbDelete'; nbEdit   : BtnName := 'nbEdit'; nbPost   : BtnName := 'nbPost'; nbCancel : BtnName := 'nbCancel'; nbRefresh: BtnName := 'nbRefresh'; end; MessageDlg('Была нажата кнопка' + BtnName, mtInformation, [mbOK], 0); end;

[001229]

Свойства кнопок DBNavigator

Как можно узнать значения свойств кнопок компонента DBNavigator (enabled/disabled или видимая/невидимая)?

Для определения видимости вы можете использовать свойство VisibleButtons. Например:

if nbRefresh in DBNavigator1.VisibleButtons then ShowMessage('Кнопка Refresh видимая') ;

Для того, чтобы узнать, активизирована (enabled/disabled) кнопка или нет:

{Вместо nbFirst вы можете определить другой член TNavigateBtn (например, nbFirst, nbPrior, nbNext, nbLast, nbInsert, nbDelete, nbEdit, nbPost, nbCancel, nbRefresh)} if DBNavigator1.Controls[Ord(nbFirst)].Enabled then ShowMessage('Кнопка First активизирована') ;

[000553]

Выключение кнопок в DBNavigator

{ Расширение DBNavigator: позволяет разработчику включать и выключать отдельные кнопки через методы EnableButton и DisableButton } unit GNav; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, DBCtrls; type TMyNavigator = class(TDBNavigator) public procedure EnableButton(Btn : TNavigateBtn) ; procedure DisableButton(Btn : TNavigateBtn) ; end; procedure Register; implementation procedure TMyNavigator.EnableButton(Btn : TNavigateBtn) ; begin Buttons[Btn].Enabled := True ; end ; procedure TMyNavigator.DisableButton(Btn : TNavigateBtn) ; begin Buttons[Btn].Enabled := False ; end ; procedure Register; begin RegisterComponents('Samples', [TMyNavigator]); end; end.

[001165]

Вызов кнопок DBNavigator

Я думаю для этого отлично подойдет вызов public-метода BtnClick(nbButton). Я догадываюсь, почему они не назвали его просто "Click", поскольку это метод события OnClick :-) .

Я делаю приблизительно так:

DBNavigator1.BtnClick(nbInsert);

Это автоматически переключит таблицу в режим Insert, как будто была нажата соответствующая кнопка DBNavigator.

Я не знаю, задокументирована эта "фича", рекомендована ли для таких случаев... Просто у меня это работает и я этим пользуюсь. [000499]

Событие OnChange компонента DBRadioGroup

Событие OnChange не возникает, если свойство Values компонента DBRadioGroup изменяется в результате щелчка мышью на кнопке.

Событие OnChange не возникает даже тогда, когда при помощи мыши я пытаюсь изменить значение компонента и переместить фокус на другое поле TDBEdit, расположенное на той же форме. Это наверняка ошибка (BUG). Почему изменение величины мышью обрабатывается иначе, чем при использовании клавиатуры? По аналогии с TDBLookupCombo, в чем разница между щелчком мьшью на выпадающем списке (чье событие OnChange возникает мгновенно) и щелчком на радиокнопке в DBRadioGroup? [000333]

DCOM

О технологии DCOM. Я написал 3-звенное распределенное RDBMS-приложение, используя новые модули удаленных данных (Remote Data Modules) из поставки Delphi3. Я добавил некоторые собственные интерфейсы и методы в мой удаленный модуль данных для поддержки пользовательских SQL-запросов от клиента. (Была такая необходимость.) Все заработало просто замечательно, но самая отрадная весть - вся клиентская часть приложения представляла собой всего-лишь 2 файла! Без BDE! Без RDBMS-клиента! Без конфигурации! Классно, правда? Всего два файла - my.exe и 'dbclient.dll'.

Мой проект всего-лишь демонстрирует данную технологию и на момент написания совета он все же медленнее, чем 2-звенный метод, но я потратил на кодирование всего лишь 2 дня, а оптимизация кода потребует еще некоторе время. Я также подозреваю, что медленная работа моего ORB связана с функционированием его на той же сильно загруженной машине, на какой я и разрабатываю свои программы.

Кто-нибудь еще разрабатывал DCOM-объекты? Я хотел бы здесь начать цикл статей (советов) о применении Delphi для создания распределенных приложений. В течение ближайших месяцев я должен разработать несколько распределенных приложений уровня предприятия. Для пользы дела я берусь опубликовать все ваши наработки, подсказки, хитрости и ньюансы технологии, присланные по электронной почте.

Приведу пример:

Экспорт DB-компонентов из модулей удаленных данных

После того, как Вы создали приложение с использованием пункта меню New->Remote Data Module при создании модуля данных сервера приложений, Вам необходимо экспортировать все необходимые для него TDataSet и TProviders-компоненты. Для этого щелкните на них правой кнопкой мыши и выберите пункт экспорта их Вашего модуля данных.

Добавление Ваших собственных методов в модули удаленных данных

Есть два пути решения задачи. При нажатии правой кнопки мыши в окне исходного кода, возникающего при просмотре исходников модулей удаленных данных, вызывается контекстное меню, содержащее пункт "Add to Interface". Это мини-Мастер, позволяющий создать процедуру, функцию или декларацию какого-либо свойства. Он последовательно предложит заполнить необходимые поля на нескольких экранах (каждый экран содержит поясняющую информацию). Не забывайте о том, что Вы просто не сможете ввести какие-либо данные для Ваших параметров. OLE/COM/DCOM/ActiveX/Whatever в Delphi поддерживают только некоторое подмножество типов данных. (например, тип WideString вместо типа String) Полный список поддерживаемых типов доступен в разделе 'types:type libraries' электронной справки.

После прохождения всех этапов Мастера, Delphi переместит курсор в правую часть страницы для генерации кода нового метода.

Второй способ заключается в использовании редактора библиотеки типов (меню View->Type Library). Это лучшее решение в случае, если Вам необходимо добавить большое количество новых методов. Сначала Вы можете разместить их здесь и включить в свой код позже. При записи кода на диск, в отличие от создаваемых в Delphi заголовков обработчиков событий, редактор библиотеки типов не удалит их даже в случае, если тело метода остается пустым.

Доступ к методам из модуля удаленных данных (или другого COM-объекта)

Единственное мною обнаруженное решение состоит в использовании компонента TRemoteServer (закладка Data Access). Установите в свойствах компонента имя компьютера и имя сервера. После этого можно обратиться к любому существующему методу, например:

MyDataModule.MyRemoteServer.AppServer.MyCustomMethod( myParam, myParam2 );

Код использует свойство AppServer компонента TRemoteServer. Данное свойства имеет тип Variant, и в данном случае имеет отношение к модулю удаленных данных. Во время компиляции Delphi не обращает внимание на имя вызываемого метода, так как выяснить его наличие можно только во время его вызова. Проверьте это во время прогона программы.

Проблема с добавлением Ваших собственных методов с интерфейсами в библиотеку типов.

При добавлении методов в модуль удаленных данных через новые интерфейсы, я столкнулся со странной проблемой. После создания новых интерфейсов, кодирования, сохранения, закрытия и повторного открытия проекта, Delphi иногда добавляет ключевое слово 'const' к спискам параметров новых интерфейсов. При этом Delphi -не делает- обновления списка параметров в коде модуля удаленных данных, поэтому при компиляции вновь открытого проекта компилятор ругается на противоречивые декларации метода. Затем мне приходится вручную добавлять ключевое слово 'const' к декларациям данных и определений методов модуля. После все работает как часы. Так что не забывайте про ключевое слово 'const'. По крайней мере это выработало во мне определенный рефлекс, и я "на автопилоте" добавляю его во все списки параметров моего метода.

Это может служить проблемой для методов, модифицирующих какие-либо параметры. Может DCOM это не поддерживает? Какие идеи?

[000073]

Отклик 1 - Сергей Качалов

Привет, Валь!

>Кто-нибудь еще разрабатывал DCOM-объекты?

Отчасти. Как только я за них вплотную взялся, еще с Delphi3 так тут же выяснились некоторые скверные детали:

1. DCOM не поддерживается в стандартной поставке Win95, только на NT. Для того, чтобы заставить клиентское приложение работать, надо либо доустанавливать на 95 поддержку DCOM, либо иметь у клиента NT (Ws или сервер - все равно). Насчет 98 не знаю.
2. На сервере надо устанавливать специальные права доступа с помощью утилиты Dcomcnfg.exe

Лично мне так и не удалось заставить ЭТО работать в РЕАЛЬНОЙ обстановке. т.е. не на одной машине, в качестве эксперимента (с этим все OK), а именно в распределенной системе. А у тебя получилось?

Зато все прекрасно получилось с Delphi4, только не с помощью DCOMConnection, а с помощью SocketConnection. Строго говоря, сама технология COM при этом никуда не девается, но она полностью остается на стороне сервера. У клиента действительно устанавливается только два файла, о которых ты упомянул. В качестве недостатка (относительного) - понижение уровня защиты. Все остальное остается на своих местах. Я пробовал. Более того, в качестве экстремальных испытаний я добился вполне сносной работы при соединении клиента модемом на 2400!

Существует и еще один интересный момент. Можно заставить программу работать с базой данных без BDE. Стандартными методами.
Боюсь ошибиться, еще осенью это проделывал, но саму технологию испытал - работает. Смысл в том, что в клиентской программе, работающей с базой данных, для соединения с данными используется CLientDataSet, вернее, его свойство сохранять работоспособность при временном отключении от базы данных. В качестве базы данных _временно_ используется локальный файл. Как известно, нет ничего более постоянного, чем "временное" :)
Сначала создается реальная таблица. Потом в приложении цепляешься к данным следующим образом:
TTable -> Provider -> ClientDataSet -> DataSource -> (далее по вкусу) В ClientDataSet делаешь непустым свойство FileName.
Активизируешь все это. В результате в файле, имя которого ты указал, создается рабочий буфер Ttable.
Свойство Active у ClientDataSet сбрасываешь в False.
Удаляешь из проекта TTable - больше он не нужен. (можно, собственно, и оставить - мешать не будет). С таким же успехом, вообще говоря, там может быть и TQuery.

Чего я не испытывал, так это "предела прочности" такой схемы, то есть как долго и с каким размером подобная "база данных" будет работать без сбоев. На тестовом проекте никаких проблем не возникало.

[-skip(личная переписка)-]

Всего.
Сергей Качалов. [000143]

Отклик 2 - Василий Цыхмыстро

Может быть это не совсем моё дело (если так, то я конечно извиняюсь), но прочитав "Советы" (Версия 1.1.7 от 1.12.1999) по DCOM я хотел бы коё-что про это рассказать. Если это не пригодиться, то прошу прощения за навязчивость...

Когда я занялся этим вопросом, то пришёл к выводу, что: Если делать локатьную базу данных с помощью одного лишь TClientDataSet и dbclient.dll, то в этой базе данных будут храниться не только данные как таковые, но и их эволюция, т.е. все изменения, происходящие с базой, притом точно в той же последовательности, в какой они были сделаны (удалённые записи и старый вид модифицированных). Следовательно, эта база представляет собой последовательный список изменений... И последовательным вызовом UndoLastChange можно вернуться к самому началу - пустой базе. Размер этой базы данных пропорционален количеству изменений, и, поэтому, её лучше не использовать для каких-либо проектов, кроме самых маленьких... Когда же я вызывал CloneCursor в надежде, что лишняя информация отбросится, то... зря я это делал.

От другого читателя:

Все это правильно, однако открываем Help и читаем: >procedure MergeChangeLog; >Description >Call MergeChangeLog to merge changes in the change log into the actual data for the >dataset, effectively creating a new data baseline. Existing values for which changes >exist are overwritten. >Note >Ordinarily, applications need not call this method. It is called automatically by >ApplyUpdates as part of the updating process. Все, проблема избыточных данных решена.

Vadim Petrov

Настроить DCOM под Windows 98 можно - было предусмотренно, но главным недостатком в этом случае является то, что для подключения к приложению DCOM-серверу необходимо, чтобы последний был запущен. (Это из-за того, что при настройке в Dcomcnfg сильно с настройками не разбежишься - выбор мал). Под Windows NT (проверенно под 4 версию) DCOM технология работает лучше, но надо настроить нормально для правильной работы. Эксперементально проверены на работоспособность следующие настройки: Authentication Level - Connect Impersonation Level - Identify Identify - The interactive user Последняя, в часности, позволила запускаться приложению-серверу не как службе (я приложение-сервер не как службу писал)...

Очень буду рад, если это поможет ещё кому-то, кроме меня...

С уважением, Chronic
(Василий Цыхмыстро) [000507]

В чем разница между сокетами, DCOM и OLE Enterprise при использовании их в качестве транспорта?

Nomadic отвечает:

Sockets (TCP/IP): на клиентах и сервере требуется наличие стека TCP/IP; не требуется дополнительной настройки клиентов; DCOM: на клиентах и серверах требуется наличие DCOM (входит в состав Windows NT 4.0, для Windows 95 доступен как опция) требуется настройка клиентов (DCOM Configuration Utility - DCOMCNFG.EXE); встроенная поддержка модели безопасности Windows NT; поддержка обратных вызовов (методов); CORBA на клиентах и серверах требуется наличие Common Object Request Broker; требуется настройка клиентов; поддержка обратных вызовов (методов); OLE Enterprise: на клиентах и серверах требуется наличие OLE Enterprise; требуется настройка клиентов; поддержка обратных вызовов (методов). [001454]

DDE - передача текста

Вот я как работаю с Excel:

type DDEClientConv1.SetLink('Excel','Sheet1'); try DDEClientConv1.OpenLink; DDEClientItem1.DDEItem:= 'R1C1'; DDEClientConv1.PokeData(DDEClientItem1.DDEItem, StrPCopy(P, SomeString))); finally DDEClientConv1.CloseLink; end;

Как вы можете здесь видеть, свойство DDEItem определяется сервером. Если ваш сервер является приложением Delphi, то DDEItem - имя DDEServerItem. На вашем месте я бы не стал так долго заниматься отладкой DDE-программ. Воспользуйтесь синхронизацией, позволяющей понять при отладке правильность действий. [001419]

GROUPFILE и ADDITEM для групп

Вот код для создания файла группы и добавления в группу файла-элемента. Чтобы использовать эту процедуру, определите DDE clientconv App как ProgMan.

procedure TMainForm.CreateWinGroup(Sender: TObject); var Name: string; Name1: string; Macro: string; Macro1: string; Cmd, Cmd1: array[0..255] of Char; begin {destDir - dos-каталог, хранящий YourFile.Ext'} Name := 'GroupName'; Name1 := destDir + 'YourFile.Ext, FileName_in_Group '; Macro := Format('[CreateGroup(%s)]', [Name]) + #13#10; Macro1 :=Format('[Additem(%s)]',[Name1]) +#13#10; StrPCopy (Cmd, Macro); StrPCopy (cmd1, Macro1); DDEClient.OpenLink; if not DDEClient.ExecuteMacro(Cmd, False) then MessageDlg('Невозможно создать группу '+Name,mtInformation, [mbOK], 0) else begin DDEClient.ExecuteMacro(Cmd1, False); end; DDEClient.CloseLink; end;

[001423]

Как добавить группу в Program Manager?

interface procedure CreateGroup; implementation procedure TSetupForm.CreateGroup; { Для установки группы в Program Manager используем компонент TProgMan } var ItemList: TStringList; GroupName: String; ItemName: String; i: word; begin { Получаем из INI-файла строку GroupName } GroupName := IniFile.ReadString('General', 'PMGroup', ''); { Если один есть, устанавливаем группу } if GroupName <> '' then begin ItemList := TStringList.Create; try { читаем элементы для установки } IniFile.ReadSectionValues('PMGroup', ItemList); with TProgMan.Create(Self) do try CreateGroup(GroupName); for i := 0 to ItemList.Count - 1 do begin { получаем имя файла }ItemName := Copy(ItemList.Strings[i], 1, Pos('=', ItemList.Strings[i]) - 1); { прибавляем путь к имени файла и добавляем элемент } AddItem(GetTarget(ItemList.Values[ItemName][1]) + ItemName, ItemName); end; finally Free; end; finally ItemList.Free; end; end; end;

[001426]

Как можно работать с DDE под Delphi, используя вызовы API?

Кстати, достаточно легко: следующий пример демонстрирует как можно научить общаться клиентскую программу с программой-сервером. Обе программы полностью созданы на Delphi. В итоге мы имеет 2 проекта, 3 формы и 3 модуля. Для работы с DDE-запросами данный пример использует методы DDE ML API.

Сервер должен начать свою работу перед тем, как клиент будет загружен. Данный пример демонстрирует 3 способа взаимодействия между клиентом и сервером: Клиент может "пропихивать" (POKE) данные на сервер. Сервер может автоматически передавать данные клиенту, после чего клиент обновляет свой вид на основе результатов, полученных от сервера. Данные сервера изменяются, после чего клиент делает запрос серверу для получения новых данных и обновляет свой вид. Как работает программа.

Ниже приведены 8 файлов, сконкатенированных в единое целое. Каждый файл имеет следующую структуру:
{ *** НАЧАЛО КОДА FILENAME.EXT *** } КОД { *** КОНЕЦ КОДА FILENAME.EXT *** },
поэтому вам остается всего-лишь взять код, расположенный между маркерами { *** }, скопировать в файл с соответствующим именем, и собрать оба проекта в среде Delphi

{ *** НАЧАЛО КОДА DDEMLCLI.DPR *** } program Ddemlcli; uses Forms, Ddemlclu in 'DDEMLCLU.PAS' {Form1}; {$R *.RES} begin Application.CreateForm(TForm1, Form1); Application.Run; end. { ***  КОНЕЦ КОДА DDEMLCLI.DPR *** } { *** НАЧАЛО КОДА DDEMLCLU.DFM *** } object Form1: TForm1 Left = 197 Top = 95 Width = 413 Height = 287 HorzScrollBar.Visible = False VertScrollBar.Visible = False Caption = 'Демонстрация DDEML, Клиентское приложение' Font.Color = clWindowText Font.Height = -13 Font.Name = 'System' Font.Style = [] Menu = MainMenu1 PixelsPerInch = 96 OnCreate = FormCreate OnDestroy = FormDestroy OnShow = FormShow TextHeight = 16 object PaintBox1: TPaintBox Left = 0 Top = 0 Width = 405 Height = 241 Align = alClient Color = clWhite ParentColor = False OnPaint = PaintBox1Paint end object MainMenu1: TMainMenu Top = 208 object File1: TMenuItem Caption = '&Файл' object exit1: TMenuItem Caption = 'В&ыход' OnClick = exit1Click end end object DDE1: TMenuItem Caption = '&DDE' object RequestUpdate1: TMenuItem Caption = '&Запрос на обновление' OnClick = RequestUpdate1Click end object AdviseofChanges1: TMenuItem Caption = '&Сообщение об изменениях' OnClick = AdviseofChanges1Click end object N1: TMenuItem Caption = '-' end object PokeSomeData: TMenuItem Caption = '&Пропихивание данных' OnClick = PokeSomeDataClick end end end end { ***  КОНЕЦ КОДА DDEMLCLU.DFM *** } { *** НАЧАЛО КОДА DDEMLCLU.PAS *** } {***************************************************} {                                                   } {   Delphi 1.0 DDEML Демонстрационная программа     } {   Copyright (c) 1996 by Borland International     } {                                                   } {***************************************************} { Это демонстрационное приложение, демонстрирующее использование DDEML API в клиентском приложении. Оно использует серверное приложение DataEntry, которое является частью данной демонстрации, и служит для ввода данных и отображения их на графической панели. Сначала вы должны запустить приложение-сервер (в DDEMLSRV.PAS), а затем стартовать клиента. Если сервер не запущен, клиент при попытке соединения потерпит неудачу. Интерфейс сервера определен списком имен (Service, Topic и Items) в отдельном модуле с именем DataEntry (DATAENTR.TPU). Сервер делает Items доступными в формате cf_Text; они преобразовываются и хранятся локально как целые. } unit Ddemlclu; interface uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, VBXCtrl, ExtCtrls, DDEML, Menus, StdCtrls; const NumValues = 3; type { Структура данных, представленная в примере } TDataSample = array [1..NumValues] of Integer; TDataString = array [0..20] of Char;     { Размер элемента как текста } { Главная форма } TForm1 = class(TForm) MainMenu1: TMainMenu; File1: TMenuItem; exit1: TMenuItem; DDE1: TMenuItem; RequestUpdate1: TMenuItem; AdviseofChanges1: TMenuItem; PokeSomeData: TMenuItem; N1: TMenuItem; PaintBox1: TPaintBox; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure RequestUpdate1Click(Sender: TObject); procedure FormShow(Sender: TObject); procedure AdviseofChanges1Click(Sender: TObject); procedure PokeSomeDataClick(Sender: TObject); procedure Request(HConversation: HConv); procedure exit1Click(Sender: TObject); procedure PaintBox1Paint(Sender: TObject); private { Private declarations } public Inst: Longint; CallBackPtr: ^TCallback; ServiceHSz : HSz; TopicHSz  : HSz; ItemHSz    : array [1..NumValues] of HSz; ConvHdl    : HConv; DataSample : TDataSample; end; var Form1: TForm1; implementation const DataEntryName : PChar = 'DataEntry'; DataTopicName : PChar = 'SampledData'; DataItemNames : array [1..NumValues] of pChar = ('DataItem1', 'DataItem2', 'DataItem3'); {$R *.DFM} { Локальная функция: Процедура обратного вызова для DDEML } function CallbackProc(CallType, Fmt: Word; Conv: HConv; hsz1, hsz2: HSZ; Data: HDDEData; Data1, Data2: Longint): HDDEData; export; begin CallbackProc := 0;    { В противном случае смотрите доказательство } case CallType of xtyp_Register: begin { Ничего ... Просто возвращаем 0 } end; xtyp_Unregister: begin { Ничего ... Просто возвращаем 0 } end; xtyp_xAct_Complete: begin { Ничего ... Просто возвращаем 0 } end; xtyp_Request, Xtyp_AdvData: begin Form1.Request(Conv); CallbackProc := dde_FAck; end; xtyp_Disconnect: begin ShowMessage('Соединение разорвано!'); Form1.Close; end; end; end; { Посылка DDE запроса для получения cf_Text данных с сервера. Запрашиваем данные для всех полей DataSample, и обновляем окно для их отображения. Данные с сервера получаем синхронно, используя DdeClientTransaction.} procedure TForm1.Request(HConversation: HConv); var hDdeTemp : HDDEData; DataStr  : TDataString; Err, I  : Integer; begin if HConversation <> 0 then begin for I := Low(ItemHSz) to High(ItemHSz) do begin hDdeTemp := DdeClientTransaction(nil, 0, HConversation, ItemHSz[I], cf_Text, xtyp_Request, 0, nil); if hDdeTemp <> 0 then  begin DdeGetData(hDdeTemp, @DataStr, SizeOf(DataStr), 0); Val(DataStr, DataSample[I], Err); end; { if } end; { for } Paintbox1.Refresh; { Обновляем экран } end; { if } end; procedure TForm1.FormCreate(Sender: TObject); var I : Integer; { Создаем экземпляр окна DDE-клиента. Создаем окно, используя унаследованный конструктор, инициализируем экземпляр данных.} begin Inst       := 0;      { Должен быть нулем для первого вызова DdeInitialize } CallBackPtr:= nil;    { MakeProcInstance вызывается из SetupWindow    } ConvHdl    := 0; ServiceHSz := 0; TopicHSz   := 0; for I := Low(DataSample) to High(DataSample) do begin ItemHSz[I]    := 0; DataSample[I] := 0; end; end; procedure TForm1.FormDestroy(Sender: TObject); { Уничтожаем экземпляр клиентского окна. Освобождаем дескрипторы DDE строк, и освобождаем экземпляр функции обратного вызова, если она существует. Также, для завершения диалога, вызовите DdeUninitialize. Затем, для завершения работы, вызовите разрушителя предка. } var I : Integer; begin if ServiceHSz <> 0 then DdeFreeStringHandle(Inst, ServiceHSz); if TopicHSz <> 0 then DdeFreeStringHandle(Inst, TopicHSz); for I := Low(ItemHSz) to High(ItemHSz) do if ItemHSz[I] <> 0 then DdeFreeStringHandle(Inst, ItemHSz[I]); if Inst <> 0 then DdeUninitialize(Inst);   { Игнорируем возвращаемое значение } if CallBackPtr <> nil then FreeProcInstance(CallBackPtr); end; procedure TForm1.RequestUpdate1Click(Sender: TObject); begin { Генерируем запрос DDE в ответ на выбор пункта меню DDE | Request.} Request(ConvHdl); end; procedure TForm1.FormShow(Sender: TObject); { Завершаем инициализацию окна сервера DDE. Выполняем те действия, которые требует правильное окно. Инициализируем использование DDEML. } var I     : Integer; InitOK: Boolean; begin CallBackPtr := MakeProcInstance(@CallBackProc, HInstance); { Инициализируем DDE и устанавливаем функцию обратного вызова. Если сервер отсутствует, вызов терпит неудачу. } if CallBackPtr <> nil then begin if DdeInitialize(Inst, TCallback(CallBackPtr), AppCmd_ClientOnly, 0) = dmlErr_No_Error then begin ServiceHSz:= DdeCreateStringHandle(Inst, DataEntryName, cp_WinAnsi); TopicHSz  := DdeCreateStringHandle(Inst, DataTopicName, cp_WinAnsi); InitOK := True; {     for I := Low(DataItemNames) to High(DataItemNames) do begin } for I := 1 to NumValues do begin ItemHSz[I]:= DdeCreateStringHandle(Inst, DataItemNames[I], cp_WinAnsi); InitOK := InitOK and (ItemHSz[I] <> 0); 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 '\DELPHI\BIN\DDEDLG.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 = clWindowText Font.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: TMainMenu Left = 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 "заинтересованным" клиентам. Данный сервер предоставляет свои услуги (сервисы) для данных со следующими именами: Service: 'DataEntry' Topic  : 'SampledData' Items  : 'DataItem1', 'DataItem2', 'DataItem3' В-принципе, в качестве сервисов могли бы быть определены и другие темы. Полезными темами, на наш взгляд, могут быть исторические даты, информация о сэмплах и пр.. Вы должны запустить этот сервер ПЕРЕД тем как запустите клиента (DDEMLCLI.PAS), в противном случае клиент не сможет установить связь. Интерфейс для этого сервера определен как список имен (Service, Topic и Items) в отдельном модуле с именем DataEntry (DATAENTR.TPU). Сервер делает Items доступными в формате cf_Text; они преобразовываются и хранятся у клиента локально как целые. } unit Ddesvru; interface uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Menus, DDEML,     { DDE APi } ShellApi; const NumValues = 3; DataItemNames : array [1..NumValues] of PChar = ('DataItem1', 'DataItem2', 'DataItem3'); type TDataString = array [0..20] of Char;      { Размер элемента как текста } TDataSample = array [1..NumValues] of Integer; {type { Структура данных, составляющих образец } {  TDataSample = array [1..NumValues] of Integer; {  TDataString = array [0..20] of Char;     { Размер элемента как текста } const DataEntryName: PChar = 'DataEntry'; DataTopicName: PChar = 'SampledData'; type TForm1 = 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; procedure Exit1Click(Sender: TObject); function MatchTopicAndService(Topic, Service: HSz): Boolean; function MatchTopicAndItem(Topic, Item: HSz): Integer; function WildConnect(Topic, Service: HSz; ClipFmt: Word): HDDEData; function AcceptPoke(Item: HSz; ClipFmt: Word; Data: HDDEData): Boolean; function DataRequested(TransType: Word; ItemNum: Integer; ClipFmt: Word): HDDEData; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormShow(Sender: TObject); procedure EnterData1Click(Sender: TObject); procedure Clear1Click(Sender: TObject); private Inst       : Longint; CallBack   : TCallback; ServiceHSz : HSz; TopicHSz   : HSz; ItemHSz    : array [1..NumValues] of HSz; ConvHdl    : HConv; Advising   : array [1..NumValues] of Boolean; DataSample : TDataSample; public { Public declarations } end; var Form1: TForm1; implementation uses DDEDlg; { Форма DataEntry } {$R *.DFM} procedure TForm1.Exit1Click(Sender: TObject); begin Close; end; { Глобальная инициализация } const DemoTitle   : PChar = 'DDEML демо, серверное приложение'; MaxAdvisories = 100; NumAdvLoops : Integer = 0; { Локальная функция: Процедура обратного вызова для DDEML } { Данная функция обратного вызова реагирует на все транзакции, генерируемые DDEML. Объект "target Window" (окно-цель) берется из глобально хранимых, и для реагирования на данную транзакцию, тип которой указан в параметре CallType, используются подходящие методы этих объектов.} function CallbackProc(CallType, Fmt: Word; Conv: HConv; HSz1, HSz2: HSZ; Data: HDDEData; Data1, Data2: Longint): HDDEData; export; var ItemNum   : Integer; begin CallbackProc := 0;    { В противном случае смотрите доказательство } case CallType of xtyp_WildConnect: CallbackProc := Form1.WildConnect(HSz1, HSz2, Fmt); xtyp_Connect: if Conv = 0 then begin if Form1.MatchTopicAndService(HSz1, HSz2) then CallbackProc := 1;   { Связь! } end; { После подтверждения установки соединения записываем дескриптор связи как родительское окно.} xtyp_Connect_Confirm: Form1.ConvHdl := Conv; { Клиент запрашивает данные, делает прямой запрос или отвечает на уведомление. Возвращаем текущее состояние данных.} xtyp_AdvReq, xtyp_Request: begin ItemNum := Form1.MatchTopicAndItem(HSz1, HSz2); if ItemNum > 0 then CallbackProc := Form1.DataRequested(CallType, ItemNum, Fmt); end; { Отвечаем на Poke-запрос ... данная демонстрация допускает только Pokes для DataItem1. Для подтверждения получения запроса возвращаем dde_FAck, в противном случае 0.} xtyp_Poke: begin if Form1.AcceptPoke(HSz2, Fmt, Data) then CallbackProc := dde_FAck; end; { Клиент сделал запрос для старта цикла-уведомления. Имейте в виду, что мы организуем "горячий" цикл. Устанавливаем флаг Advising для указания открытого цикла, который будет проверять данные на предмет их изменения.} xtyp_AdvStart: begin ItemNum := Form1.MatchTopicAndItem(HSz1, HSz2); if ItemNum > 0 then begin if NumAdvLoops < MaxAdvisories then begin { Произвольное число } Inc(NumAdvLoops); Form1.Advising[ItemNum] := True; CallbackProc := 1; end; end; end; { Клиент сделал запрос на прерывание цикла-уведомления.} xtyp_AdvStop: begin ItemNum := Form1.MatchTopicAndItem(HSz1, HSz2); if ItemNum > 0 then begin if NumAdvLoops > 0 then begin Dec(NumAdvLoops); if NumAdvLoops = 0 then Form1.Advising[ItemNum] := False; CallbackProc := 1; end; end; end; end;  { Case CallType } end; { Возращает True, если данные Topic и Service поддерживаются этим приложением. В противном случае возвращается False.} function TForm1.MatchTopicAndService(Topic, Service: HSz): Boolean; begin Result := False; if DdeCmpStringHandles(TopicHSz, Topic) = 0 then if DdeCmpStringHandles(ServiceHSz, Service) = 0 then Result := True; end; { Определяем, один ли Topic и Item поддерживается этим приложением. Возвращаем номер заданного элемента (Item Number) (в пределах 1..NumValues), если он обнаружен, и ноль в противном случае.} function TForm1.MatchTopicAndItem(Topic, Item: HSz): Integer; var I : Integer; begin Result := 0; if DdeCmpStringHandles(TopicHSz, Topic) = 0 then for I := 1 to NumValues do if DdeCmpStringHandles(ItemHSz[I], Item) = 0 then Result := I; end; { Отвечаем на запрос wildcard-соединения (дословно - дикая карта, шаблон). Такие запросы возникают всякий раз, когда клиент пытается подключиться к серверу с сервисом или именем топика, установленного в 0. Если сервер обнаруживает использование такого рода шаблона, он возвращает дескриптор массива THSZPair, содержащего найденные по шаблону Service и Topic.} function TForm1.WildConnect(Topic, Service: HSz; ClipFmt: Word): HDDEData; var TempPairs: array [0..1] of THSZPair; Matched  : Boolean; begin TempPairs[0].hszSvc  := ServiceHSz; TempPairs[0].hszTopic:= TopicHSz; TempPairs[1].hszSvc  := 0;     { 0-завершает список } TempPairs[1].hszTopic:= 0; Matched := False; if (Topic= 0) and (Service = 0) then Matched := True                    { Шаблон обработан, элементов не найдено } else if (Topic = 0) and (DdeCmpStringHandles(Service, ServiceHSz) = 0) then Matched := True else if (DdeCmpStringHandles(Topic, TopicHSz) = 0) and (Service = 0) then Matched := True; if Matched then WildConnect := DdeCreateDataHandle(Inst, @TempPairs, SizeOf(TempPairs), 0, 0, ClipFmt, 0) else WildConnect := 0; end; { Принимаем и проталкиваем данные по просьбе клиента. Для демонстрации этого способа используем только значение DataItem1, изменяемое Poke.} function TForm1.AcceptPoke(Item: HSz; ClipFmt: Word; Data: HDDEData): Boolean; var DataStr    : TDataString; Err       : Integer; TempSample: Integer; begin if (DdeCmpStringHandles(Item, ItemHSz[1]) = 0) and (ClipFmt = cf_Text) then begin DdeGetData(Data, @DataStr, SizeOf(DataStr), 0); Val(DataStr, TempSample, Err); if IntToStr(TempSample) <> Label6.Caption then begin Label6.Caption := IntToStr(TempSample); DataSample[1] := TempSample; if Advising[1] then DdePostAdvise(Inst, TopicHSz, ItemHSz[1]); end; AcceptPoke := True; end else AcceptPoke := False; end; { Возвращаем данные, запрашиваемые значениями TransType и ClipFmt. Такое может произойти в ответ на просьбу xtyp_Request или xtyp_AdvReq. Параметр ItemNum указывает на поддерживаемый (в диапазоне 1..NumValues) и требуемый элемент (обратите внимание на то, что данный метод подразумевает, что вызывающий оператор уже установил достоверность и ID требуемого пункта с помощью MatchTopicAndItem). Соответствующие данные из переменной экземпляра DataSample преобразуются в текст и возвращаются клиенту.} function TForm1.DataRequested(TransType: Word; ItemNum: Integer; ClipFmt: Word): HDDEData; var ItemStr: TDataString;   { Определено в DataEntry.TPU } begin if ClipFmt = cf_Text then begin Str(DataSample[ItemNum], ItemStr); DataRequested := DdeCreateDataHandle(Inst, @ItemStr, StrLen(ItemStr) + 1, 0, ItemHSz[ItemNum], ClipFmt, 0); end else DataRequested := 0; end; { Создаем экземпляр окна DDE сервера. Вызываем унаследованный конструктор, затем устанавливаем эти объекты родителями экземпляров данных. } procedure TForm1.FormCreate(Sender: TObject); var I : Integer; begin Inst      := 0;      { Должен быть нулем для первого вызова DdeInitialize } @CallBack := nil;    { MakeProcInstance вызывается из SetupWindow         } for I := 1 to NumValues do begin DataSample[I] := 0; Advising[I]  := False; end; { for } end; { Разрушаем экземпляр окна DDE сервера. Проверяем, был ли создан экземпляр процедуры обратного вызова, если он существует. Также, для завершения диалога, вызовите DdeUninitialize. Затем, для завершения работы, вызовите разрушителя предка.} procedure TForm1.FormDestroy(Sender: TObject); var I : Integer; begin if ServiceHSz <> 0 then DdeFreeStringHandle(Inst, ServiceHSz); if TopicHSz <> 0 then DdeFreeStringHandle(Inst, TopicHSz); for I := 1 to NumValues do if ItemHSz[I] <> 0 then DdeFreeStringHandle(Inst, ItemHSz[I]); if Inst <> 0 then DdeUninitialize(Inst);   { Игнорируем возвращаемое значение } if @CallBack <> nil then FreeProcInstance(@CallBack); end; procedure TForm1.FormShow(Sender: TObject); var I : Integer; { Завершаем инициализацию окна DDE сервера. Процедура инициализации использует DDEML для регистрации сервисов, предусмотренных данным приложением. Помните о том, что реальные имена, использованные в регистрах, определены в отдельном модуле (DataEntry), поэтому они могут быть использованы и клиентом. } begin @CallBack:= MakeProcInstance(@CallBackProc, HInstance); if DdeInitialize(Inst, CallBack, 0, 0) = dmlErr_No_Error then begin ServiceHSz:= DdeCreateStringHandle(Inst, DataEntryName, cp_WinAnsi); TopicHSz  := DdeCreateStringHandle(Inst, DataTopicName, cp_WinAnsi); for I := 1 to NumValues do ItemHSz[I] := DdeCreateStringHandle(Inst, DataItemNames[I], cp_WinAnsi); if DdeNameService(Inst, ServiceHSz, 0, dns_Register) = 0 then ShowMessage('Ошибка в процессе регистрации.'); end; end; procedure TForm1.EnterData1Click(Sender: TObject); { Активизируем диалог ввода данных и обновляем хранимые данные по окончании ввода.} var I: Integer; begin if DataEntry.ShowModal = mrOk then begin with DataEntry do begin Label6.Caption := S1; Label7.Caption := S2; Label8.Caption := S3; DataSample[1] := StrToInt(S1); DataSample[2] := StrToInt(S2); DataSample[3] := StrToInt(S3); end; { with } for I := 1 to NumValues do if Advising[I] then DdePostAdvise(Inst, TopicHSz, ItemHSz[I]); end; { if } end; procedure TForm1.Clear1Click(Sender: TObject); { Очищаем текущую дату. } var I: Integer; begin for I := 1 to NumValues do begin DataSample[I] := 0; if Advising[I] then DdePostAdvise(Inst, TopicHSz, ItemHSz[I]); end; Label6.Caption := '0'; Label7.Caption := '0'; Label8.Caption := '0'; end; end. { ***  КОНЕЦ КОДА DDESVRU.PAS *** } { *** НАЧАЛО КОДА DDEDLG.DFM *** } object DataEntry: TDataEntry Left = 488 Top = 132 ActiveControl = OKBtn BorderStyle = bsDialog Caption = 'Ввод данных' ClientHeight = 264 ClientWidth = 199 Font.Color = clBlack Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [fsBold] PixelsPerInch = 96 Position = poScreenCenter OnShow = FormShow TextHeight = 13 object Bevel1: TBevel Left = 8 Top = 8 Width = 177 Height = 201 Shape = bsFrame IsControl = True end object OKBtn: TBitBtn Left = 16 Top = 216 Width = 69 Height = 39 Caption = '&OK' ModalResult = 1 TabOrder = 3 OnClick = OKBtnClick Glyph.Data = { BE060000424DBE06000000000000360400002800000024000000120000000100 0800000000008802000000000000000000000000000000000000000000000000 80000080000000808000800000008000800080800000C0C0C000C0DCC000F0CA A600000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000F0FBFF00A4A0A000808080000000 FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00030303030303 0303030303030303030303030303030303030303030303030303030303030303 03030303030303030303030303030303030303030303FF030303030303030303 03030303030303040403030303030303030303030303030303F8F8FF03030303 03030303030303030303040202040303030303030303030303030303F80303F8 FF030303030303030303030303040202020204030303030303030303030303F8 03030303F8FF0303030303030303030304020202020202040303030303030303 0303F8030303030303F8FF030303030303030304020202FA0202020204030303 0303030303F8FF0303F8FF030303F8FF03030303030303020202FA03FA020202 040303030303030303F8FF03F803F8FF0303F8FF03030303030303FA02FA0303 03FA0202020403030303030303F8FFF8030303F8FF0303F8FF03030303030303 FA0303030303FA0202020403030303030303F80303030303F8FF0303F8FF0303 0303030303030303030303FA0202020403030303030303030303030303F8FF03 03F8FF03030303030303030303030303FA020202040303030303030303030303 0303F8FF0303F8FF03030303030303030303030303FA02020204030303030303 03030303030303F8FF0303F8FF03030303030303030303030303FA0202020403 030303030303030303030303F8FF0303F8FF03030303030303030303030303FA 0202040303030303030303030303030303F8FF03F8FF03030303030303030303 03030303FA0202030303030303030303030303030303F8FFF803030303030303 030303030303030303FA0303030303030303030303030303030303F803030303 0303030303030303030303030303030303030303030303030303030303030303 0303} Margin = 2 NumGlyphs = 2 Spacing = -1 IsControl = True end object CancelBtn: TBitBtn Left = 108 Top = 216 Width = 69 Height = 39 Caption = '&Отмена' TabOrder = 4 Kind = bkCancel Margin = 2 Spacing = -1 IsControl = True end object Panel2: TPanel Left = 16 Top = 88 Width = 153 Height = 49 BevelInner = bvLowered BevelOuter = bvNone TabOrder = 1 object Label1: TLabel Left = 24 Top = 8 Width = 5 Height = 13 end object Label2: TLabel Left = 8 Top = 8 Width = 48 Height = 13 Caption = 'Значение 2:' end object Edit2: TEdit Left = 8 Top = 24 Width = 121 Height = 20 MaxLength = 10 TabOrder = 0 Text = '0' end end object Panel1: TPanel Left = 16 Top = 16 Width = 153 Height = 49 BevelInner = bvLowered BevelOuter = bvNone TabOrder = 0 object Label4: TLabel Left = 8 Top = 8 Width = 48 Height = 13 Caption = 'Значение 1:' end object Edit1: TEdit Left = 8 Top = 24 Width = 121 Height = 20 MaxLength = 10 TabOrder = 0 Text = '0' end end object Panel3: TPanel Left = 16 Top = 144 Width = 153 Height = 49 BevelInner = bvLowered BevelOuter = bvNone TabOrder = 2 object Label6: TLabel Left = 8 Top = 8 Width = 48 Height = 13 Caption = 'Значение 3:' end object Edit3: TEdit Left = 8 Top = 24 Width = 121 Height = 20 MaxLength = 10 TabOrder = 0 Text = '0' end end end { ***   КОНЕЦ КОДА DDEDLG.DFM *** } { *** НАЧАЛО КОДА DDEDLG.PAS *** } {***************************************************} {                                                   } {   Delphi 1.0 DDEML Демонстрационная программа     } {   Copyright (c) 1996 by Borland International     } {                                                   } {***************************************************} { Данный модуль определяет интерфейс сервера DataEntry DDE (DDEMLSRV.PAS). Здесь определены имена Service, Topic, и Item, поддерживаемые сервером, и также определена структура данных, которая может использоваться клиентом для локального хранения "показательных" данных. Сервер Data Entry Server делает свои "показательные" данные доступными в текстовом виде (cf_Text) сформированными в виде трех различных топика (Topics). Клиент может их преобразовывать в целое для использования со структурой данных, которая здесь определена. } unit Ddedlg; interface uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons, StdCtrls, Mask, ExtCtrls; type TDataEntry = class(TForm) OKBtn: TBitBtn; CancelBtn: TBitBtn; Bevel1: TBevel; Panel2: TPanel; Label1: TLabel; Label2: TLabel; Panel1: TPanel; Label4: TLabel; Panel3: TPanel; Label6: TLabel; Edit1: TEdit; Edit2: TEdit; Edit3: TEdit; procedure OKBtnClick(Sender: TObject); procedure FormShow(Sender: TObject); private { Private declarations } public S1, S2, S3: String; { Public declarations } end; var DataEntry: TDataEntry; implementation {$R *.DFM} procedure TDataEntry.OKBtnClick(Sender: TObject); begin S1 := Edit1.Text; S2 := Edit2.Text; S3 := Edit3.Text; end; procedure TDataEntry.FormShow(Sender: TObject); begin Edit1.Text := '0'; Edit2.Text := '0'; Edit3.Text := '0'; Edit1.SetFocus; end; end. { ***  КОНЕЦ КОДА DDEDLG.PAS *** }

[001424]

Получение данных из Program Manager через DDE

Установите соединение DDEClientConv с сервером и установите обоим DdeTopic в 'ProgMan'. Вызовите RequestData и передайте 'Groups' как элемент (item); обратно вы получите список имен групп. Вызовите RequestData с одним из имен групп и вы получите детальную информцию о группе. Вероятно дальше вы захотите передать полученные данные в ListBox, т.к. сразу можно увидеть что мы имеем и как затем это можно обработать, например:

VAR P : PChar; ... P := DdeClientConv1.RequestData('Groups'); ListBox1.Items.SetText(P); StrDispose(P); ... WITH ListBox1 DO P := DdeClientConv1.RequestData(Items[ItemIndex]); ListBox2.Items.SetText(P); StrDispose(P); ...

- Neil [000486]

Управление Program Manager в Win95 с помощью DDE

Для управления программными группами в Program Manager с помощью DDE мною был использован следующий модуль. За основу был взят код Steve Texeira (sp) из руководства Dephi Developers Guide.

Работает под Win 3.1 и '95.

unit Pm; interface uses SysUtils, Classes, DdeMan; type EProgManError = class(Exception); TProgMan = class(TComponent) private FDdeClientConv: TDdeClientConv; procedure InitDDEConversation; function ExecMacroString(Macro: String): Boolean; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; Procedure CreateGroup(GroupName: String; ShowGroup:Boolean); procedure DeleteGroup(GroupName: String); procedure DeleteItem(ItemName: String); procedure AddItem(CmdLine, ItemName: String); end; implementation uses Utils; const { DDE-макростроки для Program Manager } SDDECreateGroup   = '[CreateGroup(%s)]'; SDDEShowGroup     = '[ShowGroup(%s, 1)]'; SDDEDeleteGroup   = '[DeleteGroup(%s)]'; SDDEDeleteItem    = '[DeleteItem(%s)]'; SDDEAddItem       = '[AddItem(%s, "%s", %s)]'; constructor TProgMan.Create(AOwner: TComponent); begin inherited Create(AOwner); InitDDEConversation; end; destructor TProgMan.Destroy; begin if Assigned(FDDEClientConv) then FDdeClientConv.CloseLink; inherited Destroy; end; function TProgMan.ExecMacroString(Macro: String): Boolean; Begin StringAsPchar(Macro); Result := FDdeClientConv.ExecuteMacro(@Macro[1], False); End; Procedure TProgMan.InitDDEConversation; begin FDdeClientConv := TDdeClientConv.Create(Self); If NOT FDdeClientConv.SetLink('PROGMAN', 'PROGMAN') then raise EProgManError.Create('Не могу установить DDE Link'); end; Procedure TProgMan.CreateGroup(GroupName: String; ShowGroup:Boolean); Begin { Удаляем группу, если она существует } ExecMacroString(Format(SDDEDeleteGroup, [GroupName])); If NOT ExecMacroString(Format(SDDECreateGroup, [GroupName])) then raise EProgManError.Create('Не могу создать группу ' + GroupName); If ShowGroup then If not ExecMacroString(Format(SDDEShowGroup, [GroupName])) then raise EProgManError.Create('Не могу показать группу ' + GroupName); End; Procedure TProgMan.DeleteGroup(GroupName: String); Begin if NOT ExecMacroString(Format(SDDEDeleteGroup, [GroupName])) then raise EProgManError.Create('Не могу удалить группу ' + GroupName); End; Procedure TProgMan.DeleteItem(ItemName: String); Begin if NOT ExecMacroString(Format(SDDEDeleteGroup, [ItemName])) then raise EProgManError.Create('Не могу удалить элемент ' + ItemName); End; Procedure TProgMan.AddItem(CmdLine, ItemName: String); Var P: PChar; PSize: Word; Begin PSize := StrLen(SDDEAddItem) + (Length(CmdLine) *2) + Length(ItemName) + 1; GetMem(P, PSize); try StrFmt(P, SDDEAddItem, [CmdLine, ItemName, CmdLine]); if NOT FDdeClientConv.ExecuteMacro(P, False) then raise EProgManError.Create('Не могу добавить элемент ' + ItemName); finally FreeMem(P, PSize); end; End; end.

[001421]

Hard mode без перерыва

При отладке я наткнулся на сообщение, похожее на системное сообщение Windows, звучащее приблизительно так: "Unable to stop at breakpoint due to Hard Mode" (невозможно остановиться в точке прерывания из-за Hard Mode - дословно "Тяжелый Режим").

Чья это страшилка, Windows или Delphi, и что это такое - "Hard Mode"?

Это Windows. Есть определенные легальные способы заставить перейти Windows в "Hard Mode". В этом режиме отладчик прервать невозможно. Тем не менее вы могли бы попробовать знаменитый "Маневр Мебиуса". Он заключается в установке дополнительной точки останова на строке *перед* той, которая сообщает системе о переходе в режим Hard. Вызов системного модального диалога обычно заставляет систему выйти из этого режима, после чего вторая точка останова сработает как обычно. Простое шаманство...

Mike Scott Mobius Ltd. [000395]

Hard mode без перерыва II

ОПРЕДЕЛЕНИЕ: "Hard mode" является режимом Windows, при которой не происходит никакой обработки сообщений. Это происходит при отрисовке меню или некоторых операциях ядра. Это означает, что в этом состоянии Delphi не может "заморозить" ваше приложение, не блокируя Windows. Обычно это возникает вследствие многочисленных вызовов SendMessage. В этом случае, для выхода из Hard mode, необходимо "встряхнуть" систему. Вполне достаточно, если ваш отладчик покажет вам системно-модальное окно (messagebox), говорящее вам о том, что вы находитесь в hard mode! Для этого попробуйте поставить дополнительный breakpoint (точку останова) на строчке, *предшествующей* вашему breakpoint. В этом случае вы получите предупреждение о том, что система находится в hard mode, и этот же диалог "вышибет" систему из этого состояния. При нажатии на OK, вторая точка останова сработает как положено.

ПРИМЕЧАНИЕ: Поскольку работа отладчика построена на обработке сообщений, то он не может остановить работу в точке останова, если он "думает", что система вошла в режим hard mode, поскольку в этом случае вы не сможете ничего сделать, и система просто напросто зависнет. [001441]

При возникновении ошибки во время отладки программы машина перезагружается. Что делать?

Nomadic отвечает:

A: Снести QEMM. Начисто. Простое отключение его функций не помогает.
Впрочем, это исправлено в QEMM 9.0. [001491]

Вывод объекта отладки

...а вы пробовали после имени переменной добавить ",r", это должно отоборазить структуру с именами и их значениями?

В окне Watch все таже длинная строка ...

А вы пробовали в Evaluate/Modify покрутить полосу прокрутки? [000410]

Организация задержки I

Организация задержки - все еще большая головная в Delphi. Я использую Delphi 1 и пытаюсь организовать задержку 2 ms с погрешностью -0 ms +1 ms. Может кто-то уже решал подобную проблему? Организация цикла не позволяет достичь такой точности. Стандартный таймерный компонент не позволяет работать с частотой выше чем 18.2 times/sec.

Приведу модуль, который я использовал при создании 16-битного хранителя экрана (screen saver). В нем есть переменная DelayInit, объявленная глобально и инициализируемая во время создания формы как показано ниже:

DelayInit := False; Delay(0);  {Проводим инициализацию и присваиваем 0 для дальнейшей калибровки}

Этим мы указываем на необходимость калибровки для конкретной системы.

unit Globals; interface Uses WinProcs, WinTypes, Messages,Classes, Graphics, IniFiles; Const OT_USER = 1; Var SsType : Integer; {  iObjL  : Integer;  { Текущая левая координата объекта } {  iObjR  : Integer;  { Текущая правая координата объекта } {  iObjT  : Integer;  { Текущая верхняя координата объекта } Finish     : Boolean; TestMode   : Boolean;                                    { True если режим тестирования } LoopsMs    : LongInt;                                    { Ms циклов } ScreenWd   : Integer;                                    { Ширина экрана } ScreenHt   : Integer;                                    { Высота экрана } SpotSize   : Integer;                                    { Размер точки } SpotSpeed  : Integer;                                    { Скорость точки } DelayInit  : Boolean;                                    { True если цикл задержки инициализирован } Procedure Delay(Ms : Integer);                             { Задержка для Ms миллисекунд } Procedure CursorOff;                                       { Включение курсора } Procedure CursorOn;                                        { Выключение курсора } {$IFDEF NOVELL} {$ENDIF} implementation Uses SysUtils, Toolhelp; Procedure CursorOff;                                        { Выключение курсора } Var Cstate : Integer;                                         { Текущее состояние курсора } Begin Cstate := ShowCursor(True);                               { Получаем состояние } While Cstate >= 0 do Cstate := ShowCursor(False);         { Пока состояние >= 0 курсор выключен } End; Procedure CursorOn;                                         { Выключаем курсор } Var Cstate : Integer;                                         { Текущее состояние курсора } Begin Cstate := ShowCursor(True);                               { Получаем состояние } While Cstate < 0 do Cstate := ShowCursor(True);           { Пока состояние < 0 курсор включен } End; Procedure Delay(Ms : Integer);                              { Задержка для Ms миллисекунд } {Если Ms равно 0, проводим калибровку } Var L,MaxLoops,StartL,EndL,Down,Up,Res : LongInt;             { Локальные переменные } Ti  : TTimerInfo; Begin Up := 0; Down := 100000; if Not DelayInit then begin Ti.dwSize := sizeof(LongInt) * 3; TimerCount(@Ti); StartL := Ti.dwmsSinceStart;                     { Получаем время старта } if Not DelayInit then begin                            { Включаем тест } for L := 0 to 100000 do begin                        { Организуем цикл с числом проходов равным 100000 } Dec(Down);                                         { Уменьшаем счетчик } Res := Abs(Down - Up);                             { Разница } if Res = 0 then Inc(Res);                          { Сверка } Inc(Up);                                           { Приращение } end; end; TimerCount(@Ti); EndL := Ti.dwmsSinceStart;                             { Получаем время старта } LoopsMs := 100000 Div (EndL - StartL);      { Вычисляем показатель MS } DelayInit := True;                                     { Откалибровали } end else begin if Ms = 0 then Exit; MaxLoops := LoopsMs * Ms;                              { Получаем необходимое количество циклов } for L := 0 to MaxLoops do Begin                        { Организация цикла } Dec(Down);                                           { Уменьшаем счетчик } Res := Abs(Down - Up);                               { Получаем разницу } if Res = 0 then Inc(Res);                            { Сверка } Inc(Up);                                             { Приращение } end end; End; end.

[000264]

Организация задержки II

Procedure Delay (Seconds: Word); Var Later: TDateTime; Begin Later := Now + (Seconds / (24.0 * 60.0 * 60.0)); While Now < Later do Application.ProcessMessages; end;

[000652]

Работа в фоне

Я пишу программу в Delphi, которая каждый час должна проверять размер файла. Это также предполагает, что в случае неактивности приложения оно должно работать сторожевым псом в фоновом режиме win 95 и NT. Как мне сделать это...??

Вот некоторый исходный код, который должен делать то, что вы хотите. Я его только что создал и еще не успел проверить, но что-то подобное я уже делал, так что это должно работать. Код допускает одно предположение, о котором вы должны отдавать себе отчет. Оно заключается в том, что приложение должно запускатьтся одновременно с Windows (может быть из группы автозапуска), так как код использует GetTickCount, возвращающий в миллисекундах время с момента старта системы, это необходимо для ежечасной инициализации кода выполнения задачи. По-моему это то, что вам нужно. Величина, возвращаемая GetTickCount имеет тип DWORD, но Delphi ее хранит как LongInt, поэтому большие значения могут иметь отрицательную величину (после примерно 25 дней). Данный эффект в алгоритме проверки наступления часа неопределен (я действительно не считал это). Аналогично, значение будет повторяться в цикле каждые 49.7 дней и может появиться другой эффект, когда раз в 49.7 дней в одном реальном часе алгоритм сработает дважды. Надеюсь это никак не скажется на вашей задаче. Во всяком случае разве это не то, что вы хотели? Успехов!

program Project1; uses Messages, Windows; {$R *.RES} function KeepRunning: Boolean; var Msg: TMsg; begin Result := True; while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do begin if (Msg.Message = WM_QUIT) then Result := False; DispatchMessage(Msg); end; end; function OnTheHour: Boolean; begin { Это действительно проверяется в течение одной секунды    } { (или меньше) для проверки наступления нового часа,       } { когда нам необходимо запустить нашу задачу на выполнение } Result := (GetTickCount mod (1{hr} * 60{min} * 60{sec} * 1000{msec}) < 1000); end; const filetocheck = 'c:\somedir\somefile.ext'; magicsize = 1000000; var f: file; size: longint; begin { проверка наступления нового часа с момента запуска системы } while keeprunning do begin { проверяем наступление часа } if onthehour then begin { открываем файл с размером записи 1 байт } { и проверяем его размер                  } assignfile(f,filetocheck); reset(f,1); size := filesize(f); closefile(f); { теперь проверяем изменение размера файла } if (size >= MAGICSIZE) then begin { Предпринимаем какие-то действия } end; { Теперь "сидим" в этом участке кода                 } { и ожидаем очередного часа, здесь можно             } { предусмотреть выход из программы или иное действие } while (KeepRunning and OnTheHour) do {ничего}; end; end; end.

[000316]

Задержка выполнения OnChange (Delphi 2)

В случае нажатия пользователем клавиши или изменении текущего элемента компонента ComboBox, вы обратите внимание на досадную задержку, возникающую при генерации события OnChange.

Так как "работа кипит", я хотел бы отреагировать на изменение ItemIndex несколько позднее, например, 100 миллисекунд спустя. Вот что у меня получилось. Созданный в Delphi2, код подходит также и для Delphi 1. На простой форме располагаем компоненты ComboBox и Label. Необходимым дополнением является вызов Application.ProcessMessages, позволяющий избежать замедления работы PC, когда очередь сообщений для формы пуста.

unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; const // Просто некоторая константа сообщения PM_COMBOCHANGE = WM_USER + 8001; // 500 миллисекунд CWantedDelay = 500; type TForm1 = class(TForm) ComboBox1: TComboBox; Label1: TLabel; procedure ComboBox1Change(Sender: TObject); private procedure PMComboChange(var message : TMessage); message PM_COMBOCHANGE; public end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.ComboBox1Change(Sender: TObject); begin PostMessage(Handle, PM_COMBOCHANGE, 0, 0); end; procedure TForm1.PMComboChange(var message : TMessage); const InProc    : BOOLEAN = FALSE; StartTick : LONGINT = 0; begin if InProc then begin // Обновляем стартовое время задержки StartTick := GetTickCount; end else begin // Организация цикла InProc := TRUE; // Инициализация стартового времени StartTick := GetTickCount; // Ожидаем истечения стартового времени. // Пока стартовое время не исчерпалось, позволяем операционной системе обрабатывать сообщения while GetTickCount - StartTick < CWantedDelay do Application.ProcessMessages; // Иллюстративное приращение счетчика, задающее некоторую реальную работу обработчику события OnChange Label1.Caption := IntToStr ( StrToIntDef ( Label1.Caption, 0 ) + 1); // Завершение цикла InProc := FALSE; end; end; end.

[000060]

Cannot optimize ...not EXE... (не могу оптимизировать... не EXE...)

Она включена в файл DELPHI\README.TXT. Ошибка происходит при включенной опции "Optimize for size and load time" (оптимизировать по размеру и времени загрузки), когда оптимизатор не может справиться со своей задачей. Выключите эту опцию и взамен используйте программу W8LOSS.EXE, как написано в README. [000680]

GPF c любым Memo

Memos и DBMemos не будут работать, если в настройках компилятора включена опция 'Smart Callbacks'.

- Richard Shotbolt [000861]

Компонент OpenDialog - ошибки и их исправление

При использовании в Delphi диалогового окна Opendialog (с Multiselect=true) и выборе более одного файла из корневой директории, возвращаемые значения содержат две косые черты вместо одной. Для примера:

c:\\autoexec.bat
c:\\config.sys

Если я выбираю из корневой директории один файл или использую любую другую директорию, этого не происходит. Кто-нибудь сталкивался с подобным глюком?

Если вы хотите это исправить (и имеете исходный код VCL), найдите строчку 1128 в DIALOGS.PAS. Она выглядит так:

FFiles.Add(DirPart+'\'+FilePart);

Измените это на:

FFiles.Add(AddBkSlash(DirPart)+FilePart);

и затем создайте локальную функцию, добавляющую при необходимости обратный слэш:

function AddBkSlash(const S:String):string; begin Result := S; if S[Length(S)] <> '\' then Result := Result+'\'; end;

Pat [000471]

Конфликт с Lotus Notes

...это больше похоже на конфликт между отладчиком Delphi IDE и утилитой "разрешения конфликтных ситуаций" под названием Quincy, входящей в поставку Notes. Quincy пишет содержимое стека в текстовый файл в момент краха Notes. К сожалению, Quincy вступает в конфликт с кучей других программ. К счастью, Quincy не требуется для работы Notes. Просто переименуйте QNCW.EXE в вашем каталоге Notes на что-нибудь другое, например, QNCW.SAV. [000681]

Неверная документация по THelpEvent

В документации:

THelpEvent = function (Command: Word; Data: Longint): Boolean of object;

ФАКТИЧЕСКИЕ параметры:

THelpEvent = function (Command: Word; Data: Longint; var CallHelp: Boolean): Boolean of object;

[000679]

Ошибка csDropDownList/csDropDown

Тема: Свойство Style во время выполнения программы??

Проблема в том, что csDropDownList (и, также, csDropDown) определен в _двух_ различных модулях, StdCtrls и DBLookup. В зависимости от порядка следования молулей в списке uses, вы получаете или одни характеристики, или другие. Вы можете избежать двоякого толкования и привязаться к модулю с помощью его имени, например так:

if Combo.Style = StdCtrls.csDropDownList then...

-Steve Schafer [000694]

Ошибка DDE/WinWord

Я нашел ошибку в DDEMAN.DCU.

В процедуре TDdeServerItem.CopyToClipboard пропущен вызов ClipBoard.Open. Я потратил на поиск ошибки 2 дня, зато теперь я могу соединиться с WinWord.

Gerald Dachs

Дополнения

Используя TDdeServerItem, я не мог копировать в буфер обмена и впоследствии вставлять данные в Excel. Чтобы проверить сказанное, достаточно запустить программу ddesrvr. Выберите "копировать" и посмотрите буфер обмена стандартной системной смотрелкой. Она сообщит вам "Unrecognized format" (неопознанный формат).

Для устранения этих досадных ошибок я внес следующие изменения в ddeman.pas:

Добавьте Clipboard.Open перед первой попыткой TDdeServerItem.CopyToClipboard (только перед первой попыткой).

Также в TDdeServerItem.CopyToClipboard, я добавил другой null в конец LinkData. Не уверен, что это необходимо, но я думаю, что список необходимо терминировать двумя нулями (null).

Sam Lissok [000700]

---

---