Советы по Delphi. Версия 1.4.3 от 1.1.2001

Объекты

Проблема циклических ссылок

У меня имеется объект A и объект B, и им обоим нужно вызывать методы друг друга…

Создание множества экземпляров

   list:=Tlist.create;
   For i:= 1 to 1000 do begin
    SSObject:=TSSObject.create;
    {поместите куда-нибудь ссылку на созданный объект - например, в Tlist}
    list.add(SSObject);
   end;

Параметры

Передача функции как параметра

   В нашем случае лучшим решением будет использование процедурного типа. Допустим, что DllFunction() на входе хочет получить определенную функцию, поясним это на примере кода:
   type TMyFuncType = function: integer;
   var MyFunc : TMyFuncType;

   function foo: integer;
   begin
    result := 1;
   end;

   begin
    MyFunc := foo;
    DllFunction(longint(MyFunc));
   Вы можете это сделать и так:
   DllFunction(longint(@foo));
   Все же я не уверен в вопросах корректности использования таким образом в вызовах DLL памяти (для меня пока неясна работа с памятью, находящейся в другом сегменте), как в этом примере, так что возможно для корректной работы вам придется объявить foo с директивой far, экспортировать ее в модуле, или что-то еще.
   Также, в зависимости от того, как написана DllFunction(), вы можете в вызове подразумевать приведение типа:
   function DllFunction(p: TMyFuncType): Integer; far; external 'mydll';
   В этом случае вам не нужна будет переменная MyFunc или оператор @.
   В Delphi/Pascal вы можете передавать функции как параметры. Тем не менее, чтобы этим воспользоваться, необходимо для компилятора установить тип. Попробуйте следующий код (я реально его компилил и тестировал):
   unit Unit1;

   interface

   uses
    SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,Forms, Dialogs, StdCtrls;

   type
    TForm1 = class(TForm)
     Button1: TButton;
     Button2: TButton;
     procedure Button1Click(Sender: TObject);
     procedure Button2Click(Sender: TObject);
    private { Private declarations }
    public { Public declarations }
    end;

   var
    Form1: TForm1;

   implementation

   {$R *.DFM}

   type
    IntFunc = function: integer;

   function DllFunction(iFunc: IntFunc): integer; far;
   begin
    DllFunction := iFunc; {Обратите внимание на то, что это вызов функции}
   end;

   function iFoo: integer; far;
   begin
    iFoo := 1;
   end;

   procedure TestIFunc;
   var
    i: integer;
   begin
    i := DllFunction(iFoo);
   end;

   procedure TForm1.Button1Click(Sender: TObject);
   begin
    TestIFunc;
   end;

   procedure TForm1.Button2Click(Sender: TObject);
   begin
    Close;
   end;

   end.
   Вы можете сделать две вещи. Во-первых, если вы хотите использовать для передачи longint, напишите следующий код:
   i := longint(@foo)
   Другая вещь, которую вы можете сделать — исключить работу с longint и вызывать функцию dll следующим образом:
   DLLfunction(@foo);
   Имейте в виду, что если вы собираетесь вызывать foo из DLL, то необходимо предусмотреть вопросы совместимости, для получения дополнительной информации почитайте описание функции MakeProcInstance.

Проблема передачи записи

   Может это не то, что вы ищете, но идея такая:
   Определите базовый класс с именем, скажем, allrecs:
   tAllrecs = class
    function getVal(field: integer): string; virtual;
   end;
   Затем создаем классы для каждой записи:
   recA = class(tAllrecs)
    this: Integer;
    that: String;
    the_other: Integer;
    function getVal(field: integer): string; virtual;
   end;
   Затем для каждой функции класса определите возвращаемый результат:
   function recA.getVal(field: integer); string;
   begin
    case field of
    1: getVal := intToStr(this);
    2: getVal := that;
    3: getVal := intToStr(the_other);
    end;
   end;
   Затем вы можете определить
   function myFunc(rec: tAllrecs; field: integer);
   begin
   label2.caption := allrecs.getVal(field);
   end;
   затем вы можете вызвать myFunc с любым классом, производным от tAllrecs, например:
   myFunc(recA, 2);
   myFunc(recB, 29);
   (getVal предпочтительно должна быть процедурой (а не функцией) с тремя var-параметрами, возвращающими имя, тип и значение.)
   Все это работает, т.к. данный пример я взял из моего рабочего проекта.
   [Sid Gudes, cougar@roadrunner.com]
   Если вы хотите за один раз передавать целую запись, установите на входе ваших функций/процедур тип 'array of const' (убедитесь в правильном приведенни типов). Это идентично 'array of TVarRec'. Для получения дополнительной информации о системных константах, определяемых для TVarRec, смотри электронную справку по Delphi.

Указатели

Указатель на функцию I

   Это то, что я нашел при создании простой машины состояний:
   Ниже приведен простой пример для Borland Delphi, использующий указатели функций для управления программным потоком. Просто создайте простую форму с единственной кнопкой и скопируйте код из Unit1 во вновь созданный модуль. Добавьте к проекту Unit2 и скомпилируйте проект. Дайте мне знать, если у вас возникнут какие-либо проблемы.
   interface

   uses
    SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,Forms, Dialogs, StdCtrls;
   type
    TForm1 = class(TForm)
     Button1: TButton;
     procedure Button1Click(Sender: TObject);
    private { Private declarations }
    public { Public declarations }
    end;

   var
    Form1: TForm1;
    CurrProc : LongInt;
    MyVal : LongInt;

   implementation

   uses Unit2;

   {$R *.DFM}

   procedure TForm1.Button1Click(Sender: TObject);
   var
    NewProc : LongInt;
    MyString : string;
   begin
    CurrProc := 2; { начальная точка в таблице методов }
    MyVal := 0; { вспомогательная переменная }
    NewProc := 0; { возвращаемое значение для следующего индекса в таблице методов }
    while CurrProc < 6 do begin
   { выполняем текущий индекс в таблице методов и получаем следующую процедуру }
     NewProc := ProcTable[CurrProc](MyVal);
     { просто показываем значения NewProc и CurrProc }
     FmtStr(MyString, 'NewProc [%d] CurrProc [%d]', [NewProc, CurrProc]);
     MessageDlg(MyString, mtInformation, [mbOK], 0);
     { присваиваем текущую процедуру возвращаемой процедуре }
     CurrProc := NewProc;
    end;
   end;

   end.

   { Это простой пример, определяющий массив указателей на функции }

   interface

   type
    { определяем Procs как функцию }
    Procs = function(var ProcNum : LongInt): LongInt;

   var
    { объявляем массив указателей на функции }
    ProcTable : Array [1..5] of Procs;
    { определения интерфейсов функций }

   function Proc1(var MyVal : LongInt) : LongInt; far;
   function Proc2(var MyVal : LongInt) : LongInt; far;
   function Proc3(var MyVal : LongInt) : LongInt; far;
   function Proc4(var MyVal : LongInt) : LongInt; far;
   function Proc5(var MyVal : LongInt) : LongInt; far;

   implementation

   uses Dialogs;

   function Proc1(var MyVal : LongInt) : LongInt;
   begin
    MessageDlg('Процедура 1', mtInformation, [mbOK], 0);
    Proc1 := 6;
   end;

   function Proc2(var MyVal : LongInt) : LongInt;
   begin
    MessageDlg('Процедура 2', mtInformation, [mbOK], 0);
    Proc2 := 3;
   end;

   function Proc3(var MyVal : LongInt) : LongInt;
   begin
    MessageDlg('Процедура 3', mtInformation, [mbOK], 0);
    Proc3 := 4;
   end;

   function Proc4(var MyVal : LongInt) : LongInt;
   begin
    MessageDlg('Процедура 4', mtInformation, [mbOK], 0);
    Proc4 := 5;
   end;

   function Proc5(var MyVal : LongInt) : LongInt;
   begin
    MessageDlg('Процедура 5', mtInformation, [mbOK], 0);
    Proc5 := 1;
   end;

   initialization
    { инициализируем содержание массива указателей на функции }
    @ProcTable[1] := @Proc1;
    @ProcTable[2] := @Proc2;
    @ProcTable[3] := @Proc3;
    @ProcTable[4] := @Proc4;
    @ProcTable[5] := @Proc5;
   end.
   Я думаю это можно сделать приблизительно так: объявите в каждой форме процедуры, обрабатывающие нажатие кнопки, типа процедуры CutButtonPressed(Sender:TObject) of Object; затем просто назначьте события кнопок OnClick этим процедурам при наступлении событий форм OnActivate. Этот способ соответствует концепции ОО-программирования, но если вам не нравится это, то вы все еще можете воспользоваться указателями функций, которая предоставляет Delphi.
   Объявите базовый класс формы с объявлениями абстрактных функций для каждой функции, которую вы хотите вызывать из вашего toolbar. Затем наследуйте каждую вашу форму от базового класса формы и создайте определения этих функций.
   Пример: (Здесь может встретиться пара синтаксических ошибок — я не компилил это)
   type
    TBaseForm = class(TForm)
    public
     procedure Method1; virtual; abstract;
    end;

   type
    TDerivedForm1= class(TBaseForm)
    public
     procedure Method1; override;
    end;

    TDerivedForm2= class(TBaseForm)
    public
     procedure Method1; override;
    end;

   procedure TDerivedForm1.Method1;
   begin
    …
   end;

   procedure TDerivedForm2.Method1;
   begin
    …
   end;

   {Для вызова функции из вашего toolbar, получите активную в настоящий момент форму и вызовите Method1}
   procedure OnButtonClick;
   var
    AForm: TBaseForm;
   begin
    AForm := ActiveForm as TBaseForm;
    AForm.Method1;
   end

Указатель на функцию II

   Что лично я использую, чтобы вызвать какую-то функцию из DLL:
   1. Объявите тип:
   type TYourDLLFunc = function(Parm1: TParm1; Parm2: TParm2): TParm3;
   2. Объявите переменную этого типа:
   var YourDllFunc: TYourDLLFunc;
   3. Получаем дескриптор DLL:
   DLLHandle := LoadLibrary('YourDLL.DLL');
   Получаем адрес функции:
   @YourDLLFunc := GetProcAddress(DLLHandle, 'YourDLLFuncName');
   Для использования функции теперь используйте переменную YourDLLFunc, например:
   Parm3 := YourDLLFunc(Parm1, Parm2);

Использование указателей на целое

   Сначала вы должны создать тип:
   Type Pinteger: ^Integer;
   Var MyPtr: Pinteger;
   Мне кажется, что в начале вы использовали плохой пример, имеет смысл использовать 32-битный указатель для 16-битной величины или распределять 10 байт для переменной.
   Pascal позволяет вам использовать методы NEW и DISPOSE, которые автоматически распределяют и освобождают правильные размеры блока.
   Например,
   NEW(MyPtr) = GetMem(MyPtr, Sizeof(MyPtr)).
   Возможно, вы захотите подсчитать количество целочесленных переменных. В этом случае ознакомьтесь с возможностями TList. Пока лучше используйте линейный массив (или указатель на первый элемент, чтобы вычислить их количество, достаточно разделить количество занимаемой массивом памяти на количество элементов).
   Для полноты, это должно быть:
   NEW(MyPtr) = GetMem(MyPtr, SizeOf(MyPtr^));
   SizeOf(MyPtr) всегда будет равен 4 байта, как 16-битный указатель.
   Если я правильно разобрался в том, что вы хотите (динамический массив целых, количество элеметнов которого может быть известно только во время выполнения приложения), вы можете сделать так:
   Type
    pIntArr = ^IntArr;
    IntArr = Array[1..1000] of Integer;
   Var
    MyPtr : pIntArr;
   Begin
    GetMem(MyPtr, 10); { 10 = SizeOf(Integer) * 5 !!}
    { MyPtr[2]:=1; }
    <<<< Заполняем массив >>>>
    MyPtr[2]^:=1;
    FreeMem(MyPtr,10);
   End;
   Технология похожа на ту, которуя Delphi использует при работе с pchar. Синтаксис очень похож:
   type intarray = array[0..20000] of integer;

   procedure TForm1.Button1Click(Sender: TObject);
   var
    xptr: ^IntArray;
   begin
    GetMem(xptr, 10);
    xptr^[idx] := 1; { где idx от 0 до 4, поскольку мы имеем 10 байте = 5 целых }
    FreeMem(xptr, 10);
   end;
   Обратите внимание на то, в вам в действительности нет необходимости распределять массив для 20,000 элементов, но проверка диапазона Delphi не будет работать, если диапазон равен 20,000. (Предостережение будущим пользователям!)

Память

Функция MemAvail для Delphi2?

   В Delphi 1, для того, чтобы получить самый большой возможный участок памяти, мы могли использовать функцию MemAvail, существует ли эквивалент этой функции в Delphi 2?
   Нет. Но чтобы получить аппроксимированную сумму доступной памяти, можно воспользоваться функцией API GlobalMemoryStatus (через поле dwAvailVirtual возвращаемой структуры TMemoryStatus).
   Steve Schafer

Как работать с блоками памяти размером более 64K?

   Nomadic советует:
   Так можно помещать в один блок памяти записи из TList (TCollection):
   imlementation
    { To use the value of AHIncr, use Ofs(AHIncr). }
   procedure AHIncr; far; external 'KERNEL' index 114;

   const
    NEXT_SELECTOR: string[13] = 'NEXT_SELECTOR';

   function WriteData: THandle;
   var
    DataPtr: PChar;
    i: Integer;
   begin
    Result := GlobalAlloc(GMEM_SHARE or GMEM_ZEROINIT, {pазмеp большого блока});
    if Result = 0 then Exit;
    DataPtr := GlobalLock(Result);
    {записываем кол-во эл-тов}
    Inc(DataPtr, {pазмеp счетчика эл-тов})
    for i := 0 to {некий}Count-1 do begin
     if LongInt(PtrRec(DataPtr).Ofs) + {pазмеp подблока} >l= $FFFF then begin
      Move(NEXT_SELECTOR, DataPtr^, SizeOf(NEXT_SELECTOR)); {некая константа}
      { коppекция сегмента }
      PtrRec(DataPtr).Seg := PtrRec(DataPtr).Seg + Ofs(AHIncr);
      PtrRec(DataPtr).Ofs := $0;
     end;
     Inc(DataPtr, {pазмеp нового блока});
    end; { for i }
    GlobalUnlock(Result);
   end;

   procedure ReadData(DataHdl: THandle);
   var
    DataPtr : PObjectCfgRec;
    RecsCount: Integer;
    i: Integer;
   begin
    if DataHdl = 0 then Exit;
    DataPtr := GlobalLock(DataHdl);
    RecsCount := PInteger(DataPtr)^;
    Inc(PInteger(DataPtr));
    for i := 1 to RecsCount do begin
     { обpаботать данные }
     Inc(DataPtr);
     if PString(DataPtr)^ = NEXT_SELECTOR then begin
      PtrRec(DataPtr).Seg := PtrRec(DataPtr).Seg + Ofs(AHIncr);
      PtrRec(DataPtr).Ofs := $0;
     end;
    end; { for i }
    GlobalUnlock(DataHdl);
   end;

События

Назначение обработчика события OnClick пункту меню, созданному во время выполнения программы

   Поскольку метод OnClick является свойством, то при динамическом создании элемента меню вы можете назначить имя метода обработчику OnClick:
   theMenuitem.OnClick := TheOnClickHandler;
   Затем, в обработчике OnClick, вы приводите sender к TMenuItem и читаете имя:
   procedure theform.TheOnClickHandler(Sender: TObject);
   var
    fName: String;
   begin
    fName := TMenuItem(Sender).name;
    …
   end;

События для компонентов, созданных во время работы программы I

   Вы должны вручную создать метод, который будет иметь тот же самый набор параметров, как и у события, которое вы хотите обработать. Затем вы должны вручную установить свойство OnXXX, чтобы она указывала на метод, который вы создали.
   Пример:
   TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
   private
   FMyButton: TButton;
   protected
    procedure Button1Click(Sender: TObject);
    {Кодируем это вручную,для соответствия}
    {структуреTNotifyEvent}
   end;

   procedure TForm1.FormCreate(Sender: TObject);
   begin
   FMyButton := TButton.Create;
    {Здесь устанавливаем позицию, заголовок и все остальное}
    FMyButton.OnClick := MyButtonClick;
   end;

   procedure TForm1.MyButtonClick(Sender: TObject);
   begin
   ShowMessage('Эй! Ты нажал на мою кнопку!');
   end;

События для компонентов, созданных во время работы программы II

   Вот простейший код для нового проекта с одной кнопкой и меню. (Надеюсь, в этом ничего сложного нет ... :)
   procedure TForm1.Button1Click(Sender: TObject);
   var
    NewItem: TMenuItem;
   begin
    NewItem := TMenuItem.Create(Form1);
    NewItem.Caption := 'Динамический элемент ...';
    NewItem.OnClick := xyz;MainMenu1.Items.Insert(0, NewItem); ←Примечание: рекомендую бегло ознакомиться с Delphi-примером для команды Insert…
   end;

   {Любая старая 'xyz'-процедура (в настоящее время может быть определена одна, например, Form1.DblClick)}
   procedure TForm1.xyz(Sender: TObject);
   begin
    showmessage('Запусти эту процедуру !!');
   end;
   Примечание: Если вы пользуетесь неопределенной процедурой, вам понадобиться объявить ее. Лично я все это сделал в «верхнем правом углу» объявления типа формы, примерно так:
   private
   { Private declarations }
   public
   { Public declarations }
   procedure xyz(Sender: TObject); ←К этой процедуре могут иметь доступ не только события Form1 …
   Установите свойство обработчика события (например, OnClick, OnDblClick, OnMouseDown и пр.) на процедуру, которую вы создали для обработки этого события. Вам нужно убедиться в том, что параметры в точности соответствуют параметрам ожидаемого заданного обработчика события.
   Например:
   MySpeedButton.OnClick := MyClickEventHandler;
   где…
   procedure MyClickEventHandler(Sender: TObject);
   begin
   end;

Массивы

Динамические массивы V

   SottNick пишет:
   Если хочется, чтобы в многомерном массиве был разный размер у разных измерений например: VarArray: array[1..2, 1..?] of TType , где ? зависит от "строки" массива (1..2)
   То дозволяется сделать так:
   1. Объявление
   Var VarArray: array of array of array…………
   2. Установка длин
   SetLength(VarArray, Razmernost1); // У первого измерения
   SetLength(VarArray[1], Razmernost2); // У второго измерения первой «строки»
   SetLength(VarArray[2], Razmernost3); // У второго измерения второй «строки»
   SetLength(VarArray[n], Razmernost4); // У второго измерения n-ной «строки»
   SetLength(VarArray[1][1], Razmernost5); // У третьего измерения первой «строки» первого «столбца»
   SetLength(VarArray[1][2], Razmernost6); // У третьего измерения первой «строки» второго «столбца»
   SetLength(VarArray[n][m], Razmernost7); // У третьего измерения n-ной «строки» m-ного «столбца»
   т.д.
   Все можно изменять в процессе естественно.
   3. Получение длин
   Razmernost1:=Length(VarArray); // У первого измерения (количество строк)
   Razmernost2:=Length(VarArray[1]); // У второго измерения первой «строки» (количество столбцов)
   Razmernost3:=Length(VarArray[2]); // У второго измерения второй «строки» (количество столбцов)
   Razmernost4:=Length(VarArray[n]); // У второго измерения n-ной «строки» (количество столбцов)
   Razmernost5:=Length(VarArray[1][1]); // У третьего измерения первой «строки» первого «столбца»
   Razmernost6:=Length(VarArray[1][2]); // У третьего измерения первой «строки» второго «столбца»
   Razmernost7:=Length(VarArray[n][m]); // У третьего измерения n-ной «строки» m-ного «столбца»
   4. Обращение
   VarArray[n][m][o][p][r]:=1; // :Integer // К элементу n-ной «строки», m-ного «столбца», // o-того «?», p-того «?», r-того «?»
   5. Обнуление (освобождение памяти)
   SetLength (VarArray, 0); // Всех сразу

Динамические массивы VI

   Например, если вам необходимо сохранить «GIZMOS» в вашем массиве, сделайте следующее:
   CONST
    MaxGIZMOS = $FFFF Div (SizeOf(GIZMOS)) { или что-то другое, смотря какой максимальный размер GIZMOS вы планируете...}
   TYPE
    pGIZMOArray = ^GIZMOArray;
    GIZMOArray = Array[1..MaxGIZMOS] of GIZMOS;
   VAR
    TheGIZMOS: pGIZMOArray;
    GIZMOcount: integer;
   BEGIN
    GetMem(TheGIZMOS,(GIZMOcount+1)*SizeOf(GIZMO)); {Нужна дополнительная единица, поскольку массив GetMem ведет отсчет с нуля…}
    TheGIZMOS^[index] := Whatever;
   ну и так далее…
   TList — такой динамический массив. Для получения дополнительной информации обратитесь к электронной справке. Если вы хотите это делать сами, то вам необходимо использовать GetMem для получения указателя на распределенную динамическую память, и затем FreeMem для освобождения памяти, занятой динамическим массивом. Tlist сделает это за вас самым надежным образом.

Динамические массивы VII

   Существует несколько способов сделать это. Применять тот или иной способ зависит от того, какой массив вы используете — массив строк или массив чисел (целые, натуральные и пр.).
   1. Если вам необходим простой динамический одномерный массив строк, я предлагаю вам взглянуть на компонент tStringList, он сам заботится о функциях управления и легок в использовании.
   2. Если вам необходим динамический многомерный массив строк, вы также можете воспользоваться tStringList (в случае, если число элементов вашего массива не превышает лимит для tStringList, я полагаю он равен 16,000). Чтобы сделать это, создайте функцию линейного распределения как показано ниже:
   Допустим у вас есть трехмерный массив строк, текущее измерение [12,80,7], и вы хотите найти элемент [n,m,x]. Вы можете найти этот элемент в приведенном одномерном массиве с помощью формулы ((n-1)*80*7 + (m-1)*80 + x). Затем вы можете использовать это в качестве индекса в tStringList. Для диманического изменения одной из границ массива, используйте метод tStringList Move, служащий как раз для таких целей. (Метод состоит из некоторых технологических внутренних циклов, но выполняются они очень быстро, поскольку tStringList манипулирует не с самими строками, а с указателями на них.)
   3. Если вам необходим динамический одномерный массив чисел, то в общих словах я приведу его ниже, но есть масса мелких деталей. Объявите указатель на тип массива, имеющего максимальное количество элементов данного типа (помните о том, что Delphi-16 позволяет иметь типам область памяти, ограниченной 64K), например так:
   type
    bigArray: array[1..32000] of integer; {или ^double, или что-то еще}
    pMyArray: ^bigArray;
   затем распределите сам массив:
   getMem (pMyArray, sizeof(integer) * n);
   где n — количество элементов. После этого вы можете ссылаться на элементы массива следующим образом:
   pMyArray^[51]
   Не забудьте освободить массив с помощью FreeMem после того, как вы его использовали.
   Изменить размер массива, определить новый указатель, перераспределить или обменяться с другим массивом можно так:
   pTemp: ^bigArray;
   getMem(pTemp, sizeof(integer) * newnumelements);
   memcopy(pTemp, pMyArray, sizeof(integer)*n);
   {n – количество элементов в pMyArray}
   freeMem(pMyArray, sizeof(integer)*n);
   pMyArray := pTemp;
   4. Если вам необходим многомерный массив чисел, скомбинируйте технику, описанную в пункте (3), с функцией распределения, описанной в пункте (2).
   5. Если для вашего массива необходим участок памяти больше чем 64K, вам необходимо разработать список указателей на участки памяти, но эта тема выходит за рамки данной статьи.
   Лично я инкапсулировал все в своем объекте. Я использую, как я это называю, «Basic String Object» (BSO), базовый строковый объект, который осуществляет динамическое распределение и освобождение памяти для строк любого размера. Непосредственно это PChar, указывающий на распределенную память. У меня существует два внешних свойства: AsString и AsPChar. Также у меня есть различные свойства и методы, позволяющие иметь различные способы доступа и манипулировать строками.
   Я написал свои собственные malloc(), calloc() и realloc(), используя частные методы объекта TString для сканирования распределенной памяти. Это классно работает, когда мне нужно «захватить» блок памяти.
   С помощью двух методов я могу распределить необходимую мне память (блоками, так что это не занимает много процессорного времени), и освобождать ее (когда существует определенный резерв – и снова так, чтобы не тратить много процессорного времени).
   О другой идее я уже рассказывал (открытый массив). Если вам нужна проверка выхода за границы и/или динамическое изменение размера массива, вы можете использовать метод, аналогичный методу работы со строковым объектом (описанный мною выше), но вам необходимо будет интегрировать свойство-массив по умолчанию, чтобы иметь к нему простой доступ. Это позволит вам иметь индексы и использовать нужный вам тип.
   TMyDynamicObject =
    …
    PROPERTY Array[idx:LONGINT]:TMyType READ GetArray WRITE PutArray DEFAULT;
   …

   VAR Mine :TMyDynamicObject;
   …
   Mine := TMyDynamicObject.Create;
   FOR i := 10 TO 20 DO Mine[i] := {значение}
   {ЧУДОВИЩНАЯ РАСТРАТА ПАМЯТИ - если вы действительно используете такие большие массивы и хэш-таблицы }
   Mine[-100000] := {значение}
   Mine[+100000] := {значение}
   Если в вашем распоряжении находится «редкозаполненный» массив, использование хэш-таблицы дало бы существенный выигрыш. Я преобразую индексные значения в строки, а все остальное перепоручаю TStrings, но не из-за того, что я такой ленивый, а из-за того, что он сделает это лучше меня, мне нужно всего лишь осуществить преобразование в строки.
   Для того, чтобы хранить все, что вы хотите, вы можете использовать TList (или TStringList.Objects)! TList.Items хранят указатели на объекты или записи, но они ничего не могут сделать с ними, поэтому вы можете привести их к типу longint, и больше о них не беспокоиться! Вот пример хранения в TList списка целых:
   var
    aList: TList;
    I : Integer;
    L : Longint;
   begin
    aList := TList.Create;
    L := 93823;
    aList.Add(Pointer(L));
    aList.Add(Pointer(83293));
    for I := 1 to aList.Count do L := L + Longint(aList.Items[I-1]);
    aList.Free;
   end;
   В TList и TStringList вы можете иметь до 16380 элементов. А теперь обещанный пример того, как можно хранить в TList записи (или объекты), вернее, указатели на них:
   type
    PMyRec = TMyRec;
    TMyRec = record
     Name: string[40];
     Addr : string[25];
     Comments: string;
     salary: Double;
    end;
   var
    aList: TList;
    aRecPtr: PMyRec;
    I : Integer;
   begin
    aList := TList.Create;
    New(aRecPtr);
    with aRecPtr^ do begin
     Name := 'Валентин';
     Addr := 'неизвестен';
     Comments := 'Автор Советов по Delphi';
     Salary := 999000.00;
    end;
    aList.Add(aRecPtr);
    aList.Add(…);
    …
    for I := 1 to aList.Count do begin
     aRecPtr := PMyRec(aList.Items[I-1]);
     {что-то делаем с записью}
    end;
    {теперь избавляемся от всех записей и самого списка-объекта}
    for I := 1 to aList.Count do Dispose(PMyRec(aList.Items[I-1]));
    aList.Free;
   end;

Динамические массивы VIII

   Иногда разработчик, работая с массивами, не знает какого размера массив ему нужен. Тогда Вам пригодится использование динамических массивов.
   var intArray : array of integer;
   При таком объявлении размер массива не указывается. Что бы использовать его дальше необходимо определить его размер (обратите внимание, что размер динамического массива можно устанавливать в программе):
   begin
    intArray:=(New(IntArray,100); //Размер массива? 100
   end;
   Igor Nikolaev aKa The Sprite

Пример массива констант (Array of Const) III

   procedure foo(a : array of const);
   implementation
    var
    var1: longint;
    var2: pointer;
    var3: integer;
   begin
    var1 := 12345678;
    var2 := @var1;
    var3 := 1234;
    foo([var1, var2, var3]);
   В действительности, массив array of const более корректным было бы назвать массивом array of tvariant. Tvariant — множественный выбор типов переменной, в которой можно задать номер типа. В Visual Basic у него имеется наследник. Delphi также позволяет использовать имена.
   Определите тип, например, так:
   TYPE NAME1 = Array[1..4,1..10] of Integer;
   Затем, в вашей секции CONST:
   NAME2: NAME1 = ((1,2,3,4,5,6,7,8,9,10),
                   (1,2,3,4,5,6,7,8,9,10),
                   (1,2,3,4,5,6,7,8,9,10),
                   (1,2,3,4,5,6,7,8,9,10));

Массив объектов-изображений

   Вы не сможете сделать это напрямую и "визуально", но если вы не возражаете против нескольких строк кода, то я покажу как это может быть просто:
   type
    TForm1 = class(TForm)
    …
    public
     images: array [1..10] of TImage;
     …
    end;

   procedure TForm1.FormCreate(…);
   var i: integer;
   begin
    …
    for i := 1 to 10 do begin
     images[i] := TImage.Create(self);
     with images[i] do begin
      parent := self;
      tag := i; { это облегчит идентификацию изображения }
      … установите другие необходимые свойства, например:
      OnClick := MyClickEventHndlr;
     end;
    end;
    …
   end;
   Для того, чтобы убедиться, что все модули в секции «uses» установлены правильно, бросьте на форму один такой динамический компонент, и затем удалите его, или установите его видимость в False. Более сложный способ заключается в разработке собственного компонента, делающего описанное выше.

Массив TPOINT

Const ptarr : Array[0..4] Of TPoint =((x:0; y:4), … (x:4; y:4));

Создание больших массивов

   В 16-битной версии Delphi нельзя сделать это непосредственно. В новой, 32-битной версии, это как-то можно сделать, но за два месяца колупания я так и не понял как. (Некоторые бета-тестеры знают как. Не могли бы они сообщить нам всю подноготную этого дела?)
   В 16-битной версии Delphi вам необходимо работать с блоками по 32K или 64K и картой. Вы могли бы сделать приблизительно следующее:
   type
    chunk: array[0..32767] of byte;
    pchunk: ^chunk;
   var BigArray: array[0..31] of pChunk;
   Для создания массива:
   for i := 0 to high(bigarray) do new (bigArray[i]);
   Для получения доступа к n-ному байту в пределах массива (n должен иметь тип longint):
   bigArray[n shr 15]^[n and $7fff] := y;
   x := bigArray[n shr 15]^[n and $7fff];
   Это даже осуществляет проверку выхода за границы диапазона, если вы установили в ваших настройках опцию «range checking»!
   n должен находиться в диапазоне [0..32*32*1024] = [0..1024*1024] = [0..1048576].
   Для освобождения массива после его использования необходимо сделать следующее:
   for i := 0 to high(bigarray) do dispose (bigArray[i]);

Свойства

Редактор свойств для точки

   TPoint не имеет информацию о типе, следовательно, вы не можете зарегистрировать для него редактор свойства. Вы можете иметь редактор свойств только для строк, реальных, порядковых чисел или указателей на объекты. Дело в том, что редактор свойств имеет только следующие методы, чтобы иметь доступ к свойствам через RTTI:
   GetValue/SetValue для строк (strings)
   GetFloatValue/SetFloatValue для натуральных чисел (floats)
   GetOrdValue/SetOrdValue для порядковых (и указателей)
   Решением может быть создание класса TPersistentPoint, являющегося наследником TPersistent и имеющего те же свойства, что и TPoint. Вы можете просто «обернуть» TPoint для хранения значений, или создать явные поля. Непосредственное использование TPoint сделает использование метода Assign легким и быстрым для кодирования. Для процедур чтения и записи вы можете использовать поля записи, как показано ниже:
   type TPersistentPoint = class(TPersistent)
   private
    FPoint: TPoint;
   published
    property X : integer read FPoint.X write FPoint.X;
    property Y : integer read FPoint.Y write FPoint.Y;
   end;
   – Mike Scott

Хитрость вызова редактора свойств

   Сделайте ваш редактор свойства наследником TStringListProperty (добавьте STREDIT в список используемых модулей) и согласно вашим обстоятельствам вызывайте метод предка Edit:
   Unit MyEditor;

   interface

   uses STREDIT;

   type TMyStringListProperty = class(TStringListProperty)
    procedure Edit; override;
   end;

   implementation

   procedure TMyStringListProperty.Edit;
   begin
    if { какие-то условия } then { что-то делаем }
    else inherited Edit;
   end;

   end.
   - Pat Ritchey

Как убрать публичное свойство компонента/формы из списка видимых/редактируемых свойств в Инспекторе Обьектов?

   Nomadic советует:
   Из TForm property не убиpал, но из TWinControl было дело. А дело было так:
   interface
   type TMyComp = class(TWinControl)
    …
   end;

   procedure Register;

   implementation

   procedure Register;
   begin
    RegisterComponents('MyPage', [TMyComp]);
    RegisterPropertyEditor(TypeInfo(String),TMyComp,'Hint',nil);
   end;
   [ и т.д.]
   Тепеpь property 'Hint' в Object Inspector не видно. Рад, если чем-то помог. Если будут глюки, умоляю сообщить. Такой подход у меня сплошь и pядом.

Свойство FileName в невизуальном компоненте

   Следующий код взят из dsgnintf.pas (иногда стоит покопаться в файлах!) для свойства TMPLayer.filename, с помощью C.Calvert…
   В заголовке модуля компонента…
   TFileNameProperty = class(TStringProperty)
   public
    function getattributes: TPropertyattributes; override;
    procedure Edit; override;
   end;
   добавьте функцию регистрации…
   RegisterPropertyEditor(Typeinfo(String), TMyComponent, 'Filename', TFileNameProperty);
   и код…
   function TFileNameProperty.GetAttributes;
   begin
    Result := [paDialog];
   end;

   Procedure TFilenameProperty.edit;
   var
    MFileOpen: TOpenDialog;
   begin
    MFileOpen := TOpenDialog.Create(Application);
    MFileOpen.Filename := GetValue;
    MFileOpen.Filter := 'Правильный тип файлов|*.*'; (* Поместите здесь ваш собственный фильтр...*)
    MFileOpen.Options := MFileOpen.Options + [ofPathMustExist,ofFileMustExist];
    try
     if MFileOpen.Execute then SetValue(MFileOpen.Filename);
    finally
     MFileOpen.Free;
    end;
   end;

Записи

Пример переменной записи

   В Delphi 2.0 я пытаюсь прочесть текстовый файл и получаю проблему. Текстовый файл, который я хочу прочесть, имеет записи фиксированной длины, но в самих записях могут располагаться различные типы с различной длиной, и оканчиваться в различных позициях, в зависимости от типа.
   Файл выглядит примерно так:
   TFH.......<First record type, первый тип записи>
   TBH.......<Second record type, второй тип записи>
   TAB........<Third record type, третий тип записи>
   TAA........<Fourth record type, четвертый тип записи>
   Вы можете поймать больше одного зайца в случае объявления переменной записи, но если сделаете это правильно.
   Type
    TDataTag = Array [1..3] of Char;
    TDataTags = Array [0..NumOfTags-1] of TDataTag;
    TDataRec = packed Record
     tagfield: TDataTag;
     case integer of
     0: ( поля для тэга TFH );
     1: ( поля для тэга TBH );
     2: …
     …
    end;
    TMultiRec = packed Record
     Case Boolean of
     false: (строка: Array [0..1024] of Char);
     { должно установать строку максимально возможной длины }
     true : ( data: TDataRec );
    End;
   Const DataTags: TDataTags = ('TFH', 'TBH', …);
   var rec: TMultirec;

   ReadLn(datafile, rec.line);
   Case IndexFromDataTag(rec.data.tagfield) Of
   0: …
   1: …
   IndexFromDataTag должен искать передаваемый тэг поля в массиве DataTags. Определите все поля в TDataRec как Array [1..someUpperBound] of Char.
   – Peter Below

Передача массива записей символов в Memo

   Тема: Передача массива записей символов в Memo.
   Обработка больших строк в 16-битной версии Delphi задача далеко непростая. Особенно когда строки являются частью структуры записи и вы хотите передать их в TMemo. В данном совете показано как создать структуру записи размером 1000 символов, прочесть в нее содержимое Memo и затем записать ее обратно в Memo. Основной метод, который мы здесь используем — метод Memo GetTextBuf. Используемая структура записи представляет собой простую строку и массив из 1000 символов, но структура могла бы быть сложнее.
   unit URcrdIO;

   interface

   uses
    SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,Forms, Dialogs, StdCtrls,dbtables;

   type
    TForm1 = class(TForm)
     Button1: TButton;
     Memo1: TMemo;
     Button2: TButton;
     procedure Button1Click(Sender: TObject);
     procedure Button2Click(Sender: TObject);
     private { Private declarations }
     public { Public declarations }
    end;
   type
    TMyRec = record
     MyArray: array [1..1000] of char;
     mystr: string;
    end;

   var
    Form1: TForm1;
    MyRec : TMyRec;
    mylist : TStringlist;
    PMyChar : PChar;
    myfile : file;
    mb : TStream;

   implementation

   {$R *.DFM}

   procedure TForm1.Button1Click(Sender: TObject);
   begin
    assignfile(myfile, 'c:\testblob.txt');
    rewrite(myfile,1);
    fillchar(MyRec.MyArray,sizeof(MyRec.MyArray),#0);
    pmychar:=@MyRec.MyArray;
    StrPCopy(pmychar,memo1.text);
    Blockwrite(MyFile,MyRec,SizeOf(MyRec));
    closefile(MyFile);
   end;

   procedure TForm1.Button2Click(Sender: TObject);
   begin
    assignfile(myfile, 'c:\testblob.txt');
    reset(myfile,1);
    fillchar(MyRec.MyArray, sizeof(MyRec.MyArray),#0);
    Blockread(MyFile, MyRec, SizeOf(MyRec));
    pmychar:=@MyRec.MyArray;
    Memo1.SetTextBuf(pmychar);
   end;

   end.

Освобождение записей

   Для начала необходимо привести объект к нужному типу, например, так:
   var
     i: integer;
   begin
    …
   for
    i := 0 to MyList.Count - 1 do dispose(PMyRecord(MyList[i]));
    MyList.Free;
   end;
   или
   begin
    for i := 0 to MyList.Count - 1 do dispose(PMyRecord(MyList.items[i]));
    MyList.Free;
   end;
   Items — свойство по умолчанию, поэтому вам нет необходимости определять это, хотя обратное не помешает.
   Теперь можно заняться созданием работоспособной и полезной функцией. В форме:
   var p : ^mystruct;
   begin
    new(p);
    …
    dispose(p);
   end;
   операторы new() и dispose() в точности соответствуют процедурам getmem() и freemem(), за исключением того, что компилитор распределяет количество байт под размер структуры, на которую ссылается переменная-указатель. По этой причине указатель должен быть типизированным указателем, и следущий код неверен:
   var
    p: pointer;
   begin
    new(p);
   end;
   поскольку невозможно установить размер памяти, на которую должен ссылаться указатель. С другой стороны, если вы используете getmem() и freemem(), вы можете распределять байты для нетепизированного указателя, например:
   var p : pointer;
   begin
    getmem(p, 32767);
    …
    freemem(p, 32767);
   end;

Строки

StrTok для Delphi 2

   Я передалал это для работы в Delphi 2.0, код приведен ниже (эта функция первоначально была написана John Cooper 76356,3601 и модифицирована мной для адаптации под Delphi 2.0).
   …вот этот код:
   function StrTok(Phrase: Pchar; Delimeter: PChar): Pchar;
   const
   tokenPtr: PChar = nil;
    workPtr: PChar = nil;
   var
   delimPtr: Pchar;
   begin
    if (Phrase <> nil) then workPtr := Phrase
    else workPtr := tokenPtr;
    if workPtr = nil then begin
    Result := nil;
     Exit;
    end;
    delimPtr := StrPos(workPtr, Delimeter);
    if (delimPtr <> nil) then
    begin
     delimPtr^ := Chr(0);
     tokenPtr := delimPtr + 1
    end else tokenPtr := nil;
    Result := workPtr;
   end;
   – Ralph Friedman

Как мне перекодировать строки из Win-кодировки в Dos-кодировку и наоборот?

   Как мне перекодировать строки из Win-кодировки в Dos-кодировку и наоборот?
   Nomadic отвечает:
   A: CharToOEM, OEMToChar, CharToOEMBuff, OEMToCharBuff. Заметьте однако, что эти функции не умеют делать таких, например, вещей, как koi8-r в DOS и т. п.

Типы

У меня константы могут иметь значение, отличное от заданного. Как лечить?

   Nomadic советует:
   DX.Bug: Const из другого unit'а дает неверное значение.
   Симптоматика –
   Unit Main;
   Interface
   Uses VData;
   Const Wko=0.9;
   …

   Unit VData;
   …Implementation
   Uses Main;
   Procedure ...;
   Begin
   { вот здесь Wko=...E+230 - наверное, бесконечность }
   End;
   Похоже, это действительно bug, причем ОСОБО ОПАСНЫЙ, т.к. может исказить результаты расчетов, не вызвав заметных нарушений работы программы.
   В общем так. Эксперимент показал, что любая вещественная константа, определенная в интерфейсе модуля, может быть неверно (и не обязательно очень неверно – например, вместо 0.7 может появиться 0.115) прочитана в другом модуле. Баг особенно опасен тем, что он неустойчив и может пропадать и возникать без видимых причин (например, возникнуть, если предыдущая компиляция была неудачной и исчезнуть после использования константы в модуле, где она определена).
   Лечится (вpоде бы) указанием типа
   const Wko: double = 0.9;
   правда, теперь это уже не совсем константа…

Значение вычисляемого поля Paradox вместо 25.55 становится 24.5499999…

   Значение вычисляемого поля вместо 25.55 у меня выводится как 24.5499999. Скажите, что я делаю неправильно?
   Вы не виноваты в ошибке калькуляции!
   Я обнаружил ту же проблему в пакете учета, который я сейчас создаю. Мне кажется, что Borland сам делает в своем коде некий перерасчет значений.
   Вы можете обойти проблему с помощью функции Round:
   SalesIncVAT:=round(SalesIncVAT*100)/100; {дает вам два десятичных порядка}
   ничего экстраординарного, это основное свойство математики плавающей точки, которая обеспечивает точность только в заданном интервале десятичных цифр. Точнее говоря, тип float точен для промежуточных целых чисел и для долей, которые представляют собой сумму компонентов в степени 2, любое другое число округляется исходя из переменной точности (7 цифр для «одинарной» точности, 15 для двойной и 20 для расширенной). Можно использовать процедуру Round или str:
   var s : string;
   begin
    str(SalesIncVat:10:2,s); {10 символов для целой части (с точкой) и 2 десятичных цифры}
    Label1.Caption:=s;
   В справке написано, что функция FloatToStr преобразует число в строку с 15 десятичными цифрами – вот почему ваше число отображается столь причудливым образом, попробуйте эту функцию с числами типа 25.5, 25.25, 25.125 или подобными, которые имеют конечное представление в двоичной нотации, и эта проблема должна у вас исчезнуть.
   Или используйте функцию FloatToStrF, которой в параметрах необходимо указать общую длину строки и количество десятичных цифр.

Классовые/статические/переменные общего доступа

   Здесь кроется небольшая хитрость: получение эквивалентной функциональности с помощью классового метода. Просто объявите NodeCount как регулярную типизированную константу в секции implementation вашего файла.
   type TNode = class
   public
   NodeCount: Integer = 0; {ЭТО НЕ ДОПУСКАЕТСЯ}
    constructor Create;
    Class Function GetNodeCount : word;
    {другой необходимый код}
   end;

   implementation
   const
    NodeCount : word = 0;

   TNode.Create;
   begin
    inherited Create;
    Inc(NodeCount);
   end;

   Function TNode.GetNodeCount : word;
   begin
   result := NodeCount;
   end;
   Итак, теперь ваш код может выглядеть так, как вы хотели:
   SampleNode := TNode.Create;
   x := SampleNode.GetNodeCount;
   следующая строка также корректна:
   x := TNode.GetNodeCount;

Чем отличается тип String в Delphi 2 и выше от аналогичного в Delphi 1?

   Nomadic советует:
   B D2 и выше на самом деле используется тип LongString вместо String, а старый тип тепеpь обзывается ShortString (о чем, кстати, написано в help). Из того же help можно узнать, что указатель LongString указывает на nullterminated string и потому возможно обычное приведение типа LongString к PChar (о чем я и написал), которое сводится просто к смене вывески. Там же можно узнать, что длина строки хранится в dword перед указателем. Есть также намек на то, что при присваивании другой строке информация не копируется, а увеличивается только счетчик ссылок. Более подробную информацию можно почерпнуть из system.pas:
   type StrRec = record
    allocSiz: Longint;
    refCnt: Longint;
    length: Longint;
   end;
   От себя добавлю:
   Сама переменная LongString указывает на байт, непосредственно следующий за этой процедурой, там же находится собственно значение строки. Значение '' (пустая строка) представляется как указатель nil, кстати, поэтому сpавнение str='' это быстpая операция.
   Теперь подробнее о счетчике ссылок. Я уже говорил, что при присваивании копирования не происходит, а только увеличивается счетчик. Когда он уменьшается? Ну, очевидно, когда в результате операции значение строки меняется, то для старого значения счетчик уменьшается. Это понятно. Более непонятно, когда освобождаются значения, на которые ссылаются поля некого класса. Это происходит в System. TObject.FreeInstance пpи вызове _FinalizeRecord, а информация берется из vtInitTable (кстати, здесь же очищаются Variant). Ещё более непонятно, когда освобождаются переменые String, которые описаны как локальные в пpоцедурах/функциях/методах. Здесь работает компилятор, которые вставляет эти неявные операции в код этой функции.
   Тепеpь о типе PString. Hа самом деле переменные этого типа указывают на такие же значения, как и LongString, но для переменных этого типа для всех опеpаций по созданию/копиpованию/удалению нужно помнить об этих самых счетчиках ссылок. Иногда без этого типа не обойтись. Вот опеpации для этого типа (sysutils.pas):
   { String handling routines }

   { NewStr allocates a string on the heap. NewStr is provided for backwards compatibility only. }
   function NewStr(const S: string): PString;

   { DisposeStr disposes a string pointer that was previously allocated using NewStr.DisposeStr is provided for backwards compatibility only. }
   procedure DisposeStr(P: PString);

   { AssignStr assigns a new dynamically allocated string to the given string pointer.AssignStr is provided for backwards compatibility only. }
   procedure AssignStr(var P: PString; const S: string);
   Можно отметить, что явно задать использование long strings можно декларацией
   var
    sMyLongString: AnsiString; // long dinamically allocated string
    sMyWideString: WideString; // wide string (UNICODE)
    sMyShortString1: ShortString; // old-style string
    sMyShortString2: String[255]; // old-style string, no more than 255 chars
   Хотелось бы также предупредить наиболее частные ошибки при использовании длинных строк:
   • Если Вы передаёте указатель PChar на буфер, взятый от длинной строки, в функцию, которая может изменить содержание буфера, то убедитесь, что на этот буфер указывает только одна строка. Это верно в случаях сложения строк, вызова UniqueString или SetLength и некоторых других;
   • Если Вы используете длинные строки как аргументы или результаты для функций, располагающихся в DLL, то в DLL надо использовать модуль ShareMem;
   • Не используйте длинные строки как члены структур типа record. Используйте там короткие строки или array[0..n] of char. Также нельзя использовать в структурах типа record динамические массивы. Данные ограничения отсутствуют для классов.

Различия TMEMOFIELD

   Во-первых, если аргумент size у GetMem равен нулю, GetMem устанавливает указатель в nil (не отбрасывайте такой способ, но разумней самому установить его в nil). Также в отладчике вы могли бы проверять значение DataSize (или getTextLen) перед самим вызовом.
   (Проигнорируйте следующий параграф, если Table1Notes не Memo.)
   Во-вторых, если Table1Notes — Memo-поле, вы, вероятно, захотите использовать Table1Notes.getTextLen, не DataSize, поскольку DataSize возвращает размер сегмента буфера записи (0-254), тогда как getTextLen возвратит вам реальный размер Memo. (Для строкового поля DataSize работать будет, но очень странно, поскольку возвращает ноль.) Также вы можете воспользоваться getTextBuf вместо getData, не знаю точно почему, но мои многочисленные экспериметны показали, что getTextBuf работает правильно и устойчиво, а getData нет.
   Поскольку "wordwrapping" (перенос слов) доступен в вашем приложении, вы можете заменить символы #10 (перевод строки) и #13 (возврат каретки) на пробелы, например так:
   cursor: pchar;
   cursor := ваш буфер;
   while cursor^ <> #0 do if (cursor^ = #13) or (cursor^ = #10) then cursor^ := ' ';
   Данный способ прост, поскольку нам нет нужды перемещать текст из переменной в переменную, хотя и не без недостатка, поскольку в конце каждой строки мы получаем два пробела, что может неправильно интерпретироваться при переносе строк. В качестве альтернативы, вместо пробела вы можете применить другой служебный символ, который ваш текстовый процессор воспримет в качестве прерывания строки, или проигнорирует его (например, символ #8). Если вам нужно просто избавиться от символов перевода строки, воспользуйтесь двумя курсорами как показано ниже (извините, не тестировал):
   out, in: pchar;
   out := ваш буфер;
   in := out;
   while in^ <> #0 do begin
    if (in^ <> #10) and (in^ <> #13) then begin
     out^ := in^;
     inc(out);
    end;
    inc(in);
   end;
   out^ := #0;
   Если вместо этого вы хотите заменить каждую пару CR-LF или отдельный CR или LF единичным пробелом, попробуйте это:
   out, inn: PChar;
   out := ваш буфер;
   inn := out;
   while in^ <> #0 do begin
    if (in^ = #10) then begin
    end
    else if (in^ = #13) then begin
     if (in+1)^
   Если вместо этого вы хотите заменить каждую пару CR-LF или отдельный CR или LF единичным пробелом, попробуйте это:
   out, inn: PChar;
   out := buf;
   inn := out;
   while inn^ <> #0 do begin
    if (inn^ = #10) or ((inn^ = #13) and ((inn+1)^ <> #10)) then begin
     out^ := ' ';
     Inc(out);
    end
    else if (inn^ = #13) then
    { только CR, игнорируем }
    else begin
     out^ := inn^;
     Inc(out);
    end;
    Inc(inn);
   end;
   out^ := #0;
   { буфер теперь закрыт }
   Непроверенное: эффект уменьшения размера (путем установки терминатора #0) этого PChar позволит уменьшить время компиляции массивов и буферов GetMem, что же будет при использовании StrAlloc/StrDispose?
   Вот конечный код после учета всех мелочей! Например, нам, в конечном счете, нужно сообщить указателю о необходимости возвратиться к началу своей новой строки.
   procedure TForm1.RemoveSpaces(var InBuf: PChar; Size: Word);
   var
    Input, OutPut, Orig: PChar;
   begin
    GetMem(Output, Size);
    input := Inbuf;
    Orig := Output;
    while input^ <> #0 do begin
     if (input^ <> #10) and (input^ <> #13) then begin
   output^ := input^;
      inc(output);
     end;
     inc(input);
    end;
    Output^ := #0;
    Output := Orig;
    InBuf := Output;
   end;
   Я все еще немало удивлен тому как работает GetData! Я все еще не хочу использовать TMemo! Если кто-то может решить эту проблему, я буду очень рад! Пока же я готовлю для вас материал, включающий новые процедуры печати! Наведем порядок в беспорядке! Я уже имею реализацию вывода текста с любым шрифтом и в любой позиции, выраженной в дюймах, и это только начало! Но что я думаю действительно классно вышло, так это диманическая сетка! Вы можете создавать сетку с любым количеством строк и колонок. Назначьте текст и ячейку, установите горизонтальное и вертикальное выравнивание, выберите стиль границы для каждой ячейки и изучите множество других способов манипулирования и печати сетки!

Функция, возвращающая тип

   Вы можете сделать это в C++. В ObjectPascal это также можно сделать, смотрите пример:
   // функция Chameleon, возвращающая тип сгенерированного исключения
   unit Unit1;

   interface

   uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,StdCtrls;

   type
    MyBoolean = class
    public
     Value : boolean;
    end;

    MyInteger = class
    public
     Value : integer;
    end;

    MyClass = class
    public
     Value : TStrings;
    end;

    TForm1 = class(TForm)
     Button1: TButton;
     procedure Button1Click(Sender: TObject);
    private { Private declarations }
    public { Public declarations }
     procedure MyProc;
     function Chameleon : boolean;
    end;

   var
    Form1: TForm1;

   implementation

   {$R *.DFM}

   function TForm1.Chameleon : boolean;
   var
    b : MyBoolean;
    i : MyInteger;
    c : MyClass;
    r : integer;
   begin
    r := Random(3);
    case r of
    0 : begin
     b := MyBoolean.Create;
     raise b;
    end;
    1 : begin
     i := MyInteger.Create;
     raise i;
    end;
    2 : begin
     c := MyClass.Create;
     raise c;
    end;
    end;
   end;

   procedure TForm1.MyProc;
   begin

    try
     Chameleon;
    excepton MyBoolean do ShowMessage('Функция возвратила класс MyBoolean');
    on MyInteger do ShowMessage('Функция возвратила класс MyInteger');
    on MyClass do ShowMessage('Функция возвратила класс MyClass');
    end;
   end;

   procedure TForm1.Button1Click(Sender: TObject);
   begin
    Chameleon;
   end;

   end.
   Взгляните на тип данных Variant в D2: следующий код
   function AnyType(const TypeParm: integer): Variant;
   begin

    case TypeParm of
   1: Result := 1;
    2: Result := 2.0;
    3: Result := 'Три';
    4: Result := StrToDate('4/4/1944');
    end;
   end;
   абсолютно бестолковый, но полностью корректный!
   Следующий код содержит объявление трех функций, принимающих на входе один и тот же параметр, но выдающих результаты различных типов (результат физичиски один и тот же, и занимает он 4 байта). Я не думаю, что можно одурачить delphi, чтобы с помощью этого метода возвратить строку. Это может привести к разрушению менеджера кучи. Вместо этого вызывайте необходимую вам функцию. Каждый вызов передается MyFuncRetAnything, а P1 определяет возвращаемый тип. Если хотите, можете написать другую обертку, делающую для вас еще и приведение типов.
   3 вызова, 1 код.
   Я понимаю, что это в действительности не то, что нужно, по я просто хотел продемонстрировать другой способ. (вы можете возвращать строки как тип PChar, который также занимает 4 байта). Вы должны использовать некоторую память, распределяемую вызовом процедуры (может быть передавать результаты как P2?).
   {моя форма имеет 3 метки, одну кнопку и этот код}

   var
    MyFuncRetInt : Function(P1, P2 : Integer) : Integer;
    MyFuncRetBool : Function (P1, P2 : Integer) : LongBool;
    MyFuncRetPointer : Function (P1, P2 : Integer) : Pointer;
    function MyFuncRetAnything (P1, P2 : Integer) : Integer;
   var
    RetPointer : Pointer;
    RetBool : LongBool;
    RetInteger : Integer;
   begin
    RetPointer := nil;
    RetBool := False;
    RetInteger := 4711;
    case P1 of
   1 : Result := Integer (RetPointer);
    2 : Result := Integer (RetBool);
    3 : Result := RetInteger;
    end;
   end;

   procedure TForm1.Button1Click(Sender: TObject);
   begin
    if MyFuncRetBool (2, 1900) then Label1.Caption := 'True'
    else Label1.Caption := 'False';
    Label2.Caption := IntToStr(MyFuncRetInt(3, 1900));
    Label3.Caption := IntToHex(Integer(MyFuncRetPointer(1, 1900)), 16);
   end;

   initialization
    MyFuncRetInt := @MyFuncRetAnything;
    MyFuncRetBool := @MyFuncRetAnything;
    MyFuncRetPointer := @MyFuncRetAnything;
   end.

Преобразование формата MS BINARY в IEEE

«Использование, независимое от машинного уровня» не так просто в реализации с процессорами, выпущенными до Intel-го математического сопроцессора 80x87. Я не уверен в том, что процессоры 80x86 имели какие-либо родные инструкции для выполнения операций с плавающей точкой. По-видимости, поэтому Microsoft создал свой собственный формат для чисел с плавающей точкой; он сам осуществлял всю арифметику с помощью библиотеки времени выполнения. Сегодня 80x87 осуществляет такую арифметику автоматически, и IEEE теперь стандарт.
Delphi хранит следующие типы чисел с плавающей точкой в формате IEEE:

Single	4 байт
Double	8 байт
Extended	10 байт

   Обратите внимание на то, что тип Real (6 байт) отсутствует в данном списке. Я могу ошибаться, но мне кажется что тип Real – синтезированный в Pascal тип; он может без особых проблем существовать на процессорах ниже 80x87.
   [В сторону: электронная справка Delphi сообщает, что по умолчанию (через директиву компилятора $N+), компилятор будет генерировать код для выполнения ВСЕХ операций с плавающей точкой, используя инструкции 80x87, включая тип Real. Также, для работы с типом Real, компилятор генерирует вызовы библиотеки времени выполнения, или же я полностью неправ в вышесказанном! :) ]
   Во всяком случае, в электронной справке Visual Basic я увидел, что VB оперирует с типами данных Single и Double, которые также относятся к типу IEEE, и идентичны Delphi-типам Single и Double. Тем не менее, в справке отсутствует упоминание «Microsoft Binary Format».
   Для того, чтобы разобраться в вопросе, я «опустился» до DOS и запустил QBasic, новую версию интерпретатора Microsoft QuickBasic, включаемую теперь в поставку DOS. Если мы посмотрим в электронную справку, то увидим следующее:
   MKSMBF$ и MKDMBF$ преобразуют числа формата IEEE в «числовые строки» формата Microsoft-Binary, которые могут храниться в строковых переменных типа FIELD. CVSMBF и CVDMBF преобразуют эти строки обратно в числа формата IEEE.
   MKSMBF$(выражение-единичной-точности!)
   MKDMBF$(выражение-двойной-точности#)
   CVSMBF (4-байтовая-числовая-строка)
   CVDMBF (8-байтовая-числовая-строка)

Функция	Возвращаемое значение
MKSMBF$	4-байтовая строка, содержащая число в формате Microsoft-Binary-format
MKDMBF$	8-байтовая строка, содержащая число в формате Microsoft-Binary-format
CVSMBF	Число единичной точности в формате IEEE
CVDMBF	Число двойной точности в формате IEEE

   Эти функции могут оказаться полезными при поддержке файлов данных, созданных с помощью старых версий Basic.
   Суммируя вышесказанное, можно дать 3 рекомендации для получения доступа к вашим «MetaStock»-файлам:
   1. Напишите вашу программу в QBasic/DOS
   2. Найдите замену (с учетом совместимости с Delphi) для функций преобразований, упомянутых выше.
   3. Напишите эти функции сами. Вы должны найти документацию для старых типов Single и Double, применявшихся в «Microsoft Binary Format», возможно в справочных файлах старых версий MS Basic.

Переменные

Статические переменные

   Да, это работает. Объявите переменную в секции const, например:
   procedure p;
   const MyVariable : Integer = 0;
   begin
    Inc(MyVariable);
   end;
   В нашем примере переменная MyVariable содержит количество вызовов P.
   Тем не менее, это лучшее решение, чем использование взамен какого-либо поля объекта (если это возможно).

Разное

Переключение ключей компилятора

   {$R+,L+} {Это директива компилятора плюс комментарий}
   {{$R+,L+} {Эта строка – два комментария, похоже на картинку?}
   Аналогично:
   {$DEFINE DEVEL}
   {$IFDEF DEVEL}
   ……
   {$ELSEIF}
   Переключение с «devel» компиляции на не-«devel» версию происходит простым прибавлением второй скобки в первой строке. Единственное нажатие клавиши позволит переключать вам ключи компилятора.
   Также для скоростных манипулиций и кратковременных изменений отлично подойдут комментарии, расположенные за строкой:
   if i=0 then inc(i); {выражение+комментарий}
   ср.
   { if i=0 then inc(i); {закомментарена вся строка}
   Сравните – два нажатия клавиш для установки фигурной скобки или десяток нажатий для установки (* *) до и после строки. Клавиша Del поможет вам вернуться в предыдущее состояние.
   – P Gallagher

Получение ссылки на класс из объекта I

   Мне необходимо получить ссылку на класс из объекта. Например, если у меня есть ссылка на объект (например, указатель на экземпляр TLabel), то мне необходимо получить ссылку на класс (например, ссылка на класс TLabel) для того, чтобы мне еще создать необходимое количество объектов данного класса. Другими словами, мне нужно дублировать экземпляры классов, создаваемые кем-то еще.
   Класс, о котором идет речь, в Delphi не зарегистрирован (его нет в палитре), поэтому GetClass('TLabel') не работает, даже если экземпляры класса существуют, работать с ними можно только через RTTI. Вдобавок к этому, у меня нет даже кода класса, поэтому работа через RTTI - единственный выход.
   Вот пример, который получает ссылку на класс и назначает значения новому классу того же типа. Имейте в виду, что вам необходимо сделать некоторое преобразование типов, чтобы с полученным типом класса можно было сделать что-либо полезное, поскольку возвращаемый класс имеет тип TClass.
   type TLabelClass = class of TLabel;

   procedure TForm1.Button1Click(Sender: TObject);
   var
    Ref : TLabelClass;
    New : TLabel;
   begin
    Ref := TLabelClass(Label1.ClassType);
    New := Ref.Create(Self);
    New.Parent := Self;
    New.Caption := 'Фантастика!';
   end;
   Реплицирование класса может быть осуществлено одним из двух способов. Во-первых, вы можете воспользоваться методом Assign (который требует, чтобы ваши классы были наследниками TPersistent). Данный способ заключается в использовании метода Assign, работающего с TPersistentClass:
   New.Assign(Label1);
   Второй способ заключается в использовании автоматической поточности компонента (этот способ требует, чтобы ваши классы являлись наследниками TComponent, и чтобы они были зарегистрированы для потоковой системы).
   В вашем вопросе вы исходили из неправильного предположения; классы могут регистрироваться потоковой системой И НЕ регистрироваться в Палитре Компонентов; обычно эти две вещи связаны, но не обязательно. Например, скажем, у вас имеется следующий класс:
   TCustomer = class(TComponent)
   private
    FCompany: string;
    FPhone : LongInt;
   published
    property Company: string read FCompany write FCompany;
    property Phone: LongInt read FPhone write FPhone;
   end;
   Вы можете зарегистрировать класс для потоковой системы следующим образом:
   RegisterClass(TCustomer);
   который позволяет знать как осуществлять поточность для TCustomer, но не регистрирует его в Палитре Компонентов.
   После регистрации классов, вы можете реплицировать их следующим образом:
   procedure TForm1.Button1Click(Sender: TObject);
   var
    Ref: TComponentClass;
    New: TComponent;
    Stream: TMemoryStream;
   begin
    Ref := TComponentClass(Label1.ClassType);
    New := Ref.Create(Self);
    Stream := TMemoryStream.Create;
    try
   Stream.WriteComponent(Label1);
     Stream.Position := 0;
     Stream.ReadComponent(New);
    finally
   Stream.Free;
    end;
   end;
   – Rick Rogers

Получение ссылки на класс из объекта II

   Мне необходимо получить ссылку на класс из объекта…
   TObject.ClassType

   var
    ClassRef: TComponentClass;
    NewComp: TComponent;
   begin
    TClass(ClassRef) := Sender.ClassType;
    NewComp := ClassRef.Create(Self);
    …
   – Pat Ritchey

Работа с комментариями в большом куске кода

В Паскале существует 2 способа обозначить комментарии – {} и (* *). Вы можете вставлять один комментарий в другой (осуществлять вложенность). Следовательно, вставляя (* в начале вашего блока, и *) в конце, вы все еще можете работать с вложенными комментариями типа { }.

Базы данных

Калькуляция

Код определения возраста

   Вызовите диалог редактирования полей (Fields Editor), дважды щелкнув на компоненте TTable или TQuery, расположенном на вашей форме (или выбрав в контекстном меню пункт Fields Editor). Добавьте все поля, с которыми вы хотите работать в форме (даже если вы хотите, чтобы они были невидимы, но вам необходим к ним доступ – для таких полей установите свойство visible в false). Затем щелкните на «Define…» (определить) для добавления вычисляемого поля. Введите имя вычисляемого поля, отличающееся от имен других полей таблицы, выберите тип (вероятно, StringField) и задайте длину (20 будет в самый раз). Убедитесь в том, что напротив поля 'calculated' стоит галочка. Затем создайте для вашего объекта TTable или TQuery обработчик события 'OnCalcFields'. В этом обработчике вы берете значения реальных полей таблицы, делаете вычисления, и помещаете результаты в объект вычисляемого поля, который вы только что создали. После этого значение выводится в TDBGrid, или в элементе управления TDBText, если вы решили использовать форму вместо табличной сетки.
   Наша функция должна достичь цели, обрабатывая значения лет и месяцев. Поскольку не все месяцы имеют одно и то же количество дней, я просто брал среднее число, поэтому результат может быть не очень точен, но большинство людей это удовлетворяет:
   function AgeStr(aDate: TDateTime): string;
   var
    DaysOld: Double;
    Years, Months: Integer;
   begin
    DaysOld:= Date – aDate;
    Years:= Trunc(DaysOld / 365.25);
    DaysOld:= DaysOld – (365.25 * Years);
    Months:= Trunc(DaysOld / 30.41);
    Result:= Format('%d лет, %d месяцев',[Years, Months]);
   end;
   В моем случае метод OnCalcFields выглядит так:
   procedure TEntryForm.TableNameOrderCalcFields(DataSet: TDataset);
   begin
    TableNameOrderAge.AsString := AgeStr(TableNameOrderDateOfBirth.AsDateTime);
   end;

Как пересчитать все вычисляемые поля (Calculated fields) без переоткрытия TDataSet?

Nomadic отвечает:
Resync([rmExact, rmCenter]);

Как создать вычисляемые поля во время исполнения программы (Calculated fields at RunTime)?

   Nomadic отвечает:
   Смотрите книгу "Developing Custom Delphi Components" от Рэя Конопки.
   Здесь немного исправленный пример из этой книги

   function TMyClass.CreateCalcField(const AFieldName: string; AFieldClass: TFieldClass; ASize: Word): TField;
   begin
    Result := FDataSet.FindField( AFieldName ); // Field may already exists!
    if Result<>nil then Exit;
    if AFieldClass = nil then
    begin
     DBErrorFmt( SUnknownFieldType, [AFieldName] );
    end;
    Result := FieldClass.Create( Owner );
    with Result do
    try
     FieldName := AFieldName;
     if (Result is TStringField) or (Result is TBCDField) or (Result is TBlobField) or (Result is TBytesField) or (Result is TVarBytesField) then
     begin
      Size := ASize;
     end;
     Calculated := True;
     DataSet := FDataset;
     Name := FDataSet.Name + AFieldName;
    except
     Free; // We must release allocated memory on error!
     raise;
    end;
   end;

Доступ

Хитрости многопользовательского доступа к БД

   Вот некоторые хитрости, могущие помочь в разработке баз многопользовательского доступа:
   В модуле DBIPROCS Delphi 1.0 и в BDE.INT 2.0 существует классная функция с именем DBISETLOCKRETRY(n).
   Синтаксис – DBISetLockRetry(n), где n – количество секунд ожидания перед повторной попыткой вставки, редактирования или другой операцией с таблицей. DBISetLockRetry(-1) будет бесконечно пытаться получить доступ к вашей таблице.
   Хорошее место для вызова функции – обработчик события TableAfterOpen. В этом случае все, что вам нужно сделать, это:
   DBISetLockRetry(x);
   Если вы используете Delphi 1.0, не забудьте включить в вашу программу DBIProcs. В Delphi 2.0 включите BDE.

Эти требования обязательны при разработке многопользовательских приложений Delphi с использованием файлов Dbase или Paradox.
– Ted Bulmanski

Выполнение запросов к базе данных в фоне

   Тема: Выполнение запросов к базе данных в фоновом потоке
   Данный документ объясняет как выполнить запрос в фоновом режиме, используя класс TThread. Для получения общей информации о классе TThread, пожалуйста обратитесь к документации Borland и электронной справке. Для понимания данного документа вам необходимо иметь представление о том, как работать с компонентами для работы с базами данных, поставляемых в комплекте с Delphi 2.0.
   Для осуществления потокового запроса необходимо выполнение двух требований. Во-первых, потоковый запрос должен находиться в своей собственной сессии с использованием отдельного компонента TSession. Следовательно, на вашей форме должен находиться компонент TSession, имя которого должно быть назначено свойству SessonName компонента TQuery, используемого для выполнения потокового запроса. Для каждого используемого в потоке компонента TQuery вы должны использовать отдельный компонент TSession. При использовании компонента TDataBase, для отдельного потокового запроса должен также использоваться отдельный TDataBase. Второе требование заключается в том, что компонент TQuery, используемый в потоке, не должен подключаться в контексте это потока к TDataSource. Это должно быть сделано в контексте первичного потока.
   Приведенный ниже пример кода иллюстрирует описываемый процесс. Данный модуль демонстрирует форму, которая содержит по два экземпляра следующих компонентов: TSession, TDatabase, TQuery, TDataSource и TDBGrid. Данные компоненты имеют следующие значения свойств:
   Session1
    Active True;
    SessionName "Ses1"

   DataBase1
    AliasName "IBLOCAL"
    DatabaseName "DB1"
    SessionName "Ses1"

   Query1
    DataBaseName "DB1"
    SessionName "Ses1"
    SQL.Strings "Select * from employee"

   DataSource1
    DataSet ""

   DBGrid1
    DataSource DataSource1

   Session2
    Active True;
    SessionName "Ses2"

   DataBase2
    AliasName "IBLOCAL"
    DatabaseName "DB2"
    SessionName "Ses2"

   Query2
    DataBaseName "DB2"
    SessionName "Ses2"
    SQL.Strings "Select * from customer"

   DataSource2
    DataSet ""

   DBGrid1
    DataSource DataSource2
   Обратите внимание на то, что свойство DataSet обоих компонентов TDataSource первоначально никуда не ссылается. Оно устанавливается во время выполнения приложения, и это проиллюстрировано в коде.
   unit Unit1;

   interface

   uses Windows, Messages, SysUtils, Classes, Graphics, Controls,Forms, Dialogs,StdCtrls, Grids, DBGrids, DB, DBTables;

   type
    TForm1 = class(TForm)
     Session1: TSession;
     Session2: TSession;
     Database1: TDatabase;
     Database2: TDatabase;
     Query1: TQuery;
     Query2: TQuery;
     DataSource1: TDataSource;
     DataSource2: TDataSource;
     DBGrid1: TDBGrid;
     DBGrid2: TDBGrid;
     GoBtn1: TButton;
     procedure GoBtn1Click(Sender: TObject);
    end;

    TQueryThread = class(TThread)
    private
   FSession: TSession;
     FDatabase: TDataBase;
     FQuery: TQuery;
     FDatasource: TDatasource;
     FQueryException: Exception;
     procedure ConnectDataSource;
     procedure ShowQryError;
    protected
     procedure Execute; override;
    public
     constructor Create(Session: TSession; DataBase: TDatabase; Query: TQuery; DataSource: TDataSource); virtual;
    end;

   var Form1: TForm1;

   implementation

   constructor TQueryThread.Create(Session: TSession; DataBase: TDatabase; Query: TQuery; Datasource: TDataSource);
   begin
    inherited Create(True); // Создаем поток c состоянием suspendend
    FSession := Session;     // подключаем все privat-поля
    FDatabase := DataBase;
    FQuery := Query;
    FDataSource := Datasource;
    FreeOnTerminate := True; // Устанавливаем флаг освобождения потока после его завершения
    Resume;                  // Продолжение выполнения потока
   end;

   procedure TQueryThread.Execute;
   begin
    try
   { Выполняем запрос и подключаем источник данных к компоненту TQuery, вызывая ConnectDataSource из основного потока(для этой цели используем Synchronize)}
     FQuery.Open;
     Synchronize(ConnectDataSource);
    except
   { Ловим исключение (если оно происходит) и его дескриптор в контексте основного потока (для этой цели используемSynchronize). }
     FQueryException := ExceptObject as Exception;
     Synchronize(ShowQryError);
    end;
   end;

   procedure TQueryThread.ConnectDataSource;
   begin
   FDataSource.DataSet := FQuery; // Подключаем DataSource к TQuery
   end;

   procedure TQueryThread.ShowQryError;
   begin
   Application.ShowException(FQueryException); // Обрабатываем исключение
   end;

   procedure RunBackgroundQuery(Session: TSession; DataBase: TDataBase; Query: TQuery; DataSource: TDataSource);
   begin
   { Создаем экземпляр TThread с различными параметрами. }
    TQueryThread.Create(Session, Database, Query, DataSource);
   end;

   {$R *.DFM}

   procedure TForm1.GoBtn1Click(Sender: TObject);
   begin
   { Запускаем два отдельных запроса, каждый в своем потоке }
    RunBackgroundQuery(Session1, DataBase1, Query1, Datasource1);
    RunBackgroundQuery(Session2, DataBase2, Query2, Datasource2);
   end;

   end.
   Метод TForm1.GoBtn1Click является обработчиком события нажатия кнопки. Данный обработчик события дважды вызывает процедуру RunBackgroundQuery, это случается при каждой передаче новых параметров компонентам для работы с базой данных. RunBackgroundQuery создает отдельный экземпляр класса TQueryThread, передает различные компоненты для работы с базой данных в его конструктор, который, в свою очередь, назначает их закрытым полям TQueryThread.
   TQueryThread содержит две определенные пользователем процедуры: ConnectDataSource и ShowQryError. ConnectDataSource связывает FDataSource.DataSet с FQuery. Тем не менее, это делается в первичном потоке с помощью метода TThread.Synchronize. ShowQryError обрабатывает исключение в контексте первиного потока, также используя метод Synchronize. Конструктор Create и метод Execute снабжены подробными комментариями.

Получение физического пути к таблице

   Тема: Получение физического пути к таблице
   Отправлено: Август 13, 1996
   Автор: Xavier Pacheco
   Если ссылка на таблицу получена через псевдоним, получить физический путь к ней не так просто. Для получения этого пути необходимо использовать функцию BDE DbiGetDatabaseDesc. Данной функции в качестве параметров передаются имя псевдонима и указатель на структуру DBDesc. Структура DBDesc будет заполнена информацией, относящейся к этому псевдониму. Определение структуры:
   pDBDesc = ^DBDesc;
   DBDesc = packed record 2{ Описание данной базы данных }
    szName    : DBINAME; { Логическое имя (или псевдоним) }
    szText    : DBINAME; { Описательный текст }
    szPhyName : DBIPATH; { Физическое имя/путь }
    szDbType  : DBINAME; { Тип базы данных }
   end;
   Физическое имя/путь будет содержаться в поле szPhyName структуры DBDesc.
   Возможные значения, возвращаемые функцией DBIGetDatbaseDesc:
   DBIERR_NONE Описание базы данных для pszName было успешно извлечено. DBIERR_OBJNOTFOUND База данных, указанная в pszName, не была обнаружена.
   Приведенный ниже пример кода показывает как можно получить физический путь для компонента TTable, использующего псевдоним DBDemos:
   var
    vDBDesc: DBDesc;
    DirTable: String;
   begin
    Check(DbiGetDatabaseDesc(PChar(Table1.DatabaseName), @vDBDesc));
    DirTable := Format('%s\%s', [vDBDesc.szPhyName, Table1.TableName]);
    ShowMessage(DirTable);
   end;

Cancel в связанных таблицах

   В книге 'Delphi unleashed' на странице 520 автор написал:
   '…, вы можете делать откат все время до тех пор, пока прямо или косвенно не сделаете постинг данных.'
   Моя проблема дважды возникала в случае ExTable.Edit в различных процедурах. Код был примерно таким:
   Procedure1 …
   begin
    ExTable.Edit;
    ExTable.FieldByName('…').asstring := …;
    …
   end;

   procedure2 …
   begin
    ExTable.Edit;
    …
   end;
   Процедура CancelSpdBtnClick была вызвана после этих двух процедур. Действительно, прежде, чем делать откат, постинг был косвенно вызван между двумя вызовами ExTable.Edit. Теперь после такой модификации все работает как часы.

Отображение формы ввода в БД CUSTOMER из рабочей формы ORDER

   В моем проекте имеется подобная функция, определяющая количество элементов:
   В обработчике события OnClick я создаю форму ввода данных и вывожу ее командой .ShowModal. Затем я проверяю результат .ModalResult – и, если он равен mrOk, я передаю запись, в противном случае делаю отмену.
   Я поместил имя модуля с формой ввода данных в список используемых модулей главной формы. Вот базовая схема моего кода:
   procedure TFrmItemNav.BtnChangeLocClick(Sender: TObject);
   {var DlgItemLoc: TDlgItemLoc;}
   begin
    DlgItemLoc := TDlgItemLoc.Create(FrmItemNav);
    DlgItemLoc.ShowModal;
    if DlgItemLoc.ModalResult = mrOk then
     {делаем все, что необходимо для постинга данных}
    else
     {очищаем и делаем Cancel};
    DlgItemLoc.Free;
   end;

Отображение определенных полей БД

   Вот что можно сделать во время выполнения программы:
   Table1.FieldByName(RemovedFieldName).Visible := False;
   или
   Table1.Field[removedFieldNumber-1].Visible := false;

Из базы данных в переменные

   Примерно так вы можете программным путем извлечь содержимое поля:
   aValue := TMyTable.FieldByName('SomeField').AsText;
   или
   aValue := TMyTable.FieldByName('SomeField').AsInteger;
   или
   aValue := TMyTable.Fields[1].AsFloat;
   В действительности здесь вы получаете объект TField от объекта TTable (или TQuery), и затем вызываете соответствующий метод объекта TField для получения самих данных. Вы можете также изменить значение самого поля, но только в случае, если объект TTable находится в режиме вставки (Insert) или редактирования (Edit). Члены AsFloat, AsInteger, AsDateTime и AsString в действительности являются свойствами, и как таковые также могут принимать значения. С помощью Редактора Полей (Fields Editor, для вызова которого достаточно дважды щелкнуть на объекте TTable или TQuery) также возможно создание объектов-полей. Эти объекты могут быть использованы вместо получения их каждый раз от объекта TTable или TQuery.

Получение информации о таблице

   Вам нужно воспользоваться свойством FieldDefs. В следующем примере список полей и их соответствующий размер передается компоненту TMemo (расположенному на форме) с именем Memo1:
   procedure TForm1.ShowFields;
   var
    i : Word;
   begin
    Memo1.Lines.Clear;Table1.FieldDefs.Update; { должно быть вызвано, если Table1 не активна }
    for i:= 0 to Table1.FieldDefs.Count - 1 do With Table1.FieldDefs.Items[i] do Memo1.Lines.Add(Name + ' - ' + IntToStr(Size));
    Memo1.Lines.Add(Name + ' – ' + IntToStr(Size));
   end;
   Если вам просто нужны имена полей (FieldNames), то используйте метод TTable GetFieldNames:
   GetIndexNames для получения имен индексов:
   var FldNames, IdxNames : TStringList
   begin
    FldNames := TStringList.Create;
    IdxNames := TStringList.Create;
    If Table1.State = dsInactive then Table1.Open;
    Table1.GetFieldNames(FldNames);
    Table1.GetIndexNames(IdxNames);
    {…… используем полученную информацию ……}
    FldNames.Free; {освобождаем stringlist}
    IdxNames.Free;
   end;
   Для получения информации об определенном поле вы должны использовать FieldDef.

Обмен данными между TMemoField и TMemo

   Procedure TMemoToTMemoField;
   begin
    TMemoField.Assign(TMemo.Lines);
   end;

   Procedure TMemoFieldToTMemo;
   VAR aBlobStream : TBlobStream;
   begin
    aBlobStream := TBlobStream.Create(TMemoField, bmRead);
    TMemo.Lines.LoadFromStream(aBlobStream);
    aBlobStream.Free;
   end;

Если в транзакции изменена какая-то таблица, то для другого пользователя блокируется вся таблица, до окончания транзакции. Как лечить?

   Nomadic отвечает:
   По умолчанию, оператор UPDATE в MS SQL Server пытается поставить эксклюзивную табличную блокировку. Вы можете обойти это, используя ключевое слово FROM в сочетании с опцией PAGLOCK для использования MS SQL Server страничных блокировок вместо эксклюзивной табличной блокировки:
   UPDATE orders SET customer_id=NULL FROM orders(PAGLOCK) WHERE customer_id=32;
   Блокиpовка на всю таблицу пpи UPDATE ставится только в том случае, если по предикату нет индекса. Так, можно просто проиндексировать таблицу orders по полю customer_id, и не забывать делать UPDATE STATISTIC, хотя будет работать и с PAGLOCK. Просто не факт, что UPDATE всегда делает табличную блокировку.

Форма Мастер-Деталь

   …это нормально в двух случаях:
   1. Эксперт баз данных по умолчанию создает запрос, где RequestLive установлен в False; если вы хотите что-либо изменить, установите RequestLive в True.
   2. При отношениях «один к многим», из-за правил сохранения целостности, вам дозволяется делать изменения только на форме «многих», а не на форме «один».
   BTW: правильно, что вы об этом задумались. Предположим, что вы имеете отношение «один к многим», где «один» — ваши клиенты, а «многие» — их счета-фактуры: естественно, счетов, относящихся к клиенту, может быть больше, чем один. Если ваша система позволяет редактировать информацию о клиентах, например, удалять записи, то вскоре вы можете обнаружить, что некоторые счета не будут иметь отношения к кому бы то ни было.

Подскажите как правильно показать на экpане и сохранить в базе картинку формата JPEG?

   Nomadic отвечает:
   Я делал так (это кусок компонента):
   if Picture.Graphic is TJPegImage then
   begin
    bs:=TBlobStream.Create(TBlobField(Field),bmWrite);
    Picture.Graphic.SaveToStream(bs);
    bs.Free;
   end
   else if Picture.Graphic is TBitmap then
   begin
    Jpg:=TJPegImage.Create;
    Jpg.CompressionQuality:=…;
    Jpg.PixelFormat:=…;
    Jpg.Assign(Picture.Graphic);
    Jpg.JPEGNeeded;
    bs:=TBlobStream.Create(TBlobField(Field),bmWrite);
    Jpg.SaveToStream(bs);
    bs.Free;
    Jpg.Free;
   end else Field.Clear;

Как исключить показ поля P_RECNO?

   Вы можете сделать:
   1. отредактируйте TTable для исключения P_RECNO
   или
   2. установите
   TableX.FieldbyName('P_RECNO').Visible := False;
   Это можно сделать также и с помощью редактора полей (Fields Editor), который связан не с DBGrid, а напрямую с компонентом Table. Для вызова редактора щелкните правой кнопкой мыши на компоненте Table и выберите самый верхний пункт контекстного меню. Добавьте все поля в список полей и выделите то поле, которое вы не хотите показывать в DBgrid. Найдите в Инспекторе Объектов свойство Visible, и установите его в False.
   //
   Если у вас имеется компонент TTable, дважды щелкните на иконке компонента (расположенной на форме), и вы получите в диалоге список полей, имеющих отношение к соответствующей таблице щелкните на одном из полей и проверьте в Инспекторе Объектов свойство Visible, оно должно быть установлено в False.
   //

Информация из одной таблицы и набора данных на двух формах

   1. Добавьте на вторую форму (form2) компонент TTable
   2. В режиме разработки присвойте этой таблице такие же значения, как и у таблицы, расположенной на form1
   3. В секции IMPLEMENTATION у form2 создайте следующий фрагмент кода:

   unit form2;
   interface
   {…}
   implementation
   uses form1;
   {…}
   4. Подключите процедуру к OnCreate-событию в form2 (через Инспектор Объектов)
   5. Добавьте к этой процедуре следующую строку:
   table1 := form1.table1;
   В режиме разработки свяжите все компоненты с table1, расположенным на form1.
   Остается только решить проблему синхронизации. Попробуйте следующее:
   - На Form1
    разместите Table1
    разместите DataSource1
     установите DataSource1.DataSet := Table1
    разместите DataGrid
     установите DataSource := DataSource1
   Ну это все просто и стандартно. Поехали дальше:
   - На Form2
    разместите DataSource1 (#1 для этой формы)
    разместите любые другие необходимые вам БД-компоненты;
     укажите у них в качестве источника данных DataSource1
    В обработчике события OnCreate для этой формы (например, FormCreate), поместите следующий код:
   With Form1 do
   begin
    Form2.DataSource1.DataSet := Table1;
   end;
    Данный код подключает Table1 на Form1 к DataSource от Form2.
    После таких действий данные будут отображены на Form2 и будут «синхронизированы» с данными, отображаемыми на Form1 (поскольку в действительности используется одна таблица).
   Единственное здесь предостережение – если вы используете TDatabase, так как это может быть не то, что вы хотите. Компонент TDatabase не обязателен для получения доступа к базам данных, но, тем не менее, он обеспечивает вас дополнительным контролем в приложениях класса клиент/сервер.
   Таким образом, если приложение не работает в среде клиент/сервер, нет необходимости использовать TDatabase. Все, что вам нужно – TDataSource, TTable и компоненты для работы с базами данных.

Как при вводе информации в БД автоматически вставлять SEQUENCE?

   Nomadic отвечает:
   Если добавление через оператор INSERT ( в TQuery), то прямо там пишешь, как в плюсе («… Values (My_seq.nextval, …»).
   Если добавление идет через TQuery c RequestLive=true, то в BeforeInsert сделай запрос через TQuery (select myseq.nextval from dual) и заноси значение в свое поле.

Помещение переменной в Memo-поле

   Если я правильно понял ваш вопрос, вам нужно сделать приблизительно так (для ПОЛУЧЕНИЯ данных):
   Memos := TStringList.Create;
   Memos.Assign(Table1Memo);
   yourvariable_0 := Memos[0];
   yourvariable_1 := Memos[1];
   ……………………
   yourvariable_n := Memos[n];
   Memos.Free;
   или так (для УСТАНОВКИ данных):
   Memos := TStringList.Create;
   Memos.Add(yourvariable_0);
   Memos.Add(yourvariable_1);
   ……………………
   Memos.Add(yourvariable_n);
   Table1Memo.Assign(Memos);
   Memos.Free;

Индикатор прогресса выполнения запроса

   Невозможно.
   Идея заключалась в том, чтобы с помощью объекта TQuery выполнять запросы, SQL сервер их в фоне обрабатывал бы, а мы смотрели бы на это дело на локальной машине с помощью линейки прогресса. Но из приложения никоим образом нельзя узнать, что делает TQuery, так что линейка прогресса, по идее, должна была бы получать текущую позицию непосредственно с SQL сервера. Но, поскольку большинство SQL серверов не публикуют такой информации, эту идею можно торжественно схоронить…
   Если вы используете Paradox или DBase, то, я думаю, для этой цели вы можете воспользоваться функцией DBIRegisterCallback:

Лично я никогда этим не пользовался, поэтому на смогу поделиться деталями.

Обновление данных БД из модальной формы

   Возможно следующий код позволит вам использовать ту же самую таблицу и источник данных в модальной форме, что и в вашей главной форме. Попробуйте изменить код модальной формы следующим образом:
   unit myModalF;
   interface
   {…}
   implementation
   {…}
   uses
    MainForm; {Имя файла родительской формы для вашей модальной формы}

   MyModalForm.OnCreate(Sender: TObject);
   begin
    DBGrid1.DataSource := MyMainForm.DataSource1;
   end;

Как записать в BLOB-поле большой текст (>255 байт) из Delphi?

   Nomadic отвечает:
   Можно так –
   var
    S: TBlobStream;
    B: pointer;
    c: integer;
   …
   Table1.Edit;
   S := TBlobStream.Create(Table1BlobField as TBlobField, bmWrite); {кажется, так}
   C := S.Write(B, C);
   Table1.Post;
   S.Destroy;
   или так –
   var
    S: TMemoryStream;
    B: pointer;
    C: integer;
    …
     S := TMemoryStream.Create;
   …
   Table1.Edit;
   S.Clear;
   S.SetSize(C);
   C := S.Write(B,C);
   (Table1BlobField as TBlobField).LoadFromStream(S);
   S.Clear;
   Table1.Post;
   …
   S.Destroy;

Блокировка таблицы

   …когда вы получаете эту, или аналогичную ошибку, вы можете прервать процесс следующим образом (в предположении, что вы пытаетесь запостить запись):
   try
    Table1.Post;
   except
    MessageDlg ('Ошибка постинга записи', прочее…
    Table1.Cancel;
   end;
   В противном случае вы не получите ошибку в случае, если текущую запись «рассматривает» другой пользователь (если вы пользуетесь базой данных Paradox, поставляемой с Delphi), если, конечно, вы правильно это установили. Paradox сам создает в сетевом каталоге файл с именем pdxusers.lck, видимый всеми пользователями, так что каждый BDE на каждой локальной машине может запирать запись, таким образом запрещая другим пользователям постить запись до снятия блокировки. Я не знаю, каким образом вы получаете эту ошибку, поэтому существует вероятность того, что я ошибаюсь в своих предположениях.

Каким драйвером пользуется TDATABASE?

   Вы можете использовать вызов IDAPI dbiGetDatabaseDesc. Вот быстрая справка (не забудьте добавить DB в список используемых модулей):
   var
    pDatabase: DBDrsc:
   begin
    { pAlias – PChar, содержащий имя псевдонима}
    dbiGetDatabaseDesc(pAlias, @pDatabase);
   Для получения дополнительной информации обратитесь к описанию свойства pDatabase.szDbType.

Как создать новый запрос и скопировать туда точно такие же описания полей?

   Nomadic отвечает:
   Копируешь FieldDefs.
   Проходишь циклом по FieldDefs.Items[i].CreateField(Owner);

Запись потока в BLOB-поле

   Вся хитрость заключается в использовании StrPcopy (помещения вашей строки в PChar) и записи буфера в поток. Вы не сможете передать это в PChar непосредственно, поскольку ему нужен буфер, поэтому для получения необходимого размера буфера используйте <BufferName>[0] и StrLen().
   Вот пример использования TMemoryStream и записи его в Blob-поле:
   var
    cString: String;
    oMemory: TMemoryStream;
    Buffer: PChar;
   begin
    cString := 'Ну, допустим, хочу эту строку!';
    { СОздаем новый поток памяти }
    oMemory := TMemoryStream.Create;
    {!! Копируем строку в PChar }
    StrPCopy(Buffer, cString);
    { Пишем =буфер= и его размер в поток }
    oMemory.Write(Buffer[0], StrLen(Buffer));
    {Записываем это в поле}
    <Blob/Memo/GraphicFieldName>.LoadFromStream(oMemory);
    { Необходимо освободить ресурсы}
    oMemory.Free;
   end;

Как я могу выбрать на клиента только часть данных с определенной позиции из набора данных на сервере?

   Nomadic отвечает:
   Наиболее приемлемым является использование TQuery и Provider.SetParams.
   Но также Вы можете сделать это иначе:
   Сперва на клиенте Вам нужно считать с сервера только метаданные для набора данных. Это можно сделать, установив PacketRecords в 0, и затем вызвав Open. Затем Вы должны вызвать метод сервера (Вы должны определить этот метод на сервере), который спозиционирует курсор на первую нужную запись. И, наконец, установите PacketRecords в нужное значение, большее нуля, и вызовите GetNextPacket.

Отследить изменение данных?

   Предположим, что пользователь изменил строковое поле в Null. Как тогда я в обработчике OnUpdateData смогу определить, изменилось ли это поле на строку Null, или поле просто не было изменено?
   Nomadic отвечает:
   Используйте свойство NewValue класса TField при чтении второй записи (той, которая содержит изменения). Если возвращаемое значение (variant) пусто или не назначено, тогда поле не было модифицировано. Здесь немного иллюстрирующего кода:
   var NewVal: Variant;
   begin
    NewVal := DataSet.FieldByName('MyStrField').NewValue;
   if VarIsEmpty(NewVal) then ShowMessage('Field was not edited')
   else if VarIsNull(NewVal) then ShowMessage('Field was blanked out')
   else ShowMessage('New Field Value: ' + String(NewVal));
   end;
   Если Вы взглянете на исходники формы RecError (в репозитории), то Вы увидите, как она использует эту информацию для вывода строки ' ' при показе ошибок синхронизации данных. На сервере Вы добавляете ограничения уровня записи, используя свойство Constraints Вашего TQuery/TTable или ограничения уровня поля, используя постоянные обьекты TField (с помощью FieldsEditor либо на CustomConstraint, либо ImportedConstraint). Если Вы используете ограничения уровня поля, они вступают в силу, когда данныеотправляются в поле (например, когда Вы уходите из органа управления, связанного с этим полем (типа TDBEdit)).

Как достучаться до методов сервера приложений из TClientDataSet?

   Nomadic отвечает:
   Вот так:
   RemoteServer.AppServer.MyMethod
   AppServer – свойство только для чтения, возвращающее интерфейс удаленного сервера, возвращаемый провайдером сервера приложений. Клиентские приложения могут общаться напрямую с сервером приложений через этот интерфейс.

Я включил dbclient.dll в секцию `additional files` опций распространения по web, но этот файл никогда не загружается на клиента. Как это исправить?

   Nomadic отвечает:
   Ваш INF-файл должен включать в себя строки наподобие:
   [Add.Code]
   dbclient.dll=dbclient.dll
   [dbclient.dll]
   file=http://yoursite.com/dbclient.cab
   clsid={9E8D2F81-591C-11D0-BF52-0020AF32BD64}
   RegisterServer=yes
   FileVersion=4,0,0,36
   Замените «yoursite» Вашим HTTP-адресом, где находится cab-файл. FileVersion – это версия файла в Вашем cab-файле (проверьте информацию о версии DBCLIENT, чтобы быть уверенным в соответствии). Убедитесь, что FileVersion относится к версии Вашего DBCLIENT.DLL. Вы можете положить dbclient.dll в cab-файл, используя утилиту CABARC, которую Вы найдете в папке delphi\bin. Примерная команда вызова CABARC может выглядеть примерно так:
   CABARC N DBCLIENT.CAB DBCLIENT.DLL

Как можно использовать TClientDataSet в локальном приложении с таблицами Paradox, без использования компонент TProvider и TRemoteServer?

   Nomadic отвечает:
   Вы не сможете отделаться от Провайдера (хотя бросать его на форму/модуль данных не придется), но Вы сможете использовать TClientDataSet в одно-точечном (single-tier) приложении. Для того, чтобы открыть client dataset, Вы должны назначить Провайдера Данных вручную.
   { CDS = TClientDataSet }
   { Table1 = TTable }
   CDS.Provider := Table1.Provider;
   CDS.Open;
   Также Вы должны включить модуль BDEProv в предложение uses.

Hе получается открыть таблицу, созданную в InterBase с DEFAULT CHARACTER SET WIN1251. Оно говорит, что `WIN1251 undefined`

Nomadic отвечает:
A: (AA): Ставьте Interbase в каталог с путем, соответствующим DOS-овским соглашениям об именах (8+3).

Создание

Функции редактора полей во время выполнения программы

   Возможен ли вызов функций редактора полей (Fields Editor) во время выполнения программы?
   Да. Если вы определили поля во время разработки приложения, то во время выполнения можно менять их свойства (например, Size).
   Например, следующий код изменяет каждый размер поля TField.Size так, чтобы соответствовать фактическому размеру поля открываемого набора данных:
   procedure SetupFieldsAndOpenDataset(DataSet: TDataSet);
   var FieldNum, DefNum: Integer;
   begin
    with DataSet do
    begin
     if Active then Close;
     FieldDefs.Update;
     {набор данных должен быть закрыт}
     {ищем каждое предопределенное TField в DataSet.FieldDefs:}
     for FieldNum := FieldCount - 1 downto 0 do with Fields[FieldNum] do
     begin
   DefNum := FieldDefs.IndexOf(FieldName);
      if DefNum < 0 then raise Exception.CreateFmt('Поле "%s" не найдено в наборе данных "%s"',[FieldName, Dataset.Name]);
      {устанавливаем свойство size:}
      Size := FieldDefs[DefNum].Size;
     end;
     Open;
    end;
   end;
   – Lindsay Reichmann

Производная TIntegerField

   Я думал о производной, новом варианте компонента TIntegerfield, но я не могу понять как мне его получить во время разработки, ведь он не устанавливается в палитру компонентов.
   Это то, что вы хотите. Создайте следующий молуль:
   MICRON.PAS:
   unit micron;
   interface
   uses DB, DBTables, Classes;

   type
    TMicronField = class(TIntegerField)
    public
     function IsValidChar(Ch: Char): Boolean; override;
    end;

   procedure Register;

   implementation

   function TMicronField.IsValidChar(Ch: Char): Boolean;
   begin
    Result := Ch in ['+', '-', '0'..'9','.'];
   end;

   procedure Register;
   begin
    RegisterFields([TMicronField]);
   end;

   end.
   Поместите данный модуль в ваш каталог lib и добавьте это поле, используя диалог установки компонент. Затем, используя «DataSet designer», свяжите TMicronField с нужными вам полями, после чего вы увидите, что список типов полей включает теперь «Micron». (для отображения полей на новый тип поля, сначала вам необходимо удалить все TIntegerFields).
   Другое решение, более простое (но так-же работающее), заключается в изменении исходного кода DBTables и простой замене существующей функции IsValidChar на TIntegerField.
   – Mark Edington

Создание новой таблицы на основе структуры другой таблицы

   На ум сразу приходит операция присваивания значения свойству (стоящему с левой стороны от ':='), при которой Delphi в своих недрах вызывает метод 'write' и передает ему в виде единственного параметра все то, что находится в правой части выражения. Если свойство не имеет метода write, оно предназначено только для чтения. Вот определение свойства FieldDefs объекта TDataSet в файле DB.PAS:
   property FieldDefs: TFieldDefs read FFieldDefs write SetFieldDefs
   Как вы можете видеть, у него есть метод write. Следовательно, код:
   Destination.FieldDefs := Source.FieldDefs;
   в действительности делает такую операцию:
   Destination.SetFieldDefs(Source.FieldDefs);
   (за исключением того, что вы не можете использовать эту строку, поскольку SetFieldDefs определен в секции Private.)
   Вот определение свойства IndexDefs объекта TTable в файле DBTABLES.PAS file:
   property IndexDefs: TIndexDefs read FIndexDefs;
   В этом случае метод write отсутствует, поэтому свойство имеет атрибут только для чтения. Тем не менее, для самого объекта TIndexDefs существует метод Assign. Следовательно, следующий код должен работать:
   Source.IndexDefs.Update;
   Destination.IndexDefs.Assign(Source.IndexDefs);
   Перед вызовом Assign для Source.IndexDefs вызывайте метод Update, чтобы быть уверенным в том, что вы получите то, что хотите.
   Метод SetFieldDefs является процедурой с одной строкой кода, в которой вызывается метод FieldDefs Assign.
   Также можно проверить, определен ли реально индекс, и, если нет, то при вызове IndexDefs.Assign вы можете получить исключение типа «List Index Out Of Bounds» (или что-то типа этого). Например, так:
   if Source.IndexDefs.Count > 0 then…
   Вам нужно будет это сделать, поскольку метод TIndexDefs.Assign не проверяет это перед копированием индекс-информации. Также вам нет необходимости вызывать Clear до работы с IndexDefs, поскольку метод Assign сделает это и без вашего участия.

Создание уникального ID для новой записи

   Существует несколько способов задавать в таблице уникальный ID.
   1. Вы можете использовать поле с автоприращением
   Этот метод не очень надежен. Если ваша таблица каким-то образом испортится, и вам понадобиться ее пересобрать, автоинкрементальные поля будут перенумерованы. Хотя это легкий способ для ситуации, когда вы не ссылаетесь на id таблицы в других таблицах, но это не очень мудрое решение в других случаях.

   2. Вы можете использовать ID-таблицу
   Если у вас имеется приложение, где нескольким таблицам необходимы уникальные ID, создайте ID-таблицу с двумя полями:
   Table Name A (первичный ключ) Last Id NВ методе BeforePost таблицы, которой необходим уникальный ID, делайте примерно так:
   TableBeforePost(Sender: TObject)
   var Id: Integer;
   begin

    with TTable(Sender) do
    begin
   {проверяем, существует ли ID для этой записи}
     if Field[0].AsInteger=0 then
     begin
      {ищем имя таблицы в ID-Таблице}
      IDTable.FindKey[Name]
      {извлекаем последний Id – подразумеваем блокировку записи}
      Id := IDTable.FieldByName['Last Id'].AsInteger;
      Inc(Id);
     {записываем новый Id в ID-таблицу – подразумеваем разблокировку таблицы}
      IDTable.FieldByName['Last Id'].AsInteger := Id;
      IDTable.Post;
      {записываем извлеченный ID в вашу таблицу}
      Field[0].AsInteger := Id;
     end;
    end;
   end;

   end;
   Если вы поместите этот код в обработчик события таблицы BeforePost, вы убедитесь в том, что все ID будут последовательными (без «дырок»). Недостаток: если пользовать во время попытки добавления новой записи вдруг передумает, вы будете иметь запись с заполненным только полем ID.
   В случае, если вы решили воспользоваться данным способом (последовательные ID), поместите приведенный выше код в обработчик события таблицы OnNewRecord.
   3. Вы можете использовать ID-файл
   Используйте те же принципы, что и в предыдущем способе, но вместо ID-таблицы используется ID-Файл. Это дает преимущество за счет более высокой скорости работы, но в многопользовательской среде вы должны сами заботиться о блокировке записей.

Динамическое создание таблицы и полей во время выполнения программы

   Delphi в режиме разработки позволяет быстро добавлять и настраивать в вашем проекте компоненты для работы с базами данных, но есть ситуации, когда вам нужно создавать и конфигурировать объекты во время выполнения программы. Например, во время выполнения программы вам может понадобиться добавить колонку с вычисляемым полем (используя алгоритмы пользователя). Поэтому вопрос: как, не используя среды разработки, Инспектора Объектов и редактора TFields, создавать и сконфигурировать TField и другие компоненты для связки данных?
   В следующем примере показано динамическое создание TTable, таблицы базы данных в связке с TTable, TFieldDefs, TFields, вычисляемых полей и подключение обработчика для события OnCalc.
   Для начала выберите пункт New Application меню File. Будет создан новый проект с пустой формой, на которой мы и будет создавать на лету наши компоненты.
   В секцию interface вашего модуля формы добавьте, как показано ниже, объявление обработчика события OnCalcFields и поля TaxAmount. Позже мы создадим TTable и назначим этот обработчик событию TTable OnCalcFields, который позволит при чтении каждой записи вызывать событие OnCalcFields, которое, в свою очередь, выполнит нашу процедуру TaxAmountCalc.
   type TForm1 = class(TForm)
    procedure TaxAmountCalc(DataSet: TDataset);
   private
    TaxAmount: TFloatField;
   end;
   В секции implementation создайте обработчик события OnCalc как показано ниже:
   procedure TForm1.TaxAmountCalc(DataSet: TDataset);
   begin
    Dataset['TaxAmount'] := Dataset['ItemsTotal'] * (Dataset['TaxRate'] / 100);
   end;
   Создайте обработчик формы OnCreate как показано ниже (для получения дополнительной информации о создании обработчиков событий обратитесь к Delphi Users Guide, Chapter 4 «Working With Code»).
   procedure TForm1.FormCreate(Sender: TObject);
   var
    MyTable: TTable;
    MyDataSource: TDataSource;
    MyGrid: TDBGrid;
   begin

    { Создаем компонент TTable -- связанная таблица базы данных будет создана ниже. }
    MyTable := TTable.Create(Self);
    with MyTable do
    begin
     { Определяем основную базу данных и таблицу. Примечание: Test.DB пока не существует. }
     DatabaseName := 'DBDemos';
     TableName := 'Test.DB';
     { Назначаем TaxAmountCalc обработчиком события, чтобы использовать его при наступлении события OnCalcFields в MyTable. }
     OnCalcFields := TaxAmountCalc;
     { Создаем и добавляем определения полей к массиву TTableFieldDefs, затем создаем TField с использованием информации из определения поля. }
     with FieldDefs do
     begin
   Add('ItemsTotal', ftCurrency, 0, false);
      FieldDefs[0].CreateField(MyTable);
      Add('TaxRate', ftFloat, 0, false);
      FieldDefs[1].CreateField(MyTable);
      TFloatField(Fields[1]).DisplayFormat := '##.0%';
      { Создаем вычисляемое TField, назначаем свойства, и добавляем поле к массиву определений MyTable. }
      TaxAmount := TFloatField.Create(MyTable);
      with TaxAmount do
      begin
   FieldName := 'TaxAmount';
       Calculated := True;
       Currency := True;
       DataSet := MyTable;
       Name := MyTable.Name + FieldName;
       MyTable.FieldDefs.Add(Name, ftFloat, 0, false);
      end;
     end;
     { Создаем в базе данных новую таблицу, используя в качестве основы MyTable. }
     MyTable.CreateTable;
    end;
    { Создаем компонент TDataSourceи назначаем его MyTable. }
    MyDataSource := TDataSource.Create(Self);
    MyDataSource.DataSet := MyTable;
    { Создаем табличную сетку, отображаемна форме, и назначаем MyDataSource дляполучения доступа к данным из MyTable. }
    MyGrid := TDBGrid.Create(Self);
    with MyGrid do
    begin
     Parent := Self;
     Align := alClient;
     DataSource := MyDataSource;
    end;
    { Запускаем нашу конструкцию! }
    MyTable.Active := True;
    Caption := 'Новая таблица ' + MyTable.TableName;
   end;
   Ниже приведен полный исходный код проекта:
   unit gridcalc;

   interface

   uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls,Forms, Dialogs, Grids, DBGrids, ExtCtrls, DBCtrls, DB,DBTables, StdCtrls;

   type
    TForm1 = class(TForm)
     procedure FormCreate(Sender: TObject);
     procedure TaxAmountCalc(DataSet: TDataset);
    private
   TaxAmount: TFloatField;
    end;

   var
    Form1: TForm1;

   implementation

   {$R *.DFM}

   procedure TForm1.TaxAmountCalc(DataSet: TDataset);
   begin
    Dataset['TaxAmount'] := Dataset['ItemsTotal'] *(Dataset['TaxRate'] / 100);
   end;

   procedure TForm1.FormCreate(Sender: TObject);
   var
    MyTable: TTable;
    MyDataSource: TDataSource;
    MyGrid: TDBGrid;
   begin
    MyTable := TTable.Create(Self);
    with MyTable do
    begin
     DatabaseName := 'DBDemos';
     TableName := 'Test.DB';
     OnCalcFields := TaxAmountCalc;
     with FieldDefs do
     begin
      Add('ItemsTotal', ftCurrency, 0, false);
      FieldDefs[0].CreateField(MyTable);
      Add('TaxRate', ftFloat, 0, false);
      FieldDefs[1].CreateField(MyTable);
      TFloatField(Fields[1]).DisplayFormat := '##.0%';
      TaxAmount := TFloatField.Create(MyTable);
      with TaxAmount do
      begin
       FieldName := 'TaxAmount';
       Calculated := True;
       Currency := True;
       DataSet := MyTable;
     Name := MyTable.Name + FieldName;
       MyTable.FieldDefs.Add(Name, ftFloat, 0, false);
      end;
     end;
     MyTable.CreateTable;
    end;
    MyDataSource := TDataSource.Create(Self);
    MyDataSource.DataSet := MyTable;
    MyGrid := TDBGrid.Create(Self);
    with MyGrid do
    begin
   Parent := Self;
     Align := alClient;
     DataSource := MyDataSource;
    end;
    MyTable.Active := True;
    Caption := 'Новая таблица ' + MyTable.TableName;
   end;

   end.

Проблема с AddIndex

   Я использую таблицу paradox на своей локальной машине.
   Я использую следующие команды:
   Table.DatabaseName := 'ABC';
   Table.TableName := 'TEST';
   Table.CreateTable;
   Table.AddIndex('Primary','ID',[ixPrimary]); (работает как часы)
   Table.AddIndex('Number_IDX','NUMBER',[ixUnique]); (здесь я получаю ошибку времени выполнения)
   ID – LongInt поле
   NUMBER – поле типа char[15]

Как создать БД в кодировке CP1251?

   Nomadic отвечает:
   Вот такая конструкция проходит на DB2 2.1.2/NT и UDB5/NT…
   CREATE DATABASE Efes2
   USING CODESET 1251 TERRITORY RU
   COLLATE USING IDENTITY;

Таблицы в памяти

   Вот пример InMemoryTable. Свободен для использования, модификации и всего остального. Ну и как в отношении других вещей: я не даю никаких гарантий. Я не несу никакой ответственности за ущерб, который может причинить код. Позвольте, я повторю это:
   ВНИМАНИЕ! ДАННЫЙ КОД НЕ ПРЕДУСМАТРИВАЕТ НИКАКИХ ГАРАНТИЙ!
   ИСПОЛЬЗУЙТЕ ЕГО НА СВОЙ СТРАХ И РИСК - ВЫ ЕДИНСТВЕННЫЙ ЧЕЛОВЕК, ОТВЕТСТВЕННЫЙ ЗА ЛЮБОЙ УЩЕРБ, КОТОРЫЙ МОЖЕТ ПОВЛЕЧЬ ЗА СОБОЙ ИСПОЛЬЗОВАНИЕ ДАННОГО КОДА — Я ВАС ПРЕДУПРЕДИЛ!
   Благодарю Steve Garland <72700.2407@compuserve.com> за предоставленную помощь. Он создал свой собственный "in-memory" табличный компонент, который послужил мне толчком для написания сего кода.
   InMemory-таблицы являются характеристикой Borland Database Engine (BDE). InMemory-таблицы создаются в RAM и удаляются при их закрытии. Работают они значительно быстрее и очень полезны в случае, если вам нужны быстрые операции в небольших таблицах. Данный пример использует вызов функции BDE DbiCreateInMemoryTable. Данный объект должен работать наподобии простой регулярной таблицы, за исключением того, что InMemory-таблицы не поддерживают некоторые характеристики (типа проверка целостности, вторичные индексы и BLOB-поля), и в настоящее время данный код не содержит механизма обработки ошибок. Вероятно, вы получите ошибку при попытке создания memo-поля. Если у вас есть любые замечания, шлите их по адресу grisha@mira.com.
   unit Inmem;

   interface

   uses DBTables, WinTypes, WinProcs, DBITypes, DBIProcs, DB, SysUtils;

   type TInMemoryTable = class(TTable)
   private
   hCursor: hDBICur;
    procedure EncodeFieldDesc(var FieldDesc: FLDDesc; const Name: string; DataType: TFieldType; Size: Word);
    function CreateHandle: HDBICur; override;
   public
    procedure CreateTable;
   end;

   implementation

   { Эта функция виртуальная, так что я смог перекрыть ее. В оригинальном VCL-коде для TTable эта функция реально открывает таблицу, но, поскольку мы уже имеем дескриптор таблицы, то мы просто возвращаем его }

   function TInMemoryTable.CreateHandle;
   begin
    Result := hCursor;
   end;

   { Эта функция получена ее простым копированием из исходного кода VCL. Я должен был это сделать, поскольку это было объявлено в секции private компонента TTable, поэтому отсюда у меня не было к этому досупа. }
   procedure TInMemoryTable.EncodeFieldDesc(var FieldDesc: FLDDesc; const Name: string; DataType: TFieldType; Size: Word);
   const
    TypeMap: array[TFieldType] of Byte = (fldUNKNOWN, fldZSTRING, fldINT16, fldINT32, fldUINT16, fldBOOL,fldFLOAT, fldFLOAT, fldBCD, fldDATE, fldTIME, fldTIMESTAMP, fldBYTES,fldVARBYTES, fldBLOB, fldBLOB, fldBLOB);
   begin
    with FieldDesc do
    begin
   AnsiToNative(Locale, Name, szName, SizeOf(szName) - 1);
     iFldType := TypeMap[DataType];
     case DataType of
   ftString, ftBytes, ftVarBytes, ftBlob, ftMemo, ftGraphic:
      iUnits1 := Size;
     ftBCD:
      begin
   iUnits1 := 32;
       iUnits2 := Size;
      end;
     end;
     case DataType of
   ftCurrency: iSubType := fldstMONEY;
     ftBlob: iSubType := fldstBINARY;
     ftMemo: iSubType := fldstMEMO;
     ftGraphic: iSubType := fldstGRAPHIC;
     end;
    end;
   end;

   { Вот кухня, где все это происходит. Я скопировал эту функцию из исходников VCL и затем изменил ее для использования DbiCreateInMemoryTable вместо DbiCreateTable. Поскольку InMemory-таблицы не поддерживают индексы, я удалил весь соответствующий код. }
   procedure TInMemoryTable.CreateTable;
   var
    I: Integer;
    pFieldDesc: pFLDDesc;
    szTblName: DBITBLNAME;
    iFields: Word;
    Dogs: pfldDesc;
   begin
    CheckInactive;
    if FieldDefs.Count = 0 then for I := 0 to FieldCount - 1 do with Fields[I] do if not Calculated then FieldDefs.Add(FieldName, DataType, Size, Required);
    pFieldDesc := nil;
    SetDBFlag(dbfTable, True);
    try
     AnsiToNative(Locale, TableName, szTblName, SizeOf(szTblName) - 1);
     iFields := FieldDefs.Count;
     pFieldDesc := AllocMem(iFields * SizeOf(FLDDesc));
     for I := 0 to FieldDefs.Count - 1 do with FieldDefs[I] do
     begin
      EncodeFieldDesc(PFieldDescList(pFieldDesc)^[I], Name,DataType, Size);
     end;
     { тип драйвера nil, т.к. поля логические }
     Check(DbiTranslateRecordStructure(nil, iFields, pFieldDesc, nil, nil, pFieldDesc));
     { здесь hCursor получает свое значение }
     Check(DbiCreateInMemTable(DBHandle, szTblName, iFields, pFieldDesc, hCursor));
    finally
     if pFieldDesc <> nil then FreeMem(pFieldDesc, iFields * SizeOf(FLDDesc));
     SetDBFlag(dbfTable, False);
    end;
   end;

   end.

   {Данный код взят из файлов помощи Ллойда!}

Поиск

FindKey для нескольких полей

   with Table1 do
   begin
    SetKey;
    FieldByName('State').AsString := 'CA';
    FieldByName('City').AsString := 'Scotts Valley';
    GotoKey;
   end;
   Вы не можете использовать Findkey с файлами DBase более чем для одного поля.
   oEmetb.indexName:='PrimaryKey';
   if oEmeTb.findkey([prCLient,prDiv,prEme]) then
   где findkey передаются параметры для Primary Keyfields.
   Я обращаю ваше внимание на то, что имя индекса (Index) чувствительно к регистру, так что будьте внимательны.
   Вы можете также воспользоваться oEmeTb.indexfieldnames, но убедитесь в том, что ваш список ключевых полей в точности соответствуют ключевым полям, которые вы ищете.
   oEmetb.indexfieldNames:='EmeClient;EmeDiv;EmeNo';
   if oEmeTb.findkey([123,'a',96]) then

Поиск существующей записи перед тем, как она будет вставлена

   Если вы находитесь в режиме редактирования (Edit) или вставки (Insert), то при изменении режима вы автоматически делаете постинг записи. И, естественно, при наличие дубликата (неуникальности) записи, вы получите ошибку. Способ обойти это – использовать другой компонент TTable, связанный с той же таблицей, и осуществляющий по ней поиск. Этот путь самый простой и эффективный.
   Воспользуйтесь двумя компонентами TTable (оба должны указывать на одну и ту же таблицу). Используйте один для поиска, а второй для редактирования.
   Ваша «ключевая» таблица BDE будет автоматически генерировать исключения, если пользователь будет пытаться послать созданный им дублирующий ключ. Для установки таблицы используйте Database Desktop.
   Создайте на основе поля первичный индекс (Primary Index). Затем создайте какой-то обработчик DB-исключения для нашего «нарушения уникальности».
   Моя технология заключается в следующем: в отдельной форме я предлагаю пользователям ввести часть записи, которая должна быть уникальна (обычно одно поле). Затем для проверки существования я делал FindKey. Если он находился, через MessageDlg я информировал пользователя, и возвращал его на форму редактирования, не создавая новой записи. Помните, что если FindKey ничего не находит, dbCursor никуда не перемещается, и закладка не нужна. Если запись найдена, она немедленно будет отображена на форме редактирования для того, чтобы пользователь смог увидеть ее содержимое. В противном случае происходит следующее:
   Table.Append;
   Table.FieldByName('KeyField').AsString := UserEntry;
   { … позволяем пользователю редактировать все остальные поля записи … }
   { в это время кнопка Cancel должна быть активной для того, чтобы дать возможность пользователю отменить ввод новой записи. }
   В моей форме редактирования поле с уникальном ключем выключается (disabled) и показывается с другим цветом. Целостность соблюдена :-).

Поиск фраз и записей переменной длины

   Для текста переменной длины вы можете использовать DBmemo. Большинство людей это делают сканированием «на лету» (когда оператор постит запрос), но для реального ускорения процесса можно попробовать способ пре-сканирования, который делают «большие мальчики» (операторы больших баз данных):
   1. при внесении в базу данных новой записи она сканируется на предмет определения ключевых слов (это может быть как предопределенный список ключевых слов, так и всех слов, не встречающиеся в стоп-листе [пример: «the», «of», «and"])
   2. ключевые слова вносятся в список ключевых слов со ссылкой на номер записи, например, «hang»,46 или «PC»,22.
   3. когда пользователь делает запрос, мы извлекаем все записи, где встречается каждое из ключевых слов, например, «hang» может возвратить номера записей 11, 46 и 22, тогда как «PC» — записи с номерами 91, 22 и 15.
   4. затем мы объединяем числа из всех списков c помощью какого-либо логического оператора, например, результатом приведенного выше примера может быть запись под номером 22 (в случае логического оператора AND), или записи 11, 15, 22, 46 и 91 (в случае оператора OR). Затем извлекайте и выводите эти записи.
   5. для синонимов определите таблицу синонимов (например, «hang»,"kaput»), и также производите поиск синонимов, добавляя их к тому же списку как и оригинальное слово.
   6. слова, имеющие общие окончания (например, «hang» и «hanged»), можно также сделать синонимами, или, как это делает большинство систем, производить анализ окончаний слов, вычисляя корень по их перекрытию (например, слову «hang» соответствует любое слово, чьи первые 4 буквы равны «hang»).
   Конечно, есть множестно технических деталей, которые необходимо учесть, например, организация списков, их эффективное управление и объединение. Оптимизация этой характеристики может вам дать очень быстрое время поиска (примером удачный реализаций могут служить двигатели поиска Nexus, Lycos или WebCrawler, обрабатывающие сотни тысяч записей в течение секунды).

dBase

Текущий номер записи набора данных

   {Извлекает физический номер записи xBase. Требует наличие модулей DBITYPES, DBIPROCS, и DBIERRS в списке используемых модулей. Функция требует на входе один аргументтипа TTable (например, Table1).}
   function Form1.Recno(oTable: TTable): Longint;
   var
    rError: DBIResult;
    rRecProp: RECprops;
    szErrMsg: DBIMSG;
   begin
    Result := 0;
    try
     oTable.UpdateCursorPos;
     rError := DbiGetRecord(oTable.Handle, dbiNOLOCK, nil, @rRecProp);
     if rError = DBIERR_NONE then Result := rRecProp.iPhyRecNum
     else case rError of
     DBIERR_BOF: Result := 1;
     DBIERR_EOF: Result := oTable.RecordCount + 1;
     else
      begin
       DbiGetErrorString(rError, szErrMsg);
       ShowMessage(StrPas(szErrMsg));
      end;
     end;
    excepton
     E: EDBEngineError do ShowMessage(E.Message);
    end;
   end;

Как открыть индексированную таблицу dBase, если отсутствует файл индекса?

   Nomadic советует:
   Для dBase-таблицы встроенными средствами ты не перестроишь индекс, если его нет. Для этой цели мне пришлось написать процедуру для физического удаления признака индексации в самом dbf-файле и после её применения добавлять индексы заново.
   Для этого в заголовок файла dbf по смещению 28(dec) записываешь 0.
   По другому никак не выходит(я долго бился) — вот для Paradox таблиц все Ok.
   С помощью BDE Callbacks. Пример для Delphi 2.0, на первом не проверял:
   === Callback.pas ===
   unit Callback;

   interface

   uses BDE, Classes, Forms, DB, DBTables;

   type
    TForm1 = class(TForm)
     Table1: TTable;
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
    private
     CBack: TBDECallback; // опpеделение BDE CallBack
     CBBuf: CBInputDesc; // пpосто буфеp
     function CBFunc(CBInfo: Pointer): CBRType; // Callback-функция
    public
    end;

   var
    Form1: TForm1;

   implementation

   {$R *.DFM}

   procedure TForm1.FormCreate(Sender: TObject);
   begin
    Session.Open; // В это вpемя сессия ещё не откpыта
    CBack := TBDECallback.Create(Session {Hапpимеp}, nil, cbINPUTREQ, @CBRegBuf, SizeOf(CBBuf), CBFunc, False); // Опpеделили Callback
    Table1.Open;
    //^^^^^^^^^^^ - здесь возможна ошибка с индексом, etc.
   end;

   procedure TForm1.FormDestroy(Sender: TObject);
   begin
    CBack.Free; // Освобождаем CallBack
   end;

   function TForm1.CBFunc(CBInfo: Pointer): CBRType;
   begin
    with PCBInputDesc(CBInfo)^ do case eCbInputId of
    cbiMDXMissing {, cbiDBTMissing - можно ещё и очищать BLOB-поля}:
     begin
      iSelection := 3; // Hомеp ваpианта ответа (1-й - откpыть только
                       // для чтения, 2-й - не откpывать, 3-й - отсоединить индекс).
                       // Возможный источник непpиятностей: а вдpуг в последующих веpсиях
                       // BDE номеpа будут дpугими?
      Result := cbrCHKINPUT; // Обpабатывать введённый ответ
     end;
    end;
   end;

   end.
   === Callback.pas ===
   PS: конечно, это лишь пример, делающий минимум необходимого. В рамках данного письма невозможно дать какое-то описание BDE Callbacks. Информацию я взял из BDE32.HLP, BDE.INT и DB.PAS. В VCL.HLP совсем ничего нет по этому поводу.
   Вообще, руки бы оторвал тем, кто писал справку по Дельфям: я неделю мучался с сабжем, пока случайно не набрёл на Callbacks.

Определение удаления записей в .DBF

   Взято из "Dtopics Database 1.10 from 3K computer Consultancy":
   Dbase в BDE имеет большее количество ситуаций 'особого случая', чем таблицы SQL и Paradox, поскольку данный формат поддерживает выражения в индексах и прочие характеристики, например:
   1. Создание и пересоздание индекса
   – DbiRegenIndexes( Table1.Handle ); { Регенерация всех индексов }
    – создание индекса (зависит от того, существует ли выражение или нет)
   if ((Pos('(',cTagExp) + Pos('+',cTagExp)) > 0) then Table1.AddIndex(cTagName, cTagExp, [ixExpression]) ( <– ixexpression – _литерал_)
   else Table1.AddIndex(cTagName, cTagExp, []);
   2. Связки Master/Detail в выражениях дочерних индексов
   – вызов процедуры BDE DbiLinkDetailToExp() вместо обычной DbiLinkDetail()
   3. Пакование таблиц
   with Table1 do StrPCopy(TName, TableName);
   Result := DBIPackTable(DbHandle, Handle, TName, szDBASE, TRUE);
   4. Задание видимости удаленных записей – вкл/выкл (например, dBase SET DELETED ON/OFF)
   DbiSetProp( hDBIObj(Table1.Handle), curSOFTDELETEON, LongInt(bValue));
   5. Задание частичного/полного соответствия символов – вкл/выкл (например, dBase SET EXACT ON/OFF)
   DbiSetProp( hDBIObj(Table1.Handle), curINEXACTON,   LongInt(bValue));
   <– Конец –>
   Ну и теперь сами вопросы:
   <– Начало –>

   В обработчике события AfterOpen вызовите приведенную ниже функцию. Включите DBITYPES, DBIERRS, DBIPROCS в список используемых модулей. Для вызова функции передайте ей в качестве аргумента имя TTable и TRUE/FALSE в зависимости от необходимости показа/скрытия удаленных записей. Пример:
   procedure TForm1.Table1AfterOpen(DataSet: TDataset);
   begin
   SetDelete(Table1, TRUE);
   end;

   procedure SetDelete(oTable:TTable; Value: Boolean);
   var
    rslt: DBIResult;
    szErrMsg: DBIMSG;
   begin
    try
     Table.DisableControls;
     try
      rslt := DbiSetProp(hDBIObj(oTable.Handle), curSOFTDELETEON,LongInt(Value));
      if rslt <> DBIERR_NONE then
      begin
       DbiGetErrorString(rslt, szErrMsg);
       raise Exception.Create(StrPas(szErrMsg));
      end;
      excepton E: EDBEngineError do ShowMessage(E.Message);
      on E: Exception do ShowMessage(E.Message);
     end;
    finally
     Table.Refresh;
     Table.EnableControls;
    end;
   end;
   «Могу ли я создать в табличной сетке колонку, в которой будут показываться записи, помеченные для удаления из таблицы dBASE?»
   Создайте вычисляемое поле, затем в обработчике события таблицы OnCalcField замените его таким образом:
   procedure TForm1.Table1CalcFields(DataSet: TDataset);
   var
    RCProps : RecProps;
    Result : DBIResult;
   begin
    Result := DbiGetRecord(Table1.Handle, dbiNo
   Рукописи не горят…

Определение номера записи в таблице dBASE

   Таблицы dBASE применяют довольно статическую систему нумерации записей. Номер записи для данной записи (извините за тавтологию) отражает физическую позицию в табличном файле. Эти номера записей не изменяются вследствие фильтрации, упорядочивания данных или сортировки. К примеру, первая запись, хранящаяся в .DBF файле, будет иметь номер записи 1. Возможно, после некоторого упорядочивания индекса, запись будет последней из 100 записей. В этом случае запись должна оставаться с тем же номером, а не номером 100, отражающим новую позицию в сортированном наборе данных. Это противоречит таблицам Paradox, где соблюдается последовательная нумерация. Последовательная нумерация Paradox похожа на нумерацию записей dBASE, за исключением большей гибкости и отражению в номере записи ее текущей позиции в наборе данных. То есть, запись может не всегда иметь номер, установленный для нее фильтром набора данных, уменьшившим общее число записей, или при активном индексе, из-за чего может измениться отображаемый порядок записи.
   В приложениях для работы с базами данных, созданных с помощью Delphi и Borland Database Engine (BDE), DB-компонентами не предусмотрено извлечение и определение записи таблицы dBASE. Такая операция, тем не менее, возможна с помощью вызова из вашего приложения функций BDE.
   Существует несколько функций BDE, возвращающих информацию о текущей записи dBASE, например, ее номер. На самом деле, любая функция, заполняющая структуру BDE pRECProps, вполне достаточна. Например, функции BDE DbiGetRecord, DbiGetNextRecord и DbiGetPriorRecord. Естественно, только первая из них реально позволяет получить информацию о текущей записи. Две других перемещают при вводе указатель на запись, подобно методам Next и Prior компонентов TTable и TQuery.
   Структура pRECProps состоит из следующих полей:
   iSeqNum: тип LongInt; определяет текущий номер записи (относительно набора данных, включая фильтрацию и сортировку индекса); используется, если тип таблицы поддерживает последовательную нумерацию (только Paradox).
   iPhyRecNum: тип LongInt; определяет номер записи; используется, если тип таблицы поддерживает физические номера записи (только dBASE).
   bRecChanged: тип Boolean; в настоящее время не используется.
   bSeqNumChanged: тип Boolean; в настоящее время не используется.
   bDeleteFlag: тип Boolean; указывает на удаленную запись; используется, если тип таблицы поддерживает "мягкое" удаление (только dBASE).
   Одна из этих BDE-функций может быть вызвана из вашего приложения для заполнения данной структуры, из которой затем может быть извлечен физический номер записи. Ниже - пример использования для этой цели функции DbiGetRecord.
   function RecNo(ATable: TTable): LongInt;
   var
    R: RECProps;
    rslt: DbiResult;
    Error: array [0..255] of Char;
   begin
    ATable.UpdateCursorPos;
    rslt := DbiGetRecord(ATable.Handle, dbiNoLock, nil, @R);
    if rslt = DBIERR_NONE then Result := R.iPhyRecNum
    else begin
     DbiGetErrorString(rslt, Error);
     ShowMessage(StrPas(Error));
     Result := -1;
    end;
   end;
   Для вызова любой BDE-функции из приложения Delphi, модули-обертки BDE DbiTypes, DbiErrs и DbiProcs должны быть включены в секцию Uses модуля, из которого они будут вызываться (секция Uses здесь не показана). Для того, чтобы сделать функции более транспортабельными, они не имеют прямой ссылки на компонент TTable, но указатель на TTable передается как параметр. Если эта функция используется в модуле, который не ссылается на модули Delphi DB и DBTables, они должны быть добавлены, иначе ссылки на компонент TTable будут недействительными.
   Метод TTable UpdateCursorPos вызывается для гарантии синхронизации номера текущей записи в компоненте TTable и связанной с ним таблицы.
   В случае ошибок BDE функций, исключительная ситуация ими не генерируется. Вместо этого они возвращают значение BDE-типа DbiResult, указывающее на успешное завершение или ошибку операции. Возвращаемое значение должно быть получено и обработано внешним приложением, с выполнением соответствующих действий. Любой результат, кроме DBIERR_NONE, указывает на неудачное выполнение функции. В этом случае может быть осуществлено дополнительное действие (как в примере выше), где с помощью BDE функции DbiGetErrorString код ошибки переводится в удобночитаемое сообщение. В этом примере возвращаемое в DbiGetRecord значение сохраняется в переменной rslt, а затем для определения успешности вызова функции сравнивается с DBIERR_NONE.
   Если вызов DbiGetRecord был успешным, физический номер записи из поля iPhyRecNum структуры pRECProps сохраняется в переменной Result, которая является возвращаемой функцией величиной. Чтобы указать на то, что функция потерпела неудачу (т.е., вызов фунции DbiGetRecord окончился неудачно), вместо номера записи возвращается отрицательная величина. Значение ее может быть произвольным (отрицательная величина совместимого типа) и отдается на усмотрение программисту.

Пакование таблиц dBASE II

   Упаковка таблиц dBASE требует вызова BDE функции DbiPackTable. Пример ее использования показан ниже, включая проверку на ошибки. Чтобы воспользоваться функцией DbiPackTable, вызывающий модуль должен в своей секции uses иметь модули-обертки BDE DbiTypes, DbiErrs и DbiProcs.
   При неудачном вызове DbiPackTable, сообщение об ошибке не генерится. Для того, чтобы понять как функция сработала, вам необходимо проверить возвращаемое ею значение. В случае успешного выполнения возвращаемое значение равно DBIERR_NONE. Любое другое значение указывает на ошибку, а с помощью него можно определить саму ошибку, ее причину, и наметить действия, необходимые для ее устранения.
   Вот сам пример:
   procedure TForm1.Button1Click(Sender: TObject);
   var
    Error: DbiResult;
    ErrorMsg: String;
    Special: DBIMSG;
   begin
    table1.Active := False;
    try
     Table1.Exclusive := True;
     Table1.Active := True;
     Error := DbiPackTable(Table1.DBHandle, Table1.Handle, nil, szdBASE, True);
     Table1.Active := False;
     Table1.Exclusive := False;
    finally
     Table1.Active := True;
    end;
    case Error of
    DBIERR_NONE: ErrorMsg := 'Успешно';
    DBIERR_INVALIDPARAM: ErrorMsg := 'Указанное имя таблицы или указатель на имя таблицы ' +'равен NULL';
    DBIERR_INVALIDHNDL: ErrorMsg := 'Указанный дескриптор базы данных или курсора ' +'неверен или равен NULL';
    DBIERR_NOSUCHTABLE: ErrorMsg := 'Таблица с таким именем не существует';
    DBIERR_UNKNOWNTBLTYPE: ErrorMsg := 'Неизвестный тип таблицы';
    DBIERR_NEEDEXCLACCESS: ErrorMsg := 'Таблица открыта не в эксклюзивном режиме';
    else
     DbiGetErrorString(Error, Special);
     ErrorMsg := '[' + IntToStr(Error) + ']: ' + Special;
    end;
    MessageDlg(ErrorMsg, mtWarning, [mbOk], 0);
   end;

Пакование таблиц dBASE III

   Для упаковки таблицы dBASE, открытой с помощью TTable, воспользуйтесь функцией BDE DbiPackTable. Для этого достаточно сделать две операции:
   1. Добавьте в секцию uses следующие модули:
   { Для Delphi 1.0: } DBITYPES, DBIPROCS и DBIERRS;
   { Для Delphi 2.0: } BDE;
   2. Затем вызовите BDE функцию DbiPackTable следующим образом:
   Check(DbiPackTable(Table1.DbHandle, Table1.Handle, Nil, szDBASE, TRUE));
   Примечания:
   • Таблица должна быть открыта в эксклюзивном режиме.
   • При вызове функций API BDE используйте процедуру Check. Check в случае ошибки при вызове BDE генерирует исключительную ситуацию.

Пакование таблиц dBASE IV

   Nomadic советует:
   Для dBase:
   uses DbiProcs;
   with table do
    begin
    OldState := Active;
    Close;
    Exclusive := True;
    Open;
    DbiPackTable(DBHandle, Handle, nil, nil, True);
    {^ здесь можно добавить check()}
    Close;
    Exclusive := False;
    Active := OldState;
    { при желании можно сохранить закладку }
   end;
   Pavel Kulchenko
   (2:465/66)
   Пример для Paradox:
   Uses BDE; // for d3, для d2 не помню (что-то типа dbiprocs и еще что-то)
   // для пpимеpа
   tLog : TTable; // таблица, юзающая d:\db\log.db
   var
    TblDesc: CRTblDesc;
    rslt: DBIResult;
    Dir: String; //имеется в виду huge string т.е. {$h+}
    hDb: hDbiDb;
   begin
    tLog.Active := False; //деактивиpуем TTable
    SetLength(Dir, dbiMaxNameLen + 1);
    DbiGetDirectory(tLog.DBHandle, False, PChar(Dir));
    SetLength(Dir, StrLen(PChar(Dir)));
    DbiOpenDatabase(nil, nil, dbiReadWrite, dbiOpenExcl, nil, 0, nil, nil, hDb);
    DbiSetDirectory(hDb, PChar(Dir));
    FillChar(TblDesc, sizeof(CRTblDesc), 0);
    StrPCopy(TblDesc.szTblName, 'd:\db\log.db');
    // здесь должно быть полное имя файла
    //котоpое можно: а) ввести pуками;
    //б) вытащить из пpопеpтей таблицы;
    //в) вытащить из алиаса;
    //г) см. FAQ
    StrCopy(TblDesc.szTblType, szParadox);
    //BTW тут может и szDBase стоять
    TblDesc.bPack := TRUE;
    DbiDoRestructure(hDb, 1, @TblDesc, nil, nil, nil, false);
    DbiCloseDatabase(hDb);
   end;
   // можно еще чеки ввести, но облом :-)

Показ удаленных записей в таблице dBASE

   В таблицах dBASE записи не удаляются до тех пор, пока таблица не будет упакована. Пока же это не произойдет, удаленные записи остаются в таблице, только имеют при этом флажок "к удалению". Для того, чтобы показать эти существующие, но не отображаемые записи, существует функция ShowDeleted(), которая использует функцию BDE API DbiSetProp(), показывающая записи, помеченные к удалению. При использовании этой функции нет необходимости закрывать и вновь открывать таблицу. ShowDeleted() в качестве параметров передается TTable и логическое значение. Логический параметр указывает на необходимость показа удаленных записей.
   Демонстрационный проект:
   unit Unit1;

   interface

   uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, DBCtrls, Grids, DBGrids, DB, DBTables;

   type
    TForm1 = class(TForm)
     Table1: TTable;
     DataSource1: TDataSource;
     DBGrid1: TDBGrid;
     DBNavigator1: TDBNavigator;
     CheckBox1: TCheckBox;
     procedure CheckBox1Click(Sender: TObject);
    public
     procedure ShowDeleted(Table: TTable; ShowDeleted: Boolean);
    end;

   var
    Form1: TForm1;

   implementation

   uses DBITYPES, DBIERRS, DBIPROCS;

   {$R *.DFM}

   procedure TForm1.ShowDeleted(Table: TTable; ShowDeleted: Boolean);
   var
    rslt: DBIResult;
    szErrMsg: DBIMSG;
   begin
    Table.DisableControls;
    try
     Check(DbiSetProp(hDBIObj(Table.Handle), curSOFTDELETEON, LongInt(ShowDeleted)));
    finally
     Table.EnableControls;
    end;
    Table.Refresh;
   end;

   procedure TForm1.CheckBox1Click(Sender: TObject);
   begin
    ShowDeleted(Table1, CheckBox1.Checked);
   end;

   end.

Пароль на dBASE-файлы

dBase-файлы не поддерживают пароли. Естественно, вы можете создать свои собственные методы поддержки паролей. Но это будет работать только с вашими приложениями. Боюсь, что при наличии тысяч читателей/конверторов dBase, этот способ не годится.

Показ меток 'удаленных' записей в dBASE-файлах

   Для начала вы должны включить SoftDeletes, после чего вы сможете просматривать записи, помеченные к удалению. В противном случае, вы их не увидите. По умолчанию, для файлов DBF, SoftDeletes установлен в False. Вот логика работы:
   procedure TForm1.Button1Click(Sender: TObject);
   var
    B: BOOL;
    W: Word;
   begin
    Check(DbiSetProp(hDBIObj(Table1.Handle), curSOFTDELETEON, longint(True)));
    { Проверяем, что это работает }
    Check(DbiGetProp(hDBIObj(Table1.Handle), curSOFTDELETEON, @B, sizeof(B), W));
    if B = False then Label2.Caption := 'Не помечена'
    else Label2.Caption := 'Помечена';
   end;
   Когда указатель на запись указывает на запись, которую вы хотите удалить, используйте следующую логику:
   Table1.UpdateCursorPos;
   Check(DbiUndeleteRecord(Table1.Handle));
   Метод UpdateCursorPos устанавливает основной курсор BDE на позицию курсора текущей записи, который существуют только для того, чтобы все работало правильно. Вам нужно только вызвать этот метод прямым вызовом одной из BDE API функций (такой как, например, DbiUndeleteRecord).
   Ну и, наконец, чтобы все работало, поместите модули DBIPROCS и DBITYPES с список USES.

DB2

Как заставить работать DB2 через протокол IPX?

   Nomadic отвечает:
   Связь Win-клиента c DB2 в сети Netware
   Hастройка доступа к DB2

1. Связь с использованием протокола IPX/SPX.

   Возможны два варианта доступа:
   • через сервер NETWARE;
   • прямая адресация.

1.1. Конфигурация для доступа через сервер.

   Замечание: Проверялся доступ через сервера NW 3.11 и 3.12. Для 4.х нужно еще разобраться.
   1.1.1. DB2 Сервер
   • должна быть установлена OS/2 Warp или OS/2 Warp Connect;
   • включена поддержка NETWARE;
   • в CONFIG.SYS в переменную среды DB2COMM добавить (через запятую) IPXSPX и перезагрузить систему;
   • создать командный файл DBIPXSET.CMD следующего вида:
   db2 update dbm cfg using fileserver objectname dbserver
   где – <NWSERVER> – имя сервера;
   • выполнить командный файл DBIPXSET.CMD;
   • перестартовать сервер базы данных;
   • создать командный файл DBIPXREG.CMD следующего вида:
   db2 register nwbindery user
   где – <USERNAME> – имя пользователя, обладающего правами администратора на сервере <NWSERVER>;
   • выполнить командный файл DBIPXREG.CMD;
   • ответить на запрос пароля.
   1.1.2. WINDOWS-клиент
   • установить WINDOWS 3.1 или WfWG 3.11;
   • установить клиента NETWARE от версии 4.х;
   • при установке влючить поддержку WINDOWS;
   • установить клиента DB2 для WINDOWS;
   • используя программу Client Setup описать новый узел – сервер базы данных:
   Name – <любое имя>
   Protocol – IPX/SPX
   File server – <NWSERVER>
   Object name – dbserver
   • описать базу данных и разрешить доступ к ней через ODBC.

1.2. Конфигурация для доступа через прямую адресацию

   1.2.1. DB2 Сервер
   • см. п 1.1.1;
   • найти в директории x:\sqllib\misc программу DB2IPXAD.EXE и выполнить ее;
   • записать полученный адрес;
   1.2.2. WINDOWS-клиент
   • см. п. 1.1.2. (первые три шага);
   • используя программу Client Setup описать новый узел – сервер базы данных:
   Name – <любое имя>
   Protocol – IPX/SPX
   File server – *
   Object name – <адрес полученный от DB2IPXAD.EXE>
   • описать базу данных и разрешить доступ к ней через ODBC.

Почему DB2 ругается на Create Trigger?

Nomadic отвечает:
Я тут писал по поводу того, что у меня не работали триггеры. Все дело оказалось в правиле написания команды «create trigger». Если все остальные команды корректно воспpинимаются на любом регистре, то эта – только набранная одними большими буквами.

Модули данных

Модуль данных для каждого MDIChild

   Когда во время разработки вы устанавливаете "DataSource"-свойство в БД-компонентах для указания на модуль данных, VCL во время выполнения приложения будет пытаться создать связь с существующим TDataModule, основываясь на его свойтсве Name. Так, если вы добавите модуль данных к вашему проекту и переместите его в свойстве проекта из колонки автоматически создаваемых форм в колонку доступных, вы сможете разработать форму, содержащую элементы управления для работы с базами данных, после чего несколькими строчками кода можете создать экземпляр формы, имеющий экземпляр собственного модуля данных.
   С помощью Репозитория создайте "standard MDI application" (стандартное MDI-приложение), в котором модуль TMDICHild будет похож на приведенный ниже. Добавленные строки имеют комментарий {!}. Хитрости спрятаны в конструкторе create и задании другого порядка следования операторов.
   unit Childwin;

   interface

   uses Windows, Classes, Graphics, Forms, Controls,ExtCtrls, DBCtrls, StdCtrls, Mask, Grids, DBGrids,DataM; {!} // Модуль TDataModule1

   type
    TMDIChild = class(TForm)
     DBGrid1: TDBGrid;
     DBGrid2: TDBGrid;
     DBEdit1: TDBEdit;
     DBEdit2: TDBEdit;
     DBNavigator1: TDBNavigator;
     procedure FormClose(Sender: TObject; var Action: TCloseAction);
    private { Private declarations }
    public { Public declarations }
     {!} DM:TDataModule1;
     {!} constructor Create(AOwner:TComponent); override;
    end;

   implementation

   {$IFDEF XOXOXOX} // DataM должен находиться в секции interface. Необходимо для среды
   uses DataM;     // времени проектирования. Определение "XOXOXOX" подразумевает,{$ENDIF}
                     // что это никогда не будет определено, но чтобы компилятор видел это.

   {$R *.DFM}

   {!} constructor TMDIChild.Create;
   {!} begin
   {!} DM := TDataModule1.Create(Application);
   {!} inherited Create(AOwner);
   {!} DM.Name := '';
   {!} end;

   procedure TMDIChild.FormClose(Sender: TObject; var Action: TCloseAction);
   begin
    Action := caFree;
   end;

   end.
   – Pat Ritchey

Как передать UserName и Password в удаленный модуль данных (remote datamodule)?

   Nomadic отвечает:
   В Удаленный Модуль Данных бросьте компонент TDatabase, затем добавьте процедуру автоматизации (пункт главного меню Edit | Add To Interface) для Login.
   Убедитесь, что свойство HandleShared компонента TDatabase установлено в True.
   procedure Login(UserName, Password: WideString);
   begin
    { DB = TDatabase }
    { Something unique between clients }
    DB.DatabaseName := UserName + 'DB';
    DB.Params.Values['USER NAME'] := UserName;
    DB.Params.Values['PASSWORD'] := Password;
    DB.Open;
   end;
   После того, как Вы создали этот метод автоматизации, Вы можете вызывать его с помощью:
   RemoteServer1.AppServer.Login('USERNAME','PASSWORD');

Paradox

Byte-поля Paradox

   Что за магия при записи в поле Paradox Byte? По этому поводу в документации ничего не сказано.
   Есть 2 пути получить доступ к данным в TBytesField.
   Просто вызовите метод GetData, передавая ему указатель на буфер, где сам буфер должен иметь размер, достаточный для хранения данных:
   procedure SetCheckBoxStates;
   var CBStates: array[1..13] of Byte;
   begin
    CBStateField.GetData(CBStates);
    { Здесь обрабатываем данные… }
   end;
   Для записи значений вы должны использовать SetData.
   Используйте свойство Value, возвращающее вариантный массив байт (variant array of bytes):
   procedure SetCheckBoxStates;
   var CBStates: Variant;
   begin
    CBStates := CBStateField.Value;
    { Здесь обрабатываем данные… }
   end;
   Первый метод, вероятно, для вас будет легче, поскольку вы сразу докапываетесь до уровня байт. Запись данных также получится сложнее, поскольку вам нужно будет работать с variant-методами типа VarArrayCreate и др.
   – Mark Edington

Доступ к таблицам Paradox на CD или c флагом только для чтения

   Тема: Доступ к таблицам Paradox на CD или на дисках c флагом только для чтения
   Данный совет поможет вам разобраться в таком вопросе, как доступ к таблицам Paradox, расположенным на CD-ROM или диске, имеющем флаг "только для чтения".
   Механиз блокирования файлов Paradox требует наличие файла PDOXUSRS.LCK, осуществляющий логику работы блокировки. Данный файл обычно создается во время выполнения приложения и располагается в том же каталоге, где и таблицы. Тем не менее, в случае с CD-ROM, во время выполнения программы нет никакой возможности создать на нем описанный выше файл. Решение простое: мы создаем этот файл и помещаем его на CD-ROM во время его (CD) создания. Следующая простейшая программка позволит создать вам файл PDOXUSRS.LCK и поместить его в образ компакта для его последующего копирования на CD-ROM:
   1. Стартуйте пустой проект и добавьте на форму следующие компоненты: TEdit, TButton и TDatabase.
   2. В обработчике кнопки OnClick используйте следующий код:
   procedure TForm1.Button1Click(Sender: TObject);
   begin
    if ChkPath then Check(DbiAcqPersistTableLock(Database1.Handle, 'PARADOX.DRO','PARADOX'));
   end;
   3. Функция ChkPath является методом, определенным пользователем для формы. Она просто проверяет путь, введенный пользователем в поле редактирования и убеждается, что он существует. Вот функция:
   function TForm1.ChkPath : Boolean;
   var s: array[0..100] of char;
   begin
    If DirectoryExists(Edit1.Text) then begin
   DataBase1.DatabaseName:= 'TempDB';
     DataBase1.DriverName:= 'Standard';
     DataBase1.LoginPrompt:= false;
     DataBase1.Connected := False;
     DataBase1.Params.Add('Path=' + Edit1.Text);
     DataBase1.Connected := TRUE;Result := TRUE;
    end else begin
   StrPCopy(s,'Каталог : ' + Edit1.text + ' не найден');
     Application.MessageBox(s, 'Ошибка!', MB_ICONSTOP);
     Result := FALSE;
    end;
   end;
   { Примечание: Не забудьте добавить объявление функции в секцию public формы.}
   4. Перед компиляцией необходимо вспомнить еще об одной вещи: в список Uses нужно добавить следующие модули:
   Delphi 1.0: FileCtrl, DbiProcs, DbiTypes, DbiErrs.
   Delphi 2.0: FileCtrl, BDE
   После компиляции и выполнения, программа создаст два файла в определенном вами каталоге. Создаваемые два файла: PDOXUSRS.LCK и PARADOX.LCK.
   Примечание: Файл PARADOX.LCK необходим только для доступа к таблицам Paradox for DOS, так что вы можете его удалить.
   5. Вам осталась сделать только одну последнюю вещь: скопировать оставшийся файл (PDOXUSRS.LCK) в образ CD-ROM. Естественно, ваши таблицы будут только для чтения.
   Примечание: Если вы собираетесь довольно часто пользоваться данной утилитой, то для удобства вы можете изменить свойство Text компонента Edit на ваш «любимый» каталог, а свойство Caption кнопки поменять на что-нибудь более «интеллектуальное».
   Вот окончательная версия кода:
   unit Unit1;

   interface

   uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, DB, StdCtrls, FileCtrl,
   {$IFDEF WIN32}
    BDE;
   {$ELSE}
    DbiProcs, DbiTypes, DbiErrs;
   {$ENDIF }

   type TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Database1: TDatabase;
    procedure Button1Click(Sender: TObject);
   private { Private declarations }
   public { Public declarations }
    function ChkPath : Boolean;
   end;

   var Form1: TForm1;

   implementation

   {$R *.DFM}

   function TForm1.ChkPath : Boolean;
   var s: array[0..100] of char;
   begin
    If DirectoryExists(Edit1.Text) then begin
     DataBase1.DatabaseName:= 'TempDB';
     DataBase1.DriverName:= 'Standard';
     DataBase1.LoginPrompt:= false;
     DataBase1.Connected := False;
     DataBase1.Params.Add('Path=' + Edit1.Text);
     DataBase1.Connected := TRUE;
     Result := TRUE;
    end else begin
     StrPCopy(s,'Каталог : ' + Edit1.text + ' не найден');
     Application.MessageBox(s, 'Ошибка!', MB_ICONSTOP);
     Result := FALSE;
    end;
   end;

   procedure TForm1.Button1Click(Sender: TObject);
   begin
    if ChkPath then Check(DbiAcqPersistTableLock(Database1.Handle, 'PARADOX.DRO','PARADOX'));
   end;

   end.

Нечувствительный к регистру поиск в первичном индексе Paradox

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

Создание таблицы Paradox

   Вот маленький кусочек кода для создания таблицы Paradox:
   with TTable.create(self) do begin
    DatabaseName := 'C:\temp';
    TableName := 'FOO';
    TableType := ttParadox;
    with FieldDefs do Begin
     Add('Age', ftInteger, 0, True);
     Add('Name', ftString, 25, False);
     Add('Weight', ftFloat, 0, False);
    End;
    IndexDefs.Add('MainIndex','IntField', [ixPrimary, ixUnique]);
    CreateTable;
   End;

DBEdit и реальные значения

При работе с реальными числами, хранимые в таблице Paradox, вы уверены в том, что вы используете тип Real как тип ваших данных? Если так, то попробуйте использовать тип Double. Double – 8-байтовое (64-битное) реальное число, которое нормально работает с BDE, тогда как Real – 6-байтовая версия и подходит только для Delphi и BP. Или попробуйте использовать Extended, занимающий 10 байтов.

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

Nomadic отвечает:
В Парадоксе первичный индекс всегда CaseSensitive.

Как сменить пароль (master password) для таблицы Paradox?

   Nomadic отвечает:
   Пожалуйста:
   var
    db : TDatabase;
    Desc : CRTblDesc;
   begin
    db := PriceTable.OpenDatabase;
    FillChar(Desc, SizeOf(Desc), #0 );
    StrCopy(Desc.szTblName, PChar(PriceTable.TableName));
    StrCopy(Desc.szTblType, szParadox);
    StrCopy(Desc.szPassword, 'password');
    Desc.bProtected := TRUE;
    Check(DbiDoRestructure(db.Handle, 1, @Desc, nil, nil, nil, FALSE));
   end;

Что нужно сделать для нормальной работы в одноранговой сети с базами Paradox?

   Nomadic отвечает:
   BDE Config/Admin – нa вкладке System устaнови LOCAL SHARE в TRUE!
   Здесь комментарий –
   В Help параметр LOCAL SHARE описан как:
   AA> === Cut ===
   AA> The ability to share access to local data between an active BDE
   AA> application and an active non-BDE application. Set to TRUE if you need to
   AA> work with the same files through both a BDE and a non-BDE application at
   AA> the same time. (It is not necessary to set LOCAL SHARE to TRUE if you do
   AA> not need to have both applications open at the same time.) Default: FALSE.
   AA> === Cut ===
   Дак читал я вышеизложенное, и расцениваю его кaк туманопускательство. А подозреваю, что просто у BDE для скорости есть свой внутренний кэш (или, может, мехaнизм блокировок в пaмяти), и для двух приложений на одном компьютере оно всё делает хорошо, a вот если приложение находится на другом компьютере (и лезет в БД через другую копию BDE), то у него есть доступ только к файлам нa диске (как и у non-BDE application).
   Скорее всего, борланд отключает эти хитрости у сетевых дисков. Hо для локального дискa, который рaсшарен по сети, он этого, похоже, не сделaл :(
   И BDE нa файл-сервере не заботится о правильных индексaх и блокировках нa диске (т.е. не ожидает, что кто-то мог исправить индекс, пока оно ворон считaло).
   А этa установка заставляет его работать по старым парадоховым соглашениям.
   Что и требовалось.
   PS. Иначе говоря, следует считать, что network is non-BDE application, и тогда это не есть бага :)

Переиндексирование файлов Paradox в пределах моей программы

   Попытаемся это сделать с помощью прямых вызовов функций BDE. На некоторых Интернет-серверах я видел описание этих функций. Некоторые «писатели» даже превращают свои трактаты в некое подобие файлов помощи. Поскольку я не хочу перегружать канал, то пошлю это по почте тому, кто пришлет мне запрос (т.е. кому это действительно нужно).
   …сейчая я пишу небольшое приложение, которое может оказаться полезным для восстановления «разбитых» таблиц. Аллен, я пошлю тебе полный список шагов, как только смогу перевести их (это писал итальянец, я же только перевожу это), но уже сейчас я могу сказать как это проблему я решил для себя. Один из наших клиентов всегда разбивал таблицы paradox, поскольку они у него всегда были очень большими (в Blob-полях хранились WAV-файлы – оцифрованный голос). Решение заключалось в создании маленьких таблиц, включенных в отношение справочной целостности, и загрузки больших blob-полей в эти отдельные таблицы. Ненужно никаких BDE функций, единственное условие – вы не должны вручную удалять индексные файлы (все .x00, .y01 и т.д., они все имеют маску .x?? и .y??, не трогайте других файлов!), в противном случае вы НЕ СМОЖЕТЕ ОТКРЫТЬ ТАБЛИЦУ, даже с помощью DBD!
   …затем я вручную восстанавливал все индексы (затем я что-то забыл, и приложение вылетело с ошибкой…). Если приложение, которое я тебе пришлю, не заработает, я думаю единственным решением будет физическое уничтожение индексов и пересоздание их с помощью соответствующих вызовов BDE.

Разное

Помещение Memo-файла с ASCII-разделителем в Memo-поле таблицы

   Вам нужно использовать процедуру getTextBuf. Вот пример из электронной справки:
   Данный пример при нажатии пользователем на кнопку копирует текст из поля редактирования в строку с терминирующим нулем, и помещает эту строку в другое поле редактирования.
   procedure TForm1.Button1Click(Sender: TObject);
   var
    Buffer: PChar;
    Size: Byte;
   begin
    Size := Edit1.GetTextLen;      {Получаем длину строки в Edit1}
    Inc(Size);                     {Добавляем место для терминирующего нуля}
    GetMem(Buffer, Size);          {Создаем динамическую переменную Buffer}
    Edit1.GetTextBuf(Buffer,Size); {Помещаем Edit1.Text в Buffer}
    Edit2.Text := StrPas(Buffer);  {Преобразуем Buffer в строку паскалевского типа}
    FreeMem(Buffer, Size);         {Освобождаем память, распределенную для Buffer}
   end;

Почему не всегда верно обновляются IndexDefs по Update?

   Nomadic отвечает:
   Ошибка в VCL.
   А помогает добавление fUpdated:=false; в теле процедуры TIndexDefs.Update.
   Или убиением владельца через Free, и пересозданием.

БД-дерево взаимоотношений

   Все это я делал раньше. Я не могу вам все это показать на развернутом примере, но я дам вам идею как сделать это. Вы должны иметь таблицу, осуществляющую взаимоотношение между людьми. Если на Peter работают Jane и Simon, вы должны иметь таблицу (RELATION) с этими двумя записями.
   Master
   Slave ------- имена полей
   Peter Jane
   Peter Simon
   Если George и Elisa работают на Jane, то таблица становится такой:
   Master Slave ------- имена полей
   Peter Jane
   Peter Simon
   Jane George
   Jane Elisa
   и так далее.
   Если в таблице RELATION необходимо создать дерево, начинающееся на Peter, то нужно добавить к дереву главный узел (запись), где Master = Peter. Затем каждая дочерняя запись располагается ниже записи Master = Peter. После добавления дочерней записи вы сразу увидите, если ребенок имеет собственного ребенка. Ребенок становится теперь, вероятно, отцом, поэтому вы должны позиционировать таблицу RELATION к первой записи, где Master = child, и так далее, рекурсивно. Такой способ гарантирует построение правильного дерева.
   Пример:
   AddFather('Peter')
   AddChild('Peter',1)

   Procedure AddFather(Name: String)
   Begin
    Tree.Add(Name);
   End;

   Procedure AddChildr(Name: String, Index:Integer)
   Begin
    Relation.FindKey([Name])while RelationMaster.AsString = Name do
    Begin
     Tree.AddChild(Index,RelationSlave.AsString);
     AddChild(RelationSlave.AsString,Tree.ItemsCount);
     Relation.Next;
    End;
   End;
   По-моему, ошибок нет.

DBGrid и Memo-поля

   В обработчик события GetText TMemoField поместите следующую строку:
   Text := GrabMemoAsString(TMemoField(Sender));
   и поместите следующую функцию так, чтобы к ней можно было свободно обратиться:
   function GrabMemoAsString(TheField : TMemoField): String;
   begin
    if TheField.IsNull then Result := '' else with TBlobStream.Create(TheField, bmRead) do begin
     if Size >= 255 then begin
      Read(Result[1], 255);
      Result[0] := #255;
     end else begin
      Read(Result[1], Size);
      Result[0] := Chr(Size);
     end;
     Free;
     while Pos(#10, Result) > 0 do Result[Pos(#10, Result)] := ' ';
     while Pos(#13, Result) > 0 do Result[Pos(#13, Result] := ' ';
   end;
   end;

Убывающий индекс

Я нашел простой способ получения убывающего индекса. В Delphi это получается очень легко и красиво:
Table1.AddIndex('NewIndex', 'CustNo;CustName', [ixDescending]);

Как работать из Delphi напрямую с MS ADO (Microsoft Active Data Objects)?

   Nomadic отвечает:
   Итак, хочу поделиться некоторыми достижениями… так на всякий случай. Если у вас вдруг потребуется сделать в своей программке доступ к базе данных, а BDE использовать будет неохота (или невозможно) – то есть довольно приятный вариант: использовать ActiveX Data Objects. Однако с их использованием есть некоторые проблемы, и одна из них это как передавать Optional параметры, которые вроде как можно не указывать. Однако, если вы работаете с ADO по-человечески, а не через тормозной IDispatch.Invoke то это превращается в головную боль. Вот как от нее избавляться:
   var
    OptionalParam: OleVariant;
    VarData: PVarData;
   begin
    OptionalParam := DISP_E_PARAMNOTFOUND;
    VarData := @OptionalParam;
    VarData^.VType := varError;
   после этого переменную OptionalParam можно передавать вместо неиспользуемого аргумента.
   Далее, самый приятный способ получения Result sets:
   Там есть масса вариантов, но как выяснилось оптимальным является следующий вариант, который позволяет получить любой желаемый вид курсора (как клиентский, так и серверный)
   var
    MyConn: _Connection;
    MyComm: _Command;
    MyRecSet: _Recordset;
    prm1: _Parameter;
   begin
    MyConn := CoConnection.Create;
    MyConn.ConnectionString := 'DSN=pubs;uid=sa;pwd=;';
    MyConn.Open('', '', '', –1);
    MyCommand := CoCommand.Create;
    MyCommand.ActiveConnection := MyConn;
    MyCommand.CommandText := 'SELECT * FROM blahblah WHERE BlahID=?'
    Prm1 := MyCommand.CreateParameter('Id', adInteger.adParamInput, –1, <value>);
    MyCommand.AppendParameter(Prm1);
    MyRecSet := CoRecordSet.Create;
    MyRecSet.Open(MyCommand, OptionalParam, adOpenDynamic, adLockReadOnly, adCmdText);
   …теперь можно фетчить записи. Работает шустро и классно. Меня радует. Особенно радуют серверные курсоры.
   Проверялось на Delphi 3.02 + ADO 1.5 + MS SQL 6.5 sp4. Пашет как зверь.
   Из вкусностей ADO – их легко можно использовать во всяких многопоточных приложениях, где BDE порой сбоит, если, конечно, ODBC драйвер грамотно сделан…
   Ну и еще можно использовать для доступа к данным всяких там «нестандартных» баз типа MS Index Server или MS Active Directory Services.
   В Delphi (как минимум в 4 версии) существует «константа» EmptyParam, которую можно подставлять в качестве пустого параметра.

Как засунуть в качестве паpаметpа хpанимой пpоцедуpы стpоку длиной более 255 символов? И вообще, как использовать паpаметpы SP, если они BLOB?

   Nomadic отвечает:
   «Засунуть» длинную строку можно было и раньше, если написать редактируемый запрос, и воспользоваться операциями Insert/Edit.
   Однако это не относится к хранимым процедурам.
   В Delphi 3.0 появился новый тип параметра (TBlobField вроде) и соответственно его поддержка в BDE.
   Если просто взять BDE 4.01 и выше, то работать все-равно не будет – нужна соотв. версия VCL (из Delphi 3.0 или выше).

Дублирование набора записей

   Вы можете воспользоваться вторым объектом TTable, подключенным к той же таблице, или можете вызвать метод объект TTable DisableControls, сделать изменения, и вызвать EnableControls. Для сохранения той же позиции вы можете попробовать воспользоваться закладкой. Например, так:
   procedure TMyForm.MakeChanges;
   var
    aBookmark: TBookmark;
   begin
    Table1.DisableControls;
    aBookmark := Table.GetBookmark;
    try
     {ваш код}
    finally
     Table1.GotoBookmark(aBookmark);
     Table1.FreeBookmark(aBookmark);
     Table1.EnableControls;
    end;
   end;

Как программно изменить LangDriver для таблиц dBase и Paradox?

   Nomadic отвечает:
   Откpываешь help и смотpишь:
   ……
   var list:tstrings;
   ……
   BEGIN
   …….
   List.Add ( 'LANGDRIVER=db866ru0 ');
   ……
   Session.ModifyDriver( 'DBASE', List );
   ……
   END;
   Это действие я пpовожy пеpед откpытием таблицы
   Ivan Sboev
   (2:5049/36.15)
   Это о «русификации» таблицы. В таблицах dBase и Paradox имеется байт, который определяет CodePage содержимого таблицы. Раньше он не использовался и был зарезервирован. Тебе нужно его правильно установить. Это делается через DBD Restructure table. Если хочешь программно, можешь воспользоваться следующей процедурой:
   uses DbiTypes, DbiProcs, DbiErrs, DB, WinProcs, SysUtils;

   procedure ChangeLangDriver( DatabaseName, TableName, LDName: string );
   var
    TblExt: string;
    Database: TDatabase;
    TblDesc: CRTblDesc;
    OptDesc: FLDDesc;
    OptData: array [0..250] of Char;
    Cur: hDBICur;
    Rec: CFGDesc;
   begin
    if (TableName='') or (LDName='') then raise Exception.Create('Unknown TableName or LDName');
    Database:=Session.OpenDatabase(DatabaseName);
    try
     if Database.IsSQLBased then raise Exception.Create('Function ChangeLangDriver working only with dBase or Paradox tables');
     FillChar(OptDesc, SizeOf(OptDesc), #0);
     FillChar(TblDesc, SizeOf(TblDesc), #0);
     StrCopy(OptDesc.szName, 'LANGDRIVER');
     OptDesc.iLen := Length(LDName) + 1;
     with TblDesc do
     begin
      StrPCopy(szTblName, TableName);
      TblExt := UpperCase(ExtractFileExt(TableName));
      if TblExt = 'DBF' then StrCopy(szTblType, szDbase)
      else if TblExt = '.DB' then StrCopy(szTblType, szParadox)
      else
     begin
       AnsiToOEM(StrPCopy(OptData, DatabaseName), OptData);
      if DbiOpenCfgInfoList(nil, dbiREADONLY, cfgPersistent, StrPCopy(OptData, '\DATABASES\' + StrPas(OptData) + '\DB INFO\')Cur) <> DBIERR_NONE then raise Exception.Create('Unknown table type');
       try
        while DbiGetNextRecord(Cur, dbiNOLOCK, @Rec, nil) <> DBIERR_EOF do if StrComp(Rec.szNodeName, 'DEFAULT DRIVER') = 0 then
        begin
         StrCopy(szTblType, Rec.szValue);
         Break;
        end;
       finally
        Check(DbiCloseCursor(Cur));
       end;
      end;
      iOptParams := 1;
      pfldOptParams := @OptDesc;
      pOptData := @OptData;
     end;
     StrPCopy(OptData, LDName);
     Check(DbiDoRestructure(Database.Handle, 1, @TblDesc, nil, nil, nil, False));
    finally
     Session.CloseDatabase(Database);
    end;
   end;
   Примеры использования:
   ChangeLangDriver('DBDEMOS', 'EMPLOYEE', 'ancyrr');
   ChangeLangDriver('DBDEMOS', 'EMPLOYEE.DB', 'ancyrr');
   ChangeLangDriver('C:\DELPHI\DEMOS\DATA', 'CLIENTS.DBF', 'db866ru0');
   LDName:
   для D1 – имя .LD файла в каталоге IDAPI\LANGDRV;
   для D2 и CB – из BDECFG32.HLP поле Short name в табличке по указателю language drivers, dBASE или поле Internal в табличке по указателю language drivers, Paradox;
   для D3 и выше – не знаю так как у меня её нет, но думаю, что также, как и в D2.

Существует ли средство для вывода определения структуры таблицы?

   Я создал таблицу и хочу получить её структуру, чтобы сделать изменённый оператор создания таблицы.
   Nomadic отвечает:
   Для этого существует утилита DB2LOOK. Она находится в SQLLIB\MISC.
   Пример использования:
   CONNECT TO SAMPLE USER xxx USING yyy
   DB2LOOK –d SAMPLE –u xxx –e –t employee
   Вывод может быть перенаправлен в файл. Полный синтаксис выдаётся по команде:
   DB2LOOK ?

У меня есть текстовые файлы, которые я хочу использовать в запросах к DB2, но не хочу создавать из них постоянные таблицы в базе. Что делать?

Nomadic отвечает:
Можно воспользоваться табличными функциями (Table Functions). Они позволяют использовать файлы как таблицы. Примеры приведены в руководстве «Embedded SQL Programming Guide».

Список структуры полей таблицы

   В данном проекте создается список структуры полей соответствующей таблицы, с использованием массивов Fields и IndexDefs, который затем отображается в компоненте ListBox. Демонстрационный проект (dbbrowsr.dpr) решает эту задачу несколько иначе. Вы можете сравнить две версии этого кода.
   Примечание: Данный код работает только в 16-битной среде.
   procedure TForm1.Button1Click(Sender: TObject);
   const MyFielddefs: array[ftUnknown..ftGraphic] of string [8] = ('Unknown', 'String', 'Smallint', 'Integer', 'Word','Boolean', 'Float', 'Currency', 'BCD', 'Date','Time', 'DateTime', 'Bytes', 'VarBytes', 'Blob','Memo', 'Graphic');
   var
    i, Indx: integer;
    Definition: string;
   begin

    for i := 0 to Table1.FieldCount - 1 do begin
     Definition := Table1.Fields[i].DisplayLabel;
     Definition := Definition + ' ' +MyFieldDefs[Table1.Fields[i].DataType];
     Table1.IndexDefs.Update;
     if Table1.Fields[i].IsIndexField then begin
      Indx := Table1.IndexDefs.Indexof(Table1.Fields[i].Name);
      if Indx > -1 then if ixPrimary in Table1.IndexDefs[Indx].Options then Definition := Definition + ' (Первичный)';
     end;
     Listbox1.Items.Add(Definition);
    end;
   end;
   Приведенная выше версия не работает в 32-битной среде, поскольку в ней присутствуют дополнительные типы полей. Вот версия, которая работает в 32-битной среде:
   procedure TForm1.Button1Click(Sender: TObject);
   const
    MyFielddefs: array[ftUnknown..ftTypedBinary] of string [11] =('Unknown', 'String', 'Smallint', 'Integer','Word', 'Boolean', 'Float', 'Currency', 'BCD','Date', 'Time', 'DateTime', 'Bytes', 'VarBytes','AutoInc', 'Blob', 'Memo', 'Graphic', 'FmtMemo','ParadoxOle', 'DBaseOle', 'TypedBinary');

   var
    i, Indx: integer;
    Definition: string;
   begin
    for i := 0 to Table1.FieldCount - 1 do begin
     Definition := Table1.Fields[i].DisplayLabel;
     Definition := Definition + ' ' +MyFieldDefs[Table1.Fields[i].DataType];
     Table1.IndexDefs.Update;
     if Table1.Fields[i].IsIndexField then begin
      Indx := Table1.IndexDefs.Indexof(Table1.Fields[i].Name);
      if Indx > -1 thenif ixPrimary in Table1.IndexDefs[Indx].Options then Definition := Definition + ' (Первичный)';
     end;
     Listbox1.Items.Add(Definition);
    end;
   end;

Создание индексного файла из Delphi

   Если вы используете таблицы dBASE или Paradox, то для создания нового индекса воспользуйтесь методом AddIndex. Для примера:
   Table1.AddIndex('Articles','Title', []);
   создаст индексный файл с именем ARTICLES с использованием поля TITLE в качестве индексного ключа. При создании вы можете воспользоваться различными индексными опциями (например, уникальность, необслуживаемый и пр.) – для получения дополнительной информации обратитесь к электронной справке по Delphi. ПРИМЕЧАНИЕ: Ваша таблица должна быть открыта исключительно для того, чтобы только воспользоваться методом AddIndex.
   Поддержка/обновление индексного файла, если только при создании вы не выставили флаг «необслуживаемый», происходит автоматически.

Контекстное меню на основе базы данных

   var
    m:TMenuItem;
    navidummy:TComponent;
   …………………………………………………
   procedure TMyForm.CreatePopUpMM(Sender: TObject);
   begin
    Navidummy.free;
    Navidummy:=TComponent.create(self);
    While not NaviT.EOF do

    begin
     m := TMenuItem.create(navidummy);
     II:=II+1;
     with m do begin
   name :='MM'+IntToStr(II);
      caption := NaviT.Fieldbyname('MyWHAT').AsString;
      tag := NaviT.Fieldbyname('MyTAG').AsInteger;
      visible:=True;
      OnClick:= NaviExec;
     end;
     MyMenuItem.add(m);
     NaviT.Next;
    end;
    NaviT.Close;
   end;

   procedure TMyForm.NaviExec(Sender:TObject);
   begin
    What.text := (Sender as TMenuItem).Caption;
    { Здесь я получаю то, что хочу ! }
    Key:= (Sender as TMenuItem).Tag;
   end;

Корректное закрытие базы данных приложением Delphi

   Очень интересный и полезный вопрос!! Я сам так с ним до конца и не разобрался! Но я попробую систематизировать события, происходящие при запросе на завершение работы Windows:
   Windows посылает сообщение WM_QUERYENDSESSION главным окнам всех запущенных приложений, при этом приложения должно сообщить свою готовность к завершению работы.
   Если при этом хотя бы одно из приложений ответит отрицательно, Windows прерывает процесс завершения работы.
   Delphi перехватывает это сообщение, и, в свою очередь, вызывает метод TForm.CloseQuery, (в главной форме, естественно), который генерирует событие OnCloseQuery, в обработчике которого можно указать на неготовность завершения приложения и отмены завершения работы Windows.
   Если я правильно понимаю, если ваше приложение «не мешает» Windows завершить свою работу, Windows нормально НЕ завершает работу приложения, поскольку для этого нет необходимости, не нужно освобождать память, ресурсы и пр. Так, если это утверждение верно (это легко можно проверить, но я слишком ленив сейчас), то событие OnCloseQuery – ваш единственный шанс сохранения данных на диске. Я не думаю что эта логика слишком плоха, просто это одна из тех причуд Windows, которую нужно знать и пользоваться ею. Что может произойти в описанном выше сценарии: редактируемая в настоящий момент запись не будет отправлена (Post) в базу данных, но та же самая вещь может случиться и при нормальном завершении приложения.
   При выходе из windows, вы вызываете WM_CLOSE api (или что-то типа этого) для каждого работающего в настоящий момент приложения. Программа закрывается точно таким же образом, как если бы вы щелкнули на кнопке закрытия или вызвали close из главной формы. Поэтому вам не нужно предпринимать никаких дополнительный действий, связанных с завершением работы с таблицами.

Изменение свойств базы данных во время выполнения приложения

   Свойство DatabaseName тесно связано с:
   • каталогом, где расположены ваши табличные файлы.
   • BDE-псевдоним вашей базы данных.
   • DatabaseName вашего компонента TDatabase, если вы имеете его.
   Выводы?

Как мне задать выражение по умолчанию для объекта TField?

   Это будет работать, если вы уже установили атрибуты поля и ассоциировали его с полем вашей таблицы. Если вы установили значение в Инспекторе Объектов, т.е. задали строку, не думайте, что это сработает во время выполнения приложения. Если вы попытаетесь во время прогона установить свойство TField.DefaultExpression примерно так:
   MyField.DefaultExpression := 'MyValue';
   то это скомпилируется, но при создании в таблице новой записи, скажем, при щелчке на кнопке + в DBNavigator, значения по умолчанию вы не получите. Чтобы во время работы приложения все работало, код должен быть таким:
   MyField.DefaultExpression := '''MyValue''';
   В Инспекторе Объектов вам нужно просто поместить значение 'MyValue' (используя одинарные кавычки).

После того, как я использовал правый щелчок мыши для создания функции-провайдера, как мне снова выполнить команду контекстного меню `Export from Table`?

Nomadic отвечает:
Как только Вы экспортировали интерфейс провайдера, эта команда контекстного меню перестает быть видимой. Чтобы снова включить ее, Вы должны удалить ассоциированное свойство в Редакторе Библиотеки Типов, и затем нажать кнопку обновления информации в Редакторе Библиотеки Типов (Type Library Editor's Refresh button). Вы могли бы также удалить точку вхождения «Get_XXX» в исходном тексте RemoteDataModule.

Как работать с новыми, своими интерфейсами в RemoteDataModule?

   Nomadic отвечает:
   В редакторе библиотеки типов (typelib) Вы можете добавить свои интерфейсы и сделать их членами оригинального coClass. После этого Вы можете обращаться к этим интерфейсам, используя следующий синтаксис:
   (IDispatch(RemoteServer.AppServer) as IAnother)
   Необходимо заметить, что это будет работать только, если Вы используете DCOM как транспорт.

Database Desktop показывает содержимое таблиц шрифтом без русских букв

   Nomadic отвечает:
   A: Для DBD 5.0 в файл c:\windows\pdoxwin.ini вставить в секцию
   [Properties]
   SystemFont=Arial Cyr
   Для DBD 7.0 нужно исправить реестр: ключ
   HKCU\Software\Borland\DBD\7.0\Preferences\Properties\
   SystemFont="Fixedsys"
   Если такой ключ не существует, его следует создать. Впрочем, для просмотра таблиц все равно можно порекомендовать rx Database Explorer – у него это получается очень хорошо.
   Ребят, я давно делаю под HТ (под 95 не знаю, не пробовал) такую вещь:
   [HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Nls\CodePage]
   "1252"="c_1251.nls"

BDE

InterBase

FAQ по InterBase

Ответы на наиболее часто задаваемые вопросы по InterBase (09/27/1996)

   Если вы имеете дополнения, исправления или пожелания, шлите мне письма по адресу rlove@pobox.com .
   Текущая версия данного FAQ'а доступна по адресу http://www.xmission.com/~uldata/ib/faq.txt .
   Авторские права: 1996 Robert J. Love
   Данный FAQ свободен для копирования, распространения и изменения формата.
   Многие из этих вопросов и ответов взяты непосредственно из документов Borland. Авторские права таких ответов остаются у Borland.
   Авторские права: Borland International, Inc.

Вопросы

   1. Что мне необходимо для распространения InterBase/Delphi приложения, созданного для нашего InterBase сервера?
   2. Что мне необходимо для распространения InterBase/Delphi приложения, созданного дла работы с Local InterBase?
   3. Что юридически необходимо для распространения Local InterBase Server (LIBS)?
   4. Я не могу подключить мои 32-битные приложения к моему серверу Novel…
   5. Мое подключение к Интернет (Internet Connection) стартует всякий раз, когда я пробую соединиться с InterBase.
   6. При попытке соединения я получаю следующее сообщение: Statement failed, SQLCODE = –902 (запрос потерпел неудачу) Unable to complete network request to host «DEV». (Невозможно завершить сетевой запрос для хоста «DEV».) –Failed to locate host machine. (невозможно найти хост-машину) –Undefined service gds_db/tcp. (сервис gds_db/tcp неопределен)
   7. Мое соединение с InterBase, похоже, очень медленно…
   8. Какие существуют Интернет-сервера, посвященные InterBase?
   9. Существуют ли 16-битные драйвера ODBC, позволяющие подключаться к InterBase NT, Netware или любому из серверов UNIX?
   10. Почему Delphi 1.00 поставляется с 16-битными драйверами ODBC для InterBase?
   11. Существуют ли 32-битные драйвера ODBC, позволяющие подключаться к InterBase NT, Netware или любому из серверов UNIX?
   12. Поддерживают ли 32-битные драйвера ODBC DSN?
   13. Почему Borland решил взимать плату за Local 32-битную версию?
   14. Как мне подписаться на список рассылки InterBase Mailing List?
   15. Если в этом FAQ'е нет ответа на мой вопрос, куда мне обратиться?

Вопросы и ответы по InterBase 4.2

   16. Что такое InterBase 4.2?
   17. Что нового в InterBase 4.2?
   18. Для чего нужен Local InterBase?
   19. Кто может быть пользователем InterBase Server под Windows 95?
   20. Что включает в себя сервер InterBase под Windows 95?
   21. Что включает в себя InterBase Server 4.2 for Windows NT?
   22. Как осуществляется лицензирование InterBase?
   23. Могу ли я свободно копировать ODBC драйвера InterBase?
   24. Сколько стоит обновление до 4.2?

Вопросы/Ответы

   1. Что мне необходимо для распространения InterBase/Delphi приложения, созданного для нашего InterBase сервера?
   Вам необходимо следующее:
    1. BDE.
    2. SQL Links
    3. Клиентская лицензия
   2. Что мне необходимо для распространения InterBase/Delphi приложения, созданного дла работы с Local InterBase?
   Вам необходимо следующее:
    1. BDE
    2. SQL Links
    3. Local InterBase Server (смотри вопрос #3)
   3. Что юридически необходимо для распространения Local InterBase Server (LIBS)?
   Реально это зависит от версии, которую вы пытаетесь распространить. Delphi C/S 1.0 поставляется с неограниченной лицензией (Unlimited Distribution License), позволяющей распространять неограниченное число копий 16-битной версии LIBS. Тем не менее, для 32-битной версии лицензия Unlimited Distribution License недоступна. По 408-431-1000 вы сможете узнать текущие условия лицензирования.
   4. Я не могу подключить мои 32-битные приложения к моему серверу Novel…
   В настоящий момент соединение с помощью 32-битного SPX к InterBase невозможен, если вам необходимо подключить ваше 32-битное приложение к вашему серверу Novel, вы должны установить на нем поддержку протокола TCP/IP. (Это является следствием неготовности библиотеки 32 SPX Novel Libraries к моменту выхода SQL Links)
   5. Мое подключение к Интернет (Internet Connection) стартует всякий раз, когда я пробую соединиться с InterBase.
   Вам необходимо выключить флажок Auto Dial, который вы можете найти в Control Panel на страничке настройки Internet.
   6. При попытке соединения я получаю следующее сообщение:
   Statement failed, SQLCODE = –902
   (запрос потерпел неудачу)
   Unable to complete network request to host «DEV».
   (Невозможно завершить сетевой запрос для хоста «DEV».)
   -Failed to locate host machine.
   (невозможно найти хост-машину)
   -Undefined service gds_db/tcp.
   (сервис gds_db/tcp неопределен)
   Следующая строчка должна присутствовать в services-файле как в вашем клиенте, так и на сервере:
   gds_db 3050/tcp
   Services-файлы могут располагаться в следующих каталогах:
   Windows95→C:\<WINDOWS95> (Где у вас установлен Win95)
   Windows NT→C:\ \System32\drivers\etc
   7. Мое соединение с InterBase, похоже, очень медленно…
   Это очень вероятно, если вы пользуетесь Netbeui, входящей в состав NT версии 4.0. Данная версия имеет ошибку, очень замедляющую работу Netbeui. Для решения проблемы попробуйте один из следующих рецептов:
    1. Обновите InterBase до самой последней версии.
    2. Установите, как вы обычно делаете, TCP/IP, это будет работать быстрее с любой версией InterBase.
   Примечание: Тестирование NT 4.0 и InterBase 4.2 с протоколами Netbeui и TCP/IP показало их равную производительность, а в некоторых случаях Netbeui был быстрее.
   8. Какие существуют Интернет-сервера, посвященные InterBase?
   На сегодняшний день я знаю 4 таких Интернет-сервера:
   InterBase Development
   http://www.xmission.com/~uldata/ib
   Mers Systems
   http://www.mers.com
   Dunstan Thomas InterBase Links
   http://www.demon.co.uk/dtuk/dtinterbaselinks.html
   Borland International
   http://www.borland.com/interbase
   9. Существуют ли 16-битные драйвера ODBC, позволяющие подключаться к InterBase NT, Netware или любому из серверов UNIX?
   Borland в настоящее время делает доступными 16-битные драйверы ODBC как часть продукта PC Client/Developer Toolkit [данное программное обеспечение также включается в пакеты InterBase для NT и сервера Netware]. Пользователи, приобредшие лицензии на PC Client/Developer Toolkit, имеют право устанавливать эти 16-битные драйвера. Цена за приобретаемый отдельно Client/Toolkit составляет $295, Borland использует для него товарный индекс ICL1140WWFN350.
   10. Почему Delphi 1.00 поставляется с 16-битными драйверами ODBC для InterBase?
   Delphi 1.00 содержал 16-битные драйвера ODBC для IB для того, чтобы все компоненты Delphi могли без проблем подключаться к серверу. Delphi 1.0 также включал SQL Link для InterBase, натив-драйвер с высокими скоростными характеристиками. Вопросы лицензирования не были явно или неявно отражены при пакетировании и в файлах deploy.txt драйвера ODBC, поэтому легальным пользователям продукта Delphi Client/Server не запрещается распространять продукты SQL Link и Local InterBase.
   В Delphi 1.02 драйверы InterBase ODBC были удалены, поскольку в необходимость в них компонентов Delphi отпала. Упоминание о драйверах остались в нескольких текстовых файлах, но это больше не требуется, так как в файлах deploy.txt содержится информация о правилах их распространения.
   11. Существуют ли 32-битные драйвера ODBC, позволяющие подключаться к InterBase NT, Netware или любому из серверов UNIX?
   Сегодня InterBase включает в себя 32-битные драйвера ODBC для Windows 95 и NT. Данные драйвера включены в InterBase 4.1 под NT и InterBase 4.2 под NT. Они были разработаны компанией Visigenic [смотри сообщение для прессы «Visigenic/Borland» на сервере www.borland.com]. Они также включены в Local InterBase под Win95/NT, который продается отдельно от Delphi. Драйвера также доступны как натив-драйвера для таких клонов UNIX, как Solaris, AIX и HP-UX. Никаких правил лицензирования не предусмотрено, а из существующих документов нельзя сделать выводы отностильно получения разработчикам доступа к драйверам путем покупки продуктов InterBase.
   12. Поддерживают ли 32-битные драйвера ODBC DSN?
   В настоящее время пока нет, в InterBase 4.2 возможность ODBC «DSN» была добавлена для поддержки соединений с серверными приложениями, такими, как сервера Web. Тем не менее, при использовании InterBase с серверами Web Server, для сервера необходимо иметь нужное число лицензий. Скоро Borland огласит свою политику отностительно лицензирования InterBase при работе с Интернет.
   13. Почему Borland решил взимать плату за Local 32-битную версию?
   (Смотри ниже подробное объяснение)
   Как вы, вероятно, уже знаете, Delphi C/S 1.0 включает в себя неограниченный в распространении Local InterBase [16-бит]. Мы [группа разработчиков InterBase] решили предложить эти беспрецендентные условия для распространения нашего продукта в среде разработчиков, демонстрации великолепия сервера и для увеличения полезности Delphi как средства разработки в среде Клиент/Сервер. Delphi Client/Server Suite 2.0 содержит Delphi Client/Server 1.0 и сохраняет условие свободного распространения Local InterBase [16-бит].
   Для 32-битных версий Delphi мы имеем:
   Delphi Desktop – не 32-битный InterBase любой сортировки [Desktop<>Client/Server]
   Delphi Developer – Local InterBase для Windows 95/NT включен, без распространения.
   Delphi C/S Suite 2.0 – Local IB для Win95/NT, IB Server NT на 2 пользователя, также без распространения.
   Почему без распространения?
   Во-первых, как вы можете увидеть из моих выкладок, новый продукт Local InterBase сертифицирован для использования в Windows 95 и Windows NT. Его архитектура полностью переписана с использованием нашего расширенного проекта SuperServer. Поскольку продукт разрабатывался как для Win95, так и для NT, Local InterBase настоятельно рекомендуется использовать в качестве отдельного сервера [MS не имеет сервера Win95; Oracle имеет один, но он имеет другой алгоритм программирования, чем NT server, они предлагают заплатить $400 за каждый 16– и 32-битный C API, и они посылают вас в InterSolv для ПОКУПКИ драйвера ODBC; Sybase имеет SQL Anywhere/Watcom и SQL Server 11 с другим API [ODBC против OpenClient], другой архитектурой и серьезными проблемами масштабируемости [продукт SQL Anywhere всегда использует Watcom с TransactSQL, но не использует OpenClient API, низкая многопользовательская производительность движка Watcom {для этого можно посмотреть последние обзоры в PC MAG за 10/94 и InfoWorld}, и так далее]; Informix не имеет ничего общего с работой на этих платформах; а Gupta свернула свою деятельность на этом поприще и кинулась разрабатывать High-End инструментарий для провайдеров, а не для серверов {если я правильно понял последнее сообщение для печати}]. 16-битные версии для отдельных пользователей отлично смотрелись в C/S пакете, в котором они распространялись. Ожидалось, что эти версии в пакете client/server должны быть свободными в распространении, но это не так.
   При продаже отдельно от Delphi и других клиентских продуктов Borland, продукт Local InterBase под Win95/NT будет сравниваться с SQL Anywhere, Personal Oracle и Personal Oracle Lite, и MS SQL Server Workstation.
   Мы включим наши C/C++ API для свободного использования.
   Мы включим наши 32-битные драйвера ODBC 2.5 под Win95/NT для свободного использования.
   Мы включим полную online-документацию, включая документацию по C API.
   Мы включим великолепную интеграцию в среду Win95/NT.
   Мы включим нативный 32-битный инструментарий.
   Мы предлагаем РАЗЛИЧНЫЕ наборы-пакеты для полного сервера [различающиеся только в поддерживаемых DDL, API, включаемой online-документацией и др.] с РАЗЛИЧНЫМ ценообразованием.
   Короче говоря, Local InterBase 32 предлагает бОльшие характеристики, лучшее взаимодействие с SQL [совместимость с уровнем ANSI 92, не '89], бОльшую универсальность [тот же комплект для Win95/NT], лучшую интеграцию с ОС, лучшую масштабируемость [мы работаем с 16 операционными системами, используя ОДНО И ТО ЖЕ API], лучшую производительность [поскольку вы пишите на одном API или посредством Delphi и никогда не переписываете свое приложение].
   Мы предлагаем такие характеристики/производительность/цены, что конкуренты просто рыдают навзрыд.
   14. Как мне подписаться на список рассылки InterBase Mailing List?
   Для подписки отправьте письмо по адресу listproc@esunix1.emporia.edu с командой «SUBSCRIBE INTERBASE Ваше Имя» в теле сообщения (без кавычек).
   15. Если в этом FAQ'е нет ответа на мой вопрос, куда мне обратиться?
   У вас имеется несколько доступных способов:
    1. Послать ваш вопрос в Compuserve GO BDEVTO (Секции 8 и 9)
    2. Послать ваш вопрос в список рассылки InterBase Mailing List (смотри Вопрос 14)
    3. Заключить контракт на поддержку (Support Contract) для InterBase и спросить службу технической поддержки (Technical Support)

Вопросы и ответы по InterBase 4.2

   16. Что такое InterBase 4.2?
   InterBase 4.2 – новая версия сервера реляционной базы данных Borland InterBase под Windows 95 и NT.
   17. Что нового в InterBase 4.2?
   InterBase 4.2 – целое семейство новых продуктов, включающее в себя потокобезопасные клиентские библиотеки для Windows 95/NT, с расширенными 32-битными драйверами ODBC, расширенную версию Local InterBase, предназначенную для разработки отдельным пользователем и ее распространения, новый многопользовательский сервер под Windows 95 для небольших рабочих групп и новый сервер под Windows NT для разработки приложений уровня департамента и предприятия. InterBase 4.2 был создан с использованием расширенной версией архитектуры Borland SuperServer, что позволило поднять производительность продукта на небывалую высоту, сохранив при этом исторические преимущества InterBase и добавив легкость установки, удобство использования и разработки. Кроме того, InterBase 4.2 для Windows NT также содержит нового менеджера лицензий (License Manager), позволяющий системным администраторам легко и эффективно управлять пользователями баз данных.
   18. Для чего нужен Local InterBase?
   Local InterBase 4.2 разрабатывался для компаний и корпораций, поставляющих решения клиент/сервер для предприятий, которые имеют как автономных, так и сетевых пользователей. Local InterBase обеспечивает пользователей ноутбуков и рабочих групп автономным сервером баз данных, работающим на всех платформах Windows [Windows 3.1, 95 и NT], предлагая таким образом решение для сотрудников предприятий, имеющих нерегулярный доступ к сети. Поскольку Local InterBase использует тот же язык программирования и формат баз данных, что и семейство продуктов сервера InterBase [доступные для платформ Windows и UNIX], то приложения, созданные для использования с сервером InterBase, на 100% совместимы с Local InterBase, и не требуют внесений изменений для правильной работы.
   19. Кто может быть пользователем InterBase Server под Windows 95?
   Сервер InterBase под Windows 95 – многопользовательский сервер для рабочих и небольших групп. Совместимый с Windows 95, Windows NT Workstation и NT Server, InterBase Server под Windows 95 идеален для приложений, которые требуют не более 4 параллельных пользователей. Если потенциальное количество пользователей может быть 10 и более, InterBase Server под Windows 95 будет управлять соединениями для гарантии того, что будут активны не более 4 пользователей, это предохранит операционную систему Windows 95 от перегрузки с операциями, связанными с базами данных. InterBase Server под Windows 95 не требует для работы выделенной машины и может работать в сетевой среде типа «peer to peer», где сервер может обслуживать не только операции с базами данных.
   20. Что включает в себя сервер InterBase под Windows 95?
   Сервер InterBase под Windows 95 включает в себя клиентские библиотеки и драйвера ODBC, необходимые для распространения в пределах рабочей группы, которая планирует пользоваться сервером, а также сам сервер, устанавливаемый на одной из машин [обычно самая быстрая машина в группе]. Отдельные клиентские приложения, работающие с Local InterBase, легко адаптируются для работы с сервером InterBase под Windows 95, тем самым позволяя компаниям и крупным корпорациям легко масштабировать свои решения по мере увеличения к ним требований.
   21. Что включает в себя InterBase Server 4.2 for Windows NT?
   InterBase Server 4.2 под Windows NT включает в себя сервер InterBase, клиентские библиотеки InterBase [включая ODBC драйвера Win95/NT], менеджер лицензий License Manager, позволяющий системным администраторам легко и эффективно управлять пользователями баз данных, и высокопроизводительный 32-битный визуальный (GUI) инструментарий. Сервер InterBase под Windows NT фирмы Borland – наилучший выбор для сервера баз данных под Windows. Тестировавшийся и сертифицированный под NT 3.51 и 4.0, InterBase Server 4.2 легко справляется с задачами уровня крупного предприятия. Способный использовать многопроцессорные машины для максимальной производительности, InterBase Server 4.2 является наилучшим выбором для крупномасштабных приложений, требующих высокую скорость, легкость установки, удобство разработки и надежность эксплуатации.
   22. Как осуществляется лицензирование InterBase?
   InterBase предусматривает два типа лицензий: Named User (пользовательская) и Concurrent Server (серверная). Лицензия Named User рекомендуется для приложений, в которых количество пользователей, имеющих доступ к базе данных, является числом относительно постоянным, а вероятность добавления в сетевую среду серверов InterBase достаточно высока. Данная лицензия гарантирует, что любой пользователь NT Named Client будет иметь полный доступ ко всем серверам предприятия InterBase NT без необходимости приобретения лицензий для множества пользователей. Цена лицензии Concurrent Server позволяет разработчикам иметь определенное количество параллельно работающих пользователей, но при этом количество потенциальных пользователей может быть значительно большим. Если число потенциальных пользователей значительно превышает число паралельно работающих пользователей на текущий момент, лицензия Concurrent Server позволит вам в будущем сэкономить немало денег. Тем не менее, если к приложению прибавляются дополнительные сервера баз данных, вы должны иметь серверные лицензии в количестве паралелльно работающих пользователей, подключенных к этим серверам, даже если эти пользователи уже работают с другими серверами NT, имеющимися на предприятии. Таким образом, лицензия Named Client позволяет лицензировать и пользователей, и машины, и допускает подключение клиента к любому серверу предприятия NT, имеющему лицензию Named Client. Лицензия Concurrent Server лицензирует количество параллельно работающих на сервере пользователей и не предоставляет клиентам никаких клиентских лицензий.
   23. Могу ли я свободно копировать ODBC драйвера InterBase?
   Нет, но все пользователи InterBase 4.2, имеющие лицензию Named User, могут иметь копию клиентских библиотек InterBase и драйверов ODBC, установленных на их машине. Таким образом, если вы купили легальную лицензию для подключения к InterBase, вы имеете право на создание резервной копии. Аналогично этому, все пользователи InterBase 4.2 с лицензиями Concurrent Server также могут иметь копии клиентских библиотек и драйверов ODBC, установленных на их машине. Разработчики не могут копировать библиотеки 4.2 на машины незарегистрированных пользователей, или пользователей предыдущих версий InterBase [например, 4.0 и 4.1]. Пользователи этой группы должны обновить сервер до версии InterBase 4.2 или приобрести индивидуальные копии инструментария разработчика (Developer Toolkit) для каждого клиента, где имеются файлы этого инструментария [драйверы ODBC, GUI-утилиты и пр.].
   24. Сколько стоит обновление до 4.2?
   Клиенты InterBase 4.0 и 4.1 могут обновить InterBase до версии 4.2 за $499.95

Как гарантированно сделать backup/restore БД InterBase с опцией 'Replace existing database' и записями протоколов в файлы с гарантированным отстрелом пользователей?

   Nomadic советует:
   Att.bat:
   at 01:00 /INTERACTIVE "e:\IB_DATA\BR.BAT"
   BR.bat
   del e:\IB_DATA\b.txt
   del e:\IB_DATA\r.txt
   del e:\ib_data\AR_IB.PRV
   del e:\IB_DATA\AR_IB.GBK
   d:\ib_42\bin\gfix –shut –force 1 e:\ib_data\AR_IB.GDB –user "SYSDBA" –password "oooo"
   net stop "InterBase Server"
   copy e:\ib_data\AR_IB.GDB e:\ib_data\AR_IB.PRV
   net start "InterBase Server"
   d:\ib_42\bin\gbak e:\ib_data\AR_IB.GDB e:\ib_data\AR_IB.GBK –user "SYSDBA" –password "oooo" –B –L –Y "e:\IB_DATA\b.txt"
   d:\ib_42\bin\gbak e:\ib_data\AR_IB.GBK e:\ib_data\AR_IB.GDB –user "SYSDBA" –password "oooo" –P 4096 –V –R –Y "e:\IB_DATA\r.txt"
   Sergey Klochkovski

Как скомпилиpовать UDF для Interbase под Linux RH 4.0?

   Nomadic советует:
   Пример –
   #!/bin/sh
   gcc –c –O –fpic udflib.c
   ld –o libudf.so –shared udflib.o
   cp libudf.so /usr/interbase/lib/
   ldconfig –v>>/dev/null

Как узнать текущие дату и время в Interbase?

   Nomadic отвечает:
   Дата + время – DATE.
   Только дата – TODAY.
   Только время – DATE-TODAY.

После снесения через родной uninstall Interbase Server 5.0 для Windows и желания поставить 5.1.1 вылетает ошибка: IBCheck. Что делать?

   Nomadic отвечает:
   Решение найдено. Прочитай сам и передай товарищу:
   Надо запустить regedit, и открыть ключ
   HKEY_LOCAL_MACHINE\Environment
   Там есть строка PATH. Так вот иногда она почему-то становится не строкой, а еще чем-то. Ее надо убить, и пересоздать как строку, прописав туда прежнее содержимое (в виде строки).

При попытке регистрации UDF возникает ошибка (udf not defined). Что не так?

   Nomadic отвечает:
   Располагайте DLL в каталоге Interbase/Bin, или в одном из каталогов, в которых ОС обязательно будет произведен поиск этой библиотеки (для Windows это %SystemRoot% и %Path%);
   При декларировании функции не следует указывать расширение модуля (в Windows по умолчанию DLL):
   declare external function f_SubStr
   cstring(254), integer, integer
   returns
   cstring(254)
   entry_point "Substr" module_name "UDF1"
   Где UDF1 – UDF1.DLL.

Как заставить Interbase принять COLLATE PXW_CYRL по умолчанию?

   Nomadic отвечает:
   (Это очень полезно при прямой работе с IB из различного CASE-инструментария, типа PowerDesigner или ErWIN)
   Чтобы не писать каждый раз COLLATE, я сделал следующее:
   1. Создал сохранённую процедуру
   create procedure fix_character_sets
   as
   begin
   update
   rdb$character_sets
   set
   rdb$default_collate_name = 'PXW_CYRL'
   where rdb$character_set_name = 'WIN1251'
   and
   rdb$default_collate_name = 'WIN1251'
   ;
   end
   2. Запустил ее один раз.
   3. Создаю таблицы без указания COLLATE.
   4. После восстановления из архива, запускаю еще раз.

ODBC

Добавление ODBC-драйверов в Delphi 3

   Минимальные требования, необходимые для установки драйвера ODBC в Delphi 3.0, заключаются в наличии следующих компонентов:
   Microsoft ODBC Manager
   Windows 95 или NT
   Delphi версии Developer или Client/Server
   Поставляемый производителем драйвер ODBC (уже установленный в вашей системе)
   При использовании Delphi 3.0 есть два общих метода добавления ODBC драйверов к BDE. Первым шагом при использовании любого из методов является установка постовляемого производителем драйвера ODBC в вашу систему. После этого достаточно сложного шага остальные шаги будут не такими сложными. В левой панели менеджера BDE расположен список драйверов и источников данных, которые прежде были ориентированы на использование с приложениями BDE.

Метод A:

   1. Для начала запустите из меню Windows Start BDE Administrator (он должен располагаться в папке Delphi 3.0.)
   2. Теперь в главном меню выберите пункт Object|ODBC administrator. (будет показан спискок установленных в настоящий момент драйверов.)
   3. Нажмите Add, выберите ODBC драйвер, для которого вы хотели бы создать источник данных, и нажмите на OK.
   4. Затем заполните необходимую для вашего драйвера информацию. (Минимальная конфигурация требует заполнения поля Data Source Name. Вам необходимо будет заполнить по крайней мере еще одно поле, описывающее месторасположение данных. В случае таблиц Paradox и dBase это будет поле «Path» (путь), или поле «Server» (сервер) в случае конфигурирования драйвера ODBC для Interbase ODBC. Если вы используете Interbase, вы должны указать путь к файлу .GDB, если вы пользуетесь файлами Paradox или dBASE, вы должны определить месторасположение каталога с таблицами, и, наконец, если вы используете Oracle, вы указать строку, расположенную в вашем файле TNSNAMES.ORA. После того как вы это сделаете, можно считать, что виртуальный драйвер вами создан, и вы можете получить доступ к вашим файлам с базами данных через созданный вами источник данных.)

Метод B:

   1. Для начала запустите из меню Windows Start BDE Administrator (он должен располагаться в папке Delphi 3.0.)
   2. Щелкните на закладке database, затем правой кнопкой мыши на левой панели.
   3. Щелкните в контекстном меню на пункте New, выберите тип ODBC драйвера, который вы хотите добавить, и нажмите на кнопку OK.
   4. Снова щелкните правой кнопкой на панели database, и в появившемся контекстном меню выберите Apply.
   5. Теперь на панели definition вы должны выбрать правильный ODBC DSN (Data Source Name, имя источника данных) и нажать apply. Оба этих метода заканчиваются способностью Delphi с помощью TDataset перехватывать живые данные.
   Вы, возможно, обратили внимание на новые опции в меню Object|Options, эти опции позволяют вам выбирать для просмотра различные режимы конфигурации. Желательно в панели View в группе Select Configuration Modes включить (отметить галочками) все выключатели. При всех включенных checkbox-ах вы получите в свое распоряжение расширенный список всех драйверов и псевдонимов, доступных вам для использования. Если галочка напротив ‘virtual’ отсутствует, вы не сможете увидеть драйверы, добавленные через менеджер MS ODBC, а увидете драйверы, установленный только с помощью BDE (в соответствии с методом 2).

Oracle

Связь Oracle с Win95

   Оптимизация связи Oracle с Windows 95
   Предварительные условия:
   • Windows 95
   • Установленное клиентское программное обеспечение для доступа к Oracle & программа для соединения с Oracle Server через TCP/IP.
   • (Опционально) Программное обеспечение Delphi 2.0 C/S для тестирования результатов.
   Цель документа:
   помочь увеличить скорость соединения Oracle под Windows 95. Под WinNT такая проблема не стоит, следовательно, данный документ рассматривает только работу с Windows 95. Ниже вы видите разницу в скорости выполнения запроса, выполненного до модификации, и после:
   До : Win95 = 10-15 секунд. WinNT = 2-3 секунд.
   После : Win95 = 3-4 секунд. (Большое улучшение)
   Проблема: Windows 95 в сущности ищет адреса IPC в нескольких сетевых узлах ДО получения соединения с Oracle DNS, WinNT же поступает по другому.
   Решение: Измените файл Oracle SQLNET.ORA для выключения вышеуказанной характеристики Windows 95.
   Решение шаг-за-шагом:
   1. Откройте в Notepad или Write файл SQLNET.ORA. (Данный файл расположен в каталоге <ORA_HOME>\network\admin. Проигнорируйте любые другие разновидности этого файла)
   Данный файл должен выглядеть примерно следующим образом:
   ################
   # Filename......: sqlnet.ora
   # Node..........: local.world
   # Date..........: 24-MAY-94 13:23:20
   ################
   TRACE_LEVEL_CLIENT = OFF
   sqlnet.expire_time = 15
   names.default_domain = borland.world
   name.default_zone = borland.world
   Добавьте следующий параметр в файл SQLNET.ORA:
   AUTOMATIC_IPC = OFF
   После изменений файл должен выглядеть примерно так:
   ################
   # Filename......: sqlnet.ora
   # Node..........: local.world
   # Date..........: 24-MAY-94 13:23:20
   ################
   AUTOMATIC_IPC = OFF
   TRACE_LEVEL_CLIENT = OFF
   sqlnet.expire_time = 15
   names.default_domain = borland.world
   name.default_zone = borland.world
   Сохраните измененный файл SQLNET.ORA и ура! В дальнейшем при инициализации соединения с Oracle время соединения вместо 15 секунд составит всего лишь 3 секунды. Скорость работы Delphi существенно увеличится.

Возникла необходимость в обработке исключительных ситуаций в PL/SQL процедуре (Oracle7 WG Server Release 7.3.2.2.0). Почему у меня не получается?

   Nomadic отвечает:
   Объявить выборку SELECT * FROM CUSTOM.CAMAIN20TEMP WHERE CC_07_01=curCC_07_01 AND CC_07_02=curCC_07_02 AND CC_07_03=curCC_07_03 курсором, а потом примерно так:
   loop
   fetch_cursor;
   выход когда фетчить больше нечего;
   begin
   INSERT INTO CUSTOM.CAMAIN20 чего нафетчили;
   EXCEPTION
   WHEN others THEN
   BEGIN
   DBMS_OUTPUT.PUT_LINE('ВВОД ДУБЛЯ В CUSTOM.CAMAIN20');
   END
   end
   end loop;

Поясните, чем в Oracle являются понятия Instance, Database etc.?

   Nomadic отвечает:
   Перевод документации:
   Что такое ORACLE Database?
   Это данные которые будут обрабатываться как единое целое. Database состоит из файлов операционной системы. Физически существуют database files и redo log files. Логически database files содержат словари, таблицы пользователей и redo log файлы. Дополнительно database требует одну или более копий control file.
   Что такое ORACLE Instance?
   ORACLE Instance обеспечивает программные механизмы доступа и управления database. Instance может быть запущен независимо от любой database (без монтирования или открытия любой database). Один instance может открыть только одну database. В то время как одна database может быть открыта несколькими Instance.
   Instance состоит из:
   SGA (System Global Area), которая обеспечивает коммуникацию между процессами;
   до пяти (в последних версиях больше) бэкграундовых процессов.
   От себя добавлю – database включает в себя tablespace, tablespace включает в себя segments (в одном файле данных может быть один или несколько сегментов, сегменты не могут быть разделены на несколько файлов). segments включают в себя extents.

Как заставить Oracle анализировать все таблицы базы данных?

   Nomadic отвечает:
   Конечно, можно использовать DBMS_SQL, DBMS_JOB…
   А можно и так:
   #!/bin/sh
   #
   # Analyze all tables
   #
   SQLFILE=/tmp/analyze.sql LOGFILE=/tmp/analyze.log
   echo @connect dbo/passwd@> $SQLFILE
   $ORACLE_HOME/bin/svrmgrl <> $SQLFILE
   connect dbo/passwd
   SELECT 'TABLE', TABLE_NAME FROM all_tables WHERE owner = 'DBO';
   EOF
   echo exit>> $SQLFILE
   cat $SQLFILE> $LOGFILE
   cat $SQLFILE | $ORACLE_HOME/bin/svrmgrl>> $LOGFILE
   cat $LOGFILE | /usr/bin/mailx –s 'Analyze tables' tlk@nbd.kis.ru
   rm $SQLFILE rm $LOGFILE

В режиме отладки приложения не разрешается доступ (открытие) базы данных. Как лечить?

   Nomadic отвечает:
   Необходимо отключить (деинсталлировать через Oracle Installer) Trace Service на клиенте – совет от ORACLE.
   Глюк имеет место быть только под Windows NT 4.xx.

Подскажите, как на Oracle 7.3.2.3 (Solaris x86) поменять compatible на 7.3.2.3 (c 7.1.0.0)?

   Nomadic отвечает:
   Ставить в initmybase.ora
   compatible = "7.3.2.3"
   и после старта с новым параметром сделать
   ALTER DATABASE RESET COMPABILITY;
   И рестартовать базу.

Как настроить Personal Oracle с русским языком на корректную работу с числами и BDE?

   Nomadic отвечает:
   прописать в \HKEY_LOCAL_MACHINE\SOFTWARE\ORACLE параметр:
   NLS_NUMERIC_CHARACTERS = '.,'
   или
   после соединения с ORACLE выполнить
   ALTER SESSION SET NLS_NUMERIC_CHARACTERS = '.,'

Как в Oracle создать sequence с некоторого номера?

Nomadic отвечает:
create sequence minvalue 10;

Как решать некоторые вопросы при подключении к Oracle?

Nomadic отвечает:

Чтобы «увидеть» integer-поля нужно в настройке Alias'а Oracle в BDE установить Enable Integers→True (и напрочь будет потерян Locate по этим якобы int/smallint полям). С датами, возможно, тоже надо разбираться через настройки Win & Oracle. У меня в Win дата формата «дд.мм.гггг», в Oracle NLS_LANG→AMERICAN_AMERICA.CL8MSWIN1251 и с датами все гут.

   Oracle в данном случае не при чем. Это глюк BDE. Лечилось просто – вместо обрамления двойными кавычками строкового значения, нужно обрамлять его с помощью #39, примерно так
   MySQLString := 'SELECT XX FROM YY WHERE XX='+#39+'QQQ'+#39;
   Belsky Roman
   (2:450/94.75)

   Клиент у тебя NT, как я понял?
   • ora7x.dll – 32bit клиент для win95
   • orant7x.dll – 32bit клиент для NT
   • ora7xwin.dll – 16bit клиент для win
   т.е. ora7xwin в Delphi3 вообще ставить бесполезно (16bit для 32bit appl). ora*71.dll у меня изначально к ORACLE 7.2 не коннектился – они там как-то резко сменили OCI. Правда потом ora72win.dll с Personal Oracle 7.3 работал, но все равно лучше, наверное, чтобы номер версии dll был не ниже версии сервера.
   А вообще я 32bit дельфях в Vendor Init давно прописываю OCIW32.dll – он всегда для последней версии сервера с которым ты работаешь.
   Это IMHO. Hо у меня Delphi3 и Delphi1 коннектятся как с Oracle 7.1 на Unix'е, так и с Personal Oracle 7.3

WindowsNT 4.0 + Delphi 2.01 C/S + Oracle Client 7.3 + Oracle Server 7.3. После логина в базу данных возникает `EExternalError 0xC0000008`. Что делать?

Nomadic коротко отвечает:
A: (IA, SK): Снести Oracle Trace Collection Services.

Псевдонимы

Получение пути псевдонима и таблицы I

   Есть три способа сделать это… №1 годится только для постоянных псевдонимов BDE. №2 работает с BDE и локальными псевдонимами, и No3 работает с BDE и локальными псевдонимами, используя "тяжелый" путь, через вызовы DBI.
   function GetDBPath1(AliasName: string): TFileName;
   var ParamList: TStringList;
   begin
    ParamList := TStringList.Create;
    with Session do try
     GetAliasParams(AliasName,ParamList);
     Result := UpperCase(ParamList.Values['PATH'])+'\';
    finally
     Paramlist.Free;
    end;
   end;

   function GetDBPath2(AliasName: string): TFileName;
   var
    ParamList: TStringList;
    i: integer;
   begin
    ParamList := TStringList.Create;
    with Session do try
     try
      GetAliasParams(AliasName,ParamList);
     except
      for i:=0 to pred(DatabaseCount) do
      if (Databases[i].DatabaseName = AliasName) then
        ParamList.Assign(Databases[i].Params);
     end;
     Result := UpperCase(ParamList.Values['PATH'])+'\';
    finally
     Paramlist.Free;
    end;
   end;

   function GetDBPath3(ATable: TTable): TFileName;
   var
    TblProps: CURProps;
    pTblName, pFullName: DBITblName;
   begin
    with ATable do begin
     AnsiToNative(Locale, TableName, pTblName, 255);
     Check(DBIGetCursorProps(Handle, TblProps));
     Check(DBIFormFullName(DBHandle,pTblName,TblProps.szTableType,pFullName));
     Result := ExtractFilePath(StrPas(pFullName));
    end;
   end;
    Reinhard Kalinke

Получение пути псевдонима и таблицы II

   Вот маленький примерчик того, как в Delphi можно получить информацию о псевдонимах. Для начала создайте новый проект с ListBox и тремя метками (с именамиListBox1, Label1, Label2 и Label3). Затем создайте обработчик события формы OnCreate с примерно следующим кодом:
   procedure TForm1.FormCreate(Sender: TObject);
   begin
    Session.GetAliasNames(ListBox1.Items);
   end;
   Теперь создайте обработчик OnClick для ListBox:
   procedure TForm1.ListBox1Click(Sender: TObject);
   var
    tStr: array[0..100] of char;
    Desc: DBDesc;
   begin
    if ListBox1.Items.Count = 0 then exit;
    StrPLCopy(tStr, ListBox1.Items.Strings[ListBox1.ItemIndex], High(tStr));
    DbiGetDatabaseDesc(tStr, @Desc);
    with Desc do begin
     Label1.Caption := StrPas(Desc.szName);
     Label2.Caption := StrPas(Desc.szPhyName);
     Label3.Caption := StrPas(Desc.szDbType);
    end;
   end;
   Добавьте следующие модули в секцию 'uses' в верхней части модуля:
   DB, DBTables, DBITypes, DBIProcs;
   Теперь вы можете увидеть путь для всех ваших стандартных псевдонимов (Paradox и dBase).

Получение пути псевдонима и таблицы III

   Используйте Session.GetAliasParams. В ответ вы получите объект Tstrings, откуда вы можете получить значение для переменной 'PATH". Для получения дополнительной информации обратитесь к электронной справке к разделу, описывающему TSession. Объект Session объявлен в модуле DB.
   uses db;
   var aliaspath : string[128];
   begin
    aliaspath := Session.GetAliasParams['MyAlias'].values['PATH'];
   end;

   uses SysUtils,DbiProcs, DBiTypes;
   ...

   function GetDataBaseDir(const Alias : string): String;
   (* Возвращает каталог базы данных, на которую
   ссылается псевдним (без конечного обратного слеша) *)
   var
    sp : PChar;
    Res : pDBDesc;
   begin
    try
     New(Res);
     sp := StrAlloc(length(Alias)+1);
     StrPCopy(sp,Alias);
     if DbiGetDatabaseDesc(sp,Res) = 0 then Result := StrPas(Res^.szPhyName)
     else Result := '';
    finally
     StrDispose(sp);
     Dispose(Res);
    end;
   end;

Получение пути псевдонима и таблицы IV

   Nomadic советует:
   1. По таблице (фактически по Database) получить физическое местонахождение.
   Примечание: Database можно создать явно, если нет, Дельфи сама его создаст, доступ к ней по Table(Query).Database
   uses DbiProcs;
   function GetDirByDatabase(Database: TDatabase): string;
   var pszDir: PChar;
   begin
    pszDir := StrAlloc(255);
    try
     DbiGetDirectory(Database.Handle, True, pszDir);
     Result := StrPas(pszDir);
    finally
     StrDispose(pszDir);
    end;
   end;
   2. По алиасу.
   function GetPhNameByAlias(sAlias: string): string;
   var
    Database: TDatabase;
    pszDir: PChar;
   begin
    Database := TDatabase.Create(nil); {allocate memory}
    pszDir := StrAlloc(255);
    try
     Database.AliasName := sAlias;
     Database.DatabaseName := 'TEMP'; {requires a name – is ignored}
     Database.Connected := True; {connect without opening any table}
     DbiGetDirectory(Database.Handle, True, pszDir); {get the dir.}
     Database.Connected := False; {disconnect}
     Result := StrPas(pszDir); {convert to a string}
    finally
     Database.Free; {free memory}
     StrDispose(pszDir);
    end;
   end;

Информация о псевдониме BDE

   var MyAliasPath: string;
   const AliasName='MyAlias';
   {**** Получаем из BDE путь MyAlias}
   ParamsList:= TStringList.Create;
   try
    with Session do begin
     Session.GetAliasNames(ParamsList);
     Session.GetAliasParams(AliasName,ParamsList);
     MyAliasPath:=Copy(ParamsList[0],6,50)+'\';
    end;
   finally
    ParamsList.Free;
   end;

   uses DbiProcs, DBiTypes;
   function GetDataBaseDir(const Alias : string): String;
    (* Возвращает каталог базы данных для псевдонима
      (без завершающего обратного слеша) *)
   var
    sp : PChar;
    Res : pDBDesc;
   begin
    try
     New(Res);
     sp := StrAlloc(length(Alias)+1);
     StrPCopy(sp,Alias);
     if DbiGetDatabaseDesc(sp,Res) = 0 then Result := StrPas(Res^.szPhyName)
     else Result:= '';
    finally
     StrDispose(sp);
     Dispose(Res);
    end;
   end;

Изменение каталога псевдонима во время выполнения приложения

   Я делаю это все время. У меня есть INI-файл, который сообщает, где можно найти таблицы и каталоги их расположения. Вот как я это делаю:
   procedure CheckTable(var Table : TTable; var TName : string);
   var
    ChangePath: boolean;
    Path: string;
    ActiveState: Boolean;
   begin
    if (TName = '') then TName := Table.TableName
    else with Table do begin
     ActiveState := Active;
     Close;
     Path := ExtractFilePath(TName);
     ChangePath := HasAttr(DatabaseName, faDirectory) or (CompareText(DatabaseName, Path) <> 0);
     if (Length(Path) > 0) and ChangePath then DatabaseName := Path;
     if (CompareText(ExtractFileName(Tname), TableName) <> 0) then TableName := ExtractFileName(Tname);
     Active := ActiveState;
    end;
   end;

Псевдоним на лету

   Попробуйте это:
   type TDataMod = class(TDataModule)
    Database: TDatabase;
   public
    procedure TempAlias(NewAlias, NewDir: String);
   end;

   procedure TDataMod.TempAlias(NewAlias, NewDir: String);
   begin

    with Session do if not IsAlias(NewAlias) then begin
     ConfigMode := cmSession; (* NewAlias будет ВРЕМЕННЫМ *)
     try
     AddStandardAlias(NewAlias, NewDir, 'PARADOX');
      Database.Close;
      Database.AliasName := NewAlias;
      Database.Open;
     finally
     ConfigMode := cmAll;
     end;
    end;
   end;
   Комментарии:
   a) Поместите компонент Database на форму DataModule;
   b) Задайте свойству DatabaseName имя базы данных, например, 'TempDB';
   c) Задайте свойству DatabaseName компонента TTable значение = 'TempDB'
   d) Для получения дополнительной информации ознакомьтесь с примером MastApp, поставляемым вместе с D2.

Псевдонимы

   Попробуйте следующий код:
   var
    theStrList : TStringList;
    GPath      : String;
   begin
    theStrList := TStringList.Create;

    {Используем GetAliasParams для получения псевдонимов и ассоциированных с ними путей}
    Session.GetAliasParams(<Здесь псевдоним из выпадающего списка>,theStrList);

    {Удаляем первые шесть символов, которые всегда равны «PATH="}
    GPath := copy(theStrList[0],6,length(theStrList[0]))

    theStrList.Free;

Ошибки

Ошибка BDE32 $2104

   Пример, приведенный для функции dbiGetDatabaseDesc в файле BDE32.HLP, неверен. Такой же пример содержится в файле TI3100.ASC. Я пробовал это на 3 разных компьютерах. Я использую среду Delphi. Ошибка, которую я получаю при попытке использования функции, выглядит следующим образом:
   EDBEngineError с сообщением 'Возникла ошибка при попытке инициализации Borland Database Engine (ошибка $2104).'
   При вызове любой из функций BDE, если вы не пользуетесь компонентами для работы с базами данных, вам необходимо инициализировать BDE вызовом dbiInit(nil).
   Pat Ritchey

Проблема BDE при использовании "неживого" TQuery

У меня была та же проблема, и я нашел единственное решение как ее обойти. Я подозреваю, что причина кроется в том, что Query1.Refresh ничего не делает, если установлен режим readonly, т.е. не ожидается никаких изменений. Один способ у меня прошел успешно (в предположении, что мы имеем один вход): я использовал 3 TQuerie, две сетки и форму обновления. Это способ, когда я могу установить requestlive в истину. Вы не должны допускать, чтобы пользователь мог сам редактировать табличную сетку (если это то, что вы хотите).

Ошибка ApplyApdates

   Делаем ApplyUpdates. Если при insert(update) произошла ошибка (поле null, сработал check, etc.), то BDE всегда говорит "General SQL Error" вместо нормального сообщения об ошибке :-( Без CU все нормально, разумеется. Как бороть этот баг?
   Nomadic советует:
   Использyй нормальнyю трансляцию ошибок в Application.OnException. Вpоде это.
   procedure DBExceptionTranslate(E: EDBEngineError);

   function OriginalMessage: String;
   var
    I: Integer;
    DBErr: TDBError;
    S: String;
   begin
    Result := '';
    for I := 0 to E.ErrorCount - 1 do begin
     DBErr := E.Errors[I];
     case DBErr.NativeError of
     -836: { Intebase exception }
     begin
      S := DBErr.Message;
      Result := #13#10 + Copy(S, Pos(#10, S) + 1, Length(S));
      Exit;
     end;
    end;
    S := Trim(DBErr.Message);
    if S <> '' then Result := Result + #13#10 + S;
   end;
   end;

   begin
    case E.Errors[0].ErrorCode of
    $2204:
     E.Message := LoadStr(SKeyDeleted);
    $271E,$2734:
     E.Message := LoadStr(SInvalidUserName);
    $2815:
     E.Message := LoadStr(SDeadlock);
    $2601:
     E.Message := LoadStr(SKeyViol);
    $2604:
     E.Message := LoadStr(SFKViolation) + OriginalMessage;
    else begin
     E.Message := Format(LoadStr(SErrorCodeFmt), [E.Errors[0].ErrorCode]) + OriginalMessage;
    end;
   end;
   end;

Ошибка создания дескриптора курсора

   Вы должны использовать ExecSql вместо Open. К примеру, если имя вашего запроса UpdateStudent, то при необходимости обновления STUDENT.DB вы должны использовать следующий код:
   Begin
    …
    UpdateStudent.ExecSql;
    …
   End;
   Ваш запрос является Passtrough-запросом, который не может возвратить установленный результат, так что это не может быть открыто, а должно быть 'ВЫПОЛНЕНО'.

При разрушении обьектов, порожденных от TDataSet (TTable, TQuery), не отрабатывает событие OnBeforeClose. Что делать?

   Nomadic отвечает:
   Недоработка в VCL.
   Сейчас вышел из ситуации так: в TForm.OnClose, т.е. пока ещё все компоненты формы живы, делаю CloseDatabases(Self).

При обращении к memo-полю из BDE возникает ошибка 'Memo too large'. Как лечить?

   Nomadic отвечает:
   В BDE есть крутая ошибка, достаточно известная всем, кроме Borland'a. Поскольку они ее еще с 1й Delphi не исправили. Этот баг проявляется как Access Violation в программе при обращении к таблице IB, которая содержит более одного поля типа VARCHAR (или CHAR) размером>255. Причем, первое поле меньшего, а второе большего размера. Если поменять местами поля или сделать их одного размера, то все нормально.
   Эффект имеет место только с IB, вроде.

Нарушение уникальности записи

   try
    tMyTable.Post;
   except
    on E : EDBEngineError do if E.Message = 'Key violation' then begin
     MessageDlgC('Дублирование записи не допускается.' mtError, [mbOk], 0);
     // Я не уверен в том, что это нужно делать:
     tMyTable.Cancel;
    end
    else Raise;
   end;
   Хорошим примером может служить проект DBERRORS.DPR, расположенный в каталоге Delphi 2 Demos. Выглядит это примерно так:
   Создайте функцию типа этой:
   function DBError(DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction);
   const eKeyViol = 9729;
   var iDBIError: Integer;
   begin
    if (E is EDBEngineError) then begin
     iDBIError := (E as EDBEngineError).Errors[0].Errorcode;
     case iDBIError of
     eKeyViol:
      begin
       MessageDlg('Нарушение уникальности записи ', mtWarning, [mbOK], 0);
       Abort;
      end;
     end;
   Затем для каждой таблицы вашего приложения создайте следующий обработчик события:
   procedure TMainForm.Table1EditError(DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction);
   begin
    DBError(Table1, E, Action);
   end;
   Таким образом вы можете перехватить множество ошибок. Смотрите примеры от Borland, там много чего есть полезного.

При выполнении некоторых живых запросов, возвращающих единственную запись, BDE ругается 'multiple records found, but only one was expected'. Как лечить?

   Nomadic отвечает:
   Запросы вида SELECT c, b, a, q FROM T WHERE b = :b, где ключ c, но BDE посчитала ключом a. Интересный запрос, да? Такое впечатление, что, поскольку ключом в исходной таблице являлась третья колонка, то Дельфы посчитали ключом третью колонку.
   Перестановкой SELECT a, b, c, q… все исправилось. Я решил теперь использовать в таких (live) запросах только SELECT *.

Как поймать свой RAISEERROR в Delphi?

   Nomadic отвечает:
   procedure TFDMUtils.GeneralError( DataSet: TDataSet; E: EDatabaseError; var Action: TDataAction);
   var
    i: Word;
    ExtInfo : String;
   begin
    ExtInfo := '';
    if (E is EDBEngineError) then begin
     if (EDBEngineError(E).Errors[0].NativeError = 0) then begin // Local Error
      if EDBEngineError(E).Errors[0].Errorcode = 9732 then
       ExtInfo := DataSet.FieldByName(trim(copy(E.Message, 29, 20))).DisplayLabel;
      .......................................
     end
     else begin // Remote SQL Server error
      ExtInfo := ExtractFieldLabels(DataSet, E.Message);
      case EDBEngineError( E ).Errors[0].NativeError of
      233, 515:
       Alert('Ошибка', 'Hе все поля заполнены ! ' + ExtInfo);
      547:
       if (StrPos(PChar(E.Message), PChar('DELETE')) <> nil) then
        Alert('Ошибка пpи удалении', 'Имеются подчиненные записи, удаление (изменение) невозможно! ' + ExtInfo)
       else if (StrPos(PChar(E.Message), PChar('INSERT')) <> nil) then
        Alert('Ошибка пpи вставке', 'Отсутствует запись в МАСТЕР-таблице!' + ExtInfo)
       else if (StrPos(PChar(E.Message), PChar('UPDATE')) <> nil) then
        Alert('Ошибка пpи обновлении', 'Отсутствует запись в МАСТЕР-таблице! ' + ExtInfo);
      2601:
       Alert('Ошибка', 'Такая запись уже есть!');
      else
       Alert('Ошибка', 'Hеизвестная ошибка, код – ' + inttostr(EDBEngineError(E).Errors[0].NativeError) + ExtInfo);
      end;
     end;
    end;
   end;
   Этот код был заточен под MSSQL, но не нужно пытаться его использовать, а лучше по этому пpимеpу написать свою процедуру.

Как добиться верной работы фильтра на запросах и на неиндексированных таблицах?

   Nomadic отвечает:
   (Т.е. при работе программы наблюдалась следующая картина: в результате очередной фильтрации оставалось видно 4 записи из восьми. Добавляем букву к фильтру, остается, допустим, две. Убираем букву, которую только что добавили, в гриде все равно видно только две записи)
   Эта проблема была в Delphi 3.0 только на TQuery, а в Delphi 3.01 появилась и в TTable.
   Лечится так (простой пример):
   procedure TMainForm.Edit1Change(Sender: TObject);
   begin
    if length(Edit1.Text) > 0 then begin
     Table1.Filtered := TRUE;
     UpdateFilter(Table1);
    end
    else Table1.Filtered := FALSE;
   end;

   procedure TMainForm.UpdateFilter(DataSet: TDataSet);
   var FR: TFilterRecordEvent;
   begin
    with DataSet do begin
     FR := OnFilterRecord;
     if Assigned(FR) and Active then begin
      DisableControls;
     try
      OnFilterRecord := nil;
       OnFilterRecord := FR;
      finally
       EnableControls;
      end;
     end;
    end;
   end;

Как бы мне соорудить в SP исключение, чтобы его увидел Delphi-клиент?

   Nomadic отвечает:
   sqlstate='99999' не подходит, так как хочется на клиенте видеть код исключения.
   Используй RAISERROR с кодом >20000. Если еще при этом научишься без потерь передавать на Delphi-клиента русские ругательства, то скажи мне как ты этого добился :).

Когда я применяю ApplyUpdates на ClientDataSet, на серверной стороне не срабатывает событие OnNewRecord для оригинального набора данных. Как это исправить?

   Nomadic отвечает:
   Никак. Эти обновления идут прямо через BDE, а не через компонент набора данных.
   В Delphi 4.0 (C++Builder 4.0) ситуация радикально изменилась.
   Во-первых, обычному провайдеру данных (TProvider) можно указать, каким образом обновлять данные.
   Во-вторых, новый тип провайдера (TDataSetProvider) работает только через соответвующие методы TDataSet.
   То есть – все события при данных условиях на сервере будут отрабатываться обычным образом.
   Если же Вы пользуетесь более старой версией Delphi, то, как обычно, можно посоветовать использование хранимых процедур, в данном контексте это будут методы сервера приложений. К сожалению, совет неприемлем для транспорта Sockets.

SQL

Функции дат в SQL

   Тема: Функции дат в SQL
   Кто-нибудь знает как «вытащить» месяц или год из datetime-поля с помощью SQL? Я знаю, что QBE этого не может. SQL в состоянии это сделать?
   Как насчет функции EXTRACT?
   SELECT SALEDATE,
    EXTRACT(DAY FROM SALEDATE) AS DD,
    EXTRACT(MONTH FROM SALEDATE) AS MM,
    EXTRACT(YEAR FROM SALEDATE) AS YY
   FROM ORDERS
   Steve Koterski

Зарезервированные слова Local SQL

   Ниже приведен список в алфавитном порядке слов, зарезервированных Local SQL в Borland Database Engine. Имейте в виду, что данный совет публикуется «как есть».
   ACTIVE, ADD, ALL, AFTER, ALTER, AND, ANY, AS, ASC, ASCENDING, AT, AUTO, AUTOINC, AVG
   BASE_NAME, BEFORE, BEGIN, BETWEEN, BLOB, BOOLEAN, BOTH, BY, BYTES
   CACHE, CAST, CHAR, CHARACTER, CHECK, CHECK_POINT_LENGTH, COLLATE, COLUMN, COMMIT, COMMITTED, COMPUTED, CONDITIONAL, CONSTRAINT, CONTAINING, COUNT, CREATE, CSTRING, CURRENT, CURSOR
   DATABASE, DATE, DAY, DEBUG, DEC, DECIMAL, DECLARE, DEFAULT, DELETE, DESC, DESCENDING, DISTINCT, DO, DOMAIN, DOUBLE, DROP
   ELSE, END, ENTRY_POINT, ESCAPE, EXCEPTION, EXECUTE, EXISTS, EXIT, EXTERNAL, EXTRACT
   FILE, FILTER, FLOAT, FOR, FOREIGN, FROM, FULL, FUNCTION
   GDSCODE, GENERATOR, GEN_ID, GRANT, GROUP, GROUP_COMMIT_WAIT_TIME
   HAVING, HOUR
   IF, IN, INT, INACTIVE, INDEX, INNER, INPUT_TYPE, INSERT, INTEGER, INTO, IS, ISOLATION
   JOIN
   KEY
   LONG, LENGTH, LOGFILE, LOWER, LEADING, LEFT, LEVEL, LIKE, LOG_BUFFER_SIZE
   MANUAL, MAX, MAXIMUM_SEGMENT, MERGE, MESSAGE, MIN, MINUTE, MODULE_NAME, MONEY, MONTH
   NAMES, NATIONAL, NATURAL, NCHAR, NO, NOT, NULL, NUM_LOG_BUFFERS, NUMERIC
   OF, ON, ONLY, OPTION, OR, ORDER, OUTER, OUTPUT_TYPE, OVERFLOW
   PAGE_SIZE, PAGE, PAGES, PARAMETER, PASSWORD, PLAN, POSITION, POST_EVENT, PRECISION, PROCEDURE, PROTECTED, PRIMARY, PRIVILEGES
   RAW_PARTITIONS, RDB$DB_KEY, READ, REAL, RECORD_VERSION, REFERENCES, RESERV, RESERVING, RETAIN, RETURNING_VALUES, RETURNS, REVOKE, RIGHT, ROLLBACK
   SECOND, SEGMENT, SELECT, SET, SHARED, SHADOW, SCHEMA, SINGULAR, SIZE, SMALLINT, SNAPSHOT, SOME, SORT, SQLCODE, STABILITY, STARTING, STARTS, STATISTICS, SUB_TYPE, SUBSTRING, SUM, SUSPEND
   TABLE, THEN, TIME, TIMESTAMP, TIMEZONE_HOUR, TIMEZONE_MINUTE, TO, TRAILING, TRANSACTION, TRIGGER, TRIM
   UNCOMMITTED, UNION, UNIQUE, UPDATE, UPPER, USER
   VALUE, VALUES, VARCHAR, VARIABLE, VARYING, VIEW
   WAIT, WHEN, WHERE, WHILE, WITH, WORK, WRITE
   YEAR
   Операторы:
   ||, –, *, /, <>, <, >, ,(запятая), =, <=, >=, ~=, !=, ^=, (, )

Сиротские Master-записи

   Как с помощью SQL найти записи таблицы, которых нет в другой таблице?
   Вот пример:
   with PeopleHiddenForm.PersonQuery.SQL do begin
    Add('Select P.Last, P.First, P.Middle, P."Suffix", P.KeyNo, COUNT(PersMemL.PersonKeyNo)');
    Add('From   Person P Left Outer Join ');
    Add('       PersMemL PersMemL');
    Add('On     ((P.KeyNo = PersMemL.PersonKeyNo))');
    Add('Group By P.Last, P.First, P.Middle, P.Suffix, P.KeyNo');
    Add('Having ((Count(PersmemL.PersonKeyNo) = 0))');
   Данный код позволяет связаться с таблицей (PersMemL), содержащей количество ключей персональной записи и запись членства. Запрос возвращает имена персон, которые не имеют записей членства.
   На практике этот способ оказывается очень эффективным, по крайней мере, с локальным SQL в таблицах Paradox.
   David G. Wachtel

Назначение SQL-счетчика переменной

   query.Close;
   query.SQL.Clear;
   query.SQL.Add('select count(*) from table where field = :XXX');
   Query.ParamByName('XXX').AsString := value;
   query.Open;
   while Query.Eof <> True do begin
    SqlCount := Query.Fields[0].AsInteger;
    Query.Next
   end;
   Подразумевается наличие компонентов TTable, TQuery, TStoredProc
   Объявление
   property RecordCount: Longint;
   Описание
   Времени исполнения и только для чтения. Свойство RecordCount определяет количество записей в наборе данных. Количество возвращаемых записей может зависеть от сервера и не зависит от границ задаваемого диапазона.

Как удобнее работать с динамически формируемыми запросами?

   Nomadic советует:
   В процессе работы с БД иногда необходимо выполнить какие-то мелкие запросы. Держать для этого где-то временную Query меня лично ломает, посему ловите творение (под Delphi) — модуль для создания временных TQuery и работы с ними.
   примеры использования:
   var S: string;
   …
   S := FastLookUp(format('select A.F1 from A,B where A.F4=B.F4 and B.F9=%d', [1]));
   with GiveMeResultSet( 'select*from A where F1="777"' ) do try
    ……
   finally
    Free; {не забудьте!}
   end;
   …
   if NOT ExecuteSQL('delete from A') then ShowMessage('Something Wrong');
   ……
   Сам модуль идёт ниже —
   {
    Temporary Queries Creatin' and handlin'
    (c) 1997-98 by Volok Alexander (D1/D2)
    creation date: 30.10.1997
    last update : 17.06.1998
   }
   unit TmpQuery;

   interface

   uses DBTables;

   const InternalDBname = 'MAIN'; {Изменять по вкусу - TDataBase.DataBaseName}

   type TSQLScript = {$IFDEF WIN32} string {$ELSE} PChar {$ENDIF};

   {Создаст куери с текстом запроса, но не откроет его}
   function CreateTempQuery(SQLscript: TSQLscript): TQuery;

   {Создаст куери и откроет запрос - не забудьте прибить}
   function GiveMeResultSET(SQLscript: TSQLscript): TQuery;

   {Проверит непустоту выборки, заданной ...}
   function CheckExistence(SQLscript: TSQLscript): boolean;

   {Вытащит аж одно значение(лукап) из выборки, заданной ...}
   function FastLookUP(SQLscript: TSQLscript): string;

   {Выполнит запрос и сообщит результат}
   function ExecuteSQL(SQLscript: TSQLscript): boolean;

   implementation

   uses Forms;

   function CreateTempQuery(SQLscript: TSQLscript): TQuery;
   begin
    Result:= TQuery.Create(Application);
    with Result do begin
     DatabaseName := InternalDBname;
   {$IFDEF WIN32}
     SQL.Text := SQLscript;
   {$ELSE}
     SQL.SetText(SQLscript);
   {$ENDIF}
    end;
   end;

   function ExecuteSQL(SQLscript: TSQLscript): boolean;
   begin
    with CreateTempQuery(SQLscript) do begin
     try
      ExecSQL;
      Result := True;
     except
      Result := False;
     end;
     Free;
    end;
   end;

   function CheckExistence(SQLscript: TSQLscript): boolean;
   begin
    with GiveMeResultSET(SQLscript) do begin
     Result := NOT EOF;
     Free;
    end;
   end;

   function GiveMeResultSET(SQLscript: TSQLscript): TQuery;
   begin
    Result := CreateTempQuery(SQLscript);
    with Result do try
     Open;
    except
     Free;
     Result:= NIL;
    end;
   end;

   function FastLookUP(SQLscript: TSQLscript): string;
   begin
    with GiveMeResultSET(SQLscript) do begin
     try
      Result:= Fields[0].AsString;
     except
      Result:= '';
     end;
     Free;
    end;
   end;

   end.

Поиск записи в SQL DataSet

   В случае изменения содержимого полей редактирования сделайте следующее:
   Query1.Close;
   Query1.SQL.Clear;
   Query1.SQL.Add('SELECT * FROM <таблица> WHERE <поле> LIKE ''' + SpeedEdit.Text + '*''');
   Query1.Open;
   Будут возвращены все записи, указанные в поле редактирования.

При попытке выполнения такого оператора SQL – 'DELETE from T39 T39C0 WHERE T39C0.F1LHT35=253291661' SQL-сервер ругается на недопустимый синтаксис. В чем я неправ?

   Nomadic отвечает:
   В данном случае, видимо, T39C0 расценивается как псевдоним. Hо стандартом SQL-92 такое запрещено в DELETE.
   Цитата собственно из этого стандарта (сборник из delete и names and identifiers, определение identifier пропущено, просто набор <simple latin letter> | <digit>, начинается с буквы):
   Format <delete statement: positioned>::= delete from <table name> where current of <cursor name>

   <table name> ::= <qualified name> | <qualified local name>
   <qualified name> ::= [<shema name><period>] [<qualified identifier>]
   <qualified identifier> ::=<identifier>
   <shema name>::=[<catalog name><period>]<unqualified shema name>
   <unqualified shema name>::=<identifier>
   <catalog name>::=<identifier>
   <qualified local name>::= MODULE <period><local table name>
   <local table name>::=<qualified identifier>
   Стандартом запрещено вот такое
   select test.a, p_test.a from test p_test;
   вот это не по стандарту, хотя Microsoft SQL Server такое ест.

Поиск с помощью SQL

   Предположим:
   1. если вашей таблицы определены следующие поля…
   last_name char (n),
   first_name char (n)
   то…
   select
    last_name+', '+first_name
   from
    person
   where
    first_name='john'
   2. если вашей таблицы определены следующие поля…
   person_name char (n) (например, Lennon, John)
   то…
   select
    person_name
   from
    person
   where
    person_name like '%John' <--- 'John' должен быть в конце строки, еще используйте '%John%'

Как получить результирующим полем разницу между хранимой датой и текущей датой?

   Nomadic отвечает:
   SELECT CAST((поле_с_датой –"NOW") AS INTEGER) FROM MyBase
   Получишь результат в днях.

SQL и поле даты

   Есть множество способов сделать это:
   1. Если дата константа, используйте:
   WHERE Date = #31/11/95#
   В зависимости от «настроек вашей страны», это могло бы быть и #11/31/95#. Попробуйте оба: один из них работает.
   2. Если дата является переменной, вы должны воспользоваться параметром, например так:
   WHERE Date = :MyDate
   Затем, после нажатия на ok, выберите в Инспекторе Объектов для Query свойство Params, нажмите на кнопку с тремя точками, и установите MyDate как тип Date.
   SELECT * from PFMANUAL WHERE PRMANUAL."DATE" = "31/11/95"
   Я обнаружил это после решения аналогичной проблемы, когда для создания QBE-запроса я использовал DataBase Desktop, а затем «переводил» запрос на SQL.

SQL-запросы в Delphi

1. Введение

Компоненты Delphi для работы с базами данных были созданы в расчете на работу с SQL и архитектурой клиент/сервер. При работе с ними вы можете воспользоваться характеристиками расширенной поддержки удаленных серверов. Delphi осуществляет эту поддержку двумя способами. Во-первых, непосредственные команды из Delphi позволяют разработчику управлять таблицами, устанавливать пределы, удалять, вставлять и редактировать существующие записи. Второй способ заключается в использовании запросов на языке SQL, где строка запроса передается на сервер для ее разбора, оптимизации, выполнения и передачи обратно результатов.
Данный документ делает акцент на втором методе доступа к базам данных, на основе запросов SQL (pass-through). Авторы не стремились создать курсы по изучению синтаксиса языка SQL и его применения, они ставили перед собой цель дать несколько примеров использования компонентов TQuery и TStoredProc. Но чтобы сделать это, необходимо понимать концепцию SQL и знать как работают selects, inserts, updates, views, joins и хранимые процедуры (stored procedures). Документ также вскользь касается вопросов управления транзакциями и соединения с базой данных, но не акцентирует на этом внимание. Итак, приступая к теме, создайте простой запрос типа SELECT и отобразите результаты.

2. Компонент TQuery

Если в ваших приложениях вы собираетесь использовать SQL, то вам непременно придется познакомиться с компонентом TQuery. Компоненты TQuery и TTable наследуются от TDataset. TDataset обеспечивает необходимую функциональность для получения доступа к базам данных. Как таковые, компоненты TQuery и TTable имеют много общих признаков. Для подготовки данных для показа в визуальных компонентах используется все тот же TDatasource. Также, для определения к какому серверу и базе данных необходимо получить доступ, необходимо задать имя псевдонима. Это должно выполняться установкой свойства aliasName объекта TQuery.

Свойство SQL

   Все же TQuery имеет некоторую уникальную функциональность. Например, у TQuery имеется свойство с именем SQL. Свойство SQL используется для хранения SQL-запроса. Ниже приведены основные шаги для составления запроса, где все служащие имеют зарплату свыше $50,000.
   1. Создайте объект TQuery
   2. Задайте псевдоним свойству DatabaseName. (Данный пример использует псевдоним IBLOCAL, связанный с демонстрационной базой данных employee.gdb).
   3. Выберите свойство SQL и щелкните на кнопке с текстом - '…' (три точки, Инспектор Объектов — В.О.). Должен появиться диалог редактора списка строк (String List Editor).
   4. Введите: Select * from EMPLOYEE where SALARY>50000. Нажмите OK.
   5. Выберите в Инспекторе Объектов свойство Active и установите его в TRUE.
   6. Разместите на форме объект TDatasource.
   7. Установите свойство Dataset у TDatasource в Query1.
   8. Разместите на форме TDBGrid.
   9. Установите его свойство Datasource в Datasource1.
   Свойство SQL имеет тип TStrings. Объект TStrings представляет собой список строк, и чем-то похож на массив. Тип данных TStrings имеет в своем арсенале команды добавления строк, их загрузки из текстового файла и обмена данными с другим объектом TStrings. Другой компонент, использующий TStrings — TMemo. В демонстрационном проекте ENTRSQL.DPR (по идее, он должен находится на отдельной дискетте, но к "Советам по Delphi" она не прилагается — В.О.), пользователь должен ввести SQL-запрос и нажать кнопку "Do It" ("сделать это"). Результаты запроса отображаются в табличной сетке. В Листинге 1 полностью приведен код обработчика кнопки "Do It".

Листинг 1

   procedure TForm1.BitBtn1Click(Sender: TObject);
   begin
    Query1.close; {Деактивируем запрос в качестве одной из мер предосторожности }
    Query1.SQL.Clear; {Стираем любой предыдущий запрос}
    If Memo1.Lines[0] <> '' {Проверяем на предмет пустого ввода} then
     Query1.SQL.Add(Memo1.Text) {Назначаем свойству SQL текст Memo}
    else begin
     messageDlg('Не был введен SQL-запрос', mtError, [mbOK], 0);
     exit;
    end;
    try {перехватчик ошибок}
     Query1.Open; {Выполняем запрос и открываем набор данных}
    except {секция обработки ошибок}
    On e : EDatabaseError do {e – новый дескриптор ошибки}
     messageDlg(e.message, mtError, [mbOK],0); {показываем свойство message объекта e}
    end; {окончание обработки ошибки}
   end;

Свойство Params

   Этого должно быть достаточно для пользователя, знающего SQL. Тем не менее, большинство пользователей не знает этого языка. Итак, ваша работа как разработчика заключается в предоставлении интерфейса и создании SQL-запроса. В Delphi, для создания SQL-запроса на лету можно использовать динамические запросы. Динамические запросы допускают использование параметров. Для определения параметра в запросе используется двоеточие (:), за которым следует имя параметра. Ниже приведе пример SQL-запроса с использованием динамического параметра:
   select * from EMPLOYEE
   where DEPT_NO = :Dept_no
   Если вам нужно протестировать, или установить для параметра значение по умолчанию, выберите свойство Params объекта Query1. Щелкните на кнопке '…'. Должен появиться диалог настройки параметров. Выберите параметр Dept_no. Затем в выпадающем списке типов данных выберите Integer. Для того, чтобы задать значение по умолчанию, введите нужное значение в поле редактирования «Value».
   Для изменения SQL-запроса во время выполнения приложения, параметры необходимо связать (bind). Параметры могут изменяться, запрос выполняться повторно, а данные обновляться. Для непосредственного редактирования значения параметра используется свойство Params или метод ParamByName. Свойство Params представляет из себя массив TParams. Поэтому для получения доступа к параметру, необходимо указать его индекс. Для примера,
   Query1.params[0].asInteger := 900;
   Свойство asInteger читает данные как тип Integer (название говорит само за себя). Это не обязательно должно указывать но то, что поле имеет тип Integer. Например, если тип поля VARCHAR(10), Delphi осуществит преобразование данных. Так, приведенный выше пример мог бы быть записан таким образом:
   Query1.params[0].asString := '900';
   или так:
   Query1.params[0].asString := edit1.text;
   Если вместо номера индекса вы хотели бы использовать имя параметра, то воспользуйтесь методом ParamByName. Данный метод возвращает объект TParam с заданным именем. Например:
   Query1.ParamByName('DEPT_NO').asInteger := 900;
   В листинге 2 приведен полный код примера.

Листинг 2

   procedure TForm1.BitBtn1Click(Sender: TObject);
   begin
    Query1.close; {Деактивируем запрос в качестве одной из мер предосторожности }
    if not Query1.prepared then
     Query1.prepare; {Убедимся что запрос подготовлен}
    {Берем значение, введенное пользователем и заменяемим параметр.}
    if edit1.text <> '' {Проверяем на предмет пустого ввода} then
     Query1.ParamByName('DEPT_NO').AsString := edit1.text
    else Begin
     Query1.ParamByName('DEPT_NO').AsInteger := 0;
     edit1.text := '0';
    end;
    try {перехватчик ошибок}
     Query1.Open; {Выполняем запрос и открываем набор данных}
    except {секция обработки ошибок}
    On e : EDatabaseError do {e – новый дескриптор ошибки}
     messagedlg(e.message, mtError, [mbOK],0); {показываем свойство message объекта e}
    end; {окончание обработки ошибки}
   end;
   Обратите внимание на процедуру, первым делом подготовливающую запрос. При вызове метода prepare, Delphi посылает SQL запрос на удаленный сервер. Сервер выполняет грамматический разбор и оптимизацию запроса. Преимущество такой подготовки запроса состоит в его предварительном разборе и оптимизации. Альтернативой здесь может служить подготовка сервером запроса при каждом его выполнении. Как только запрос подготовлен, подставляются необходимые новые параметры, и запрос выполняется.

Источник данных

   В предыдущем примере пользователь мог ввести номер отдела, и после выполнения запроса отображался список сотрудников этого отдела. А как насчет использования таблицы DEPARTMENT, позволяющей пользователю легко перемещаться между пользователями и отделами?
   Примечание: Следующий пример использует TTable с именем Table1. Для Table1 имя базы данных IBLOCAL, имя таблицы – DEPARTMENT. DataSource2 TDatasource связан с Table1. Таблица также активна и отображает записи в TDBGrid.
   Способ подключения TQuery к TTable – через TDatasource. Есть два основных способа сделать это. Во-первых, разместить код в обработчике события TDatasource OnDataChange. Например, листинг 3 демонстрирует эту технику.

Листинг 3 – Использования события OnDataChange для просмотра дочерних записей

   procedure TForm1.DataSource2DataChange(Sender: TObject; Field: TField);
   begin
    Query1.Close;
    if not Query1.prepared then Query1.prepare;
    Query1.ParamByName('Dept_no').asInteger := Table1Dept_No.asInteger;
    try
     Query1.Open;
    except On e : EDatabaseError do
     messageDlg(e.message, mtError, [mbOK], 0);
    end;
   end;
   Техника с использованием OnDataChange очень гибка, но есть еще легче способ подключения Query к таблице. Компонент TQuery имеет свойство Datasource. Определяя TDatasource для свойства Datasource, объект TQuery сравнивает имена параметров в SQL-запросе с именами полей в TDatasource. В случае общих имен, такие параметры заполняются автоматически. Это позволяет разработчику избежать написание кода, приведенного в листинге 3 (*** приведен выше ***).
   Фактически, техника использования Datasource не требует никакого дополнительного кодирования. Для поключения запроса к таблице DEPT_NO выполните действия, приведенные в листинге 4.

Листинг 4 – Связывание TQuery c TTable через свойство Datasource

   Выберите у Query1 свойство SQL и введите:
   select * from EMPLOYEE
   where DEPT_NO = :dept_no
   Выберите свойство Datasource и назначьте источник данных, связанный с Table1 (Datasource2 в нашем примере)
   Выберите свойство Active и установите его в True
   Это все, если вы хотите создать такой тип отношений. Тем не менее, существуют некоторые ограничения на параметризованные запросы. Параметры ограничены значениями. К примеру, вы не можете использовать параметр с именем Column или Table. Для создания запроса, динамически изменяемого имя таблицы, вы могли бы использовать технику конкатенации строки. Другая техника заключается в использовании команды Format.

Команда Format

   Команда Format заменяет параметры форматирования (%s, %d, %n и пр.) передаваемыми значениями. Например,
   Format('Select * from %s', ['EMPLOYEE'])
   Результатом вышеприведенной команды будет 'Select * from EMPLOYEE'. Функция буквально делает замену параметров форматирования значениями массива. При использовании нескольких параметров форматирования, замена происходит слева направо. Например,
   tblName := 'EMPLOYEE';
   fldName := 'EMP_ID';
   fldValue := 3;
   Format('Select * from %s where %s=%d', [tblName, fldName, fldValue])
   Результатом команды форматирования будет 'Select * from EMPLOYEE where EMP_ID=3'. Такая функциональность обеспечивает чрезвычайную гибкость при динамическом выполнении запроса. Пример, приведенный ниже в листинге 5, позволяет вывести в результатах поле salary. Для поля salary пользователь может задавать критерии.

Листинг 5 – Использование команды Format для создания SQL-запроса

   procedure TForm1.BitBtn1Click(Sender: TObject);
   var
    sqlString : string; {здесь хранится SQL-запрос}
    fmtStr1, fmtStr2 : string; {здесь хранится строка, передаваемая для форматирования}
   begin
    { Создание каркаса запроса }
    sqlString := 'Select EMP_NO %s from employee where SALARY %s';
    if showSalaryChkBox.checked {Если checkbox Salary отмечен} then
     fmtStr1 := ', SALARY'
    else fmtStr1 := '';
    if salaryEdit.text <> '' { Если поле редактирования Salary не пустое } then
     fmtStr2 := salaryEdit.text
    else fmtStr2 := '>0';
    Query1.Close; {Деактивируем запрос в качестве одной из мер предосторожности }
    Query1.SQL.Clear; {Стираем любой предыдущий запрос}
    Query1.SQL.Add(Format(sqlString,[fmtStr1, fmtStr2])); {Добавляем}
    {форматированную строку к свойству SQL}
    try {перехватчик ошибок}
     Query1.Open; {Выполняем запрос и открываем набор данных}
    except {секция обработки ошибок}
    On e : EDatabaseError do {e – новый дескриптор ошибки}
     messageDlg(e.message, mtError,[mbOK],0);
     {показываем свойство message объекта e}
    end; {окончание обработки ошибки}
   end;
   В этом примере мы используем методы Clear и Add свойства SQL. Поскольку «подготовленный» запрос использует ресурсы сервера, и нет никакой гарантии что новый запрос будет использовать те же таблицы и столбцы, Delphi, при каждом изменении свойства SQL, осуществляет операцию, обратную «подготовке» (unprepare). Если TQuery не был подготовлен (т.е. свойство Prepared установлено в False), Delphi автоматически подготавливает его при каждом выполнении. Поэтому в нашем случае, даже если бы был вызван метод Prepare, приложению от этого не будет никакой пользы.

Open против ExecSQL

В предыдущих примерах TQuerie выполняли Select-запросы. Delphi рассматривает результаты Select-запроса как набор данных, типа таблицы. Это просто один класс допустимых SQL-запросов. К примеру, команда Update обновляет содержимое записи, но не возвращает записи или какого-либо значения. Если вы хотите использовать запрос, не возвращающий набор данных, используйте ExecSQL вместо Open. ExecSQL передает запрос для выполнения на сервер. В общем случае, если вы ожидаете, что получите от запроса данные, то используйте Open. В противном случае допускается использование ExecSQL, хотя его использование с Select не будет конструктивным. Листинг 6 содержит код, поясняющий сказанное на примере.

Листинг 6

   procedure Form1.BitBtnClick(sender : TObject)
   begin
    Query1.Close;
    Query1.Clear;
    Query1.SQL.Add('Update SALARY from EMPLOYEE ' +'where SALARY<:salary values (SALARY*(1+:raise)');
    Query1.paramByName('salary').asString := edit1.text;
    Query1.paramByName('raise').asString := edit2.text;
    try
     Query1.ExecSQL;
    except On e : EDatabaseError do
     messageDlg(e.message, mtError, [mbOK], 0);
    end;
   end;
   Все приведенные выше примеры предполагают использования в ваших приложениях запросов. Они могут дать солидное основание для того, чтобы начать использовать в ваших приложениях TQuery. Но все же нельзя прогнозировать конец использования SQL в ваших приложених. Типичные серверы могут предложить вам другие характеристики, типа хранимых процедур и транзакций. В следующих двух секциях приведен краткий обзор этих средств.

3. Компонент TStoredProc

   Хранимая процедура представляет собой список команд (SQL или определенного сервера), хранимых и выполняемых на стороне сервера. Хранимые процедуры не имеют концептуальных различий с другими типами процедур. TStoredProc наследуется от TDataset, поэтому он имеет много общих характеристик с TTable и TQuery. Особенно заметно сходство с TQuery. Поскольку хранимые процедуры не требуют возврата значений, те же правила действуют и для методов ExecProc и Open. Каждый сервер реализует работу хранимых процедур с небольшими различиями. Например, если в качестве сервера вы используете Interbase, хранимые процедуры выполняются в виде Select-запросов. Например, чтобы посмотреть на результаты хранимой процедуры, ORG_CHART, в демонстрационной базе данных EMPLOYEE, используйте следующих SQL-запрос:
   Select * from ORG_CHART
   При работе с другими серверами, например, Sybase, вы можете использовать компонент TStoredProc. Данный компонент имеет свойства для имен базы данных и хранимой процедуры. Если процедура требует на входе каких-то параметров, используйте для их ввода свойство Params.

4. TDatabase

Компонент TDatabase обеспечивает функциональность, которой не хватает TQuery и TStoredProc. В частности, TDatabase позволяет создавать локальные псевдонимы BDE, так что приложению не потребуются псевдонимы, содержащиеся в конфигурационном файле BDE. Этим локальным псевдонимом в приложении могут воспользоваться все имеющиеся TTable, TQuery и TStoredProc. TDatabase также позволяет разработчику настраивать процесс подключения, подавляя диалог ввода имени и пароля пользователя, или заполняя необходимые параметры. И, наконец, самое главное, TDatabase может обеспечивать единственную связь с базой данных, суммируя все операции с базой данных через один компонент. Это позволяет элементам управления для работы с БД иметь возможность управления транзакциями.
Транзакцией можно считать передачу пакета информации. Классическим примером транзакции является передача денег на счет банка. Транзакция должна состоять из операции внесения суммы на новый счет и удаления той же суммы с текущего счета. Если один из этих шагов по какой-то причине был невыполнен, транзакция также считается невыполненной. В случае такой ошибки, SQL сервер позволяет выполнить команду отката (rollback), без внесения изменений в базу данных. Управление транзакциями зависит от компонента TDatabase. Поскольку транзакция обычно состоит из нескольких запросов, вы должны отметить начало транзакции и ее конец. Для выделения начала транзакции используйте TDatabase.BeginTransaction. Как только транзакция начнет выполняться, все выполняемые команды до вызова TDatabase.Commit или TDatabase.Rollback переводятся во временный режим. При вызове Commit все измененные данные передаются на сервер. При вызове Rollback все изменения теряют силу. Ниже в листинге 7 приведен пример, где используется таблица с именем ACCOUNTS. Показанная процедура пытается передать сумму с одного счета на другой.

Листинг 7

   procedure TForm1.BitBtn1Click(Sender: TObject);
    { ПРИМЕЧАНИЕ: Поле BALANCE у ACCOUNTS имеет триггер, проверяющийситуацию, когда вычитаемая сумма превышает BALANCE. Если так, UPDATEбудет отменен}
   begin
    try
     database1.StartTransaction;
     query1.SQL.Clear;
     { Вычитаем сумму из выбранного счета }
     query1.SQL.Add(Format('update ACCOUNTS ' +'set BALANCE = BALANCE - %s ) ' +'where ACCT_NUM = %s ',[edit1.text,Table1Acct_Num.asString]));
     query1.ExecSQL;
     query1.SQL.Clear;
     { Добавляем сумму к выбранному счету }
     query1.SQL.Add(Format('update ACCOUNTS ' +'set BALANCE = BALANCE + %s ' +'where ACCT_NUM = %s ',[edit1.text,Table2Acct_Num.asString]));
     query1.ExecSQL;database1.Commit; {В этом месте делаем все изменения}
     table1.Refresh;
     table2.Refresh;
    except
     {При возникновении в приведенном коде любых ошибок,откатываем транзакцию назад}
    One : EDatabaseError do
     begin
      messageDlg(e.message, mtError, [mbOK], 0);
      database1.rollback;
      exit;
     end;
    One : Exception do
     begin
      messageDlg(e.message, mtError, [mbOK], 0);
      database1.rollback;
      exit;
     end;
    end;
   end;
   И последнее, что нужно учесть при соединении с базой данных. В приведенном выше примере, TDatabase использовался в качестве единственного канала для связи с базой данных, поэтому было возможным выполнение только одной транзакции. Чтобы выполнить это, было определено имя псевдонима (Aliasname). Псевдоним хранит в себе информацию, касающуюся соединения, такую, как Driver Type (тип драйвера), Server Name (имя сервера), User Name (имя пользователя) и другую. Данная информация используется для создания строки соединения (connect string). Для создания псевдонима вы можете использовать утилиту конфигурирования BDE, или, как показано в примере ниже, заполнять параметры во время выполнения приложения.
   TDatabase имеет свойство Params, в котором хранится информация соединения. Каждая строка Params является отдельным параметром. В приведенном ниже примере пользователь устанавливает параметр User Name в поле редактирования Edit1, а параметр Password в поле Edit2. В коде листинга 8 показан процесс подключения к базе данных:

Листинг 8

   procedure TForm1.Button1Click(Sender: TObject);
   begin
    try
     With database1 do begin
      Close;
      DriverName := 'INTRBASE';
      KeepConnection := TRUE;
      LoginPrompt := FALSE;
      With database1.Params do begin
       Clear;
       Add('SERVER NAME=C:\IBLOCAL\EXAMPLES\EMPLOYEE.GDB');
       Add('SCHEMA CACHE=8');
       Add('OPEN MODE=READ/WRITE');
       Add('SQLPASSTHRU MODE=SHARED NOAUTOCOMMIT');
       Add('USER NAME=' + edit1.text);
       Add('PASSWORD=' + edit2.text);
      end;
      Open;
     end;
     session.getTableNames(database1.databasename, '*', TRUE, TRUE, ComboBox1.items);
    Except One : EDatabaseError do
     begin
      messageDlg(e.message, mtError, [mbOK], 0);
     end;
    end;
   end;
   Этот пример показывает как можно осуществить подключение к серверу без создания псевдонима. Ключевыми моментами здесь являются определение DriverName и заполнение Params информацией, необходимой для подключения. Вам не нужно определять все параметры, вам необходимо задать только те, которые не устанавливаются в конфигурации BDE определенным вами драйвером базы данных. Введенные в свойстве Params данные перекрывают все установки конфигурации BDE. Записывая параметры, Delphi заполняет оставшиеся параметры значениями из BDE Config для данного драйвера. Приведенный выше пример также вводит такие понятия, как сессия и метод GetTableNames. Это выходит за рамки обсуждаемой темы, достаточно упомянуть лишь тот факт, что переменная session является дескриптором database engine. В примере она добавлена только для «показухи».
   Другой темой является использование SQLPASSTHRU MODE. Этот параметр базы данных отвечает за то, как натив-команды базы данных, такие, как TTable.Append или TTable.Insert будут взаимодействовать с TQuery, подключенной к той же базе данных. Существуют три возможных значения: NOT SHARED, SHARED NOAUTOCOMMIT и SHARED AUTOCOMMIT. NOT SHARED означает, что натив-команды используют одно соединение с сервером, тогда как запросы – другое. Со стороны сервера это видится как работа двух разных пользователей. В любой момент времени, пока транзакция активна, натив-команды не будут исполняться (committed) до тех пор, пока транзакция не будет завершена. Если был выполнен TQuery, то любые изменения, переданные в базу данных, проходят отдельно от транзакции.
   Два других режима, SHARED NOAUTOCOMMIT и SHARED AUTOCOMMIT, делают для натив-команд и запросов общим одно соединение с сервером. Различие между двумя режимами заключаются в передаче выполненной натив-команды на сервер. При выбранном режиме SHARED AUTOCOMMIT бессмысленно создавать транзакцию, использующую натив-команды для удаления записи и последующей попыткой осуществить откат (Rollback). Запись должна быть удалена, а изменения должны быть сделаны (committed) до вызова команды Rollback. Если вам нужно передать натив-команды в пределах транзакции, или включить эти команды в саму транзакцию, убедитесь в том, что SQLPASSTHRU MODE установлен в SHARED NOAUTOCOMMIT или в NOT SHARED.

5. Выводы

Delphi поддерживает множество характеристик при использовании языка SQL с вашими серверами баз данных. На этой ноте разрешите попращаться и пожелать почаще использовать SQL в ваших приложениях.

SQL: – сортировка вычисляемого поля

   Иногда схема данных требует, чтобы набор данных имел вычисляемый результат. В приложениях Delphi в случае использования SQL это возможно, но эта технология немного разнится в зависимости от используемого типа данных.
   Для локального SQL, включая таблицы Paradox и dBASE, вычисляемому полю дают имя с использованием ключевого слова AS. При этом допускается ссылаться на такое поле для задания порядка сортировки с помощью ключевой фразы ORDER BY в SQL-запросе. Например, используя демонстрационную таблицу ITEMS.DB:
   SELECT I."PARTNO", I."QTY", (I."QTY" * 100) AS TOTAL
   FROM "ITEMS.DB" I
   ORDER BY TOTAL
   В данном примере вычисляемому полю было присвоено имя TOTAL (временно, только для ссылки), после чего оно стало доступным в SQL-запросе для выражения ORDER BY.
   Вышеуказанный метод не поддерживается в InterBase. Тем не менее, сортировать вычисляемые поля в таблицах InterBase (IB) или сервере Local InterBase Server все же возможно. Вместо использования имени вычисляемого поля, в выражении ORDER BY используется порядковое число, представляющее собой позицию вычисляемого поля в списке полей таблицы. Например, используя демонстрационную таблицу EMPLOYEE (расположенную в базе данных EMPLOYEE.GDB):
   SELECT EMP_NO, SALARY, (SALARY / 12) AS MONTHLY
   FROM EMPLOYEE
   ORDER BY 3 DESCENDING
   В то время, как таблицы IB и LIBS используют второй метод, и не могут воспользоваться первым, оба метода доступны при работе с локальным SQL. К примеру, используя SQL-запрос для таблицы Paradox, и приспосабливая его для работы с относительной позицией вычисляемого поля, а не его именем:
   SELECT I."PARTNO", I."QTY", (I."QTY" * 100) AS TOTAL
   FROM "ITEMS.DB" I
   ORDER BY 3

SQL: – суммирование вычисляемого поля

   Бывают случаи, когда в приложении Delphi, которое для получения доступа к данным использует SQL, необходимо узнать сумму вычисленных данных. Другими словами, необходимо с помощью SQL создать вычисляемое поле и применить к нему функцию SUM.
   При выполнении такой операции с SQL-таблицами (например, Local InterBase Server), все достаточно тривиально, и сумма вычисляется простым использованием функции SUM с указанием поля. Например, используя демонстрационную таблицу EMPLOYEE (из базы данных EMPLOYEE.GDB):
   SELECT SUM(SALARY / 12)
   FROM EMPLOYEE
   Та же самая методика применима в случае возвращаемого набора данных, в котором значения группируются в другом столбце с помощью утверждения GROUP BY:
   SELECT EMP_NO, SUM(SALARY / 12)
   FROM EMPLOYEE
   GROUP BY EMP_NO
   ORDER BY EMP_NO
   Пока SQL базы данных поддерживают суммирование вычисляемых полей, локальный SQL этого делать не будет. Для получения результатов нужны другие методы, например копирование результатов запроса с вычисляемым полем во временную таблицу (как и в случае компонента TBatchMove), и использование компонента TQuery для вычисления суммы данных во временной таблице.

SQL: – использование функции SUBSTRING

   SQL-функция SUBSTRING может использоваться в приложениях Delphi, работающих с запросами к локальной SQL, но она не поддерживается при работе с таблицами InterBase (IB) и Local InterBase Server (LIBS). Ниже приведен синтаксис функции SUBSTRING, примеры ее использования в запросах к local SQL, и альтернатива для возвращения тех же результатов для таблиц IB/LIBS.
   Синтаксис функции SUBSTRING:
   SUBSTRING(<column> FROM <start> [, FOR <length>])
   Где:
   <column> – имя колонки таблицы, из которой должна быть получена подстрока (substring).
   <start> место в значении колонки, начиная с которого извлекается подстрока.
   <length> длина извлекаемой подстроки.
   Функция SUBSTRING в примере ниже возвратит второй, третий и четвертый символы из колонки с именем COMPANY:
   SUBSTRING(COMPANY FROM 2 FOR 3)
   Функция SUBSTRING может быть использована и для списка полей в SELECT-запросе, где ключевое слово WHERE допускает сравнение значения с определенным набором колонок. Функция SUBSTRING может использоваться только с колонками типа String (на языке SQL тип CHAR). Вот пример функции SUBSTRING, использующей список колонок в SELECT-запросе (используем демонстрационную таблицу Paradox CUSTOMER.DB):
   SELECT (SUBSTRING(C."COMPANY" FROM 1 FOR 3)) AS SS
   FROM "CUSTOMER.DB" C
   Данный SQL-запрос извлекает первые три символа из колонки COMPANY, возвращаемой как вычисляемая колонка с именем SS. Вот пример функции SUBSTRING, использованной в SQL-запросе с ключевым словом WHERE (используем ту же самую таблицу):
   SELECT C."COMPANY"
   FROM "CUSTOMER.DB" C
   WHERE SUBSTRING(C."COMPANY" FROM 2 FOR 2) = "an"
   Данный запрос возвратит все строки таблицы, где второй и третий символы в колонке COMPANY равны «ar».
   Так как функция SUBSTRING не поддерживается в базах данных IB и LIBS, операции с подстроками со списком колонок в запросе невозможны (исключение: IB может работать с подстроками через функции, определяемые пользователем, User-Defined Functions). Но с помощью оператора LIKE и сопутствующих символьных маркеров подстановки возможно работать с подстрокой и в случае WHERE. Вот пример на основе таблицы EMPLOYEE (в базе данных EMPLOYEE.GDB):
   SELECT LAST_NAME, FIRST_NAME
   FROM EMPLOYEE
   WHERE LAST_NAME LIKE "_an%"
   Данный SQL-запрос возвратит все строки таблицы, где второй и третий символы в колонке LAST_NAME равны «an», см. предыдущий пример на основе таблицы Paradox. Базам данных IB и LIBS для выполнения сравнения подстроки в операторе запроса WHERE данный метод необходим (и невозможно воспользоваться функцией SUBSTRING), таблицы же Paradox и dBASE (например, local SQL) могут воспользоваться любым методом.

Sybase

32-битное соединение с сервером Sybase

   Данный документ содержит информацию, позволяющую осуществить подключение к базе данных Sybase через 32-битный пакет от фирмы Borland Sybase SQL Links, поставляемый в составе Delphi 2.x. Клиентское программное обеспечение Sybase займет на вашем жестком диске приблизительно 10+ мегабайт свободного пространства.
   Шаги для подключения:
   1. Убедитесь в том, что пакет SQL Links установлен на вашем локальном диске. При полной установке Delphi 2.x это должно быть уже установлено в системе.
   2. Инсталируйте клиентское программное обеспечение Sybase.
   3. При появлявлении в процессе установки диалога выбора 16– и 32-разрядной версии Sybase links, выберите только 32-битную версию (отметьте галочкой) и убедитесь в том, что опция 16-битной версии выключена.
   4. После того, как клиентское программное обеспечение будет установлено на вашем жестком диске, у вас попросят разрешение на автоматическую программную коррекцию вашего файла AUTOEXEC.BAT. Выберите YES.
   5. На запрос по поводу редактирования вашего файла SQL.INI ответьте YES.
   6. В секции «Input Server Name:» (введите имя сервера) укажите псевдоним сервера. Щелкните на кнопке 'Add' (добавить) для внесения имени сервера в список «Server Entry:». Затем убедитесь в том, что поля редактирования «Service Type:» (тип сервиса) (должно быть 'query' (запрос)), «Platform:» (платформа) (по умолчанию обычно устанавливается в NT, dos или Win3), и «Net-Library Driver:» (драйвер сетевой библиотеки) (должен быть NLWNSCK или NLNWLINK) содержат верные сведения. Заполните поле редактирования «Connection Information/Network Address:» (адрес информационного/сетевого соединения), введя сетевой адрес сервера, с которым вы хотите иметь соединение. Щелкните на кнопке 'Add Service' (добавить сервис). Вы можете теперь пропинговать ваш сервер, щелкая по кнопке 'Ping'. Сохраните текущие настройки и выйдите из программы.
   7. Завершите работу Windows и перегрузите машину.
   8. В меню пуск выберите программную группу Delphi и запустите Database Explorer.
   9. В Навигаторе баз данных (Database explorer) щелкните на закладке Database. Активизируйте пункт меню Object | New… В диалоговом окне в выпадающем списке должно стоять имя STANDARD. Щелкните на стрелке и выберите из появившегося списка SYBASE.
   10. Теперь там должен быть псевдоним для вашего соединения с Sybase с именем SYBASE1. Убедитесь в том, что это имя выделено. Щелкните в Database Explorer на следующей закладке. В секции «Server Name» (имя сервера) выберите имя одного из серверов, которые вы поместили в ваш SQL.INI, и который пингуется. В секции «User Name» укажите имя пользователя, имеющего права на доступ к определенному в секции «Server Name» серверу. Убедитесь в том, что вы знаете пароль только что назначенного пользователя.
   11. Дважды щелкните на имене псевдонима (SYBASE1) и в появившемся диалоговом окне введите имя пользователя и его пароль. Имя пользователя должно совпадать с именем, определенным в секции «User Name» для псевдонима Sybase. Введите пароль, соответствующий данному пользователю. Нажмите кнопку OK. Теперь около псевдонима Sybase (SYBASE1) вы должны увидеть иконку, обозначающую маленький зеленый ящик. Это означает успешное установление соединения.
   Тестирование вашего соединения с помощью Delphi 2.x:
   1. Разместите на пустой форме компоненты TDataSource, TTable и TDBGrid.
   2. В Инспекторе Объектов (Object Inspector) установите для TDataSource свойство DataSet в 'Table1' (без кавычек).
   3. В Инспекторе Объектов установите для TTable имя базы данных в SYBASE1. Переместитесь ниже до свойства TableName, и дважды щелкните на поле редактирования, расположенного около данного свойства. Должно появиться диалоговое окно с требованием ввести имя пользователя и его пароль. При этом должно уже отображаться имя пользователя, которое вы определили в Database Explorer для псевдонима Sybase. Введите соответствующий пароль. Нажмите на кнопку OK.
   4. Теперь вы должны увидеть спискок, состоящий из имен таблиц. Выберите одно.
   5. Щелкните на TDBGrid. Присвойте его свойству DataSource значение DataSource1.
   6. Установите свойство Active компонента TTable в TRUE.
   7. Теперь вы можете увидеть данные в TDBGrid. После запуска приложения должно появиться диалоговое окно с требованием ввести имя пользователя и его пароль. Введите пароль и нажмите OK. Теперь вы должны увидеть данные в табличной сетке.
   Сообщения об ошибках:
   Ошибка, связанная с невозможностью нахождения сетевой библиотеки: Данная ошибка означает, что программе не удалось найти нужную ей .DLL. Следующие файлы должны располагаться в вашем каталоге \Sybase\DLL:
   Libblk.dll
   Libcomn.dll
   Libcs.dll
   Libct.dll
   Libintl.dll
   Libsrv.dll
   Libsybdb.dll
   Libtcl.dll
   Mscvrt10.dll
   Nldecnet.dll
   Nlmsnmp.dll
   Nlnwadvt.exe
   Nlnwlink.dll
   Nlwnsck.dll
   Предостережение: Данный документ не гарантирует установление соединения с сервером, он демонстрирует самый лучший и быстрый способ сделать это.

Разное

Решение проблемы BDE ~Index out of Date~

Некоторое время назад у меня также была масса ошибок типа 'index out of date' и даже искажение данных. После продолжительного исследования я выяснил причину, она оказалось в различных установках Paradox Language в BDE (v1 и V3) на странице Driver и System в утилите конфигурирования BDE. Я не обратил внимание на установки на странице System одной из рабочих станций, и получил искажение данных.
Tom Jensen

Обратные вызовы BDE32 для получения статуса операций

   Тема: Обратные вызовы BDE для получения статуса операций
   Данный совет показывает как в Delphi 2.01 можно использовать функцию BDE DbiCallBack для получения значения линейки прогресса при длительных пакетных операциях, связанных с движением данных.
   Дополнительная документация, описывающая вызовы функций BDE, находится в файле BDE32.HLP (расположенном в каталоге, где установлен 32-битный IDAPI).
   При создании функций обратного вызова BDE, BDE будет осуществлять "обратный вызов" функций вашего приложения, позволяя тем самым извещать ваше приложение о происходящих событиях, а в некоторых случаях передавать информацию обратно BDE.
   BDE определяет несколько возвращаемых типов, которые могут быть установлены для обратного вызова:
   состояние больших пакетных операций.
   запросы для передачи информации вызывающему оператору.
   Данный совет подробно описывает обратный вызов типа cbGENPROGRESS, позволяющий изменять полоску прогресса в соответствии с состоянием операции.
   Чтобы это сделать, необходимо сперва вызвать функцию DbiGetCallBack(), возвращающую дескриптор обратного вызова, который мог быть уже установлен (с этими параметрами), и сохранить информацию в структуре данных. Затем установить свой обратный вызов, заменяя им любой установленный до этого.
   При установке вашего обратного вызова вам понадобится передавать BDE указатель на структуру данных, содержащую информацию о предыдущем установленном обратном вызове, после чего, при выполнении вашей функции обратного вызова, вы можете воспользоваться оригинальным обратным вызовом (если он установлен).
   BDE каждый раз возвращает вашему приложению сообщение, содержащее количество обработанных записей, или же процентное соотношение обработанных записей, также передаваемое в виде целого числа. Ваш код должен учитывать эту ситуацию. Если процентное поле в структуре обратного вызова больше чем -1, можно сделать вывод что передан процент и можно сразу обновить линейку прогресса. Если же это поле меньше нуля, обратный вызов получил текстовое сообщение, помещенное в поле szTMsg и содержащее количество обработанных записей. В этом случае вам понадобится осуществить грамматический разбор текстового сообщения, преобразовать остальные строки в целое, затем вычислить текущий процент обработанных записей, и только после этого изменить линейку прогресса.
   Наконец, после осуществления операции с данными, вам необходимо "отрегистрировать" ваш обратный вызов, и вновь установить предыдущую функцию обратного вызова (если она существует).
   Для следующего примера необходимо создать форму и расположить на ней две таблицы, компонент ProgressBar и кнопку.
   ----- Демонстрационный код ---------
   unit Testbc1;
   interface

   uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Grids, DBGrids, DB, DBTables, ComCtrls;

   type TForm1 = class(TForm)
    Table1: TTable;
    BatchMove1: TBatchMove;
    Table2: TTable;
    Button1: TButton;
    ProgressBar1: TProgressBar;
    procedure Button1Click(Sender: TObject);
   private
   { Private declarations }
   public
   { Public declarations }
   end;

   var Form1: TForm1;

   implementation

   uses Bde; {Здесь расположены Dbi Types и Procs}

   {$R *.DFM}

   {тип структуры данных для сохранения информации о предыдущем обратном вызове}
   type TDbiCbInfo = record
    ecbType     : CBType;
    iClientData : longint;
    DataBuffLn : word;
    DataBuff    : pCBPROGRESSDesc;
    DbiCbFn     : pointer;
   end;
   type PDbiCbInfo = ^TDbiCbInfo;

   {Наша функция обратного вызова}
   function DbiCbFn(ecbType: CBType; iClientData: Longint; CbInfo: pointer): CBRType stdcall;
   var s : string;
   begin
    {Проверяем, является ли тип обратного вызова тем, который мы ожидаем}
    if ecbType = cbGENPROGRESS then begin
     {если iPercentDone меньше нуля, извлекаем число}
     {обработанных записей из параметра szMsg}
     if pCBPROGRESSDesc(cbInfo).iPercentDone < 0 then begin
      s := pCBPROGRESSDesc(cbInfo).szMsg;
      Delete(s, 1, Pos(': ', s) + 1);
      {Вычислям процент выполненного и изменяем линейку прогресса}
      Form1.ProgressBar1.Position :=Round((StrToInt(s) / Form1.Table1.RecordCount) * 100);
     end else begin
      {Устанавливаем линейку прогресса}
      Form1.ProgressBar1.Position:=pCBPROGRESSDesc(cbInfo).iPercentDone;
     end;
    end;
    {существовал ли предыдущий зарегистрированный обратный вызов?}
    {если так - осуществляем вызов и возвращаемся}
    if PDbiCbInfo(iClientData)^.DbiCbFn <> nil then
     DbiCbFn:=pfDBICallBack(PDbiCbInfo(iClientData)^.DbiCbFn)(ecbType,PDbiCbInfo(iClientData)^.iClientData,cbInfo)
    else DbiCbFn := cbrCONTINUE;
   end;

   procedure TForm1.Button1Click(Sender: TObject);
   var
    CbDataBuff: CBPROGRESSDesc; {Структура DBi}
    OldDbiCbInfo : TDbiCbInfo; {структура данных должна хранить информацию о предыдущем обратном вызове}
   begin
    {Убедимся в том, что перемещаемая таблица открыта}
    Table1.Open;
    {Убедимся в том, что таблица-приемник закрыта}
    Table2.Close;
    {получаем информацию о любом установленном обратном вызове}
    DbiGetCallBack(Table2.Handle, cbGENPROGRESS, @OldDbiCbInfo.iClientData, @OldDbiCbInfo.DataBuffLn, @OldDbiCbInfo.DataBuff, pfDBICallBack(OldDbiCbInfo.DbiCbFn));
    {регистрируем наш обратный вызов}
    DbiRegisterCallBack(Table2.Handle, cbGENPROGRESS, longint(@OldDbiCbInfo), SizeOf(cbDataBuff), @cbDataBuff, @DbiCbFn);
    Form1.ProgressBar1.Position := 0;
    BatchMove1.Execute;
    {если предыдущий обратный вызов существовал - вновь устанавливаем его,}
    {в противном случае "отрегистрируем" наш обратный вызов}
    if OldDbiCbInfo.DbiCbFn <> nil then
     DbiRegisterCallBack(Table2.Handle, cbGENPROGRESS, OldDbiCbInfo.iClientData,
      OldDbiCbInfo.DataBuffLn, OldDbiCbInfo.DataBuff, OldDbiCbInfo.DbiCbFn)
    else
     DbiRegisterCallBack(Table2.Handle, cbGENPROGRESS, longint(@OldDbiCbInfo),
      SizeOf(cbDataBuff), @cbDataBuff, nil);
    {Показываем наш успех!}
    Table2.Open;
   end;

   end.

Управление сетевыми каталогами (BDE)

   Если два различных пользователя подключают два различных сетевых каталога (net control directories, NCD), но при этом пути к каталогам одинаковые (это не трудно при работе с сетью), BDE думает, что в этом случае используются одни и те же NCD. Это может привести к _огромным_ проблемам.
   Если два пользователя подключают один и тот же NCD, но с разными путями, BDE думает что используются два различных NCD и не позволяет второму пользователю редактировать таблицу. Например, пользователь A подключил NCD по пути G:\DATA\BDENET. Пользователь B подключил NCD по пути H:\BDENET, где H: подключен по пути G:\DATA. В этом случае оба пользователя пытаются использовать один и тот же NCD, но BDE не знает об этом.
   Если в вышеприведенном примере пользователи используют один и тот же путь, но с различными буквами диска, BDE позволяет работать обоим пользователям, подразумевая, что они используют один и тот же NCD. Так, если пользователь A подключен к G:\DATA\BDENET, а пользователь B к H:\DATA\BDENET, BDE даст работать обоим.
   Это полезно в peer-to-peer сети, где сервер также является и рабочей станцией. В этом случае некоторые (какие?) peer-to-peer OS не позволят серверу подключить сетевой диск к самому себе (я не уверен что у них невозможен эквивалент SUBST, но, по крайней мере, у тех OS, которые я знаю, это отсутствует) так что сервер может использовать только диск C: (или D:, или какой-то другой локальный диск), а рабочая станция нет, поскольку сама имеет собственный локальный диск C:.
   Richard Davis
   Дополнение от Mark Ostroff (Borland):
   В дополнение к ИЗУМИТЕЛЬНОМУ ответу Richard'а, пожалуйста помните об одной ОЧЕНЬ важной вещи… НИКОГДА не допускайте ситуации (в ЛЮБОЙ сети), при которой вы имеете нескольких пользователей, имеющих доступ к одним и тем же таблицам, но использующих разные физические NET-файлы. Это создает ОГРОМНЫЕ проблемы, особенно в в корпоративных и peer-to-peer сетях.
   Pdox DOS версии 4.0 использует ту же BDE-схему работы с сетью, что и таблицы Paradox. Необходимо учесть несколько важных моментов:
   1. Убедитесь в том, что у вас включена опция BDE Local Share, если вы создаете таблицы с общим доступом для приложений Pdox DOS и BDE.
   2. Из-за странного поведения при работе с сетевыми каталогами, пути в файле контроля сети Pdox DOS у ваших пользователей должны быть ИДЕНТИЧНЫ BDE путям (например, тот же каталог И та же буква диска). Это должно быть сделано в случае, если и Pdox DOS, и BDE делают общими одни и те же таблицы и запущены ОБА приложения. Это может создать некоторые проблемы с установкой peer-to-peer сетей.
   3. Убедитесь в том, у вас выключена опция BDE Strict Integrity, если вы создаете таблицы с общим доступом для приложений Pdox DOS и BDE. В противном случае BDE заблокирует пользователей Pdox DOS для редактирования данных в таблицах Paradox (в любом каталоге), у которых установлена опция целостности данных (Referential Integrity).
   4. Убедитесь в том, что номер версии Paradox, имеющийся в настройках BDE, совместим с OLDEST версией Pdox DOS для использования в вашей сети. Установить ее можно, выбрав соответствующий драйвер Paradox в BDE Config Utility и проверив значение в поле LEVEL. Установите номер версии Pdox DOS, округлив его до ближайшего МЕНЬШЕГО целого числа.

Пример DBIDoRestructure

   Единственный способ изменить размер поля или его тип — использовать DBIDoRestructure. Вот простой пример, который может вам помочь в этом:
   function BDEStringFieldResize(ATable: TTable; AFieldName: string; ANewSize: integer): boolean;
   type TRestructStatus = (rsFieldNotFound, rsNothingToDo, rsDoIt);
   var
    hDB: hDBIdb;
    pTableDesc: pCRTblDesc;
    pFldOp: pCROpType;    {фактически это массив array of pCROpType}
    pFieldDesc: pFldDesc; {фактически это массив array of pFldDesc}
    CurPrp: CurProps;
    CSubType: integer;
    CCbrOption: CBRType;
    eRestrStatus: TRestructStatus;
    pErrMess: DBIMsg;
    i: integer;
   begin
    Result := False;
    eRestrStatus := rsFieldNotFound;
    AFieldName := UpperCase(AFieldName);
    pTableDesc := nil;
    pFieldDesc := nil;
    pFldOp := nil;
    with ATable do try
     {убедимся что имеем исключительный доступ и сохраним dbhandle:}
     if Active and (not Exclusive) then Close;
     if (not Exclusive) then Exclusive := True;
     if (not Active) then Open;hDB := DBHandle;
     {готовим данные для DBIDoRestructure:}
     BDECheck(DBIGetCursorProps(Handle,CurPrp));
     GetMem(pFieldDesc,CurPrp.iFields*sizeOf(FldDesc));
     BDECheck(DBIGetFieldDescs(Handle,pFieldDesc));
     GetMem(pFldOp,CurPrp.iFields*sizeOf(CROpType));
     FillChar(pFldOp^,CurPrp.iFields*sizeOf(CROpType),0);
     {ищем в цикле (через fielddesc) наше поле:}
     for i:=1 to CurPrp.iFields do begin
      {для ввода мы имеем серийные номера вместоPdox ID, возвращаемых DbiGetFieldDescs:}
      pFieldDesc^.iFldNum := i;
      if (Uppercase(StrPas(pFieldDesc^.szName)) = AFieldName) and (pFieldDesc^.iFldType = fldZSTRING) then begin
       eRestrStatus := rsNothingToDo;
       if (pFieldDesc^.iUnits1 <> ANewSize) then begin
        pFieldDesc^.iUnits1 := ANewSize;
        pFldOp^ := crModify;
        eRestrStatus := rsDoIt;
       end;
      end;
      inc(pFieldDesc);
      inc(pFldOp);
     end; {for}
     {"регулируем" массив указателей:}
     dec(pFieldDesc,CurPrp.iFields);
     dec(pFldOp,CurPrp.iFields);
     {в случае отсутствия операций возбуждаем исключение:}
     case eRestrStatus of
     rsNothingToDo:
      raise Exception.Create('Ничего не сделано');
     rsFieldNotFound:
     raise Exception.Create('Поле не найдено');
     end;
     GetMem(pTableDesc,sizeOf(CRTblDesc));
     FillChar(pTableDesc^,SizeOf(CRTblDesc),0);
     StrPCopy(pTableDesc^.szTblName,TableName);
     {StrPCopy(pTableDesc^.szTblType,szPARADOX); {}
     pTableDesc^.szTblType := CurPrp.szTableType;
     pTableDesc^.iFldCount := CurPrp.iFields;
     pTableDesc^.pecrFldOp := pFldOp;
     pTableDesc^.pfldDesc := pFieldDesc;
     Close;
     BDECheck(DbiDoRestructure(hDB, 1, pTableDesc, nil, nil, nil, False));
    finally
     if pTableDesc <> nil then FreeMem(pTableDesc,sizeOf(CRTblDesc));
     if pFldOp <> nil then FreeMem(pFldOp, CurPrp.iFields*sizeOf(CROpType));
     if pFieldDesc <> nil then FreeMem(pFieldDesc, CurPrp.iFields*sizeOf(FldDesc));
     Open;
    end; {пробуем с table1}
    Result := True;
   end;
   Reinhard Kalinke

Изменение конфигурации IDAPI

   Возможно ли установить параметр MAXFILEHANDLES в IDAPI.CFG посредством Delphi?
   Да. Следующий компонент показывает как это можно сделать (а также изменить другие параметры):
   unit CFGTOOL;
   interface

   uses SysUtils, Classes, DB, DbiProcs, DbiTypes, DbiErrs;

   type TBDEConfig = class(TComponent)
   private
    FLocalShare : Boolean;
    FMinBufSize : Integer;
    FMaxBufSize : Integer;
    FSystemLangDriver : String;
    FParadoxLangDriver : String;
    FMaxFileHandles : Integer;
    FNetFileDir : String;
    FTableLevel : String;
    FBlockSize : Integer;
    FDefaultDriver : String;
    FStrictIntegrity : Boolean;
    FAutoODBC : Boolean;
    procedure Init;
    procedure SetLocalShare(Value : Boolean);
    procedure SetMinBufSize(Value : Integer);
    procedure SetMaxBufSize(Value : Integer);
    procedure SetSystemLangDriver(Value : String);
    procedure SetParadoxLangDriver(Value : String);
    procedure SetMaxFileHandles(Value : Integer);
    procedure SetNetFileDir(Value : String);
    procedure SetTableLevel(Value : String);
    procedure SetBlockSize(Value : Integer);
    procedure SetDefaultDriver(Value : String);
    procedure SetAutoODBC(Value : Boolean);
    procedure SetStrictIntegrity(Value : Boolean);
    procedure UpdateCFGFile(path, item, value : string);
   protected
   public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
   published
    property LocalShare : Boolean read FLocalShare write SetLocalShare;
    property MinBufSize : Integer read FMinBufSize write SetMinBufSize;
    property MaxBufSize : Integer read FMaxBufSize write SetMaxBufSize;
    property SystemLangDriver : String read FSystemLangDriver write SetSystemLangDriver;
    property ParadoxLangDriver : String read FParadoxLangDriver write SetParadoxLangDriver;
    property MaxFileHandles : Integer read FMaxFileHandles write SetMaxFileHandles;
    property NetFileDir : String read FNetFileDir write SetNetFileDir;
    property TableLevel : String read FTableLevel write SetTableLevel;
    property BlockSize : Integer read FBlockSize write SetBlockSize;
    property DefaultDriver : string read FDefaultDriver write SetDefaultDriver;
    property AutoODBC : Boolean read FAutoODBC write SetAutoODBC;
    property StrictIntegrity : Boolean read FStrictIntegrity write SetStrictIntegrity;
   end;

   procedure Register;

   implementation

   function StrToBoolean(Value : string) : Boolean;
   begin
    if (UpperCase(Value) = 'TRUE') or (UpperCase(Value) = 'ON') or (UpperCase(Value) = 'YES') or (UpperCase(Value) = '.T.' ) then Result := True
    else Result := False;
   end;

   function BooleanToStr(Value : Boolean) : String;
   begin
    if Value then Result := 'TRUE'
    else Result := 'FALSE';
   end;

   procedure Register;
   begin
    RegisterComponents('Data Access', [TBDEConfig]);
   end;

   procedure TBDEConfig.Init;
   var
    h: hDBICur;
    pCfgDes: pCFGDesc;
    n, v : string;
   begin
    Check(DbiOpenCfgInfoList(nil, dbiREADWRITE, cfgPersistent,'\SYSTEM\INIT', h));
    GetMem(pCfgDes, sizeof(CFGDesc));
    try
     FillChar(pCfgDes^, sizeof(CFGDesc), #0);
     while (DbiGetNextRecord(h, dbiWRITELOCK, pCfgDes, nil) = DBIERR_NONE) do begin
      n := StrPas(pCfgDes^.szNodeName);
      v := StrPas(pCfgDes^.szValue);
      if n = 'LOCAL SHARE' then FLocalShare := StrToBoolean(v)
      else if n = 'MINBUFSIZE' then FMinBufSize := StrToInt(v)
      else if n = 'MAXBUFSIZE' then FMaxBufSize := StrToInt(v)
      else if n = 'MAXFILEHANDLES' then FMaxFileHandles := StrToInt(v)
      else if n = 'LANGDRIVER' then FSystemLangDriver := v
      else if n = 'AUTO ODBC' then FAutoODBC := StrToBoolean(v)
      else if n = 'DEFAULT DRIVER' then FDefaultDriver := v;
     end;
     if (h <> nil) then DbiCloseCursor(h);
     Check(DbiOpenCfgInfoList(nil, dbiREADWRITE, cfgPersistent,'\DRIVERS\PARADOX\INIT', h));
     FillChar(pCfgDes^, sizeof(CFGDesc), #0);
     while (DbiGetNextRecord(h, dbiWRITELOCK, pCfgDes, nil) = DBIERR_NONE) do begin
      n := StrPas(pCfgDes^.szNodeName);
      v := StrPas(pCfgDes^.szValue);
      if n = 'NET DIR' then FNetFileDir := v
      else if n = 'LANGDRIVER' then FParadoxLangDriver := v;
     end;
     if (h <> nil) then DbiCloseCursor(h);
     Check(DbiOpenCfgInfoList(nil, dbiREADWRITE, cfgPersistent, '\DRIVERS\PARADOX\TABLE CREATE', h));
     FillChar(pCfgDes^, sizeof(CFGDesc), #0);
     while (DbiGetNextRecord(h, dbiWRITELOCK, pCfgDes, nil) = DBIERR_NONE) do begin
      n := StrPas(pCfgDes^.szNodeName);
      v := StrPas(pCfgDes^.szValue);
      if n = 'LEVEL' then FTableLevel := v
     else if n = 'BLOCK SIZE' then FBlockSize := StrToInt(v)
      else if n = 'STRICTINTEGRITY' then FStrictIntegrity := StrToBoolean(v);
     end;
    finally
     FreeMem(pCfgDes, sizeof(CFGDesc));
     if (h <> nil) then DbiCloseCursor(h);
    end;
   end;

   procedure TBDEConfig.SetLocalShare(Value : Boolean);
   begin
    UpdateCfgFile('\SYSTEM\INIT', 'LOCAL SHARE', BooleanToStr(Value));
    FLocalShare := Value;
   end;

   procedure TBDEConfig.SetMinBufSize(Value : Integer);
   begin
   UpdateCfgFile('\SYSTEM\INIT', 'MINBUFSIZE', IntToStr(Value));
    FMinBufSize := Value;
   end;

   procedure TBDEConfig.SetMaxBufSize(Value : Integer);
   begin
    UpdateCfgFile('\SYSTEM\INIT', 'MAXBUFSIZE', IntToStr(Value));
    FMaxBufSize := Value;
   end;

   procedure TBDEConfig.SetSystemLangDriver(Value : String);
   begin
    UpdateCfgFile('\SYSTEM\INIT', 'LANGDRIVER', Value);
    FSystemLangDriver := Value;
   end;

   procedure TBDEConfig.SetParadoxLangDriver(Value : String);
   begin
    UpdateCfgFile('\DRIVERS\PARADOX\INIT', 'LANGDRIVER', Value);
    FParadoxLangDriver := Value;
   end;

   procedure TBDEConfig.SetMaxFileHandles(Value : Integer);
   begin
    UpdateCfgFile('\SYSTEM\INIT', 'MAXFILEHANDLES', IntToStr(Value));
    FMaxFileHandles := Value;
   end;

   procedure TBDEConfig.SetNetFileDir(Value : String);
   begin
    UpdateCfgFile('\DRIVERS\PARADOX\INIT', 'NET DIR', Value);
    FNetFileDir := Value;
   end;

   procedure TBDEConfig.SetTableLevel(Value : String);
   begin
    UpdateCfgFile('\DRIVERS\PARADOX\TABLE CREATE', 'LEVEL', Value);
    FTableLevel := Value;
   end;

   procedure TBDEConfig.SetBlockSize(Value : Integer);
   begin
    UpdateCfgFile('\DRIVERS\PARADOX\TABLE CREATE', 'BLOCK SIZE', IntToStr(Value));
    FBlockSize := Value;
   end;

   procedure TBDEConfig.SetStrictIntegrity(Value : Boolean);
   begin
    UpdateCfgFile('\DRIVERS\PARADOX\TABLE CREATE', 'STRICTINTEGRITY', BooleanToStr(Value));
    FStrictIntegrity := Value;
   end;

   procedure TBDEConfig.SetDefaultDriver(Value : String);
   begin
    UpdateCfgFile('\SYSTEM\INIT', 'DEFAULT DRIVER', Value);
    FDefaultDriver := Value;
   end;

   procedure TBDEConfig.SetAutoODBC(Value : Boolean);
   begin
    UpdateCfgFile('\SYSTEM\INIT', 'AUTO ODBC', BooleanToStr(Value));
    FAutoODBC := Value;
   end;

   procedure TBDEConfig.UpdateCFGFile;
   var
    h : hDbiCur;
    pCfgDes: pCFGDesc;
    pPath : array[0..127] of char;
   begin
    StrPCopy(pPath,Path);
    Check(DbiOpenCfgInfoList(nil, dbiREADWRITE, cfgPersistent, pPath, h));
    GetMem(pCfgDes, sizeof(CFGDesc));
    try
     FillChar(pCfgDes^, sizeof(CFGDesc), #0);
     while (DbiGetNextRecord(h, dbiWRITELOCK, pCfgDes, nil) = DBIERR_NONE) do begin
     if StrPas(pCfgDes^.szNodeName) = item then begin
       StrPCopy(pCfgDes^.szValue, value);
       Check(DbiModifyRecord(h, pCfgDes, True));
      end;
     end;
    finally
     FreeMem(pCfgDes, sizeof(CFGDesc));
     if (h <> nil) then DbiCloseCursor(h);
    end;
   end;

   constructor TBDEConfig.Create(AOwner: TComponent);
   begin
    inherited Create(AOwner);
    Init;
   end;

   destructor TBDEConfig.Destroy;
   begin
    inherited Destroy;
   end;

   end.
   Eryk Bottomley

Default Cursor после завершения выполнения запросов

   Тема: Возврат курсора по умолчанию после выполнения запроса

   Почему мышиный курсор не возвращается обратно (не становится обычной стрелкой) после выполнения запроса?
   При выполнении открытого запроса, Delphi изменяет для вас курсор, и произойти это может даже в середине события, как, например, при нажатии на кнопку. Приведенный ниже пример отобразит курсор в виде иконки песочных часов (SQL Hourglass Icon) после того, как вы закроете окно с сообщением. При этом мышь будет вести себя так, как будто находится в режиме "стрелки".
   // Добавьте к обработчику события нажатия кнопки,
   // использование запроса при этом не имеет значения
   // Select * from Customer (в IBLocal)
   with query1 do begin
    close;
    open;
    showmessage(IntToStr(RecordCount));
   end; // with
   При наступлении события, Delphi пробует обратно придать курсору тип стрелки (Arrow), при этом выводится новая форма (диалог showmessage), которая мешает автоматическому переводу курсора в режим стрелки.
   Для решения этой проблемы нужно добавить Application.ProcessMessages прежде, чем форма будет показана, это позволит обработать все сообщения, скопившиеся в очереди (и очистить ее), после чего мышиный курсор вновь пример нормальную форму.
   // Добавьте к обработчику события нажатия кнопки,
   // использование запроса при этом не имеет значения
   // Select * from Customer (в IBLocal)
   with query1 do begin
    close;
    open;
    application.ProcessMessages; // Добавьте эту строку.
    showmessage(IntToStr(RecordCount));
   end; // with

Протокол блокировки BDE

   Тема: BDE и Database Desktop Locking Protocol
   Предполагаемая аудитория
   Данная информация будет полезна каждому, кто решил разрабатывать приложения для работы с базами данных с использованием Delphi и BDE.
   Предварительные условия
   Базовые знания или интерес к протоколам блокировки Paradox и форматам таблиц.
   Цель
   Дать пользователям лучшее понимание протокола блокировки таблицы.
   Таблицы, типы полей и поддерживаемые характеристики
   Каждый следующий выпуск Paradox, начиная с версии 2.0, содержал улучшения структуры таблицы. Все типы таблиц Paradox, начиная с Paradox 1.0 и заканчивая Paradox 3.5, совместимые друг с другом.
   Paradox 4.0 добавляет новый тип данных к формату таблиц: Binary Large Objects (бинарные большие объекты), обычно известные как BLOb'ы, и новые типы вторичных индексов. Paradox 4.0 поддерживает два типа BLOb-полей: Memo и BLOb. Paradox старее версии 4.0 и Engine до версии 3.0 не могут читать, писать и создавать этот новый табличный формат. При попытке чтения или записи таблиц типа Paradox 4.0 более ранней версией Paradox, вы получите ошибку о защите таблицы паролем.
   Paradox 5.0 добавляет несколько новых типов данных к формату таблиц: Long Integer, Time, TimeStamp, Logical, Autoincrement, BCD, Bytes. Paradox 7.0 добавляет наследуемый вторичный индекс. Создание или любое изменение таблицы переводит ее формат на новый уровень, включающий все вышеописанные характеристики. По умолчанию создаваемая с использованием Database Desktop или BDE (Borland Database Engine) таблица имеет тип Paradox 4.0. Данный тип, заданный по умолчанию, может быть изменен с помощью утилиты BDE configuration utility или Database desktop configuration utility, и ему может быть присвоен тип Paradox 3, 4, 5 или 7 для BDE.
   Paradox 4.0 может читать, писать и создавать таблицы типа Paradox, совместимые с таблицами версий от Paradox 1.0 до Paradox 4.0. Так, таблица, созданая в Paradox 1.0, совместима с Paradox 4.0. Таблица, созданная в Engine 1.0 или 2.0, может быть прочитана и записана в Paradox 4.0.
   Paradox и Engine не изменяет тип таблицы при чтении или записи. Тип таблицы изменяется только при ее реструктуризации.
   Протоколы блокировки Paradox
   Есть два различных протокола блокировки Paradox: протокол, введенный в Paradox 2.0 и протокол, введенный в Paradox 4.0. Эти два протокола не совместимы друг с другом. Протокол блокировки не оказывает влияния на тип таблицы, с которым может работать программа. Существуют несколько программ, также поддерживающих протоколы блокировки; тем не менее, эти программы в отдельный момент времени могут поддерживать только один протокол. Здесь мы рассматриваем только протокол блокировки версии 4.0.
   Протокол блокировки Database Desktop/ Paradox 4.0
   Протокол блокировки Paradox 4.0 – единственный протокол, доступный для Paradox 4.0 и IDAPI Engine. Обозначение «Paradox 4.0 locking protocol» представляет данный стиль блокировки.
   Блокировки каталога
   Paradox 4.0 располагает файл блокировки, PDOXUSRS.LCK, в каждом каталоге, в котором доступны таблицы. Файл блокировки регулирует доступ к файлам, расположенным в каталоге. Файл блокировки ссылается на PDOXUSRS.NET, поэтому все пользователи должны подключать данные по одному и тому же пути. При этом в каталоге также располагается эксклюзивный файл PARADOX.LCK. Это делается для того, чтобы предохранить те версии Paradox или Engine, которые используют старую блокировочную систему, от неумышленного получения доступа к таблицам.
   Рабочие каталоги и каталоги общего доступа
   Когда Paradox или Database Desktop необходимо получить доступ к таблицам, расположенным в каталоге, то в этом каталоге они размещают «общий» файл PDOXUSRS.LCK и «эксклюзивный» файл PARADOX.LCK. Этим способом они «метят» каталог для того, чтобы другие пользователи Paradox 4.0 также могли иметь доступ к таблицам, расположенным в данном каталоге. Эксклюзивный файл PARADOX.LCK устанавливается в этом каталоге для обеспечения работы несовместимого протокола блокировки, и, таким образом, для уменьшения риска при постинге данных. В Paradox'е этот каталог известен как рабочий, «Working» каталог.
   Частные/эксклюзивные каталоги
   Для Paradox и Database Desktop также необходим каталог, где они могли бы сохранять временные файлы, например, результаты запроса. При запуске Paradox или Paradox Runtime, они также размещают в каталоге «эксклюзивные» файлы PDOXUSRS.LCK и PARADOX.LCK, определяя данный каталог как место для хранения временных файлов. Это обозначает, что другие пользователи Paradox не смогут получить доступ к таблицам в этом каталоге. В Paradox'е этот каталог известен как частный, «Private» каталог.
   Блокировка таблицы
   Paradox 4.0 размещает каждую табличную блокировку в блокирующем файле PDOXUSRS.LCK, располагаемом в каталоге с таблицами. Теперь нет необходимости в использовании отдельного блокирующего файла для каждой таблицы, как это было в предыдущих версиях. Например, если три пользователя просматривают таблицу CUSTOMER.DB и один пользователь реструктуризирует таблицу ORDERS.DB, то файл PDOXUSRS.LCK будет иметь общую блокировку, указывающую на каждого из тех трех пользователей, просматривающих таблицу CUSTOMER.DB, и эксклюзивную блокировку на ORDERS.DB для пользователя, реструктуризирующего таблицу.
   Протокол блокировки параллельности Paradox 4.0 (Locking Protocol Concurrency)
   В многопользовательской среде протокол блокировки Paradox 4.0 поддерживает параллелизм, т.е. одновременное использование приложений, через файл PDOXUSRS.NET. Все пользователи, которые хотят иметь общий доступ к таблицам Paradox, должны иметь один и тот же путь к файлу PDOXUSRS.NET, но при этом логическая буква сетевого диска может отличаться. Для того, чтобы предотвратить доступ к файлам, расположенным в каталоге, предыдущим версиям, Paradox размещает PDOXUSRS.LCK и эксклюзивный файл PARADOX.LCK в каждом каталоге, где имеются доступные таблицы. Каждый пользователь, который хочет дать общий доступ к таблице в этом каталоге, должен подключить этот каталог с одним и тем же путем, с использованием одного логического сетевого диска и пути. Затем Paradox разместит всю информацию о блокировках для этой таблице в файле PDOXUSRS.LCK, уменьшая этим количество необходимых файлов.
   Сетевой управляющий файл (Network Control File)
   Сетевой управляющий файл Paradox, PDOXUSRS.NET, служит в качестве контрольной точки для всех блокирующих файлов, создаваемых Paradox. Net-файл содержит список пользователей, в настоящий момент использующих BDE, вместе со списком используемых ими таблиц. Каждый блокирующий файл ссылается на сетевой управляющий файл и содержит информацию о блокировках таблицы и пользователях, заблокировавших эти таблицы, поэтому все пользователи должны иметь один и тот же путь к сетевому управляющему файлу, но при этом логическая буква сетевого диска может отличаться.
   Например, если вы используете том DATA на сервере SERVER_1, и сетевой управляющий файл расположен в каталоге \PDOXDATA, то все пользователи должны использовать путь \\SERVER_1\DATA:\PDOXDATA, тем не менее, любой пользователь может при этом использовать свою логическую букву сетевого диска. Если в вашей сети не пользуют тома, DATA должен быть корневым каталогом SERVER_1.
   Если вы подключаете \\SERVER_1\DATA в корень диска P, то каждая система Paradox должна определять расположение PARADOX.NET как P:\PDOXDATA\. Тем не менее, другие пользователи могут подключить \\SERVER_1\DATA к корневому каталогу O и установить O:\PDOXDATA\ как местоположение сетевого управляющего файла.
   Конфигурирование 16-битного Database Engine / IDAPI.CFG
   Файл конфигурации Database Engine хранит специфическую сетевую информацию, список псевдонимов баз дынных и другую информацию. Вы можете конфигурировать IDAPI с помощью программы конфигурации Database Engine, BDECFG.EXE, и устанавливать с помощью нее месторасположение сетевого управляющего файла. Также возможно добавление, удаление и изменение псевдонимов баз данных (включая информацию об используемом драйвере и типе псевдонима), каким способом IDAPI осуществляет общий доступ к локальным таблицам для программ, использующих протокол блокировки Paradox 4.0, а также некоторые особенности относительно таблиц и способа отображения данных.
   Локальные 16-битные установки
   Файл WIN.INI содержит путь к файлу IDAPI.CFG, «рабочему» («Working») каталогу Database Desktop и «частному» («Private») каталогу Database Desktop. Для изменения этих значений необходимо загрузить файл WIN.INI в любой текстовый редактор и отредактировать его. Путь к файлу IDAPI.CFG описан в группе [IDAPI] как CONFIGFILE=<полный диск, путь и имя файла> или CONFIGFILE01=<полный диск, путь и имя файла>.
   Месторасположение «рабочего» («Working») и «частного» («Private») каталога Database Desktop описано в группе [DBD] соответственно как WORKDIR=<полный диск и каталог> и PRIVDIR=<полный диск и каталог>.
   Конфигурирование 32-битного Database Engine / IDAPI32.CFG
   Конфигурационный файл BDE хранит ту же информацию, что и конфигурационный файл Database Engine. Для конфигурирования IDAPI32.CFG используется утилита BDE Configuration, BDECFG32.EXE. Вдобавок к этому, вы можете сохранять информацию в регистрах, или сразу, и в регистрах, и в IDAPI32.CFG.
   Локальные 32-битные установки
   В регистрах содержится путь к IDAPI32.CFG, к «рабочему» («Working») и частному («Private») каталогу. Месторасположение файла IDAPI32.CFG хранится в ключе HKEY_LOCAL_MACHINE\Software\Borland\Database Engine. Значение CONFIGFILE01 содержит данные типа <полный диск, путь и имя файла>.
   Месторасположение каталогов BDE «Working» и «Private» хранится соответственно в ключах HKEY_CURRENT_USER\Software\Borland\DBD\7.0\Configuration\WorkDir и HKEY_CURRENT_USER\Software\Borland\DBD\7.0\Configuration\PrivDir. По умолчанию, данные для каждого каталога хранятся в виде <Полный диск и каталог>.
   Доступ к таблицам Paradox
   BDE сначала пытается получить доступ к файлу PDOXUSRS.NET. Если файл PDOXUSRS.NET не найден, Paradox создает новый файл PDOXUSRS.NET и продолжает процедуру запуска. Если файл PDOXUSRS.NET присутствует, но владелец этого net-файла использует другой путь, т.е. подключил сервер иначе, возникает исключительная ситуация «Multiple net files in use» (Используются несколько net-файлов) и BDE прекращает свою работу. После того, как сеть успешно открыла эксклюзивную блокировку, PARADOX.LCK размещается во временном, частном каталоге. При невозможности установки блокировки, BDE прекращает свою работу. Причина неудачи может заключаться в том, что какой-то пользователь имеет в этом каталоге эксклюзивную блокировку, или же файлы блокировки используют различные net-файлы. После того, как каталог будет защищен от частного использования, общий файл PARADOX.LCK будет расположен в рабочем каталоге, и на этом процесс инициализации будет завершен.

Я так и не смог заставить выводить текст с помощью DBMS_OUTPUT.PUT_LINE в режиме отладки

Nomadic отвечает:
Эта функция используется действительно только для отладки. Для того, чтобы результаты ее работы были видны из SQL Plus, необходимо в нем выдать команду: set serveroutput on size 10000;

После analyze_schema некоторые (приличное количество) из запросов начинают сильно тормозить. Как лечить?

   Nomadic отвечает:
   Это у всех так или у воркгрупп 7.3.2 под HТ только? Пока полечил удалением статистики. Хинтить не предлагайте, запросы генерит crystal report, а он очень трепетно относится к редактированию sql-предложения в некоторых местах…
   А ты метод оптимизатора по дефолту переключи в RULE. Это можно сделать разными способами :
   1. ALTER SESSION SET OPTIMIZER_GOAL = … (это только для данной сессии)
   2. При старте инстанса поправить параметр OPTIMIZER_MODE (это для всех сессий)

Определение установленной BDE

   Для Delphi 2 проверьте регистрацию в ключе регистра
   HKEY_LOCAL_MACHINE\Software\Borland\Database Engine
   Для Delphi 1 проверьте в файле Win.INI секцию с именем IDAPI
   [IDAPI]
   DLLPATH=3DD:\WINPROG\DELPHI\IDAPI
   CONFIGFILE01=3DD:\WINPROG\DELPHI\IDAPI\IDAPI.CFG
   Хотя это и не лучший путь, поскольку пользователь может удалить BDE, а регистры или INI-файл будут хранить эту информацию.

Установка BDE

   Вот имена файлов, которые вам нужно установить в рантайме:
   Borland Database Engine
   Уникальный файл на BDE Disk #1
   Имя файла :– IDAPICFG.PAK
   Устанавливаемый Exe :-Setup.exe

   Borland SQL Links
   Уникальный файл на SQL Disk #1
   Имя файла :– MNOVLWP.PAK
   Устанавливаемый Exe :-Setup.exe

   Borland ReportSmith Runtime
   Уникальный файл на RPT Disk #1
   Имя файла :– INSTXTRA.PAK
   Устанавливаемый Exe :-Setup.exe
   Borland настоятельно рекомендует при установке рантайм-версий пользоваться программами установки.

Каковы текущие ограничения BDE?

   Nomadic отвечает:
   BDE: под Windows, все версии.
   Если Вы обнаружите, что Вы ограничены более строго, чем здесь описано, или Вы получаете ошибку выхода за пределы доступной памяти, то увеличение параметра SHAREDMEMSIZE в BDE Config до 4096 или более может способствовать снятию более строгих ограничений.
   Здесь указаны максимальные ограничения для некоторых общих обьектов BDE.
   Основные ограничения BDE:
   • 48 клиентов в системе;
   • 32 сессии на одного клиента (для версии 3.5 и ниже, 16 Bit, 32 Bit)
   • 256 сессий на одного клиента (для версии 4.0 и выше, 32 Bit)
   • 32 открытых баз данных на сессию (для версии 3.5 и ниже, 16 Bit, 32 Bit)
   • 2048 открытых баз данных на сессию (для версии 4.0 и выше, 32 Bit)
   • 32 загруженных драйвера
   • 64 сессии в системе (для версии 3.5 и ниже, 16 Bit, 32 Bit)
   • 12288 сессии в системе (для версии 4.0 и выше, 32 Bit)
   • 4000 курсоров на сессию
   • 16 вхождений в стеке ошибок
   • 8 типов таблиц на один драйвер
   • 16 типов полей на один драйвер
   • 8 типов индексов на один драйвер
   • 48K Размер конфигурационного файла (IDAPI.CFG)
   • 64K Максимальный размер оператора SQL при RequestLive=False
   • 4K Максимальный размер оператора SQL при RequestLive=True (для версии 4.0 и ниже, 16/32 Bit)
   • 6K Максимальный размер оператора SQL при RequestLive=True (для версии 4.01 и выше, 32 Bit)
   • 16K Размер буфера записи (SQL и ODBC)
   • 31 Размер имени таблицы и имени поля в символах
   • 64 Размер имени хранимой процедуры в символах
   • 16 Полей в ключе
   • 3 Размер расширения имени файла в символах
   • 260 Длина имени таблицы в символах (некоторые сервера могут иметь другие ограничения)
   • 260 Длина полного имени файла и пути файловой системы в символах
   Ограничения Paradox:
   • 127 открытых таблиц в системе (для версии 4.0 и ниже, 16/32 Bit)
   • 254 открытых таблиц в системе (для версии 4.01 и выше, 32 Bit)
   • 64 блокировки на запись на одну таблицу (16Bit) на одну сессию
   • 255 блокировок на запись на одну таблицу (32Bit) на одну сессию
   • 255 записей, учавствующих в транзакции на таблицу (32 Bit)
   • 512 открытых физически файлов (DB, PX, MB, X??, Y??, VAL, TV) (для версии 4.0 и ниже, 16/32 Bit)
   • 1024 открытых физически файлов (DB, PX, MB, X??, Y??, VAL, TV) (для версии 4.01 и выше, 32 Bit)
   • 300 пользователей в одном файле PDOXUSRS.NET
   • 255 полей в таблице
   • 255 размер символьных полей
   • 2 миллиарда записей в таблице
   • 2 миллиарда байт в .DB (таблица) файле
   • 10800 байт на запись для индексированных таблиц
   • 32750 байт на запись для неиндексированных таблиц
   • 127 вторичных индексов на таблицу
   • 16 полей на индекс
   • 255 одновременно работающих пользователей на таблицу
   • 256 Мегабайт данных на одно BLOb поле
   • 100 паролей на сессию
   • 15 длина пароля
   • 63 паролей на таблицу
   • 159 полей с проверками корректности (validity check) (32 Bit)
   • 63 поля с проверками корректности (validity check) (16 Bit)
   Ограничения dBase:
   • 256 открытых таблиц dBASE на систему (16 Bit)
   • 350 открытых таблиц dBASE на систему (BDE 3.0 – 4.0, 32 Bit)
   • 512 открытых таблиц dBASE на систему (BDE 4.01 и выше, 32 Bit)
   • 100 блокировок на запись на одной таблице dBASE (16 and 32 Bit)
   • 100 записей, учавствующих в транзакции на таблицу (32 Bit)
   • 1 миллиард записей в таблице
   • 2 миллиарда байт в файле .DBF (таблица)
   • 4000 Размер записи в байтах (dBASE 4)
   • 32767 Размер записи в байтах (dBASE for Windows)
   • 255 Количество полей в таблице (dBASE 4)
   • 1024 Количество полей в таблице (dBASE for Windows)
   • 47 Количество тэгов индексов на один .MDX-файл.
   • 254 Размер символьных полей
   • 10 открытых основных индексов (.MDX) на таблицу
   • 220 Длина ключевого выражения в символах

В процессе работы программы изменилась структура БД (alter table etc.). Программа продолжала успешно открывать таблицы, но запросы посылались в соответствии со старой схемой данных

   Nomadic отвечает:
   В установках BDE (Configuration utility или BDEAdmin) можно выставить SCHEMA CACHE = FALSE (не кэшировать схему данных).
   Но в некоторых случаях ошибки такого рода все-таки происходят. В таком случае необходимо воспользоваться методом TDatabase.FlushSchemaCache после каждого изменения метаданных.

Как в Delphi сбросить кэш БД на диск?

   Nomadic отвечает:
   uses BDE {в Delphi 1.x не помню, но вроде bdeprocs};
   dbiSaveChanges
   На Delphi 1.x (16bit) дополнительно вызовите эту процедуру -
   procedure DropCache; assembler;
   asm
    mov ah,$0D
    int $21
   end;

Как настроить MS SQL Server 6.5 на корректную работу с числами и BDE при выполнении UPDATE?

   Nomadic отвечает:
   Дело в том, что SQL Links на NT-ишном клиенте шлет на сервер дату как 1-янв-97, что сервер не пpиемлет. Совершенно случайно я нашел системный скрипт, который подключает русский и болгарский языки.
   1. выполни sp_configure и убедись, что у тебя default sortorder id==106 (rus case insens) или 105 (rus case sens). Если нет – переставь сервер.
   2. найди в каталоге c:\mssql\install скрипт instlang.sql и запусти его.
   3. либо руками каждому проставь каждому логину, работающему с NT, язык русский, либо поставь его как default language серверу. В этом случае 95-м клиентам придется руками прописать в логине язык us_english, иначе они перестанут работать.
   Для установки russian как default надо выполнить скрипт:
   exec sp_configure 'default language', 2
   go
   reconfigure
   go

Как научить VCL делать Refresh для запросов правильно?

   Особенно интересует Refresh для связки Master-Detail.

   Nomadic отвечает:
   Старо как мир, и нет ничего военного:
   procedure RefreshQuery(Query: TQuery; F: boolean);
   var B: TBookMark;
   begin
    with Query do if Query.Active then begin
     B := GetBookMark;
     try
      Close;
      Unprepare; {Если не поставить этого, то если используется select SP, то иногда последующая операция вешает сервер. Кто скажет почему?!}
      Active:=True;
      if F then begin
       try
        GotoBookMark(B)
       except on EDatabaseError do First;
       end
      end else First;
     finally
      FreeBookmark(B);
     end;
    end;
   end;
   Уфф! Кажется, лучше уже не сделать. :)
   dbtables можно опционально пропатчить (см. в конце), чтобы иметь такой вот рyлезный Detail query.
   Update for dbtables.pas
   New interface function DoRefreshQuery can Refresh TQuery component in master-detail scheme and alone.
   TQuery.RefreshParams should be updated
   function GetFieldNamesStr(DataSet: TDataSet): String;
   var I: Integer;
   begin
    Result := '';
    with DataSet do for I := 0 to FieldCount - 1 do begin
     Result := Result + Fields[ I ].FieldName + ';';
    end;
   end;

   procedure DoRefreshQuery(Query: TQuery; KeyFields: String; BookMarkSearch: Boolean);
   var
    Fields: TList;
    KeyValues: Variant;
    KeyNames: String;
    Bmk: TBookmark;
    I: Integer;
    BookmarkFound: Boolean;
    CanLocate: Boolean;
   begin
    Fields := TList.Create;
    if KeyFields = '' then KeyFields := GetFieldNamesStr(Query);
    try
     Query.GetFieldList(Fields, KeyFields);
     for I := Fields.Count - 1 downto 0 do with TField(Fields[I]) do
      if Calculated or Lookup then Fields.Delete(I);
     CanLocate := Fields.Count > 0;
     if CanLocate then begin
      if Fields.Count = 1 then KeyValues := TField(Fields[0]).Value
      else begin
       KeyValues := VarArrayCreate([0, Fields.Count - 1], varVariant);
       KeyValues[0] := TField(Fields[0]).Value;
      end;
      KeyNames := TField(Fields[0]).FieldName;
      for I := 1 to Fields.Count - 1 do begin
       KeyNames := KeyNames + ';' + TField(Fields[I]).FieldName;
       KeyValues[I] := TField(Fields[I]).Value;
      end;
     end;
    finally
     Fields.Free;
    end;
    with Query do begin
     Bmk := nil;
     DisableControls;
     try
      BookmarkFound := False;
      if BookMarkSearch then Bmk := GetBookmark;
      Close;
      Open;
      if Assigned(Bmk) then try
       GotoBookMark(Bmk);
       BookmarkFound := True;
      except
      end;
      if not BookmarkFound and CanLocate then Locate(KeyNames, KeyValues, []);
     finally
      EnableControls;
      Screen.Cursor := crDefault;
      FreeBookmark(Bmk);
     end;
    end;
   end;

   procedure TQuery.RefreshParams;
   var DataSet: TDataSet;
   begin
    DisableControls;
    try
     if FDataLink.DataSource <> nil then begin
      DataSet := FDataLink.DataSource.DataSet;
      if DataSet <> nil then
       if DataSet.Active and (DataSet.State <> dsSetKey) then
        DoRefreshQuery(Self, GetFieldNamesStr(Self), False);
     end;
    finally
     EnableControls;
    end;
   end;

Как заставить BDE сохранять в БД поле времени с сотыми долями секунды?

   Nomadic отвечает:
   Если руками, то в BDE Administrator (BDE Configuration Utility).
   Если при инсталляции твоей программы, то –
   В пункте Make Registry Changes InstallShield'а создай ключ
   HKEY_LOCAL_MACHINE\SOFTWARE\Borland\Database Engine\Settings\SYSTEM\FORMATS\TIME\MILSECONDS=TRUE

Запись буфера BDE на диск

   Общее:
   Сделанные в таблице изменения непосредственно на диск не записываются до тех пор, пока таблица не будет закрыта. Потеря питания или сбой в системе может привести к потере данных и прочим неприятностям. Чтобы избежать этого, существует два прямых вызова Database Engine, дающих один и тот же результат. Эти функции – DbiUseIdleTime и DbiSaveChanges.
   DbiSaveChanges(hDBICur):
   DbiSaveChanges сохраняет на диске все обновления, находящиеся в буфере таблицы, связанной с курсором (hDBICur). Может быть вызвана из любого места программы. Например, можно при каждом обновлении записи сохранять на диске все изменения (добавьте dbiProcs в список используемых модулей):
   procedure TForm1.Table1AfterPost(DataSet: TDataSet);
   begin
    DbiSaveChanges(Table1.handle);
   end;
   При таком способе можно не беспокоиться насчет потерь данных в случае потери питания или сбоя системы, которое может произойти после обновления записи.
   DbiSaveChanges также можно использовать для того, чтобы временную таблицу (созданную с помощью DbiCreateTempTable) сделать постоянной.
   Эта функция не применима к таблицам SQL.
   DbiUseIdleTime:
   DbiUseIdleTime может быть вызвана, если «Windows Message Queue» (очередь запросов Windows) пуста. Это позволяет Database Engine сохранить на диске «грязные буферы». Другими словами, выполняется операция DbiSaveChanges, но применительно ко ВСЕМ измененным таблицам. Тем не менее, данная операция не обязательно должна выполняться после каждого обновления записи, ее нужно приберечь для «холостого» периода (период простоя, idle).
   В Delphi это может быть использовано таким образом (добавьте dbiProcs в список используемых модулей):
   procedure TForm1.FormCreate(Sender: TObject);
   begin
    Application.onIdle := UseIdle;
   end;

   procedure Tform1.UseIdle(Sender: TObject; var Done: Boolean);
   begin
    DbiUseIdleTime;
   end;
   Некоторые замечания:
   Использование обоих вызовов DbiUseIdleTime и DbiSaveChanges (после каждого обновления записи) излишне и сопровождается необязательными вызовами функций. Если приложение выполняет множественный ввод новых записей или их редактирование в течение небольшого периода времени, рекомендуем осуществлять вызов функции DbiUseIdleTime во время простоя клинта, а вызов DbiSaveChanges после осуществления «пакета» обновлений.
   В случае, если в таблице выполняется не слишком много изменений, клиент может использовать вызов DbiSaveChanges после каждого постинга или же «повесить» на таймер вызов DbiUseIdleTime.

Internet

Мультимедиа

Аппаратное обеспечение

Операционная система

Буфер обмена

Как удобнее работать с буфером обмена как с последовательностью байт?

   Из советов Nomadic'a:
   Используя потоки —
   unit ClipStrm;
   {
    This unit is Copyright (c) Alexey Mahotkin 1997-1998
    and may be used freely for any purpose. Please mail
    your comments to
    E-Mail: alexm@hsys.msk.ru
    FidoNet: Alexey Mahotkin, 2:5020/433

    This unit was developed during incorporating of TP Lex/Yacc
    into my project. Please visit ftp://ftp.nf.ru/pub/alexm
    or FREQ FILES from 2:5020/433 or mail me to get hacked
    version of TP Lex/Yacc which works under Delphi 2.0+.
   }

   interface uses Classes, Windows;

   type TClipboardStream = class(TStream)
   private
    FMemory : pointer;
    FSize : longint;
    FPosition : longint;
    FFormat : word;
   public
    constructor Create(fmt : word);
    destructor Destroy; override;
    function Read(var Buffer; Count : Longint) : Longint; override;
    function Write(const Buffer; Count : Longint) : Longint; override;
    function Seek(Offset : Longint; Origin : Word) : Longint; override;
   end;

   implementation uses SysUtils;

   constructor TClipboardStream.Create(fmt : word);
   var
    tmp : pointer;
    FHandle : THandle;
   begin
    FFormat := fmt;
    OpenClipboard(0);
    FHandle := GetClipboardData(FFormat);
    FSize := GlobalSize(FHandle);
    FMemory := AllocMem(FSize);
    tmp := GlobalLock(FHandle);
    MoveMemory(FMemory, tmp, FSize);
    GlobalUnlock(FHandle);
    FPosition := 0;
    CloseClipboard;
   end;

   destructor TClipboardStream.Destroy;
   begin
    FreeMem(FMemory);
   end;

   function TClipboardStream.Read(var Buffer; Count : longint) : longint;
   begin
    if FPosition + Count > FSize then Result := FSize - FPosition
    else Result := Count;
    MoveMemory(@Buffer, PChar(FMemory) + FPosition, Result);
    Inc(FPosition, Result);
   end;

   function TClipboardStream.Write(const Buffer; Count : longint) : longint;
   var
    FHandle : HGlobal;
    tmp : pointer;
   begin
    ReallocMem(FMemory, FPosition + Count);
    MoveMemory(PChar(FMemory) + FPosition, @Buffer, Count);
    FPosition := FPosition + Count;
    FSize := FPosition;
    FHandle := GlobalAlloc(GMEM_MOVEABLE or GMEM_SHARE or GMEM_ZEROINIT, FSize);
    try
     tmp := GlobalLock(FHandle);
     try
      MoveMemory(tmp, FMemory, FSize);
      OpenClipboard(0);
      SetClipboardData(FFormat, FHandle);
     finally
      GlobalUnlock(FHandle);
     end;
     CloseClipboard;
    except
     GlobalFree(FHandle);
    end;
    Result := Count;
   end;

   function TClipboardStream.Seek(Offset : Longint; Origin : Word) : Longint;
   begin
    case Origin of
    0 : FPosition := Offset;
    1 : Inc(FPosition, Offset);
    2 : FPosition := FSize + Offset;
    end;
    Result := FPosition;
   end;
   end.

Шрифты

Хранение стилей шрифта

   Как мне сохранить свойство шрифта Style, ведь он же набор?
   Вы можете получать и устанавливать FontStyle через его преобразование к типу byte.
   Для примера,
   Var Style: TFontStyles;
   begin
    { Сохраняем стиль шрифта в байте }
    Style := Canvas.Font.Style; {необходимо, поскольку Font.Style – свойство}
    ByteValue := Byte(Style);
    { Преобразуем значение byte в TFontStyles }
    Canvas.Font.Style := TFontStyles(ByteValue);
   end;
   Для восстановления шрифта, вам необходимо сохранить параметры Color, Name, Pitch, Style и Size в базе данных и назначить их соответствующим свойствам при загрузке.
   – Robert Wittig

Управление настройками шрифта

   {
    Данный код изменяет стиль шрифта поля редактирования,
    если оно выбрано. Может быть адаприрован для управления
    шрифтами в других объектах.
    Расположите на форме Edit(Edit1) и ListBox(ListBox1).
    Добавьте следующие элементы (Items) к ListBox:
     fsBold
     fsItalic
     fsUnderLine
     fsStrikeOut
   }
   procedure TForm1.ListBox1Click(Sender: TObject);
   var X: Integer;
   type TLookUpRec = record
    Name: String;
    Data: TFontStyle;
   end;
   const LookUpTable: array[1..4] of TLookUpRec = (
    (Name: 'fsBold'; Data: fsBold),
    (Name: 'fsItalic'; Data: fsItalic),
    (Name: 'fsUnderline'; Data: fsUnderline),
    (Name: 'fsStrikeOut'; Data: fsStrikeOut));
   begin
    X := ListBox1.ItemIndex;
    Edit1.Text := ListBox1.Items[X];
    Edit1.Font.Style := [LookUpTable[ListBox1.ItemIndex+1].Data];
   end;

Перетащи и брось (Drag and Drop)

Как получить список файлов, которые были перенесены на мою форму, например, из Проводника?

   Из советов Nomadic'a:
   Развлекался когда-то — вот, осталось:
   unit Unit1;

   interface

   uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ShellAPI, Grids, StdCtrls;

   type TForm1 = class(TForm)
    lb: TListBox;
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
   private
    procedure WMDropFiles(var M: TMessage); message WM_DROPFILES;
    { Private declarations }
   public
    { Public declarations }
   end;

   var Form1: TForm1;

   implementation

   Var
    CountFiles: integer;
    SizeName  : integer;
    cch       : integer;

   Var
    hDrop: integer;
    Point: TPoint;
    lpszFile: PChar;

   {$R *.DFM}

   procedure TForm1.WMDropFiles(var M: TMessage);
   Var i: integer;
   begin
    hDrop:= M.WParam;
    DragQueryPoint(hDrop, Point);
    CountFiles:= DragQueryFile(hDrop, $FFFFFFFF, nil, cch);
    for i:=0 to CountFiles-1 do begin
     SizeName:= DragQueryFile(hDrop, i, nil, cch);
     GetMem(lpszFile, SizeName+1);
     DragQueryFile(hDrop, i, lpszFile, SizeName+1);
     lb.Items.Add(lpszFile);
     FreeMem(lpszFile, SizeName+1);
    end;
    DragFinish(hDrop);
   end;

   procedure TForm1.FormCreate(Sender: TObject);
   begin
    DragAcceptFiles(Handle,True);
   end;

   procedure TForm1.Button1Click(Sender: TObject);
   begin
    lb.Items.Clear;
   end;

   procedure TForm1.Button2Click(Sender: TObject);
   begin
    ShellAbout(Handle, 'Anton Saburov', 'APSystems', 0);
   end;
   end.

Рабочий стол

Как програмным путем задавать координаты ярлыкам на рабочем столе?

   Рабочий стол перекрыт сверху компонентом ListView. Вам просто необходимо взять хэндл этого органа управления. Пример:
   function GetDesktopListViewHandle: THandle;
   var S: String;
   begin
    Result := FindWindow('ProgMan', nil);
    Result := GetWindow(Result, GW_CHILD);
    Result := GetWindow(Result, GW_CHILD);
    SetLength(S, 40);
    GetClassName(Result, PChar(S), 39);
    if PChar(S) <> 'SysListView32' then Result := 0;
   end;
   После того, как Вы взяли тот хэндл, Вы можете использовать API этого ListView, определенный в модуле CommCtrl, для того, чтобы манипулировать рабочим столом. Смотрите тему «LVM_xxxx messages» в оперативной справке по Win32.
   К примеру, следующая строка кода:
   ListView_SetItemPosition(GetDesktopListViewHandle, i, x, y); {Не забудьте в uses добавить CommCtrl}
   ярлыку с индексом i, задаст координаты (x,y). К примеру Мой компьютер имеет индекс 0, т.е i:=0;
   С наилучшими пожеланиями, Сергей.
   E-mail: ssa_sss@mail.ru
   Nomadic дополняет:
   К примеру, следующая строка кода:
   SendMessage(GetDesktopListViewHandle, LVM_ALIGN, LVA_ALIGNLEFT, 0);
   разместит иконки рабочего стола по левой стороне рабочего стола Windows.

Как я могу использовать анимированный курсор?

   Из советов Nomadic'a:
   Сперва Вы должны взять хэндл курсора Windows и присвоить его одному из элементов массива Cursors обьекта Screen.
   Предопределенные курсоры имеют отрицательный индекс, а определенные пользователем (Вами) курсоры получают положительные индексы.
   Ниже пример формы, использующей анимированный курсор:
   procedure TForm1.Button1Click(Sender: TObject);
   var h: THandle;
   begin
    h:= LoadImage(0, 'C:\TheWall\Magic.ani', IMAGE_CURSOR, 0, 0, LR_DEFAULTSIZE or LR_LOADFROMFILE);
    if h = 0 then ShowMessage('Cursor not loaded')
    else begin
     Screen.Cursors[1] := h;
     Form1.Cursor := 1;
    end;
   end;

Как узнать текущее разрешение экрана?

   Из советов Nomadic'a :
   Советуем ознакомиться с Help topic относительно глобального обьекта Screen типа TScreen. У этого обьекта есть свойства Width и Height.
   { Example }
   begin
    iScreenWidth := Screen.Width;
   end;
   Заодно и другие свойства могут Вас заинтересовать, например, Fonts и Cursors.

Как изменить изображение кнопки `Пуск`

   The_Sprite советует:
   Пример из серии "Что можно сделать с рабочим столом". В общем, это обычный трюк с кнопкой "Пуск" (Start).
   Совместимость: все версии Delphi
   { объявляем глобальные переменные }
   var
    Form1: TForm1;
    StartButton: hWnd;
    OldBitmap: THandle;
    NewImage: TPicture;
   { добавляем следующий код в событие формы OnCreate }
   procedure TForm1.FormCreate(Sender: TObject);
   begin
    NewImage := TPicture.create;
    NewImage.LoadFromFile('C:\Windows\Circles.BMP');
    StartButton := FindWindowEx(FindWindow('Shell_TrayWnd', nil), 0, 'Button', nil);
    OldBitmap := SendMessage(StartButton, BM_SetImage, 0, NewImage.Bitmap.Handle);
   end;
   { Событие OnDestroy }
   procedure TForm1.FormDestroy(Sender: TObject);
   begin
    SendMessage(StartButton, BM_SetImage, 0, OldBitmap);
    NewImage.Free;
   end;

Как программно заменить обои на рабочем столе? III

   Igor Nikolaev aKa The Sprite советует:
   program wallpapr;
   uses Registry, WinProcs;
   procedure SetWallpaper(sWallpaperBMPPath: String; bTile: boolean);
   var reg : TRegIniFile;
   begin
    // Изменяем ключи реестра
    // HKEY_CURRENT_USER
    //   Control Panel\Desktop
    //     TileWallpaper (REG_SZ)
    //     Wallpaper (REG_SZ)
    reg := TRegIniFile.Create('Control Panel\Desktop');
    with reg do begin
     WriteString('', 'Wallpaper', sWallpaperBMPPath);
     if (bTile) then begin
      WriteString('', 'TileWallpaper', '1');
     end else begin
      WriteString('', 'TileWallpaper', '0');
    end;
   end;
   reg.Free;
   // Оповещаем всех о том, что мы изменили системные настройки
   SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, Nil,
    {Эта строка – продолжение предыдущей} SPIF_SENDWININICHANGE);
   end;
   // пример установки WallPaper по центру рабочего стола
   SetWallpaper('c:\winnt\winnt.bmp', False);
   //Эту строчку надо написать где-то в программе.

Как программно заменить обои на рабочем столе? IV

   Владимир Рыбант пишет:
   Советы «Как програмно заменить обои на рабочем столе» I, II, III не изменяют обои, если в Windows работает в режиме Active Desktop
   Нужно использовать следующее:
   uses ComObj, ShlObj;
   procedure ChangeActiveWallpaper;
   const CLSID_ActiveDesktop: TGUID = '{75048700-EF1F-11D0-9888-006097DEACF9}';
   var ActiveDesktop: IActiveDesktop;
   begin
    ActiveDesktop := CreateComObject(CLSID_ActiveDesktop) as IActiveDesktop;
    ActiveDesktop.SetWallpaper('c:\windows\forest.bmp', 0);
    ActiveDesktop.ApplyChanges(AD_APPLY_ALL or AD_APPLY_FORCE);
   end;
   Этим способом можно также изменять обои картинками jpg и gif.

А как поместить свою иконку на taskbar, там где часы и переключатель клавиатуры?

Nomadic советует:
A: В библиотеке rxLib есть компонент TrxTrayIcon. Заметьте, что для корректного завершения работы операционной системе вам потребуется обрабатывать сообщение WM_QUERYENDSESSION.

Как ограничить перемещение курсора мыши какой-либо областью экрана?

Nomadic отвечает:
A: ClipCursor(). Учтите, что использование этой функции – плохой тон.

Диалоги

Использование InputBox и InputQuery

   Тема: Использование InputBox, InputQuery и ShowMessage
   Данная функция демонстрирует 3 очень мощных и полезных процедуры, интегрированных в Delphi.
   Диалоговые окна InputBox и InputQuery позволяют пользователю вводить данные.
   Функция InputBox используется в том случае, когда не имеет значения что пользователь выбирает для закрытия диалогового окна – кнопку OK или кнопку Cancel (или нажатие клавиши Esc). Если вам необходимо знать какую кнопку нажал пользователь (OK или Cancel (или нажал клавишу Esc)), используйте функцию InputQuery.
   ShowMessage – другой простой путь отображения сообщения для пользователя.
   procedure TForm1.Button1Click(Sender: TObject);
   var
    s, s1: string;
    b: boolean;
   begin
    s := Trim(InputBox('Новый пароль', 'Пароль', 'masterkey'));
    b := s <> '';
    s1 := s;
    if b then b := InputQuery('Повторите пароль', 'Пароль', s1);
    if not b or (s1 <> s) then ShowMessage('Пароль неверен');
   end;

Текст на кнопках MessageDlg

   Как можно сменить текст на кнопках диалогового окна MessageDlg? Английский язык для текста кнопок пользователь хочет заменить на родной.
   Текст кнопок извлекается из списка строк, расположенных в файле …\DELPHI\SOURCE\VCL\CONSTS.PAS. Отредактируйте его, после чего пересоберите VCL.
   -Steve Schafer

Дополнение

VS дополняет:
Но можно ничего не менять. Вместо MessageDlg использовать MessageBox – функция WINDOWS. И, если ваш WINDOWS русифицирован, то надписи на кнопках в диалоговых окнах будут на русском языке.

Изменения в TOpenDialog

Почитайте про Open Dialog Box (диалоговое окно открытия файла) в файле помощи Windows API. Ознакомьтесь в статье с описанием аргумента lpTemplateName. Главное, вы можете создать новое диалоговое окно для Open Dialog Box и заменить стандартный диалог вашим собственным.

Как вывести диалог выбора каталога?

Nomadic советует:
A: (DS): SelectDirectory, rxLib: TDirectoryEdit.

Сообщения

Как послать самостийное сообщение всем главным окнам в Windows?

   Nomadic советует:
   Пример:
   Var FM_FINDPHOTO: Integer;
   // Для того, чтобы использовать hwnd_Broadcast нужно сперва зарегистрировать уникальное
   // сообщение.
   Initialization
    FM_FindPhoto:=RegisterWindowMessage('MyMessageToAll');
   // Чтобы поймать это сообщение в другом приложении (приёмнике) нужно перекрыть DefaultHandler
   procedure TForm1.DefaultHandler(var Message);
   begin
    with TMessage(Message) do begin
     if Msg = Fm_FindPhoto then MyHandler(WPARAM,LPARAM)
     else Inherited DefaultHandler(Message);
    end;
   end;
   // А теперь можно в приложении-передатчике
   SendMessage(HWND_BROADCAST, FM_FINDPHOTO, 0, 0);
   Кстати, для посылки сообщения дочерним контролам некоего контрола можно использовать метод Broadcast.

Как избавиться от торможения модальных окон?

   Igor Nikolaev aKa The Sprite советует:
   Hемодальные диалоговые окна, находящиеся на экране во время выполнения длительных операций,могут реагировать на действия пользователя очень медленно. Это ограничение Windows, и обойти его можно так:
   while Flag do begin
    PerformOperation;
    Application.ProcessMessages;
    Flag:=ContinueOperation;
   end;

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

   Nomadic отвечает:
   A: Application.ProcessMessages.
   (AA): Если вы хотите отдавать timeslices в нитях, пользуйтесь Sleep(0); это отдаст остаток слайса системе.
   (Win16) Если вы хотите разрешить отработку сообщений другим программам, но не вашей, то лучше пользоваться Yield().

Файловая система

Метка диска под Win32

   По моему глубокому убеждению для получения метки диска в среде Win95 необходимо использовать FindFile. Но это не работает, так?
   Правильно, FindFile в Win32 больше не возвращает имя диска, поскольку в не-FAT файловых системах (например, в NTFS) это работает иначе, чем в FAT. Вместо этого используйте функцию API GetVolumeInformation.
   – Peter Below

Восстанавление длинных имен файлов по известным коротким

   boris советует:
   //---------------------------------------------------------------------
   // Восстанавливает длинные имена файлов по известным коротким (8.3)
   // В качестве аргумента принимает полный или неполный (в т.ч. относительный)
   // путь к файлу, например 'C:\WINDOWS\РАБОЧИ~1\ИТАКДА~1.LNK' или
   // '..\..\COMMON~1\BORLAN~1\BDE\BDEREA~1.TXT'. Понимает сетевые имена.
   // Возвращает полный(!) путь типа 'C:\Windows\Рабочий стол\и так далее.lnk',
   // 'C:\Program Files\Common Files\Borland Shared\BDE\bdereadme.txt',
   // '\\Computer\resource\Folder with long name\File with long name.ext'
   //---------------------------------------------------------------------

   Function RestoreLongName(fn: string): string;

    function LookupLongName(const filename: string): string;
    var sr: TSearchRec;
    begin
     if FindFirst(filename, faAnyFile, sr)=0 then Result:=sr.Name
     else Result:=ExtractFileName(filename);
     SysUtils.FindClose(sr);
    end;

    function GetNextFN: string;
    var i: integer;
    begin
     Result:='';
     if Pos('\\', fn)=1 then begin
      Result:='\\';
      fn:=Copy(fn, 3, length(fn)-2);
      i:=Pos('\', fn);
      if i<>0 then begin
      Result:=Result+Copy(fn,1,i);
       fn:=Copy(fn, i+1, length(fn)-i);
      end;
     end;
     i:=Pos('\', fn);
     if i<>0 then begin
     Result:=Result+Copy(fn,1,i-1);
     fn:=Copy(fn, i+1, length(fn)-i);
     end else begin
     Result:=Result+fn;
     fn:='';
     end;
    end;

   Var name: string;
   Begin
    fn:=ExpandFileName(fn);
    Result:=GetNextFN;
    Repeat
     name:=GetNextFN;
     Result:=Result+'\'+LookupLongName(Result+'\'+name);
    Until length(fn)=0;
   End;

Как указать системе на необходимость сбросить буфера *.INI-файла на диск?

   Nomadic советует:
   procedure FlushIni(FileName: string);
   var
   {$IFDEF WIN32}
    CFileName: array[0..MAX_PATH] of WideChar;
   {$ELSE}
    CFileName: array[0..127] of Char;
   {$ENDIF}
   begin
   {$IFDEF WIN32}
    if (Win32Platform = VER_PLATFORM_WIN32_NT) then begin
     WritePrivateProfileStringW(nil, nil, nil, StringToWideChar(FileName, CFileName, MAX_PATH));
    end else begin
     WritePrivateProfileString(nil, nil, nil, PChar(FileName));
    end;
   {$ELSE}
    WritePrivateProfileString(nil, nil, nil, StrPLCopy(CFileName, FileName, SizeOf(CFileName) – 1));
   {$ENDIF}
   end;

Копирование файлов III

   Nomadic советует:
   Можно так:
   procedure CopyFile(const FileName, DestName: TFileName);
   var
    CopyBuffer: Pointer; { buffer for copying }
    TimeStamp, BytesCopied: Longint;
    Source, Dest: Integer; { handles }
    Destination: TFileName; { holder for expanded destination name }
   const
    ChunkSize: Longint = 8192; { copy in 8K chunks }
   begin
    Destination := ExpandFileName(DestName); { expand the destination path }
    if HasAttr(Destination, faDirectory) then { if destination is a directory... }
     Destination := Destination + '\' + ExtractFileName(FileName); { ...clone file name }
    TimeStamp := FileAge(FileName); { get source's time stamp }
    GetMem(CopyBuffer, ChunkSize); { allocate the buffer }
    try
     Source := FileOpen(FileName, fmShareDenyWrite); { open source file }
     if Source < 0 then raise EFOpenError.Create(FmtLoadStr(SFOpenError, [FileName]));
     try
      Dest := FileCreate(Destination); { create output file; overwrite existing }
      if Dest < 0 then raise EFCreateError.Create(FmtLoadStr(SFCreateError, [Destination]));
      try
       repeat
        BytesCopied := FileRead(Source, CopyBuffer^, ChunkSize); { read chunk }
        if BytesCopied > 0 then { if we read anything... }
         FileWrite(Dest, CopyBuffer^, BytesCopied); { ...write chunk }
       until BytesCopied < ChunkSize; { until we run out of chunks }
      finally
       FileClose(Dest); { close the destination file }
   {        SetFileTimeStamp(Destination, TimeStamp);} { clone source's time stamp }{!!!}
      end;
     finally
      FileClose(Source); { close the source file }
     end;
    finally
     FreeMem(CopyBuffer, ChunkSize); { free the buffer }
    end;
    FileSetDate(Dest,FileGetDate(Source));
   end;
   Хм. IMHO крутовато будет такие функции писать, когда в большинстве случаев достаточно что-нубудь типа нижеприводимого, причем оно даже гибче, так как позволяет скопировать как весь файл пpи From и Count = 0, так и произвольный его кусок.
   function CopyFile(InFile, OutFile: String; From, Count: Longint): Longint;
   var InFS, OutFS: TFileStream;
   begin
    InFS := TFileStream.Create(InFile, fmOpenRead);
    OutFS := TFileStream.Create(OutFile, fmCreate);
    InFS.Seek(From, soFromBeginning);
    Result := OutFS.CopyFrom(InFS, Count);
    InFS.Free;
    OutFS.Free;
   end;
   try..except расставляются по вкусу, а навороты вроде установки атрибутов, даты и времени файла и т.п. для ясности удалены, да и не нужны они в основном никогда.
   Конечно, под Win32 имеет смысл использовать функции CopyFile, SHFileOperation.

Как получить имя папки pабочего стола (не чеpез registry)?

   Nomadic советует:
   Просто очень хочется поработать с shell functions.
   В этом примере делается и это -
   procedure TForm1.Button1Click(Sender: TObject);
    procedure madd(s:string);
    begin
     memo1.lines.add(s);
    end;
   VAR
    ppmalloc:imalloc;
    id:ishellfolder;
    pi:pitemidlist;
    lpname:tstrret;
   begin

    if succeeded(shgetspecialfolderlocation(0, CSIDL_PROGRAMS, pi)) then begin
     madd('Succeeded programs location');
     if succeeded(shgetdesktopfolder(id)) then begin
      madd('Succeeded get desktop folder');
      if succeeded(id.getdisplaynameof(pi, 0, lpname)) then begin
       madd('Succeeded get display name');
       if lpname.uType=2 then begin
        madd(lpname.cstr);
       end;
      end else madd('UnSucceeded get display name');
     end else madd('UnSucceeded get desktop folder');
    end else madd('UNSucceeded programs location');
   end;

Количество строк в текстовом файле

   Если файлы не слишком велики, вы можете сделать так:
   List := TStringList.Create;
   try
    List.LoadFromFile('C:\FILE.TXT');
    Gauge.MaxValue := List.Count;
   finally
    List.Free;
   end;
   Мы читаем в память весь текст, и кроме подсчета строк этот код ничего не делает. Другая идея заключается в использовании не счетчика строк, а счетчика байт. В самом начале вы запрашиваете размер файла (используя функцию Delphi FileSize), и в цикле проходите все байты, как вы делали это со строками. Цикл может выглядеть примерно так (предположим, вы используете стандартный паскалевский тип TEXT):
   Gauge.MaxValue := FileSize(TextFile);
   Reset(TextFile);
   while not eof(TextFile) do begin
    Readln(TextFile, Line);
    { Обработка строки }
    with Gauge do begin
     Progress := Progress + Length(Line) + 2; { 2 для CR/LF }
     Refresh;
    end;
   end;

Копирование файлов IV

   Igor Nikolaev aKa The Sprite советует:
   Copyfile('C:\1.txt', 'C:\files\2.txt', 0);
   где первый параметр – путь и имя нужного файла, а второй путь и имя нового(скопированого) файла
   Если же необходимо задавать имена файлов через Edit, то:
   Copyfile(PChar(edit1.text), PChar(edit2.text), 0);

Сеть

Как узнать доступные сетевые pесуpсы?

   Nomadic советует:
   Вот пример:
   type
    PNetResourceArray = ^TNetResourceArray;
    TNetResourceArray = array[0..MaxInt div SizeOf(TNetResource) - 1] of TNetResource;

   Procedure EnumResources(LpNR:PNetResource);
   Var
    NetHandle: THandle;
    BufSize: Integer;
    Size: Integer;
    NetResources: PNetResourceArray;
    Count: Integer;
    NetResult:Integer;
    I: Integer;
    NewItem:TListItem;
   Begin
    If WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY,
     // RESOURCETYPE_ANY - все ресурсы
     // RESOURCETYPE_DISK - диски
     // RESOURCETYPE_PRINT - принтеры
     0, LpNR, NetHandle) <> NO_ERROR then Exit;
    Try
     BufSize := 50 * SizeOf(TNetResource);
     GetMem(NetResources, BufSize);
     Try
      while True do begin
       Count := -1;
       Size := BufSize;
       NetResult := WNetEnumResource(NetHandle, Count, NetResources, Size);
       If NetResult = ERROR_MORE_DATA then begin
        BufSize := Size;
        ReallocMem(NetResources, BufSize);
        Continue;
       end;
       if NetResult <> NO_ERROR then Exit;
       For I := 0 to Count-1 do Begin
        With NetResources^[I] do Begin
         If RESOURCEUSAGE_CONTAINER = (DwUsage and RESOURCEUSAGE_CONTAINER) then
          EnumResources(@NetResources^[I]);
         If dwDisplayType = RESOURCEDISPLAYTYPE_SHARE Then
          // ^^^^^^^^^^^^^^^^^^^^^^^^^ - ресурс
          // RESOURCEDISPLAYTYPE_SERVER - компьютер
          // RESOURCEDISPLAYTYPE_DOMAIN - рабочая группа
          // RESOURCEDISPLAYTYPE_GENERIC - сеть
         Begin
          NewItem:= Form1.ListView1.Items.Add;
          NewItem.Caption:=LpRemoteName;
         End;
        End;
       End;
      End;
     finally
      FreeMem(NetResources, BufSize);
     end;
    finally
     WNetCloseEnum(NetHandle);
    end;
   End;

   procedure TForm1.Button1Click(Sender: TObject);
   Var OldCursor: TCursor;
   begin
    OldCursor:= Screen.Cursor;
    Screen.Cursor:= crHourGlass;
    With ListView1.Items do Begin
   BeginUpdate;
     Clear;
     EnumResource(nil);
     EndUpdate;
    End;
    Screen.Cursor:= OldCursor;
   end;

Реестр

Как из программы выявить версию Windows, на кого зарегистрирована и т.п.?

   Nomadic пишет:
   Вот тебе кyсочек Windows Registry, pазбиpайся:
   === Cut here! [a.reg] === REGEDIT4
   [HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion]
   "InstallType"=hex:03,00
   "SetupFlags"=hex:08,01,00,00
   "DevicePath"="C:\\WINDOWS\\INF"
   "ProductType"="9"
   "RegisteredOwner"="Jacky Shikerya"
   "RegisteredOrganization"="SigmaЩ Soft. Universal ltd.й"
   "ProductId"="12095-OEM-0004226-12233"
   "LicensingInfo"=""
   "SubVersionNumber"=" B"
   "InventoryPath"="C:\\WINDOWS\\SYSTEM\\PRODINV.DLL"
   "ProgramFilesDir"="C:\\Program Files"
   "CommonFilesDir"="C:\\Program Files\\Common Files"
   "MediaPath"="C:\\WINDOWS\\media"
   "ConfigPath"="C:\\WINDOWS\\config"
   "SystemRoot"="C:\\WINDOWS"
   "OldWinDir"=""
   "ProductName"="Microsoft Windows 95"
   "FirstInstallDateTime"=hex:81,73,b0,22
   "Version"="Windows 95"
   "VersionNumber"="4.00.1111"
   "BootCount"="3"
   "OtherDevicePath"="C:\\WINDOWS\\INF\\OTHER"
   === And cut Here!(or there?!) [a.reg] ===
   В uses пpописываешь модуль Registry и дальше так:
   var
    R:TRegistry;
    No:String;
   begin
    R:=TRegistry.Create;
    R.RootKey:=HKEY_LOCAL_MACHINE;
    R.OpenKey('….', false) {если false то пытается откpыть не создавая}
    No:=R.ReadString('VersionNumber');
    if no=….. then …… else ……
   end;
   Выше был приведён кусочек из Windows 95/98 Registry. В Windows NT эта ветвь находится в разделе [HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion] Кроме того, обязательно посмотрите на список функций WinAPI, имена которых начинаются с Get…. Например, GetComputerName, GetVersionEx, GetSystemInfo, SystemParametersInfo.

Ярлыки (ShortCuts)

Создание ярлыков

   VRSLazy@mail.ru пишет:
   Может ещё так можно ярлыки делать?
   uses … ShlObj, ComObj, ActiveX, shellapi, ComCtrls, ... // не помню какая из них нужна, вообще наити можно поиском в *.pas в каталоге
   // disk:\Program Files\Borland\Delphi5\Source

   procedure SetShortCut(path, cmd, icon, wd, name, arg : String);
   var
    ShellObject:IUnknown;
    LinkFile:IPersistFile;
    ShellLink:IShellLink;
   begin

    Try
     CoInitialize(nil);
     ShellObject:=CreateComObject(CLSID_ShellLink);
     LinkFile:=ShellObject as IPersistFile;
     ShellLink:=ShellObject as IShellLink; // RTFM - интерфейсу IShellLink, там всё описано
     ShellLink.SetPath(@cmd[1]);
     ShellLink.SetWorkingDirectory(@wd[1]);
     ShellLink.SetIconLocation(@icon[1], 0); // вместо 0 можно указать номер иконки если их там много…
     ShellLink.SetDescription(@name[1]);
     ShellLink.SetArguments(@arg[1]);
     LinkFile.Save(PWChar(WideString(path)),true);
    finally
     ShellObject:=Unassigned;
     CoUninitialize;
    end;
   end;

Разное

`Устойчивые` всплывающие подсказки

   На TabbedNotebook у меня есть множество компонентов TEdit. Я изменяю цвет компонентов TEdit на желтый и назначаю свойству Hint компонента строчку предупреждения, если поле редактирования содержит неверные данные.
   Поведение окна со всплывающей подсказкой (hintwindow) позволяет делать его видимым только тогда, когда курсор мыши находится в области элемента управления. Но мой заказчик хочет видеть подсказки все время, пока поле редактирования имеет фокус.
   Я не знаю как изменить поведение всплывающей подсказки, заданное по умолчанию. Я знаю что это возможно, но кто мне подскажет как?
   Ниже приведен модуль, содержащий новый тип hintwindow, TFocusHintWindow. Когда вы "просите" TFocusHintWindow появиться, он появляется ниже элемента управления, имеющего фокус. Для показа и скрытия достаточно следующих команд:
   FocusHintWindow.Showing := True;
   FocusHintWindow.Showing := False;
   Пример того, как это можно использовать, содержится в комментариях к модулю. Это просто.
   unit FHintWin;
   { -----------------------------------------------------------
    TFocusHintWindow --

    Вот пример того, как можно использовать TFocusHintWindow.
    Данный пример выводит всплывающую подсказку ниже любого
    TEdit, имеющего фокус. В противном случае выводится
    стандартная подсказка Windows.

   unit Unit1;
   interface
   uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, FHintWin;

   type TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
   private
    FocusHintWindow: TFocusHintWindow;
    procedure AppIdle(Sender: TObject; var Done: Boolean);
    procedure AppShowHint(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo);
   end;

   implementation

   procedure TForm1.FormCreate(Sender: TObject);
   begin
    Application.OnIdle := AppIdle;
    Application.OnShowHint := AppShowHint;
    FocusHintWindow := TFocusHintWindow.Create(Self);
   end;

   procedure TForm1.AppIdle(Sender: TObject; var Done: Boolean);
   begin
    FocusHintWindow.Showing := Screen.ActiveControl is TEdit;
   end;

   procedure TForm1.AppShowHint(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo);
   begin
    CanShow := not FocusHintWindow.Showing;
   end;

   end.
   ----------------------------------------------------------- }

   interface

   uses SysUtils, WinTypes, WinProcs, Classes, Controls, Forms;

   type TFocusHintWindow = class(THintWindow)
   private
    FShowing: Boolean;
    HintControl: TControl;
   protected
    procedure SetShowing(Value: Boolean);
    function CalcHintRect(Hint: string): TRect;
    procedure Appear;
    procedure Disappear;
   public
    property Showing: Boolean read FShowing write SetShowing;
   end;

   implementation

   function TFocusHintWindow.CalcHintRect(Hint: string): TRect;
   var Buffer: array[Byte] of Char;
   begin
    Result := Bounds(0, 0, Screen.Width, 0);
    DrawText(Canvas.Handle, StrPCopy(Buffer, Hint), -1, Result, DT_CALCRECT or DT_LEFT or DT_WORDBREAK or DT_NOPREFIX);
    with HintControl, ClientOrigin do OffsetRect(Result, X, Y + Height + 6);
    Inc(Result.Right, 6);
    Inc(Result.Bottom, 2);
   end;

   procedure TFocusHintWindow.Appear;
   var
    Hint: string;
    HintRect: TRect;
   begin
    if (Screen.ActiveControl = HintControl) then Exit;
    HintControl := Screen.ActiveControl;
    Hint := GetShortHint(HintControl.Hint);
    HintRect := CalcHintRect(Hint);
    ActivateHint(HintRect, Hint);
    FShowing := True;
   end;

   procedure TFocusHintWindow.Disappear;
   begin
    HintControl := nil;
    ShowWindow(Handle, SW_HIDE);
    FShowing := False;
   end;

   procedure TFocusHintWindow.SetShowing(Value: Boolean);
   begin
    if Value then Appear else Disappear;
   end;
   end.
   – Ed Jordan

Вызов 16-разрядного кода из 32-разрядного

   Andrew Pastushenko пишет:
   Посылаю код для определения системных ресурсов (как в "Индикаторе ресурсов"). Использовалась статья "Calling 16-bit code from 32-bit in Windows 95".
   { GetFeeSystemResources routine for 32-bit Delphi.
     Works only under Windows 9x }
   unit SysRes32;

   interface

   const
    //Constants whitch specifies the type of resource to be checked
    GFSR_SYSTEMRESOURCES = $0000;
    GFSR_GDIRESOURCES    = $0001;
    GFSR_USERRESOURCES   = $0002;

   // 32-bit function exported from this unit
   function GetFeeSystemResources(SysResource: Word): Word;

   implementation

   uses SysUtils, Windows;

   type
    //Procedural variable for testing for a nil
    TGetFSR = function(ResType: Word): Word; stdcall;

    //Declare our class exeptions
    EThunkError = class(Exception);
    EFOpenError = class(Exception);

   var
    User16Handle : THandle = 0;
    GetFSR       : TGetFSR = nil;

   //Prototypes for some undocumented API
   function LoadLibrary16(LibFileName: PAnsiChar): THandle; stdcall; external kernel32 index 35;
   function FreeLibrary16(LibModule: THandle): THandle; stdcall; external kernel32 index 36;
   function GetProcAddress16(Module: THandle; ProcName: LPCSTR): TFarProc;stdcall; external kernel32 index 37;
   procedure QT_Thunk; cdecl; external 'kernel32.dll' name 'QT_Thunk';

   {$StackFrames On}
   function GetFeeSystemResources(SysResource: Word): Word;
   var EatStackSpace: String[$3C];
   begin
    // Ensure buffer isn't optimised away
    EatStackSpace := '';
    @GetFSR:=GetProcAddress16(User16Handle, 'GETFREESYSTEMRESOURCES');
    if Assigned(GetFSR) then //Test result for nil
     asm
      //Manually push onto the stack type of resource to be checked first
      push SysResource
      //Load routine address into EDX
      mov   edx, [GetFSR]
      //Call routine
      call QT_Thunk
      //Assign result to the function
      mov   @Result, ax
     end
    else raise EFOpenError.Create('GetProcAddress16 failed!');
   end;

   initialization
    //Check Platform for Windows 9x
    if Win32Platform <> VER_PLATFORM_WIN32_WINDOWS then raise EThunkError.Create('Flat thunks only supported under Windows 9x');
    //Load 16-bit DLL (USER.EXE)
    User16Handle:= LoadLibrary16(PChar('User.exe'));
    if User16Handle < 32 then raise EFOpenError.Create('LoadLibrary16 failed!');

   finalization
    //Release 16-bit DLL when done
    if User16Handle <> 0 then FreeLibrary16(User16Handle);
   end.

Как проверить, имеем ли мы административные привилегии в системе?

   Nomadic пишет:
   // Routine: check if the user has administrator provileges
   // Was converted from C source by Akzhan Abdulin. Not properly tested.
   type PTOKEN_GROUPS = TOKEN_GROUPS^;
   function RunningAsAdministrator(): Boolean;
   var
    SystemSidAuthority: SID_IDENTIFIER_AUTHORITY = SECURITY_NT_AUTHORITY;
    psidAdmin: PSID;
    ptg: PTOKEN_GROUPS = nil;
    htkThread: Integer; { HANDLE }
    cbTokenGroups: Longint; { DWORD }
    iGroup: Longint; { DWORD }
    bAdmin: Boolean;
   begin
    Result := false;
    if not OpenThreadToken(GetCurrentThread(),      // get security token
     TOKEN_QUERY, FALSE, htkThread) then
     if GetLastError() = ERROR_NO_TOKEN then begin
     if not OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, htkThread) then Exit;
     end else Exit;
     if GetTokenInformation(htkThread,            // get #of groups
      TokenGroups, nil, 0, cbTokenGroups) then Exit;
     if GetLastError() <> ERROR_INSUFFICIENT_BUFFER then Exit;
     ptg := PTOKEN_GROUPS(getmem(cbTokenGroups));
     if not Assigned(ptg) then Exit;
     if not GetTokenInformation(htkThread,           // get groups
      TokenGroups, ptg, cbTokenGroups, cbTokenGroups) then Exit;
     if not AllocateAndInitializeSid(SystemSidAuthority, 2, SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, psidAdmin) then Exit;
     iGroup := 0;
     while iGroup < ptg^.GroupCount do // check administrator group
     begin
      if EqualSid(ptg^.Groups[iGroup].Sid, psidAdmin) then begin
       Result := TRUE;
      break;
     end;
     Inc(iGroup);
    end;
    FreeSid(psidAdmin);
   end;
   Два метода в одном флаконе:
   #include
   #include
   #include
   #pragma hdrstop

   #pragma comment(lib, "netapi32.lib")

   // My thanks to Jerry Coffin (jcoffin@taeus.com)
   // for this much simpler method.
   bool jerry_coffin_method() {
    bool result;
    DWORD rc;
    wchar_t user_name[256];
    USER_INFO_1 *info;
    DWORD size = sizeof(user_name);

    GetUserNameW(user_name, &size);
    rc = NetUserGetInfo(NULL, user_name, 1, (byte **)&info);
    if (rc != NERR_Success) return false;
    result = info->usri1_priv == USER_PRIV_ADMIN;
    NetApiBufferFree(info);
    return result;
   }

   bool look_at_token_method() {
    int found;
    DWORD i, l;
    HANDLE hTok;
    PSID pAdminSid;
    SID_IDENTIFIER_AUTHORITY ntAuth = SECURITY_NT_AUTHORITY;

    byte rawGroupList[4096];
    TOKEN_GROUPS& groupList = *((TOKEN_GROUPS *)rawGroupList);
    if (!OpenThreadToken(GetCurrentThread(), TOKEN_QUERY, FALSE, &hTok)) {
     printf( "Cannot open thread token, trying process token [%lu].\n", GetLastError());
     if (!OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, &hTok)) {
      printf("Cannot open process token, quitting [%lu].\n", GetLastError());
      return 1;
     }
    }

    // normally, I should get the size of the group list first, but ...
    l = sizeof rawGroupList;
    if (!GetTokenInformation(hTok, TokenGroups, &groupList, l, &l)) {
     printf( "Cannot get group list from token [%lu].\n", GetLastError());
     return 1;
    }

    // here, we cobble up a SID for the Administrators group, to compare to.
    if (!AllocateAndInitializeSid(&ntAuth, 2, SECURITY_BUILTIN_DOMAIN_RID,   DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, &pAdminSid )) {
     printf("Cannot create SID for Administrators [%lu].\n", GetLastError());
     return 1;
    }

    // now, loop through groups in token and compare
    found = 0;
    for (i = 0; i < groupList.GroupCount; ++i) {
     if (EqualSid(pAdminSid, groupList.Groups[i].Sid)) {
      found = 1;
      break;
     }
    }

    FreeSid(pAdminSid);
    CloseHandle(hTok);
    return !!found;
   }

   int main() {
    bool j, l;

    j = jerry_coffin_method();
    l = look_at_token_method();
    printf("NetUserGetInfo(): The current user is %san Administrator.\n", j? "": "not ");
    printf("Process token: The current user is %sa member of the Administrators group.\n", l? "": "not ");
    return 0;
   }

   //****************************************************************************//

Как узнать язык Windows по умолчанию?

   Nomadic лаконично отвечает:
   GetSystemDefaultLCID
   GetLocaleInfo

GetLocalUserList — возвращает список пользователей (Windows NT, Windows 2000)

   Кондратюк Виталий предлагает следующий код:
   unit Func;
   interface

   uses Sysutils, Classes, Stdctrls, Comctrls, Graphics, Windows;

   ////////////////////////////////////////////////////////////////////////////////
   {$EXTERNALSYM NetUserEnum}
   function NetUserEnum(servername: LPWSTR; level, filter: DWORD; bufptr: Pointer; prefmaxlen: DWORD; entriesread, totalentries, resume_handle: LPDWORD): DWORD; stdcall; external 'NetApi32.dll' Name 'NetUserEnum';

   function NetApiBufferFree(Buffer: Pointer{LPVOID}): DWORD; stdcall; external 'NetApi32.dll' Name 'NetApiBufferFree';
   ////////////////////////////////////////////////////////////////////////////////

   procedure GetLocalUserList(ulist: TStringList);

   implementation

   //------------------------------------------------------------------------------
   // возвращает список пользователей локального хоста
   //------------------------------------------------------------------------------
   procedure GetLocalUserList(ulist: TStringList);
   const
    NERR_SUCCESS                     = 0;
    FILTER_TEMP_DUPLICATE_ACCOUNT    = $0001;
    FILTER_NORMAL_ACCOUNT            = $0002;
    FILTER_PROXY_ACCOUNT             = $0004;
    FILTER_INTERDOMAIN_TRUST_ACCOUNT = $0008;
    FILTER_WORKSTATION_TRUST_ACCOUNT = $0010;
    FILTER_SERVER_TRUST_ACCOUNT      = $0020;

   type
    TUSER_INFO_10 = record
   usri10_name, usri10_comment, usri10_usr_comment, usri10_full_name: PWideChar;
    end;
    PUSER_INFO_10 = ^TUSER_INFO_10;

   var
    dwERead, dwETotal, dwRes, res: DWORD;
    inf: PUSER_INFO_10;
    info: Pointer;
    p: PChar;
    i: Integer;
   begin
    if ulist=nil then Exit;
    ulist.Clear;
    info := nil;
    dwRes := 0;
    res := NetUserEnum(nil, 10, FILTER_NORMAL_ACCOUNT, @info, 65536, @dwERead, @dwETotal, @dwRes);
    if (res<>NERR_SUCCESS) or (info=nil) then Exit;
    p := PChar(info);
    for i:=0 to dwERead-1 do begin
     inf := PUSER_INFO_10(p + i*SizeOf(TUSER_INFO_10));
     ulist.Add(WideCharToString(PWideChar((inf^).usri10_name)));
    end;
    NetApiBufferFree(info);
   end;
   end.

Каков способ обмена информацией между приложениями Win32 – Win16?

   Nomadic предлагает следующее:
   Пользуйтесь сообщением WM_COPYDATA.
   Для Win16 константа определена как $004A, для Win32 смотрите в WinAPI Help.
   #define WM_COPYDATA 0x004A
   /*
   * lParam of WM_COPYDATA message points to…
   */
   typedef struct tagCOPYDATASTRUCT {
    DWORD dwData;
    DWORD cbData;
    PVOID lpData;
   } COPYDATASTRUCT, *PCOPYDATASTRUCT;

Остановка и запуск сервисов

Postmaster предлагает следующий код:

Unit1.dfm

   object Form1: TForm1
    Left = 192
    Top = 107
    Width = 264
    Height = 121
    Caption = 'Сервис'
    Color = clBtnFace
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = []
    OldCreateOrder = False
    PixelsPerInch = 96
    TextHeight = 13
    object Label1: TLabel
     Left = 2
     Top = 8
     Width = 67
     Height = 13
     Caption = 'Имя сервиса'
    end
    object Button1: TButton
     Left = 4
     Top = 56
     Width = 95
     Height = 25
     Caption = 'Стоп сервис'
     TabOrder = 0
     OnClick = Button1Click
    end
    object Button2: TButton
     Left = 148
     Top = 56
     Width = 95
     Height = 25
     Caption = 'Старт сервис'
     TabOrder = 1
     OnClick = Button2Click
    end
    object Edit1: TEdit
     Left = 0
     Top = 24
     Width = 241
     Height = 21
     TabOrder = 2
     Text = 'Messenger'
    end
   end

Unit1.pas

   unit Unit1;

   interface

   uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Winsvc;

   type TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure StopService(ServiceName: String);
    procedure Button2Click(Sender: TObject);
    procedure StartService(ServiceName: String);
   private
   { Private declarations }
   public
   { Public declarations }
   end;

   var Form1: TForm1;

   implementation

   {$R *.DFM}

   procedure TForm1.Button1Click(Sender: TObject);
   begin
    StopService(Edit1.Text);
   end;

   procedure TForm1.StopService(ServiceName: String);
   var
    schService, schSCManager: DWORD;
    p: PChar;
    ss: _SERVICE_STATUS;
   begin
    p:=nil;
    schSCManager:= OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
    if schSCManager = 0 then RaiseLastWin32Error;
    try
     schService:=OpenService(schSCManager, PChar(ServiceName), SERVICE_ALL_ACCESS);
     if schService = 0 then RaiseLastWin32Error;
     try
      if not ControlService(schService, SERVICE_CONTROL_STOP, SS) then RaiseLastWin32Error;
     finally
      CloseServiceHandle(schService);
     end;
    finally
     CloseServiceHandle(schSCManager);
    end;
   end;

   procedure TForm1.Button2Click(Sender: TObject);
   begin
    StartService(Edit1.Text);
   end;

   procedure TForm1.StartService(ServiceName: String);
   var
    schService, schSCManager: Dword;
    p: PChar;
   begin
    p:=nil;
    schSCManager:= OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
    if schSCManager = 0 then RaiseLastWin32Error;
    try
     schService:=OpenService(schSCManager, PChar(ServiceName), SERVICE_ALL_ACCESS);
     if schService = 0 then RaiseLastWin32Error;
     try
      if not Winsvc.startService(schService, 0, p) then RaiseLastWin32Error;
     finally
      CloseServiceHandle(schService);
     end;
    finally
     CloseServiceHandle(schSCManager);
    end;
   end;
   end.

Прямой вызов метода Hint

   function RevealHint (Control: TControl): THintWindow;
   {----------------------------------------------------------------}
   { Демонстрирует всплывающую подсказку для определенного элемента }
   { управления (Control), возвращает ссылку на hint-объект,        }
   { поэтому в дальнейшем подсказка может быть спрятана вызовом     }
   { RemoveHint (смотри ниже).                                      }
   {----------------------------------------------------------------}
   var
   ShortHint: string;
    AShortHint: array[0..255] of Char;
    HintPos: TPoint;
    HintBox: TRect;
   begin
    { Создаем окно: }
    Result := THintWindow.Create(Control);

    { Получаем первую часть подсказки до '|': }
    ShortHint := GetShortHint(Control.Hint);

    { Вычисляем месторасположение и размер окна подсказки }
    HintPos := Control.ClientOrigin;
    Inc(HintPos.Y, Control.Height + 6);    <<<< Смотри примечание ниже
    HintBox := Bounds(0, 0, Screen.Width, 0);
    DrawText(Result.Canvas.Handle, StrPCopy(AShortHint, ShortHint), -1, HintBox, DT_CALCRECT or DT_LEFT or DT_WORDBREAK or DT_NOPREFIX);
    OffsetRect(HintBox, HintPos.X, HintPos.Y);
    Inc(HintBox.Right, 6);
    Inc(HintBox.Bottom, 2);

    { Теперь показываем окно: }
    Result.ActivateHint(HintBox, ShortHint);
   end; {RevealHint}

   procedure RemoveHint (var Hint: THintWindow);
   {----------------------------------------------------------------}
   { Освобождаем дескриптор окна всплывающей подсказки, выведенной }
   { предыдущим RevealHint.                                         }
   {----------------------------------------------------------------}
   begin
   Hint.ReleaseHandle;
    Hint.Free;
    Hint := nil;
   end; {RemoveHint}
   Строка с комментарием <<<< позиционирует подсказку ниже элемента управления. Это может быть изменено, если по какой-то причине вам необходима другая позиция окна с подсказкой.

Как использовать свои курсоры в программе? I

   Nomadic предлагает следующее:
   {$R CURSORS.RES}
   const
    crZoomIn = 1;
    crZoomOut = 2;
   Screen.Cursors[crZoomIn] := LoadCursor(hInstance, 'CURSOR_ZOOMIN');
   Screen.Cursors[crZoomOut] := LoadCursor(hInstance, 'CURSOR_ZOOMOUT');
   С вашей программой должен быть слинкован файл ресурсов, содержащий соответствующие курсоры.

Как использовать свои курсоры в программе? II

   С помощью программы Image Editor упакуйте курсор в RES-файл. В следующем примере подразумевается, что вы сохранили курсор в RES-файле как «cursor_1», и записали RES-файл с именем MYFILE.RES.
   {$R c:\programs\delphi\MyFile.res} { Это ваш RES-файл }
   const PutTheCursorHere_Dude = 1;   { произвольное положительное число }
   procedure stuff;
   begin
    screen.cursors[PutTheCursorHere_Dude] := LoadCursor(hInstance, PChar('cursor_1'));
    screen.cursor := PutTheCursorHere_Dude;
   end;

Компоненты

BatchMove

Пересборка индексов с помощью TBatchMove

   … вы все делаете правильно. BatchMove не может пересобирать индексы. Тем не менее, следующая процедура все же поможет вам сделать это (создать индексы заново). Задайте ей необходимые параметры (.DBF. Name, исходная и целевая таблица, Source и Target) и попробуйте ее в деле!
   procedure Form1.FormCreate(Sender: TObject);
   var x: integer;
   begin
    BatchMove1.Execute;
    Source.Open;
    Target.Exclusive := True;
    Target.Open;
    Source.IndexDefs.Update;
    for x := 0 to Source.IndexDefs.Count – 1 do
     Target.AddIndex(Source.IndexDefs[x].Name, Source.IndexDefs[x].Fields, Source.IndexDefs[x].Options);
    Source.Close;
    Target.Close;
   end;

Есть некоторая таблица и требуется при нажатии на кнопку создавать таблицы такой же структуры. Подскажите, как это удобнее всего сделать?

   Nomadic отвечает:
   Удобней всего, например, так —
   with bmovMyBatchMove do begin
    Mode := bmCopy;
    RecordCount := 1;
    Execute;
    R Destination.Delete;
   end;
   Где bmovMyBatchMove – экземпляр класса TBatchMove из VCL.
   Неправда Ваша! ;)
   Этот загадочный BatchMove имеет одну очень неприятную особенность (по крайней мере при работе с DBF-таблицами и в Delphi 1.0x), как-то:
   увеличивает в создаваемых таблицах в полях типа NUMBER количество значащих цифр после запятой (не помню – возможно, что и до), если там указаны небольшие (около 1-3 цифр) значения :(.
   Я эту особенность побороть не сумел, а мириться с ней в условиях нашей конторы (когда приходится бороться за место под солнцем с программистами на Clipper и FoxPro совершенно неприемлемо.
   Кроме того, в предложенном выше варианте еще и запись удалять приходится…:)
   Решалась же эта проблема следующим способом:
   procedure CopyStruct(SrcTable, DestTable: TTable; cpyFields: array of string);
   var
    i: Integer;
    bActive: Boolean;
    SrcDatabase, DestDatabase: TDatabase;
    iSrcMemSize, iDestMemSize: Integer;
    pSrcFldDes: PFldDesc; CrtTableDesc: CRTblDesc;
    bNeedAllFields: Boolean;
   begin
    SrcDatabase := Session.OpenDatabase(SrcTable.DatabaseName);
    try
     DestDatabase := Session.OpenDatabase(DestTable.DatabaseName);
     try
      bActive := SrcTable.Active;
      SrcTable.FieldDefs.Update;
      iSrcMemSize := SrcTable.FieldDefs.Count * SizeOf(FLDDesc);
      pSrcFldDes := AllocMem(iSrcMemSize);
      if pSrcFldDes = nil then begin
       raise EOutOfMemory.Create('Не хватает памяти!');
      end;
      try
       SrcTable.Open;
       Check(DbiGetFieldDescs(SrcTable.Handle, pSrcFldDes));
       SrcTable.Active := bActive;
       FillChar(CrtTableDesc, SizeOf(CrtTableDesc), 0);
       with CrtTableDesc do begin
        StrPcopy(szTblName, DestTable.TableName);
        StrPcopy(szTblType, 'DBASE');
        if (Length(cpyFields[0] ) = 0) or (cpyFields[0] = '*') then begin
         bNeedAllFields := True;
         SrcTable.FieldDefs.Update;
         iFldCount := SrcTable.FieldDefs.Count;
        end else begin
         bNeedAllFields := False;
         iFldCount := High(cpyFields) + 1;
        end;
        iDestMemSize := iFldCount * Sizeof(FLDDesc);
        CrtTableDesc.pFLDDesc := AllocMem(iDestMemSize);
        if CrtTableDesc.pFLDDesc = nil then begin
         raise EOutOfMemory.Create('Не хватает памяти!');
        end;
       end;
       try
        if bNeedAllFields then begin
         for i := 0 to CrtTableDesc.iFldCount - 1 do begin
          Move(PFieldDescList(pSrcFldDes)^[i], PFieldDescList(CrtTableDesc.pFLDDesc)^[i], SizeOf(FldDesc));
         end;
        end else begin
         for i:=0 to CrtTableDesc.iFldCount-1 do begin
          Move(PFieldDescList(pSrcFldDes)^[SrcTable.FieldDefs.Find(cpyFields[i]).FieldNo – 1], PFieldDescList(CrtTableDesc.pFLDDesc)^[i], SizeOf(FldDesc));
         end;
        end;
        Check(DbiCreateTable(DestDatabase.Handle, True, CrtTableDesc));
       finally
        FreeMem(CrtTableDesc.pFLDDesc, iDestMemSize);
       end;
      finally
       FreeMem(pSrcFldDes, iSrcMemSize);
      end;
     finally
      Session.CloseDatabase(DestDatabase);
     end;
    finally
     Session.CloseDatabase(SrcDatabase);
    end;
   end;

Button

Цветная кнопка

   VS пишет:
   В книгах Калверта, Свана и других авторов можно найти похожий текст. Смысл текста — "Изменить цвет кнопок Button, BitBt нельзя, т.к. их рисует WINDOWS". Если нельзя, но ОЧЕНЬ НУЖНО, то можно.
   Небольшой компонент ColorBtn, дает возможность использовать в кнопках цвет. Кроме того, представлено новое свойство — Frame3D, позволяющее получить более реалистичный вид нажатой кнопки. В отличие от API, при изменении значения свойства Frame3D, не требуется переоткрытие компонента.
   unit ColorBtn;

   interface
   uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons;

   type TColorBtn = class(TButton)
   private
    { Private declarations }
    IsFocused: boolean;
    FCanvas: TCanvas;
    F3DFrame: boolean;
    FButtonColor: TColor;
    procedure Set3DFrame(Value: boolean);
    procedure SetButtonColor(Value: TColor);
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure DrawButtonText(const Caption: string; TRC: TRect; State: TButtonState; BiDiFlags: Longint);
    procedure CalcuateTextPosition(const Caption: string; var TRC: TRect; BiDiFlags: Longint);
   protected
    { Protected declarations }
    procedure CreateParams(var Params: TCreateParams); override;
    procedure SetButtonStyle(ADefault: boolean); override;
   public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
   published
    { Published declarations }
    property ButtonColor: TColor read FButtonColor write SetButtonColor default clBtnFace;
    property Frame3D: boolean read F3DFrame write Set3DFrame default False;
   end;

   procedure Register;

   implementation
   { TColorBtn }
   constructor TColorBtn.Create(AOwner: TComponent);
   begin
    Inherited Create(AOwner);
    FCanvas:= TCanvas.Create;
    FButtonColor:= clBtnFace;
    F3DFrame:= False;
   end;

   destructor TColorBtn.Destroy;
   begin
    FCanvas.Free;
    Inherited Destroy;
   end;

   procedure TColorBtn.CreateParams(var Params: TCreateParams);
   begin
    Inherited CreateParams(Params);
    with Params do Style:= Style or BS_OWNERDRAW;
   end;

   procedure TColorBtn.Set3DFrame(Value: boolean);
   begin
    if F3DFrame <> Value then F3DFrame:= Value;
   end;

   procedure TColorBtn.SetButtonColor(Value: TColor);
   begin
    if FButtonColor <> Value then begin
     FButtonColor:= Value;
     Invalidate;
    end;
   end;

   procedure TColorBtn.WMLButtonDblClk(var Message: TWMLButtonDblClk);
   begin
    Perform(WM_LBUTTONDOWN, Message.Keys, Longint(Message.Pos));
   end;

   procedure TColorBtn.SetButtonStyle(ADefault: Boolean);
   begin
    if IsFocused <> ADefault then IsFocused:= ADefault;
   end;

   procedure TColorBtn.CNDrawItem(var Message: TWMDrawItem);
   var
    RC: TRect;Flags: Longint;
    State: TButtonState;
    IsDown, IsDefault: Boolean;
    DrawItemStruct: TDrawItemStruct;
   begin
    DrawItemStruct:= Message.DrawItemStruct^;
    FCanvas.Handle:= DrawItemStruct.HDC;
    RC:= ClientRect;
    with DrawItemStruct do begin
     IsDown:= ItemState and ODS_SELECTED <> 0;
     IsDefault:= ItemState and ODS_FOCUS <> 0;
     if not Enabled then State:= bsDisabled
     else if IsDown then State:= bsDown
     else State:= bsUp;
    end;
    Flags:= DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
    if IsDown then Flags:= Flags or DFCS_PUSHED;
    if DrawItemStruct.ItemState and ODS_DISABLED <> 0 then Flags:= Flags or DFCS_INACTIVE;
    if IsFocused or IsDefault then begin
     FCanvas.Pen.Color:= clWindowFrame;
     FCanvas.Pen.Width:= 1;
     FCanvas.Brush.Style:= bsClear;
     FCanvas.Rectangle(RC.Left, RC.Top, RC.Right, RC.Bottom);
     InflateRect(RC, -1, -1);
    end;
    if IsDown then begin
     FCanvas.Pen.Color:= clBtnShadow;
     FCanvas.Pen.Width:= 1;
     FCanvas.Rectangle(RC.Left, RC.Top, RC.Right, RC.Bottom);
     InflateRect(RC, -1, -1);
     if F3DFrame then begin
      FCanvas.Pen.Color:= FButtonColor;
      FCanvas.Pen.Width:= 1;
      DrawFrameControl(DrawItemStruct.HDC, RC, DFC_BUTTON, Flags);
     end;
    end else DrawFrameControl(DrawItemStruct.HDC, RC, DFC_BUTTON, Flags);
    FCanvas.Brush.Color:= FButtonColor;
    FCanvas.FillRect(RC);
    InflateRect(RC, 1, 1);
    if IsFocused then begin
     RC:= ClientRect;
     InflateRect(RC, -1, -1);
    end;
    if IsDown then OffsetRect(RC, 1, 1);
    FCanvas.Font:= Self.Font;
    DrawButtonText(Caption, RC, State, 0);
    if IsFocused and IsDefault then begin
     RC:= ClientRect;
     InflateRect(RC, -4, -4);
     FCanvas.Pen.Color:= clWindowFrame;
     Windows.DrawFocusRect(FCanvas.Handle, RC);
    end;
    FCanvas.Handle:= 0;
   end;

   procedure TColorBtn.CalcuateTextPosition(const Caption: string; var TRC: TRect; BiDiFlags: Integer);
   var
    TB: TRect;
    TS, TP: TPoint;
   begin
    with FCanvas do begin
     TB:= Rect(0, 0, TRC.Right + TRC.Left, TRC.Top + TRC.Bottom);
     DrawText(Handle, PChar(Caption), Length(Caption), TB, DT_CALCRECT or BiDiFlags);
     TS := Point(TB.Right - TB.Left, TB.Bottom - TB.Top);
     TP.X := ((TRC.Right - TRC.Left) - TS.X + 1) div 2;
     TP.Y := ((TRC.Bottom - TRC.Top) - TS.Y + 1) div 2;
     OffsetRect(TB, TP.X + TRC.Left, TP.Y + TRC.Top);
     TRC:= TB;
    end;
   end;

   procedure TColorBtn.DrawButtonText(const Caption: string; TRC: TRect; State: TButtonState; BiDiFlags: Integer);
   begin
    with FCanvas do begin
     CalcuateTextPosition(Caption, TRC, BiDiFlags);
     Brush.Style:= bsClear;
     if State = bsDisabled then begin
      OffsetRect(TRC, 1, 1);
      Font.Color:= clBtnHighlight;
      DrawText(Handle, PChar(Caption), Length(Caption), TRC, DT_CENTER or DT_VCENTER or BiDiFlags);
      OffsetRect(TRC, -1, -1);
      Font.Color:= clBtnShadow;
      DrawText(Handle, PChar(Caption), Length(Caption), TRC, DT_CENTER or DT_VCENTER or BiDiFlags);
     end else DrawText(Handle, PChar(Caption), Length(Caption), TRC, DT_CENTER or DT_VCENTER or BiDiFlags);
    end;
   end;

   procedure Register;
   begin
    RegisterComponents('Controls', [TColorBtn]);
   end;
   end.
   Небольшое дополнение. Кнопку по прежнему рисует WINDOWS, а раскрашивает ее ColorBtn. Код компонента на 90% повторяет код BitBtn, ничего необычного здесь нет. Хочется повторить слова Калверта — «Пользуйтесь исходным кодом». Чаще заглядывайте в VCL – можно найти много интересного.

Обработка щелчка нескольких кнопок, используя их заголовок

   …с ваших слов я понял, что вы все уже реализовали, но давайте все повторим: вы должны убедиться в том, что событие OnClick привязано к каждой кнопке калькулятора (числовые кнопки 0..9) и указывают на общий обработчик события.
   В разделяемом обработчике события получите заголовок обрабатываемой кнопки следующим образом:
   Edit1.Text := TButton(Sender).Caption;
   …я думаю в этом случае самым разумным будет использование свойства Tag каждой кнопки:
   1. назначьте уникальный Tag для каждой кнопки (например, эквивалент арабским цифрам)
   2. procedureTForm1.Button1Click(Sender: TObject);
   begin
    if (Sender is TButton) then with (Sender as TButton) do
     {используем Tag}
   end;
   Если вам нужен только заголовок, то есть изящный способ получить к нему доступ. Подключите общий обработчик события для всех кнопок и используйте приведение типа как показано ниже:
   procedure TForm1.Edit1Click(Sender: TObject);
   begin
    edit1.text := (sender as TButton).caption;
   end;
   Приведенная ниже конструкция будет недостаточной:
   sender.caption
   поскольку компилятор не знает о том, имеет ли «sender» свойство caption, или нет.

CheckBox

Массив из CheckBox – использование разделяемого обработчика события I

   Поместите несколько Checkbox в компонент TGroupBox. Во время прогона (или проектирования) назначьте общий обработчик события Click для всех checkbox'в. Чтобы в цикле обойти все «дочерние» TCheckBox'ы, можно воспользоваться свойством-массивом Controls TGroupBox (и заодно привести их к типу TCheckBox). Приблизительно так:
   for i := 0 to GroupBox1.ControlCount -1 do

    if (GroupBox1.Controls[i] as TCheckBox).checked then
     {что-то там еще};
   Вы можете получить имя sender следующим образом:
   procedure TMain1.CheckBoxClick(Sender: TObject);
   var whodidit: string[63];
   begin
    whodidit := TComponent(sender).name;
   end;
   После приведения типа можно добраться и до других свойств. К примеру, очень полезным может оказаться свойство Tag. Во время создания, вы можете присвоить каждому checkbox.tag свой ID номер. А в обработчике события, читая ID, можно идентифицировать sender.

Массив из CheckBox – использование разделяемого обработчика события II

   var
    CheckArray: array[1..x] of TCheckBox;
    i:integer;
   begin
    for i:=1 to x do begin
     CheckArray[i]:=TCheckBox.Create(Form1);
     {Устанавливаем свойства}
     with CheckBox[i] do begin
      Left:=i*20;
      Width:=15;
      другое…
     end;
    end;
   Очевидно, можно сказать:
   Check[i].OnClick:=xyz.
   Пока я и сам не знаю как поступить. Динамическое создание компонентов да, но обработчики событий?
   Существует способ организации массива checkbox'ов с разделяемым обработчиком события. Расположите их на форме и дайте им «непрерывные» имена (Check1, Check2 и т.д.). Затем установите у них общий обработчик события. Обработчик события может выглядеть так:
   procedure TForm.Check1Click(Sender : TObject);
   var i : Integer;
   begin
    for i := 1 to 10 { предположим, что мы имеем 10 checkbox'ов } do
     With TCheckBox(FindComponent('Check'+IntToStr(i))) do begin
     { другой какой-то код }
    end;
   end;

Идентификация CheckBox'ов

   В режиме проектирования вы, как программист, без труда узнаете, сколько checkbox'ов содержит ваша форма. А вот когда приложение запущено… Используйте Delphi Run Time Type Information (RTTI). Для нашей испытуемой формы вы можете попробовать следующий код:
   var i : Integer
   begin
    for i := 0 to ComponentCount - 1 do
     if Components[i] is TCheckBox then
     (Components[i] as TCheckBox).Checked then begin
     ... сюда поместите ваш код ...
    end;
   end;
   Кроме того, следующий код Delphi абсолютно корректен:
   if Components[i] = CheckBox5 then Чтотоделаем;
   Также, каждый компонент в Delphi имеет опубликованное (Published) свойство с именем 'Tag', значение которого вы можете задавать во время создания компонента, и затем, во время выполнения приложения, обращаться к нему для получения доступа к компоненту:
   var i : Integer
   begin
    for i := 0 to ComponentCount - 1 do
     if Components[i] is TCheckBox then
     with (Components[i] as TCheckBox) do
     Case Tag of
     1 : if Checked then DoSomethingOnBox1;
     2 : if Checked then DoSomethingOnBox2;
     … другое …
    end;
   end;
   Для получения дополнительной информации, обратитесь к справке Delphi с ключевым словом «ComponentCount».

BitBtn

Кнопка с несколькими строчками текста III

   Вот полный код проекта, создающего на кнопке во время выполнения две строчки текста.
   program TwolnBtn;
   uses Forms,TwolnBtu in 'TWOLNBTU.PAS' {Form1};
   {$R *.RES}
   begin
    Application.CreateForm(TForm1, Form1);
    Application.Run;
   end.

Файл TWOLNBTU.TXT → TWOLNBTU.DFM

   object Form1: TForm1
    Left = 202
    Top = 98
    Width = 320
    Height = 176
    Caption = 'Form1'
    Font.Color = clRed
    Font.Height = -12
    Font.Name = 'Arial'
    Font.Style = [fsBold]
    PixelsPerInch = 96
    OnActivate = ChgSpeedButton
    OnCreate = ChgBitBtn
    TextHeight = 15
    object SpeedButton1: TSpeedButton
     Left = 144
     Top = 24
     Width = 65
     Height = 45
     Caption = 'Это двустрочный заголовок'
     OnClick = ChgSpeedButton
    end
    object
    BitBtn1: TBitBtn
     Left = 32
     Top = 24
     Width = 69
     Height = 37
     Caption = 'Прерывание работы программы'
     TabOrder = 0
     OnClick = BitBtn1Click
    end
   end

Файл TWOLNBTU.PAS

   unit Twolnbtu;
   interface

   uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons;

   type TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    SpeedButton1: TSpeedButton;
    procedure ChgBitBtn(Sender: TObject);
    procedure ChgSpeedButton(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
   private
    { Private declarations }
   public
    { Public declarations }
   end;

   var Form1: TForm1;

   implementation

   {$R *.DFM}

   procedure TForm1.ChgBitBtn(Sender: TObject);
   VAR
   R : TRect;
    N : Integer;
    Buff : ARRAY[0..255] OF Char;
   BEGIN
    WITH BitBtn1 DO BEGIN
     Glyph.Canvas.Font := Self.Font;
     Glyph.Width := Width-6;
     Glyph.Height := Height-6;
     R := Bounds(0,0,Glyph.Width,0);
     StrPCopy(Buff, Caption);
     Caption := '';
     DrawText(Glyph.Canvas.Handle, Buff, StrLen(Buff), R, DT_CENTER OR DT_WORDBREAK OR DT_CALCRECT);
     OffsetRect(R, (Glyph.Width-R.Right) DIV 2, (Glyph.Height - R.Bottom) DIV 2);
     DrawText(Glyph.Canvas.Handle, Buff, StrLen(Buff), R, DT_CENTER OR DT_WORDBREAK);
    END;
   END;

   procedure TForm1.ChgSpeedButton(Sender: TObject);
   VAR
   R : TRect;
    N : Integer;
    Buff : ARRAY[0..255] OF Char;
   BEGIN
    WITH SpeedButton1 DO BEGIN
     Glyph.Canvas.Font := Self.Font;
     Glyph.Width := Width-6;
     Glyph.Height := Height-6;
     R := Bounds(0,0,Glyph.Width,0);
     StrPCopy(Buff, Caption);
     Caption := '';
     DrawText(Glyph.Canvas.Handle, Buff, StrLen(Buff), R,DT_CENTER OR DT_WORDBREAK OR DT_CALCRECT);
     OffsetRect(R, (Glyph.Width-R.Right) DIV 2, (Glyph.Height - R.Bottom) DIV 2);
     DrawText(Glyph.Canvas.Handle, Buff, StrLen(Buff), R,DT_CENTER OR DT_WORDBREAK);
    END;
   END;

   procedure TForm1.BitBtn1Click(Sender: TObject);
   begin
    Close;
   end;
   end.
   -Dennis Passmore

ComboBox

Хочу реализовать правильный выпадающий контрол (combo). Как это сделать?

   Nomadic отвечает:
   Когда-то потратил немало времени на разбор, как же все таки работают дропдаун-контролы. В итоге мной был написан маленький юнит, который я положил у себя в каталоге Demo для ознакомления интересующихся. Он маленький (его основная задача — показать принцип работы, а все остальное — как реализуешь), я думаю, что большинству он пригодиться, поэтому публикую здесь. Касательно твоего вопроса - реализуй вместо листбокса выпадающий контрол, который даст тебе функциональность дерева.
   unit edit1;

   interface

   uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

   type
    TPopupListbox = class(TCustomListbox)
    protected
     procedure CreateParams(var Params: TCreateParams); override;
     procedure CreateWnd; override;
     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    end;

    TTestDropEdit = class(TEdit)
    private
     FPickList: TPopupListbox;
     procedure CMCancelMode(var Message: TCMCancelMode); message CM_CancelMode;
     procedure WMKillFocus(var Message: TMessage); message WM_KillFocus;
    protected
     procedure CloseUp(Accept: Boolean);
     procedure DropDown;
     procedure WndProc(var Message: TMessage); override;
    public
     constructor Create(Owner: TComponent); override;
     destructor Destroy; override;
    end;

   implementation

   { TPopupListBox }

   procedure TPopupListBox.CreateParams(var Params: TCreateParams);
   begin
    inherited;
    with Params do begin
     Style := Style or WS_BORDER;
     ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST;
     WindowClass.Style := CS_SAVEBITS;
    end;
   end;

   procedure TPopupListbox.CreateWnd;
   begin
    inherited CreateWnd;
    Windows.SetParent(Handle, 0);
    CallWindowProc(DefWndProc, Handle, WM_SETFOCUS, 0, 0);
   end;

   procedure TPopupListbox.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
   begin
    inherited MouseUp(Button, Shift, X, Y);
    TTestDropEdit(Owner).CloseUp((X >= 0) and (Y >= 0) and (X < Width) and (Y < Height));
   end;

   { TTestDropEdit }

   constructor TTestDropEdit.Create(Owner: TComponent);
   begin
    inherited Create(Owner);
    Parent := Owner as TWinControl;
    FPickList := TPopupListbox.Create(nil);
    FPickList.Visible := False;
    FPickList.Parent := Self;
    FPickList.IntegralHeight := True;
    FPickList.ItemHeight := 11;
    FPickList.Items.CommaText :='1,2,3,4,5,6,7,8,9,0';
   end;

   destructor TTestDropEdit.Destroy;
   begin
    FPickList.Free;
    inherited;
   end;

   procedure TTestDropEdit.CloseUp(Accept: Boolean);
   begin
    if FPickList.Visible then begin
     if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
     SetWindowPos(FPickList.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
     if FPickList.ItemIndex <> -1 then Text := FPickList.Items.Strings[FPickList.ItemIndex];
     FPickList.Visible := False;
     Invalidate;
    end;
   end;

   procedure TTestDropEdit.DropDown;
   var
    P: TPoint;
    I,J,Y: Integer;
   begin
    if Assigned(FPickList) and (not FPickList.Visible) then begin
     FPickList.Width := Width;
     FPickList.Color := Color;
     FPickList.Font := Font;
     FPickList.Height := 6 * FPickList.ItemHeight + 4;
     FPickList.ItemIndex := FPickList.Items.IndexOf(Text);
     P := Parent.ClientToScreen(Point(Left, Top));
     Y := P.Y + Height;
     if Y + FPickList.Height > Screen.Height then Y := P.Y - FPickList.Height;
     SetWindowPos(FPickList.Handle, HWND_TOP, P.X, Y, 0, 0, SWP_NOSIZE or SWP_NOACTIVATE or SWP_SHOWWINDOW);
     FPickList.Visible := True;
     Invalidate;
     Windows.SetFocus(Handle);
    end;
   end;

   procedure TTestDropEdit.CMCancelMode(var Message: TCMCancelMode);
   begin
    if (Message.Sender <> Self) and (Message.Sender <> FPickList) then CloseUp(False);
   end;

   procedure TTestDropEdit.WMKillFocus(var Message: TMessage);
   begin
    inherited;
    CloseUp(False);
   end;

   procedure TTestDropEdit.WndProc(var Message: TMessage);
    procedure DoDropDownKeys(var Key: Word; Shift: TShiftState);
    begin
     case Key of
     VK_UP, VK_DOWN:
      if ssAlt in Shift then begin
       if FPickList.Visible then CloseUp(True)
      else DropDown;
       Key := 0;
      end;
     VK_RETURN, VK_ESCAPE:
      if FPickList.Visible and not (ssAlt in Shift) then begin
       CloseUp(Key = VK_RETURN);
       Key := 0;
      end;
     end;
    end;
   begin
    case Message.Msg of
    WM_KeyDown, WM_SysKeyDown, WM_Char:
     with TWMKey(Message) do begin
      DoDropDownKeys(CharCode, KeyDataToShiftState(KeyData));
      if (CharCode <> 0) and FPickList.Visible then begin
       with TMessage(Message) do SendMessage(FPickList.Handle, Msg, WParam, LParam);
       Exit;
      end;
     end
    end;
    inherited;
   end;
   end.

Программное открытие ComboBox II

   procedureTForm1.ComboBox1Enter(Sender:TObject);
   begin
    SendMessage(ComboBox1.Handle, CB_SHOWDROPDOWN, Integer(True), 0);
   end;
   Поместите эту строку в обработчик события OnEnter ComboBox:
   SendMessage(combobox1.Handle, CB_SHOWDROPDOWN, 1, 0);
   Измените третий параметр (1) на 0, если вы хотите спрятать список.

Проблемы с ComboBox

…попробуйте сохранять в переменной в методе формы OnEnter или OnCreate значение Index. Затем, чтобы отменить выбор пользователя, сделайте:
ComboBox1.ItemIndex := var1;

DBEdit

Исправление DBEdit MaxLength

   Я, кажется, не могу получить свойство MaxLength, чтобы работать с компонентами TDBEdit. В TEdit это работает как положено, но при попытке задать максимальную длину текста в TDBEdit это не срабатывает, и я все еще могу набрать текст сверх установленного ограничения.
   По-моему, это является следствием этого кода в TDBEdit.DataChange (DBCTRLS.PAS):
   if FDataLink.Field <> nil then begin
    …
    if FDataLink.Field.DataType = ftString then MaxLength := FDataLink.Field.Size
    else MaxLength := 0;
    …
   end else begin
    …
    MaxLength := 0;
    …
   end;
   т.к. иногда значение устанавливается на ноль…
   Похоже все будет работать, если вы измените строку
   MaxLength := 0;
   на
   MaxLength := inherited MaxLength;
   Для того, чтобы изменения вступили в силу, вам необходимо перекомпилировать ваш complib с измененным DBCTRLS.PAS, находящимся в пути lib.
   Если вы хотите использовать MaxLength с StringField, изменений необходимо сделать немного больше:
   …
   if (FDataLink.Field.DataType = ftString) and (inherited MaxLength = 0) then
     MaxLength := FDataLink.Field.Size
   else MaxLength := inherited MaxLength;
   …
   Или использовать что-то типа EditMask…
   – Reinhard Kalinke

Поиск и управление TEdit/TField

   Я хотел бы менять цвет компонентов TDBEdit и TEdit, расположенных на форме, на другой, "отчетливый" цвет, в том случае, если с помощью них требуется ввести какие-либо данные.
   Как насчет этого? Представляю вашему вниманию два метода. Первый метод задает цвет каждому DBEdit, имеющему требуемое поле. Второй метод (более сложный) задает цвет каждому БД-компоненту, имеющему необходимое поле.
   procedure TForm3.Button3Click(Sender: TObject);
   Var Control : Integer;
   begin
    For Control := 0 To ControlCount-1 Do
     If Controls[Control] Is TDBEdit Then
     With TDBEdit(Controls[Control]) Do
       If DataSource.DataSet.FieldByName(DataField).Required Then Color := clRed;
   end;

   { Данный метод будет работать только в случае, если БД-компонент обладает тремя полями: DataSource, типа TDataSource, DataField, типа String, и Color, типа TColor (это не должно быть проблемой). Также вам необходимо включить TypInfo в список используемых модулей }

   procedure TForm3.Button4Click(Sender: TObject);
   Var
    Control : Integer;
    DataSource : TDataSource;
    DataField : String;

    Function GetDataSource(Instance: TComponent) : Boolean;
    Var PropInfo: PPropInfo;
    Begin
     Result := False;
     PropInfo := TypInfo.GetPropInfo(Instance.ClassInfo, 'DataSource');
     If (PropInfo <> Nil) And (PropInfo^.PropType^.Kind = tkClass) Then Begin
      DataSource := TDataSource(TypInfo.GetOrdProp(Instance, PropInfo));
      Result := DataSource <> Nil;
     End;
     End;

    Function GetDataField(Instance: TComponent) : Boolean;
    Var PropInfo : PPropInfo;
    Begin
     Result := False;
     PropInfo := TypInfo.GetPropInfo(Instance.ClassInfo, 'DataField');
     If (PropInfo <> Nil) And (PropInfo^.PropType^.Kind = tkString) Then Begin
      DataField := TypInfo.GetStrProp(Instance, PropInfo);
      Result := True;
     End;
    End;

    Procedure SetColor(Instance: TComponent; Color: TColor);
    Var PropInfo : PPropInfo;
    Begin
     PropInfo := TypInfo.GetPropInfo(Instance.ClassInfo, 'Color');
     If (PropInfo <> Nil) And (PropInfo^.PropType^.Kind = tkInteger) Then TypInfo.SetOrdProp (Instance, PropInfo, Ord(Color));
    End;

   begin
    For Control := 0 To ControlCount-1 Do
     If GetDataSource(Controls[Control]) And GetDataField(Controls[Control]) And
      (DataSource.DataSet <> Nil) And
      DataSource.DataSet.FieldByName(DataField).Required Then
      SetColor(Controls[Control], clRed);
   end;
   – Robert Wittig

Insert/Override с помощью DBEdit

   Сама Windows не позволяет это сделать, но я нашел как это обойти с помощью одной хитрости, и, похоже, это классно работает (надеюсь вы получите даже больше, чем вы хотите :).
   Сначала я добавляю к моей форме свойство (и соответствующие переменные и процедуры), наподобие этому:
   private
    FinsertMode: boolean;
   procedure SetInsertMode(value: boolean);
   public
    property insertMode: boolean read FinsertMode write SetInsertMode;
   В обработчике создания события формы я инициализирую его:
   procedure TForm1.FormCreate(Sender: TObject);
   begin
    {инициализация}
    insertMode := True;
   end;
   Также для этого свойства я создаю процедуру SetInsertMode, которая с помощью TPanel с именем Panel1 извещает пользователя о текущем режиме работы:
   procedure TForm1.SetInsertMode(value: boolean);
   begin
    FinsertMode := value;
    if FinsertMode then Panel1.Caption := 'ВСТАВКА'
    else Panel1.Caption := 'ПЕРЕЗАПИСЬ';
   end;
   Затем я добавляю три обработчика событий (OnKeyDown, OnKeyPress, OnEnter) для каждого моего DBEdit (можно при наличии нескольких компонентов создать один общий обработчик для всех):
   procedure TForm1.DBEditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
   begin
    if (Key = VK_INSERT) then insertMode := not insertMode;
   end;

   procedure TForm1.DBEditKeyPress(Sender: TObject; var Key: Char);
   begin
    if (not insertMode) and (Sender is TDBEdit) then (Sender as TDBEdit).SelLength := 1
    else (Sender as TDBEdit).SelLength := 0;
   end;

   procedure TForm1.DBEditEnter(Sender: TObject);
   begin
    insertMode := True;
   end;
   Банзай! Похоже это работает, хотя я и не имел достаточного времени протестировать это. Естественно, вы можете изменить это по просьбе вашего заказчика (например, я всегда сбрасывал режим во вставку при перемещении к другому компоненту DBEedit). Все вышесказанное должно также работать без проблем и с компонентами Edit.
   – Denis Sarrazin

Как очистить DBEdit

   Пробую так:
   myDbEdit.Text := '';
   или адрес TField, если вы хотите так:
   TableNameMyField.Value := '';
   Ответ:
   Table1.Edit;
   Table1.FieldByName(DBEdit1.FieldName).Clear;

DBGrid

Dbgrid и множественный выбор

   Тема: TDBGrid и множественный выбор записей (Multi-Selecting Records)
   При включении флажка [dgMultiSelect] в свойстве-наборе Options компонента DBGrid, вы добавляете к табличной сетке возможность множественного выбора записей.
   Выбранные вами записи представлены в виде закладок и храняться в свойстве SelectedRows.
   Свойство SelectedRows является объектом, имеющим тип TBookmarkList. Его свойства и методы описаны ниже.
   // property SelectedRows: TBookmarkList read FBookmarks;
   //   TBookmarkList = class
   //   public
    {* Метод Clear освобождает все выбранные в DBGrid записи *}
    // procedure Clear;
    {* Метод Delete удаляет все выбранные строки из набора данных *}
    // procedure Delete;
    {* Метод Find определяет наличие закладки в выбранном списке. *}
    // function Find(const Item: TBookmarkStr;
    //      var Index: Integer): Boolean;
    {* Метод IndexOf возвращает индекс закладки, расположенной в свойстве Items. *}
    // function IndexOf(const Item: TBookmarkStr): Integer;
    {* Метод Refresh возвращает логическую величину, уведомляющую о том, что в то время, пока в табличной сетке была выбрана запись, были добавлены (удалены) какие-то данные. Метод Refresh может быть использован для обновления списка выбранных записей для уменьшения возможности получения удаленной записи. *}
    // function Refresh: Boolean; True = orphans found
    {* Свойство Count возвращает количество выбранных в настоящий момент элементов в DBGrid *}
    // property Count: Integer read GetCount;
    {* Свойство CurrentRowSelected содержит логическую величину, зависящую от того, выбрана текущая строка или нет. *}
    // property CurrentRowSelected: Boolean
    //      read GetCurrentRowSelected
    //      write SetCurrentRowSelected;
    {* Свойство Items – TStringList TBookmarkStr *}
    // property Items[Index: Integer]: TBookmarkStr
    //      read GetItem; default;
   // end;

   unit Unit1;
   interface

   uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Grids, DBGrids, DB, DBTables;

   type TForm1 = class(TForm)
    Table1: TTable;
    DBGrid1: TDBGrid;
    Count: TButton;
    Selected: TButton;
    Clear: TButton;
    Delete: TButton;
    Select: TButton;
    GetBookMark: TButton;
    Find: TButton;
    FreeBookmark: TButton;
    DataSource1: TDataSource;
    procedure CountClick(Sender: TObject);
    procedure SelectedClick(Sender: TObject);
    procedure ClearClick(Sender: TObject);
    procedure DeleteClick(Sender: TObject);
    procedure SelectClick(Sender: TObject);
    procedure GetBookMarkClick(Sender: TObject);
    procedure FindClick(Sender: TObject);
    procedure FreeBookmarkClick(Sender: TObject);
   private
    { Private declarations }
   public
    { Public declarations }
   end;

   var
    Form1: TForm1;
    Bookmark1: TBookmark;
    z: Integer;

   implementation

   {$R *.DFM}

   //Пример использования свойства Count
   procedure TForm1.CountClick(Sender: TObject);
   begin
    if DBgrid1.SelectedRows.Count > 0 then begin
     showmessage(inttostr(DBgrid1.SelectedRows.Count));
    end;
   end;

   //Пример использования свойства CurrentRowSelected
   procedure TForm1.SelectedClick(Sender: TObject);
   begin
    if DBgrid1.SelectedRows.CurrentRowSelected then showmessage('Выбрана');
   end;

   //Пример использования метода Clear
   procedure TForm1.ClearClick(Sender: TObject);
   begin
    dbgrid1.SelectedRows.Clear;
   end;

   //Пример использования метода Delete
   procedure TForm1.DeleteClick(Sender: TObject);
   begin
    DBgrid1.SelectedRows.Delete;
   end;

   {*Данные пример проходит в цикле все выбранныезаписи табличной сетки и отображает второеполе набора данных.

   Метод DisableControls используется в случае,когда необходимо запретить обновление DBGridпри изменении набора данных. Последняя позициянабора данных сохраняется как TBookmark.

   Метод IndexOf вызывается при необходимостипроверить существование закладки.Решение использовать метод IndexOf, а неRefresh, должно приниматься исходя изспецифики приложения.*}

   procedure TForm1.SelectClick(Sender: TObject);
   var
    x: word;
    TempBookmark: TBookMark;
   begin
    DBGrid1.Datasource.Dataset.DisableControls;
    with DBgrid1.SelectedRows do if Count > 0 then begin
     TempBookmark:= DBGrid1.Datasource.Dataset.GetBookmark;
     for x:= 0 to Count - 1 do begin
      if IndexOf(Items[x]) > -1 then begin
       DBGrid1.Datasource.Dataset.Bookmark:= Items[x];
     showmessage(DBGrid1.Datasource.Dataset.Fields[1].AsString);
      end;
     end;
    end;
    DBGrid1.Datasource.Dataset.GotoBookmark(TempBookmark);
    DBGrid1.Datasource.Dataset.FreeBookmark(TempBookmark);
    DBGrid1.Datasource.Dataset.EnableControls;
   end;

   {*Данный пример позволит вам установить закладку изатем найти ее в списке выбранных записей компонента DBGrid.*}

   //Устанавливаем закдадку
   procedure TForm1.GetBookMarkClick(Sender: TObject);
   begin
    Bookmark1:= DBGrid1.Datasource.Dataset.GetBookmark;
   end;

   //Освобождаем закладку
   procedure TForm1.FreeBookmarkClick(Sender: TObject);
   begin
    if assigned(Bookmark1) then begin
     DBGrid1.Datasource.Dataset.FreeBookmark(Bookmark1);
     Bookmark1:= nil;
    end;
   end;

   //Испольуем метод Find для установления позиции
   //записи-закладки в списке выбранных записей компонента DBGrid
   procedure TForm1.FindClick(Sender: TObject);
   begin
    if assigned(Bookmark1) then begin
     if DBGrid1.SelectedRows.Find(TBookMarkStr(Bookmark1),z) then showmessage(inttostr(z));
    end;
   end;
   end.

Вертикальная полоса прокрутки 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

TDBGrid Lookup-поле в D2

   1. Как создать lookup-поле в TDBGrid для Delphi 2.0
   2. Разместите на форме 2 компонента TTable, 1 компонент TDataSource и 1 – TDBGrid.
    • Подключите Table1 – к DataSource1 – к DBGrid1
    • DataSource1.DataSet = Table1
    • DBGrid1.DataSource = DataSource1
   3. Установка Table1
    • Table1.Database = DBDemos
    • Table1.TableName = Customer
    • Table1.Active = True
   4. Установка Table2
    • Table2.Database = DBDemos
    • Table2.TableName = Orders
    • Table2.Active = True
   5. Добавьте все поля для Table1, используя Fields Editor (редактор полей):
    • Дважды щелкните на Table1
    • Нажмите правую кнопку мыши в редакторе полей
    • Выберите пункт Add New Fields. Добавьте их все.
   6. Добавьте новое поле для Table1.
    • Нажмите правую кнопку мыши в редакторе полей и выберите пункт «New Field».
   7. Определите следующие параметры для вновь добавленного поля:
    • Name: Bob
    • Type: String
    • Size: 30
    • Select Lookup
    • Key Fields: CustNo    – Поле в Table1 для хранения значения
    • DataSet: Table2       – Здесь устанавливается табличный lookup
    • LookUpKeys: CustNo – Данный ключ копируется в KeyField
    • Result Field: OrderNo – Значение для показа пользователю в выпадающем списке
   8. Запустите приложение

Как зафиксировать один или несколько столбцов в TDBGrid с возможностью навигации по этим столбцам?

   Nomadic советует:
   Это маленькая вставка в Ваш наследник от TCustomDBGrid, которая решает данную задачу.
   // DBGRIDEX.PAS
   // ----------------------------------------------------------------------------
   destructor TDbGridEx.Destroy;
   begin
    _HideColumnsValues.Free;_HideColumns.Free;
    inherited Destroy;
   end;

   // ----------------------------------------------------------------------------
   constructor TDbGridEx.Create(Component : TComponent);
   begin
    inherited Create(Component);
    FFreezeCols   := ?;
    _HideColumnsValues := TList.Create;
    _HideColumns       := TList.Create;
   end;

   // ----------------------------------------------------------------------------
   procedure TDbGridEx.KeyDown(var Key: Word; Shift: TShiftState);
   begin
    if (Key = VK_LEFT) then ColBeforeEnter(-1);
    if (Key = VK_RIGHT) then ColBeforeEnter(1);
    inherited;
   end;

   // ----------------------------------------------------------------------------
   procedure TDbGridEx.SetFreezeColor(AColor : TColor);
   begin
    InvalidateRow(0);
   end;

   // ----------------------------------------------------------------------------
   procedure TDbGridEx.SetFreezeCols(AFreezeCols : Integer);
   begin
    FFreezeCols := AFreezeCols;
    InvalidateRow(0);
   end;

   // ----------------------------------------------------------------------------
   procedure TDbGridEx.ColEnter;
   begin
    ColBeforeEnter(0);
    if Assigned(OnColEnter) then OnColEnter(Self);
   end;

   // ----------------------------------------------------------------------------
   procedure TDbGridEx.ColBeforeEnter(ADelta : Integer);
   var nIndex : Integer;

    function ReadWidth : Integer;
    var i : Integer;
    begin
     i := _HideColumns.IndexOf(Columns[nIndex]);
     if i = -1 then result := 120
     else result := Integer(_HideColumnsValues[i]);
    end;

    procedure SaveWidth;
    var i : Integer;
    begin
     i := _HideColumns.IndexOf(Columns[nIndex]);
     if i <> - 1 then begin
      _HideColumnsValues[i] := Pointer(Columns[nIndex].Width);
     end else begin
      _HideColumns.Add(Columns[nIndex]);
      _HideColumnsValues.Add(Pointer(Columns[nIndex].Width));
     end;
    end;

   begin
    for nIndex := 0 to Columns.Count - 1 do begin
     if (Columns[nIndex].Width = 0) then begin
      if (nIndex + 1 <= FreezeCols) or (nIndex >= SelectedIndex + ADelta) then
       Columns[nIndex].Width := ReadWidth;
     end else begin
      SaveWidth;
      if (nIndex + 1 > FreezeCols) and (nIndex < SelectedIndex + ADelta) and
       (nIndex + 1 < Columns.Count) and (FreezeCols > 0) then
      Columns[nIndex].Width := 0;
     end;
    end;
   end;

Dbgrid с цветными ячейками IV

   Nomadic советует:
   Hапример, так:
   DefaultDrawing:=False;
   ….
   procedure TfrmCard.GridDrawColumnCell(Sender: TObject; constRect: TRect; DataCol: Integer; Column: TColumn;State: TGridDrawState);
   var
    Index : Integer;
    Marked, Selected: Boolean;
   begin
    Marked := False;
    if (dgMultiSelect in Grid.Options) and THackDBGrid(Grid).Datalink.Active then
    Marked:=Grid.SelectedRows.Find(THackDBGrid(Grid).Datalink.Datasource.Dataset.Bookmark, Index);
    Selected := THackDBGrid(Grid).Datalink.Active and (Grid.Row-1 = THackDBGrid(Grid).Datalink.ActiveRecord);
    if Marked then begin
     Grid.Canvas.Brush.Color:=$DFEFDF;
     Grid.Canvas.Font.Color :=clBlack;
    end;
    if Selected then begin
     Grid.Canvas.Brush.Color:=$FFFBF0;
     Grid.Canvas.Font.Color :=clBlack;
     if Marked then Grid.Canvas.Brush.Color:=$EFE3DF; { $8F8A30 }
    end;
    Grid.DefaultDrawColumnCell(Rect, DataCol, Column, State);
   end;
   где
   THackDBGrid = class(TDBGrid)
    property DataLink;
    property UpdateLock;
   end;
   Обратите внимание на обьявление класса THackDBGrid. Таким образом можно получить доступ к приватным полям, свойствам и методам класса, что, к сожалению, приходится делать, если авторы исходного класса оказались не предусмотрительны.

Dbgrid с цветными ячейками V

   Попробуйте следующий код в обработчике события TDBGrid OnDrawDataCell:
   Procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect; Field: TField; State: TGridDrawState);
   begin
    If gdFocused in State then with (Sender as TDBGrid).Canvas do begin
     Brush.Color := clRed;
     FillRect(Rect);
     TextOut(Rect.Left, Rect.Top, Field.AsString);
    end;
   end;
   Установите рисование по умолчинию (Default drawing) в True. Только после этого можно нарисовать выделенную ячейку. Если вы установили DefaultDrawing в False, вы должны сами рисовать все ячейки, используя свойство Canvas.

Что я получаю от наличия ConstraintBroker (брокера ограничений)?

   Nomadic отвечает:
   ConstraintBroker позволяет Вам включать проверки на ограничения в данные.
   Это означает, что когда Вы запрашиваете данные, Вы получаете вместе с ними и правила, которым они дорлжны удовлетворять. Эти правила автоматически без дополнительного кода входят в силу.
   Поскольку это происходит без единой строчки кода, то Вам не требуется переписывать или обновлять приложение каждый раз при изменении правил.
   Фактически это простое решение задачи обновления клиентского приложения без выхода из него.
   Каждое приложение, использующее ConstraintBroker, автоматически получает это качество…

Улучшенный 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.

Пример Drag and Drop между двумя Dbgrid

   Данный пример компонента и демонстрационный проект показывают простой путь осуществления операции "drag and drop" (перетащи и брось) между двумя полями различных табличных сеток.
   Запустите Delphi 3 (с незначительными изменениями данный код может работать и в Delphi 1-2).

   Активизируйте File|New|Unit. Скопируйте приведенный ниже модуль MyDBGrid во вновь созданный модуль. Сделайте File|Save As. Сохраните модуль как MyDBGrid.pas.

   Выберите пункт меню Component|Install Component. Переключитесь на страницу Info New Package. Поместите MyDBGrid.pas в поле редактирования "Unit file name" (имя файла модуля). Назовите модуль MyPackage.dpk. Ответьте Yes на вопрос Delphi 3 о необходимости сборки и установки пакета. Нажмите OK на сообщение Delphi 3 о необходимости включения VCL30.DPL. После этого пакет будет собран и установлен. Теперь компонент TMyDBGrid будет отображен в Палитре Компонентов в группе "Samples". Закройте редактор пакетов и сохраните пакет.

   Выберите пункт меню File|New Application. Щелкните правой кнопкой мыши на форме (Form1) и выберите View As Text. Скопируйте приведенный ниже исходный код формы GridU1 в Form1. Щелкните правой кнопкой мыши на форме и выберите View As Form. Убедитесь в активности ваших таблиц. Скопируйте расположенный ниже модуль GridU1 в ваш модуль Unit1.

   Выберите пункт меню File|Save Project As. Сохраните модуль как GridU1.pas. Сохраните проект как GridProj.dpr.

   Теперь запустите проект и наслаждайтесь функцией Drag and Drop между двумя табличными сетками.

Модуль MyDBGrid

   unit MyDBGrid;

   interface

   uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Grids, DBGrids;

   type TMyDBGrid = class(TDBGrid)
   private
    { Private declarations }
    FOnMouseDown: TMouseEvent;
   protected
    { Protected declarations }
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
   published
    { Published declarations }
    property Row;
    property OnMouseDown read FOnMouseDown write FOnMouseDown;
   end;

   procedure Register;

   implementation

   procedure TMyDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
   begin
    if Assigned(FOnMouseDown) then FOnMouseDown(Self, Button, Shift, X, Y);
    inherited MouseDown(Button, Shift, X, Y);
   end;

   procedure Register;
   begin
    RegisterComponents('Samples', [TMyDBGrid]);
   end;
   end.

Модуль GridU1

   unit GridU1;

   interface

   uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Db, DBTables, Grids, DBGrids, MyDBGrid, StdCtrls;

   type TForm1 = class(TForm)
    MyDBGrid1: TMyDBGrid;
    Table1: TTable;
    DataSource1: TDataSource;
    Table2: TTable;
    DataSource2: TDataSource;
    MyDBGrid2: TMyDBGrid;
    procedure MyDBGrid1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure MyDBGrid1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
    procedure MyDBGrid1DragDrop(Sender, Source: TObject; X, Y: Integer);
   private
    { Private declarations }
   public
    { Public declarations }
   end;

   var Form1: TForm1;

   implementation

   {$R *.DFM}

   var SGC : TGridCoord;

   procedure TForm1.MyDBGrid1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
   var DG : TMyDBGrid;
   begin
    DG := Sender as TMyDBGrid;
    SGC := DG.MouseCoord(X,Y);
    if (SGC.X > 0) and (SGC.Y > 0) then (Sender as TMyDBGrid).BeginDrag(False);
   end;

   procedure TForm1.MyDBGrid1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
   var GC : TGridCoord;
   begin
    GC := (Sender as TMyDBGrid).MouseCoord(X,Y);
    Accept := Source is TMyDBGrid and (GC.X > 0) and (GC.Y > 0);
   end;

   procedure TForm1.MyDBGrid1DragDrop(Sender, Source: TObject; X, Y: Integer);
   var
    DG     : TMyDBGrid;
    GC     : TGridCoord;
    CurRow : Integer;
   begin
    DG := Sender as TMyDBGrid;
    GC := DG.MouseCoord(X,Y);
    with DG.DataSource.DataSet do begin
     with (Source as TMyDBGrid).DataSource.DataSet do
      Caption := 'Вы перетащили «'+Fields[SGC.X-1].AsString+'"';
     DisableControls;
     CurRow := DG.Row;
     MoveBy(GC.Y-CurRow);
     Caption := Caption+' в «'+Fields[GC.X-1].AsString+'"';
     MoveBy(CurRow-GC.Y);
     EnableControls;
    end;
   end;
   end.

Форма GridU1

   object Form1: TForm1
    Left = 200
    Top = 108
    Width = 544
    Height = 437
    Caption = 'Form1'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = []
    PixelsPerInch = 96
    TextHeight = 13
    object MyDBGrid1: TMyDBGrid
     Left = 8
     Top = 8
     Width = 521
     Height = 193
     DataSource = DataSource1
     Row = 1
     TabOrder = 0
     TitleFont.Charset = DEFAULT_CHARSET
     TitleFont.Color = clWindowTextTitle
     Font.Height = -11
     TitleFont.Name = 'MS Sans Serif'
     TitleFont.Style = []
     OnDragDrop = MyDBGrid1DragDrop
     OnDragOver = MyDBGrid1DragOver
     OnMouseDown = MyDBGrid1MouseDown
    end
    object MyDBGrid2: TMyDBGrid
     Left = 7
     Top = 208
     Width = 521
     Height = 193
     DataSource = DataSource2
     Row = 1
     TabOrder = 1
     TitleFont.Charset = DEFAULT_CHARSET
     TitleFont.Color = clWindowText
     TitleFont.Height = -11
     TitleFont.Name = 'MS Sans Serif'
     TitleFont.Style = []
     OnDragDrop = MyDBGrid1DragDrop
     OnDragOver = MyDBGrid1DragOver
     OnMouseDown = MyDBGrid1MouseDown
    end
    object Table1: TTableActive = True
     DatabaseName = 'DBDEMOS'
     TableName = 'ORDERS'
     Left = 104
     Top = 48
    end
    object DataSource1: TDataSource
     DataSet = Table1
     Left = 136
     Top = 48
    end
    object Table2: TTable
     Active = True
     DatabaseName = 'DBDEMOS'
     TableName = 'CUSTOMER'
     Left = 104
     Top = 240
    end
    object DataSource2: TDataSource
     DataSet = Table2
     Left = 136
     Top = 240
    end
   end

Как заставить DBGrid сортировать данные по щелчку на заголовке столбца?

   Nomadic советует:
   Кyсочек кода, чтобы повесить на clickable столбец RxGrid, показывающий RxQuery с определенным макросом %Order. Работать не бyдет (без модyлей), но в качестве идеи может быть полезен.
   unit vgRXutil;

   interface

   uses SysUtils, Classes, DB, DBTables, rxLookup, RxQuery;

   { TrxDBLookup }
   procedure RefreshRXLookup(Lookup: TrxLookupControl);
   procedure RefreshRXLookupLookupSource(Lookup: TrxLookupControl);

   function RxLookupValueInteger(Lookup: TrxLookupControl): Integer;

   { TRxQuery }

   { Applicatable to SQL's without SELECT * syntax }

   { Inserts FieldName into first position in '%Order' macro and refreshes query }
   procedure HandleOrderMacro(Query: TRxQuery; Field: TField);

   { Sets '%Order' macro, if defined, and refreshes query }
   procedure InsertOrderBy(Query: TRxQuery; NewOrder: String);

   { Converts list of order fields if defined and refreshes query }
   procedure UpdateOrderFields(Query: TQuery; OrderFields: TStrings);

   implementation
   uses vgUtils, vgDBUtl, vgBDEUtl;

   { TrxDBLookup refresh }

   type TRXLookupControlHack = class(TrxLookupControl)
    property DataSource;
    property LookupSource;
    property Value;
    property EmptyValue;
   end;

   procedure RefreshRXLookup(Lookup: TrxLookupControl);
   var SaveField: String;
   begin
    with TRXLookupControlHack(Lookup) do begin
     SaveField := DataField;
     DataField := '';
     DataField := SaveField;
    end;
   end;

   procedure RefreshRXLookupLookupSource(Lookup: TrxLookupControl);
   var SaveField: String;
   begin
    with TRXLookupControlHack(Lookup) do begin
     SaveField := LookupDisplay;
     LookupDisplay := '';
     LookupDisplay := SaveField;
    end;
   end;

   function RxLookupValueInteger(Lookup: TrxLookupControl): Integer;
   begin
    with TRXLookupControlHack(Lookup) do try
     if Value <> EmptyValue then Result := StrToInt(Value)
     else Result := 0;
    except
     Result := 0;
    end;
   end;

   procedure InsertOrderBy(Query: TRxQuery; NewOrder: String);
   var
    Param: TParam;
    OldActive: Boolean;
    OldOrder: String;
    Bmk: TPKBookMark;
   begin
    Param := FindParam(Query.Macros, 'Order');
    if not Assigned(Param) then Exit;
    OldOrder := Param.AsString;
    if OldOrder <> NewOrder then begin
     OldActive := Query.Active;
     if OldActive then Bmk := GetPKBookmark(Query, '');
     try
      Query.Close;
      Param.AsString := NewOrder;
      try
       Query.Prepare;
      except
       Param.AsString := OldOrder;
      end;
      Query.Active := OldActive;
      if OldActive then SetToPKBookMark(Query, Bmk);
     finally
      if OldActive then FreePKBookmark(Bmk);
     end;
    end;
   end;

   procedure UpdateOrderFields(Query: TQuery; OrderFields: TStrings);
   var NewOrderFields: TStrings;

    procedure AddOrderField(S: String);
    begin
     if NewOrderFields.IndexOf(S) < 0 then NewOrderFields.Add(S);
    end;

   var
    I, J: Integer;
    Field: TField;
    FieldDef: TFieldDef;
    S: String;
   begin
    NewOrderFields := TStringList.Create;
    with Query do try
     for I := 0 to OrderFields.Count - 1 do begin
      S := OrderFields[I];
      Field := FindField(S);
      if Assigned(Field) and (Field.FieldNo > 0) then AddOrderField(IntToStr(Field.FieldNo))
      else try
       J := StrToInt(S);
       if J < FieldDefs.Count then AddOrderField(IntToStr(J));
      except
      end;
     end;
     OrderFields.Assign(NewOrderFields);
    finally
     NewOrderFields.Free;
    end;
   end;

   procedure HandleOrderMacro(Query: TRxQuery; Field: TField);
   var
    Param: TParam;
    Tmp, OldOrder, NewOrder: String;
    I: Integer;
    C: Char;
    TmpField: TField;
    OrderFields: TStrings;
   begin
    Param := FindParam(Query.Macros, 'Order');
    if not Assigned(Param) or Field.Calculated or Field.Lookup then Exit;
    OldOrder := Param.AsString;
    I := 0;
    Tmp := '';
    OrderFields := TStringList.Create;
    try
     OrderFields.Ad(Field.FieldName);
     while I < Length(OldOrder) do begin
      Inc(I);
      C := OldOrder[I];
      if C in FieldNameChars then Tmp := Tmp + C;
      if (not (C in FieldNameChars) or (I = Length(OldOrder))) and (Tmp <> '') then begin
       TmpField := Field.DataSet.FindField(Tmp);
       if OrderFields.IndexOf(Tmp) < 0 then OrderFields.Add(Tmp);
       Tmp := '';
      end;
     end;
     UpdateOrderFields(Query, OrderFields);
     NewOrder := OrderFields[0];
     for I := 1 to OrderFields.Count – 1 do NewOrder := NewOrder + ', ' + OrderFields[1];
    finally
     OrderFields.Free;
    end;
    InsertOrderBy(Query, NewOrder);
   end;
   end.

DBGrid и TQuery

   1. Расположите на вашей форме 2 TQuerie с двумя соответствующими TDatasource (Query1 будет вашим Мастером, Query2 будет вашей Деталью)
   2. Разместите 2 TDBGrid, связанных с Datasource'ами (вероятно, вы уже это сделали)
   3. Используйте базу данных, поставляемую с Delphi:
   Query1.SQL := 'Select * from customer'
   Query2.SQL := 'Select * from Orders whereOrders."CustNo" = :CustNo'
   (это можно сделать как во время выполнения приложения, так и во время его разработки)
   4. В свойствах Query2 выберите свойство Params и напишите в строке 'CustNo'. 'CustNo' был определен как параметр, поскольку в SQL строке было использовано ':'.
   5. ОЧЕНЬ ВАЖНО: установите Query2.Datasource в набор данных, связанный с Query1.
   Каждый раз при изменении записи в наборе данных Query1, Query2 будет обновляться. Имя параметра 'CustNo' соответствует имени реального поля в таблице Customer.
   P.S.: Для получения дополнительной информации обратитесь к разделу электронной справки 'dynamic SQL'

DBGrid как навигатор

   1. Расположите компонент table на пустой форме и свяжите его с вашего таблицей Client.
   2. Добавьте компонент Datasource и свяжите его с компонентом table, описанным выше.
   3. Добавьте компонент grid и свяжите его с компонентом datasource, описанным выше.
   4. Используя Редактор Полей (Fields Editor), создайте компоненты TField для всех полей таблицы client.
   5. Установите свойство Visible всех компонентов TField, кроме Client Name (или другого поля, которое будет отображаться в DBGrid), в False. Grid теперь будет отображать только Client Name.
   6. Для отображения полей таблицы Client (которые вы хотите показать, или которые вы хотите сделать доступными для редактирования пользователем), ниже табличной сетки расположите компоненты DBEdit. Они могут использовать тот же набор данных, что и DBGrid.
   Теперь пользователь может воспользоваться DBGrid для навигации и ввода/редактирования данных посредством DBEdit'ов.

Позиция DBGrid

В режиме разработки дважды щелкните на компоненте TQuery, и выберите все поля, которые вы хотите использовать в DBGrid. Затем в обработчике события DBGrid doubleclick смотрите значение DBGrid.SelectedIndex. Если оно < 0, выбранных пунктов нет. Также, текущая запись TQuery будет указывать на ту же самую строку, которая выбранна в DBGrid. Таким образом, вы можете использовать что-то типа requiredvalue := Query1Field1.AsString; и т.д., естественно, компоненты TQuery и DBGrid должны быть подключены друг к другу.

DBGrid – переход к следующей записи

   Для перехода к следующей записи:
   MyDBGrid.SelectedIndex := MyDBGrid.SelectedIndex + 1;
   Колонки DBGrid индексируются с 0, поэтому SelectedIndex := 0 даст вам первую колонку. Свойство FieldCount вернет вам количество колонок, так что вы без труда можете пробежаться по всей матрице данных.

onClick и DBGrid

   Многие программисты хотели бы использовать OnClick у TDBGrid. Но TDBGrid не имеет такого события. В данном документе рассказывается о том, как обеспечить поддержку события OnClick для TDBGrid. Рассказанная здесь технология может пригодиться при добавлении других свойств к различным объектам. Если вы знаете, что сделать это мог предок, то можно заставить сделать это и наследника. Ключевым моментом здесь можно считать добавление csClickEvents к свойству-набору элемента управления ControlStyle. Это позволит элементу управления, приведенному к типу THack, получать и правильно обрабатывать системные сообщение о щелчке мышью. Назначение OnClick какого-либо элемента управления OnClick DBGrid1 позволяет воспользоваться событием OnClick для элемента управления, которое его не поддерживает.
   Это "неофициальный" путь. Существует несколько причин того, почему dbgrid не поддерживает этого события. Используйте этот код на свой страх и риск.

   unit Udbgclk;

   interface

   uses Windows, Messages, SysUtils, Classes, Graphics,Controls, Forms, Dialogs, StdCtrls, Grids, DBGrids, DBTables, DB;

   type
    thack = class(tcontrol);

    TForm1 = class(TForm)
     DBGrid1: TDBGrid;
     Button1: TButton;
     DataSource1: TDataSource;
     Table1: TTable;
     procedure Button1Click(Sender: TObject);
     procedure FormClick(Sender: TObject);
    private
     { Private declarations }
    public
     { Public declarations }
    end;

   var Form1: TForm1;

   implementation

   {$R *.DFM}

   procedure TForm1.Button1Click(Sender: TObject);
   begin
    THack(dbgrid1).controlstyle :=THack(dbgrid1).controlstyle + [csClickEvents];
    THack(dbgrid1).OnClick := Form1.OnClick;
   end;

   procedure TForm1.FormClick(Sender: TObject);
   begin
    messagebeep(0);
    application.processmessages;
   end;
   end.

Числа с плавающей точкой в DBGrid

   Для показа в табличной сетке дробных чисел, выберите таблицу, с которой связана ваша сетка (через datasource, источник данных).
   Активизируйте редактор полей (правой кнопкой мыши) и выберите поле, в котором вы хотите видеть дробное число.
   Измените значение свойств 'DisplayFormat' и 'EditFormat', чтобы дробь имела формат такой, какой вы хотите (к примеру, шаблон '0.00', позволяющий сетке показывать поле с двумя цифрами после запятой).
   Дважды щелкните на компоненте table, расположенном на форме. Нажмите на кнопку 'Add'. Будут показаны все поля вашей таблицы. Выберите их в списке «Available field» (доступные поля) и щелкните на кнопке OK. Теперь при щелчке на имени поля, в Инспекторе Объектов будут показаны все свойства, относящиеся к данному полю, здесь можно изменить текст заголовка, выводимый формат «DisplayFormat» (это как раз то, что вам нужно, измените его на ####0.0) и пр.

Получение данных DBGrid прежде, чем они будут отправлены: как мне узнать, что пользователь вводит в DBGrid?

   Вы можете «видеть» что набирается в TDBGrid, «смотря» на контрол сетки TInPlaceEdit. Вы должны убедиться только в том, что к моменту использования TInPlaceEdit, контрол уже создан. Следующая функция покажет данные, редактируемые в колонках сетки:
   procedure TForm1.DBGrid1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
   var B: byte;
   begin
    for B := 0 to DBGrid1.ControlCount - 1 do
     if DBGrid1.Controls[B] is TInPlaceEdit then begin
      with DBGrid1.Controls[B] as TInPlaceEdit do begin
       Label1.Caption := 'Текст = ' + Text;
      end;
     end;
   end;

Хочу шапку в TDBGrid. Как сделать?

   Nomadic советует:
   Уже реализовано в виде вот этого компонента — © Andre
   unit bdbgrid;
   interface
   uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Grids, DBGrids, Math;
   type
    TOnDrawTitleEvent = procedure(ACol : integer; ARect : TRect; var TitleText : string) of object;

    TBitDBGrid = class(TDBGrid)
    private
     FBitmapBrowse : TBitmap;
     FBitmapEdit : TBitmap;
     FBitmapInsert : TBitmap;
     FBitmapFill : TBitmap;
     FRealTitleFont : TFont;
     FOnDrawTitle : TOnDrawTitleEvent;
     FResizeFlag : boolean;
     { Private declarations }
     procedure SetRealTitleFont(Value : TFont);
     procedure UpdateTitlesHeight;
    protected
     procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
     { Protected declarations }
    public
     constructor Create(AOwner : TComponent);override;
     destructor Destroy; override;
     { Public declarations }
    published
     property OnDrawTitle : TOnDrawTitleEvent read FOnDrawTitle write FOnDrawTitle;
     property RealTitleFont : TFont read FRealTitleFont write SetRealTitleFont;
     { Published declarations }
    end;

   procedure Register;

   implementation

   var DrawBitmap : TBitmap;

   function Max(X, Y: Integer): Integer;
   begin
    Result := Y;
    if X > Y then Result := X;
   end;

   procedure WriteText(ACanvas: TCanvas; ARect: TRect; DX, DY: Integer; const Text: string; Alignment: TAlignment);
   // © Borland function :)
   const AlignFlags : array [TAlignment] of Integer =
    ( DT_LEFT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
    DT_RIGHT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
    DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX );
   var
    B, R: TRect;
    I, Left: Integer;
   begin
    with DrawBitmap, ARect do { Use offscreen bitmap to eliminate flicker and }
    begin { brush origin tics in painting / scrolling. }
     Width := Max(Width, Right - Left);
     Height := Max(Height, Bottom - Top);
     R := Rect(DX, DY, Right - Left - 1, Bottom - Top - 1);
     B := Rect(0, 0, Right - Left, Bottom - Top);
    end;
    with DrawBitmap.Canvas do begin
     DrawBitmap.Canvas.CopyRect(B, ACanvas, ARect);
     Font := ACanvas.Font;
     Font.Color := ACanvas.Font.Color;
     Brush := ACanvas.Brush;
     SetBkMode(Handle, TRANSPARENT);
     DrawText(Handle, PChar(Text), Length(Text), R, AlignFlags[Alignment]);
    end;
    ACanvas.CopyRect(ARect, DrawBitmap.Canvas, B);
   end;

   constructor TBitDBGrid.Create(AOwner : TComponent);
   begin
    inherited Create(Aowner);
    FRealTitleFont := TFont.Create;
    FResizeFlag := false;
   end;

   destructor TBitDBGrid.Destroy;
   begin
    FRealTitleFont.Free;
    inherited Destroy;
   end;

   procedure TBitDBGrid.UpdateTitlesHeight;
   var
    Loop : integer;
    MaxTextHeight : integer;
    RRect : TRect;
   begin
    MaxTextHeight := 0;
    for loop := 0 to Columns.Count - 1 do begin
     RRect := CellRect(0, 0);
     RRect.Right := Columns[Loop].Width;
     RRect.Left := 0;
     Canvas.Font := RealTitleFont;
     MaxTextHeight := Max(MaxTextHeight, DrawText(Canvas.Handle, PChar(Columns[Loop].Title.Caption), Length(Columns[Loop].Title.Caption), RRect, DT_CALCRECT + DT_WORDBREAK));
    end;
    if TitleFont.Height <> - MaxTextHeight then TitleFont.Height := - MaxTextHeight;
   end;

   procedure TBitDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
   begin
    if MouseCoord(X, Y).Y = 0 then FResizeFlag := true;
    inherited MouseDown(Button, Shift, X, Y);
   end;

   procedure TBitDBGrid.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
   begin
    inherited MouseUp(Button, Shift, X, Y);
    if FResizeFlag then begin
     FResizeFlag := false;
     UpdateTitlesHeight;
    end;
   end;

   procedure TBitDBGrid.DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState);
   var
    Indicator : TBitmap;
    TitleText : string;
    Al : TAlignment;
   begin
    if not ((gdFixed in AState) and ((ARow = 0) and (dgTitles in Options) and (ACol <> 0))) then
     inherited DrawCell(ACol, ARow, ARect, AState)
    else begin
     if DefaultDrawing then begin
      DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_BOTTOMLEFT);
      DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_TOPRIGHT);
      InflateRect(ARect, -1, -1);
      Canvas.Brush.Color := FixedColor;
      Canvas.FillRect(ARect);
     end;
     TitleText := Columns[ACol - 1].Title.Caption;
     if Assigned(OnDrawTitle) then OnDrawTitle(ACol, ARect, TitleText);
     if DefaultDrawing and (TitleText <> '') then begin
      Canvas.Brush.Style := bsClear;
      Canvas.Font := RealTitleFont;
      if ACol > 0 then Al := Columns[ACol - 1].Title.Alignment
      else Al := Columns[0].Title.DefaultAlignment;
      WriteText(Canvas, ARect, 2, 2, TitleText, Al);
     end;
    end;
   end;

   procedure TBitDBGrid.SetRealTitleFont(Value : TFont);
   begin
    FRealTitleFont.Assign(Value);
    Repaint;
   end;

   procedure Register;
   begin
    RegisterComponents('Andre VCL', [TBitDBGrid]);
   end;

   initialization
    DrawBitmap := TBitmap.Create;
   finalization
    DrawBitmap.Free;
   end.

Несколько таблиц в одном TDBGrid

Насколько я знаю, единственное легкое решение заключается в использовании вычисляемых полей.
Для того, чтобы поместить данные из нескольких таблиц в один DBGrid, нужно воспользоваться объектом TQuery. На заметку: используйте TQuery в режиме только для чтения, если вы не можете обеспечить гарантию выполнения некоторых из его руководящих принципов, один из которых – данные могут быть получены только от одной таблицы.

Как сделать так, чтобы в DBGrid напротив некоторых строк можно было бы галочку поставить?

   Nomadic советует:
   Ну примерно так (лишнее мало-мало порезал, больно много его, но идея видна :) на сервере — тaблицa Advertis.DB, первичный ключ ID — autoincrement. На локальном диске — тaблицa Founds.DB, с полем Advertis: integer, по которому есть индекс, и tblFounds.IndexFieldNames = 'Advertis'.
   На гриде:
   === cut ===
   procedure TMainForm.dbgWorkDblClick(Sender: TObject);
   begin
    TriggerRowSelection;
   end;

   procedure TMainForm.TriggerRowSelection;
   begin
    if dmFile.AdvertisCount <> 0 then begin
     with dmFile do if not tblFounds.FindKey([tblAdvertisID.Value]) then begin
      tblFounds.AppendRecord([tblAdvertisID.Value]);
     end else begin
      tblFounds.Delete;
     end;
     dbgWork.Refresh;
    end;
   end;

   procedure TMainForm.dbgWorkDrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
   begin
    if DataCol = 0 then with dmFile, dbgWork.Canvas do begin
     FillRect(Rect); {clear the cell}
     if tblFounds.FindKey([tblAdvertisID.Value]) then begin
     TextOut(Rect.Left, Rect.Top, '?');
     end else begin
      TextOut(Rect.Left, Rect.Top, 'o');
     end;
    end;
   end;
   === cut ===
   Оказывается, я переопределял рисование гридa, а не вычислял поле. Не помню точно, но кажется, чтобы не перечитывать таблицу на каждый даблклик, а только перерисовать грид.
   А колонка для галки в гриде определялась так:
   === cut ===
   with dmFile, dbgWork.Columns do begin
    BeginUpdate;
    Clear;
    {check mark}
    nc := Add;
    nc.Width := 14;
    nc.Font.Name := 'Wingdings';
    nc.Font.Size := 11;
    nc.Alignment := taRightJustify;
    nc.Title.Caption := 'y';
    nc.Title.Font.Name := 'Wingdings';
    nc.Title.Font.Size := 10;
    nc.Title.Alignment := taCenter;
    [skip определения остaльных колонок]
    EndUpdate;
   end;
   === cut ===
   Вроде всё.
   Ну, как напечатать/обработать только помеченное, сам разберёшься. У меня там накручено чего-то с фильтрами, думаю, можно проще.
   Что касается других способов – можно вместо временной тaблицы попользовать список, массив или in-memory table.

Как в TDBGrid разрешить только операции UPDATE записей и запретить INSERT/DELETE?

   Nomadic советует:
   А я делаю так.
   На DataSource, к которому прицеплен Grid, вешаю обработчик на событие OnStateChange.
   Ниже текст типичного обработчика –
   if DBGrid1.DataSource.DataSet.State in [dsEdit, dsInsert] then
   DBGrid1.Options := DBGrid1.Options + goRowSelect
   else DBGrid1.Options := DBGrid1.Options – goRowSelect;
   Дело в том, что если у Grid'а стоит опция goRowSelect, то из Grid'а невозможно добавить запись. Ну а когда програмно вызываешь редактирование или вставку, то курсор принимает обычный вид и все Ok.
   Лучше использовать конструкцию «State in dsEditModes».

Обновление TDBGrid после редактирования отдельной записи на отдельной форме

   А вы постите запись, прежде чем закрыть форму? При закрытии, форма самостоятельно данных не постит. Вы должны постить изменения или с помощью компонента dbnavigator, или c помощью кода, который при закрытии формы постит данные в основную таблицу.
   На странице 95 Database Application Developers Guide (руководство разработчиков приложений баз данных), поставляемое с Delphi, приведен демонстрационный проект с двумя формами, демонстрирующий хорошую технику при использовании ttable на мастер-форме в качестве набора данных для детали.
   Одним из решений вашей проблемы может служить связывание компонента DataSource на Form2 с набором данных DataSet на Form1. Это может быть достигнуто путем добавления следующей строки в обработчик события OnActivate для Form2:
   MyDataSource.DataSet := Form1.MyTable;
   Данный метод имеет 3 преимущества:
   1. сделанные вами изменения немедленно отображаются, поскольку вы используете одну и ту же логическую таблицу;
   2. если вам нужно определить установки для ваших полей таблицы, например, DisplayFormat или EditMask, вам нужно сделать это только один раз в таблице на Form1, вам не нужно это делать на каждой форме, которая использует таблицу;
   3. это сохраняет ресурсы и повышает производительность, поскольку ваше приложение при работе с таблицей использует только одну сессию. Тем не менее, в проектном времени вам нужно иметь TTable на вашей Form2 для того, чтобы вы могли выбрать поля для БД-контролов, после чего вы можете удалить TTable.

Пересортица в коде полей TDBGrid во время вополнения программы

используйте <имя поля>.index := <желаемый номер поля>

В 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) также работает «красиво».

Изменение месторасположение колонок в TDBGrid

   Var
    i: Integer;
    fName: string;
    …………
    { Определение изменения месторасположения колонок }
    …………
    with dbgrid1.datasource.dataset as ttable do
     for i := 0 to indexdefs.count – 1 do begin
     fName := DBGrid1.Fields[0].FieldName;
     if copy(indexdefs[i].fields, 1, length(fname)) = fname then IndexName := IndexDefs[i].Name
    end;

Решение проблемы передачи фокуса TDBGrid

   В данном документе содержится решение проблемы невозможности получения DBGrid-ом фокуса после щелчка на каком-либо элементе управления родительской формы, в то время, как DBGrid находится на ее дочерней MDI-форме.
   Относится ко всем версиям Delphi.
   Очевидно, DBGrid имеет некоторые проблемы с управлением фокусом, если он находится на дочерней MDI-форме. Эта проблема решена в приведенном ниже наследнике TDBGrid, в котором обрабатываются мышиные сообщения и выясняется когда фокус должен быть передан сетке. Наследник создан в виде компонента, который легко устанавливается в Палитру Компонентов. Примечание: код адаптирован для всех версий Delphi. Проблемы могут быть в Delphi 2 и 3, если вы забудете заменить устаревшие в этих версиях модули "winprocs" и "wintypes" на "windows."
   unit FixedDBGrid;

   interface

   uses Winprocs,wintypes, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Grids, DBGrids;

   type TFixedDBGrid = class(TDBGrid)
   private
    { Private declarations }
   protected
    { Protected declarations }
   public
    { Public declarations }
    procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
   published
    { Published declarations }
   end;

   procedure Register;

   implementation

   procedure TFixedDBGrid.WMRButtonDown(var Message: TWMRButtonDown);
   begin
    winprocs.SetFocus(handle); {помните, что winprocs относится только к Delphi 1!}
    inherited;
   end;

   procedure TFixedDBGrid.WMLButtonDown(var Message: TWMLButtonDown);
   begin
    winprocs.SetFocus(handle); {помните, что winprocs относится только к Delphi 1!}
    inherited;
   end;

   procedure tfixeddbgrid.wmlbuttondown(var Message: twmlbuttondown);
   begin
    winprocs.SetFocus(handle); {помните, что winprocs относится только к Delphi 1!}
    inherited;
   end;

   procedure Register;
   begin
    RegisterComponents('Samples', [TFixedDBGrid]);
   end;
   end.

Как отучить TDBGrid от автодобавления новой записи?

   Добавьте в обработчик события вашего TTable «BeforeInsert» следующую строку:
   procedure TForm1.Tbable1BeforeInsert(DataSet: TDataset);
   begin
    Abort; ←эту строчку
   end;
   Осуществляем перехват нажатия клавиши и проверку на конец файла (end-of-file):
   procedure TForm8.DBGrid1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
   begin
    if (Key = VK_DOWN) then begin
     TTable1.DisableControls;
     TTable1Next;
     if TTable1.EOF then Key := 0
     else TTable1.Prior;
     TTable1.EnableControls;
    end;
   end;

Две таблицы в одном TDBGrid

Если у вас D2, вы можете воспользоваться свойством Lookup. Для этого выберите в контекстном меню объекта table редактор полей (fields editor). Затем для добавления нового поля нажмите <Ctrl>+N. Просто раскройте combobox и выберите lookup-поле. TDBGrid автоматически создаст выпадающий список, в котором пользователь сможет выбрать нужный элемент.

Добавление к TDBGrid события OnClick

   TGroothuisGrid = class() {!}
   published
    property OnClick;
   end;
   Это все! OnClick уже объявлен в TControl как защищенное свойство. Все, что вы должны сделать, это опубликовать это свойство в компоненте-наследнике, зарегистрировать его (смотри гл. 8 Руководства по созданию компонентов, Component Writer's Guide) и использовать взамен TDBGrid.

Позиция ячейки в TDBGrid

   В TCustomGrid определен метод CellRect, который, к сожалению, защищен. Это означает, что даный метод доступен только для TCustomGrid и его наследников. Но все-таки существует немного мудреное решение вызова данного метода:
   type TMyDBGrid = class(TDBGrid)
   public
    function CellRect(ACol, ARow: Longint): TRect;
   end;

   function TMyDBGrid.CellRect(ACol, ARow: Longint): TRect;
   begin
    Result := inherited CellRect(ACol, ARow);
   end;
   Вы можете сделать приведение типа вашего DBGrid к TMyDBGrid (это возможно, поскольку CellRect статический метод) и вызвать CellRect:
   Rectangle := TMyDBGrid(SomeDBGrid).CellRect(SomeColumn, SomeRow);
   procedure TfmLoadIn.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn;State: TGridDrawState);
   const Disp = 2;        //Правильно выравниваем компонент
   begin
    inherited;
    if (gdFocused in State) then begin
     if (Column.FieldName = 'TYPEDescription') then begin
      dlTYPEDescription.Left := Rect.Left + DBGrid1.Left + Disp;
      dlTYPEDescription.Top := Rect.Top + DBGrid1.top + Disp;
      dlTYPEDescription.Width := Rect.Right – Rect.Left;
      dlTYPEDescription.Height := Rect.Bottom – Rect.Top;
      dlTYPEDescription.Visible := True;
     end;
    end;
   end;

Dbgrid с цветными ячейками VI

   Установите defaultDrawing в false, и создайте собственный onDrawDataCell, в котором и задавайте нужный вам цвет ячеек. Примерно так:
   procedure Tform1.DBgrid1DrawDataCell(Sender: TObject; const Rect: TRect; Field: TField; State: TGridDrawState);
   begin
    { выберите цвет для текста (font.color) и фона (brush.color) }
    if (field = table1Status) then begin
     { белый на красном }
     DBgrid1.canvas.font.color := clWhite;
     DBgrid1.canvas.brush.color := clRed;
    end else begin
     { черное на белом }
     DBgrid1.canvas.brush.color := clWhite;
     DBgrid1.canvas.font.color := clBlack;
    end;
    { рисуем ячейку }
    DBgrid1.canvas.textrect(rect, rect.left+2, rect.top+2, field.asString);
   end;

   procedure TMainForm.CharGridDrawCell(Sender: TObject; Col, Row: Longint; Rect: TRect; State: TGridDrawState);
   var TheText: string;
   begin
    TheText := CharGrid.Cells[Col, Row];
    with CharGrid.Canvas do begin
     { Определяем цвет фона в зависимости от состояния ячейки: }
     if gdFocused in State then Brush.Color := clYellow {Цвет ячейки с фокусом}
     else if gdSelected in State then Brush.Color := clOlive {Цвет выбранной ячейки}
     else {ячейка не имеет фокуса и не выбрана}
      if IntFromStr(TheText) <> 0 then Brush.Color := clNavy {Цвет фона подсвеченной ячейки}
      else Brush.Color := clWhite; {Цвет фона нормальной ячейки}
     { Определяем цвет текста: }
     if IntFromStr(TheText) <> 0 then Font.Color := clRed {Цвет текста подсвеченной ячейки}
     else Font.Color := clNavy; {Цвет текста нормальной ячейки}
     TextRect(Rect, Rect.Left + 2, Rect.Top + 2, TheText);
    end; {with CharGrid.Canvas}
   end;

Показ Memo-поля в Dbgrid

   …я все же лелею надежду, что когда-нибудь увижу TMemoField.DataSize, имеющим значение, отличное от нуля. Может быть значение DataSize является размером части Memo, которая сохранилась в .db-файле? Вместо этого я теперь пользуюсь объектом TBlobStream, который вполне хорошо справляется с этой работой. Все это у меня происходит примерно так:
   Var
    pBuffer: PChar;
    Blob: TBlobStream;
   begin
    {FDataField – это TMemoField}
    Blob := TBlobStream.Create(FDataField, bmRead);
    try
     if Blob.Size > 0 then try
      GetMem(pBuffer, Blob.Size);
      Blob.Read(pBuffer^, Blob.Size);
      { что-то тут делаем }
      FreeMem(pBuffer, Blob.Size);
     except
      ShowMessage('Нехватка памяти' );
     end;
    finally
     Blob.Free
    end;

Как определить изменение фокуса строки в TDBGrid?

   Используйте событие OnDataChange объекта Datasource, соединенного с DBGrid. Если параметр State в обработчике событие равен dsBrowse, значит вы перешли в новую строку (или только что открыли таблицу).
   Почему сетка не поддерживает такое событие? Поскольку сетка может быть не единственным элементом управления, оторбажающим данные из текущей строки и может быть не единственным элементом, позволяющим осуществлять перемещение от строки к строке. С помощью Datasource обработка события осуществляется централизованно.
   Я не уверен в том, что проблему можно решить, обрабатывая событие одинарного щелчка, для отслеживания события изменения строк я рекомендую использовать событие TDatasource.OnDataChange, а для колонок — TDBGrid.OnColEnter/Exit.
   Лично я пользуюсь следующей рабочей технологией:
   1. Для того, чтобы обнаружить изменения текущей строки, воспользуйтесь событием TDataSource OnDataChange. OnDataChange возникает при прокрутке или щелчке на другой строке. Обработчик события может выглядеть приблизительно так:
   procedure Form1.DSrc1DataChange(Sender: TObject; Field: TField);
   где Field является колонкой, где произошло изменение.
   Поля TTable могут использоваться для сравнения текущих выбранных строк полей (ключ) с вашими требованиями. С той же целью может быть использовано и свойство TDBGrid Fields. Для примера:
   if tbl1.Fields[0].AsString = 'BlaBlaBla' then …
   или
   if dbGrid1.Fields[I].IsNull then …
   2. Для отслеживания изменения колонки, используйте события TDBGrid OnColExit & OnColEnter. Для определения выбранной к настоящему времени колонки воспользуйтесь свойствами TDBGrid SelectedField и SelectedIndex.
   Когда выбирается другая колонка другой строки, вы получаете события OnColExit, OnColEnter и OnDataChange.
   3. Можно пойти и «кривым» путем, взявшись за обработку события TDBGrid OnDrawDataCell, которое возникает когда ячейка выбирается, или когда сетка скроллируется. Обработчик события может выглядеть примерно так:
   procedure Form1.dbGrid1DrawDataCell(Sender: TObject; Rect: TRect; Field: TField; State: TGridDrawState);
   При изменении ячейки вы получаете поток событий, поэтому вам нужно каким-то образом их фильтровать.
   4. Если у вас нет проблем в создании «101 изменения» стандартных компонентов – что является проблемой для меня 8-), то попробуйте это. Это легко.
   Чтобы иметь доступ к индексу строки или колонки выбранной ячейки, вы должны унаследовать ваш класс от TCustomGrid и опубликать свойства времени выполнения Row и Col (текущие строка и колонка сетки, не таблицы!!):
   type TSampleDBGrid = class(TCustomGrid)
   public
    property Col;
    property Row;
   end;
   в соответствующей процедуре или обработчике события осуществите приведение типа:
   var G: TSampleDBGrid;
   begin
    G := TSampleDBGrid(myDBGrid1);
    if G.Row = I then …
    if G.Col = J then …
   Дело в том, что TDBGrid является потомком TCustomGrid, который имеет несколько свойств, содержащих координаты сетки, но это не опубликовано в TDBGrid.
   …из чего я могу заключить, что вы должны это сделать программным путем. Подразумеваем, что сетка уже существует, и у вас есть доступ к основной таблице TTable:
   grid.colcount := dbGrid.fieldcount;
   table.first;
   row := 0;
   while not table.eof do begin
    grid.rowcount := row + 1;
    for i := 0 to grid.colcount-1 do
     grid.cells[i,row] := dbGrid.fields[i].asString;
    table.next;
    inc(row);
   end;
   Могут быть ошибки, но это должно помочь.
   Посмотрите на следующий код, он может вам помочь. Он берет у элемента управления свойсто 'Name' и помещает его в свойство 'Caption' метки.
   unit Unit1;

   interface

   uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

   type TForm1 = class(TForm)
    Label1: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Edit1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure Edit2MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
   private
    { Private declarations }
   public
    { Public declarations }
   end;

   var Form1: TForm1;

   implementation

   {$R *.DFM}

   procedure TForm1.Button1Click(Sender: TObject);
   begin
    close;
   end;

   procedure TForm1.Edit1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
   begin
    Label1.Caption := TEdit(Sender).Name;
   end;

   procedure TForm1.Edit2MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
   begin
    Label1.Caption := TEdit(Sender).Name;
   end;
   end.

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

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

DBLookupComboBox

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

   Вы можете редактировать ваш источник данных. Говорят, вы хотите сохранить ваши lookuping-данные из таблицы customer в таблицу sales – 'Cust No'? Вы можете просто проинициализировать поля (задать значение по умолчанию), редактируя таблицу sales «Cust No»
   with tbSales do begin
    Edit;
    FieldByName('Cust No').AsInteger := 1;
    Post;
   end;

Сортировка 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

Значение 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.

DBMemo

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

Попробуй:
DBMemo6.Lines:=DBMemo5.Lines.Assign;

Поиск текста в 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;

DBNavigator

Настройки всплывающих подсказок в 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

Выключение кнопок в 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.

Работа в коде с кнопками 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;

Edit

Денежное поле редактирования

   unit CurrEdit;

   interface

   uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Menus, Forms, Dialogs, StdCtrls;

   type TCurrencyEdit = class(TCustomMemo)
   private
    DispFormat: string;
    FieldValue: Extended;
    procedure SetFormat(A: string);
    procedure SetFieldValue(A: Extended);
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
    procedure CMExit(var Message: TCMExit);   message CM_EXIT;
    procedure FormatText;
    procedure UnFormatText;
   protected
    procedure KeyPress(var Key: Char); override;
    procedure CreateParams(var Params: TCreateParams); override;
   public
    constructor Create(AOwner: TComponent); override;
   published
    property Alignment default taRightJustify;
    property AutoSize default True;
    property BorderStyle;
    property Color;
    property Ctl3D;
    property DisplayFormat: string read DispFormat write SetFormat;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property HideSelection;
    property MaxLength;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property Value: Extended read FieldValue write SetFieldValue;
    property Visible;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
   end;

   procedure Register;

   implementation

   procedure Register;
   begin
    RegisterComponents('Additional', [TCurrencyEdit]);
   end;

   constructor TCurrencyEdit.Create(AOwner: TComponent);
   begin
    inherited Create(AOwner);
    AutoSize := True;
    Alignment := taRightJustify;
    Width := 121;
    Height := 25;
    DispFormat := '$,0.00;($,0.00)';
    FieldValue := 0.0;
    AutoSelect := False;
    WantReturns := False;
    WordWrap := False;
    FormatText;
   end;

   procedure TCurrencyEdit.SetFormat(A: String);
   begin
    if DispFormat <> A then begin
     DispFormat:= A;
     FormatText;
    end;
   end;

   procedure TCurrencyEdit.SetFieldValue(A: Extended);
   begin
    if FieldValue <> A then begin
     FieldValue := A;
     FormatText;
    end;
   end;

   procedure TCurrencyEdit.UnFormatText;
   var
    TmpText : String;
    Tmp     : Byte;
    IsNeg   : Boolean;
   begin
    IsNeg := (Pos('-',Text) > 0) or (Pos('(',Text) > 0);
    TmpText := '';
    For Tmp := 1 to Length(Text) do
     if Text[Tmp] in ['0'..'9','.'] then
      TmpText := TmpText + Text[Tmp];
    try
     FieldValue := StrToFloat(TmpText);
     if IsNeg then FieldValue := -FieldValue;
    except
     MessageBeep(mb_IconAsterisk);
    end;
   end;

   procedure TCurrencyEdit.FormatText;
   begin
    Text := FormatFloat(DispFormat,FieldValue);
   end;

   procedure TCurrencyEdit.CMEnter(var Message: TCMEnter);
   begin
    SelectAll;
    inherited;
   end;

   procedure TCurrencyEdit.CMExit(var Message: TCMExit);
   begin
    UnformatText;
    FormatText;
    Inherited;
   end;

   procedure TCurrencyEdit.KeyPress(var Key: Char);
   begin
    if Not (Key in ['0'..'9','.','-']) Then Key := #0;
    inherited KeyPress(Key);
   end;

   procedure TCurrencyEdit.CreateParams(var Params: TCreateParams);
   begin
    inherited CreateParams(Params);
    case Alignment of
    taLeftJustify : Params.Style := Params.Style or ES_LEFT and Not ES_MULTILINE;
    taRightJustify: Params.Style := Params.Style or ES_RIGHT and Not ES_MULTILINE;
    taCenter      : Params.Style := Params.Style or ES_CENTER and Not ES_MULTILINE;
    end;
   end;
   end.

Отслеживаем позицию курсора в EditBox

   The_Sprite советует:
   В форму добавляются TEditBox и TLabel, при этом TLabel постоянно показывает позицию курсора в элементе редактирования.
   Совместимость: Все версии Delphi
   Пример:
   procedure TForm1.Edit1Change(Sender: TObject);
   begin
    CurPos := Edit1.SelStart;
    Label1.Caption := IntToStr(CurPos);
   end;

   procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
   begin
    If Key = VK_LEFT then dec(CurPos);
    if Key = VK_RIGHT then inc(CurPos);
    Label1.Caption:= IntToStr(CurPos);
   end;

GroupBox

Рисование на GroupBox

   Я хочу рисовать на холсте (Canvas) моего компонента GroupBox. Но когда я пробую рисовать на Component.Parent.Canvas, рисование происходит на форме, а не на моем компоненте GroupBox. Что я делаю неправильно?
   Canvas – защищенное свойство TGroupBox и, поэтому, недоступное. Вы можете сделать его доступным следующим образом:
   type TMyGroupBox = class(TGroupBox)
   public
    property Canvas;
   end;

   procedure SomeProcedure;
   begin
    …
    with TMyGroupBox(GroupBox1).Canvas do
     CopyRect(ClipRect, Image1.Canvas, ClipRect);
    …
   end;
   – Ralph Friedman

Доступ к компонентам GroupBox

   Одно из свойств всех элементов управления – указатель на другие элементы, которые он содержит. Это свойство – свойство Controls, которое индексируется наподобие массива. Количество элементов управления содержится в свойстве ControlCount. Если вы хотите получить доступ к свойству или методу, которого нет у TControl, вам неоходимо осуществить приведение типа элемента списка.
   procedure DoSomethingWithAGroupBox;
   var i: integer;
   begin
    with AGroupBox do
     for i := 0 to ControlCount - 1 do
      if controls[i] is TEdit then
       TEdit(controls[i]).text := 'Как насчет этого?';
   end;
   end;
   Приведенный выше пример будет работать, если элементом управления является TEdit или его наследник, например, TDBEdit или TMaskEdit. Все объекты могут быть приведены к типу одного из объектов, являющегося наследником базового типа (или им самим). Но не спешите приводить все к родительскому классу, родитель в данном случае здесь не подходит, поскольку он означает объект, который содержит сам себя.

Label

Как сделать бегущую строку?

   The_Sprite отвечает:
   с помощью TLabel и TTimer. Пример:
   procedure TForm1.Timer1Timer(Sender: TObject);
   Const
    LengthGoString = 10;
    GoString = 'В конце строку желательно повторить,'+
     ' чтоб получить эффект кольцевого движения! В конце ст';
   Const i: Integer = 1;
   begin
    Label1.Caption:=Copy(GoString,i,LengthGoString);
    Inc(i);
    If Length(GoString)-LengthGoString < i then i:=1;
   end;

ListBox

Навигация в ListBox при множественном выборе

   Тема: Навигация в ListBox при множественном выборе
   Данный пример выводит сообщение для каждого элемента Listbox, выбранного пользователем.
   procedure TForm1.Button1Click(Sender: TObject);
   var Loop: Integer;
   begin
    for Loop := 0 to Listbox1.Items.Count – 1 do begin
     if listbox1.selected[loop] then ShowMessage(Listbox1.Items.Strings[Loop]);
    end;
   end;

Внешние данные и ListBox

   Мне необходимо создать Listbox с использованием внешних данных, хранимых в огромном (!) TStringList. Существует ли какое-нибудь системное сообщение, которое я мог бы перехватывать для получения данных Listbox из внешнего TStringlist?
   Просматривая справочник по API, я нашел интересный пункт, который может помочь вам решить проблему: в Win32 вы можете создать Listbox со стилем LBS_NODATA:
   (из описания CreateWindow:)
   LBS_NODATA
   Определяет ListBox со стилем no-data (без данных). Данный стиль необходимо применять в случае, если количество элементов в ListBox превышает одну тысячу. no-data ListBox также должен иметь стиль LBS_OWNERDRAWFIXED, но не может иметь стиль LBS_SORT или LBS_HASSTRINGS.
   no-data ListBox похож на owner-drawn ListBox за исключением того, что он не содержит в своих элементах строк и изображений (иконок). Команды добавления, вставки или удаления данных в элементах такого типа ListBox будут проигнорированы, а запросы для поиска строк всегда будут заканчиваться неудачей. При необходимости отрисовки данного элемента, Windows посылает родительскому окну сообщение WM_DRAWITEM. Член itemID стуктуры DRAWITEMSTRUCT, передаваемой с сообщением WM_DRAWITEM, определяет номер строки (элемент), который должен быть перерисован. no-data ListBox не посылает сообщение WM_DELETEITEM.
   Количество элементов в таком списке вы можете установить с помощью сообщения LB_SETCOUNT. Это позволит вам создать «виртуальный» ListBox с очень небольшой загрузкой.
   Чтобы воспользоваться новым стилем, вам нужно создать новый класс-наследник от TListbox и перекрыть метод CreateParams.
   – Peter Below

Инкрементальный поиск в ListBox II

   Я видел приложение, в котором ListBox позволял осуществлять инкрементальный поиск. При вводе очередного символа он позиционирует вас к первой ячейке, начало значения которой совпадает с введенным пользователем текстом, или выделяет все строки с текстом, содержащим введенный текст.
   Как это осуществить на Delphi?
   Здесь придется немного воспользоваться Win API. Установите свойство формы KeyPreview в True и сделайте примерно следующее:
   unit LbxSrch;
   interface

   uses Windows, Messages, SysUtils, Classes, Controls, Forms, StdCtrls;

   type TFrmLbxSrch = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    ListBox1: TListBox;
    Label1: TLabel;
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure ListBox1Enter(Sender: TObject);
   private
    { Private declarations }
    FPrefix: array[0..255] of char;
   public
    { Public declarations }
   end;

   varFrmLbxSrch: TFrmLbxSrch;

   implementation

   {$R *.DFM}

   procedure TFrmLbxSrch.FormKeyPress(Sender: TObject; var Key: Char);
   { Помните о том, что свойство KeyPreview должно быть установлено в True }
   var
    curKey: array[0..1] of char;
    ndx: integer;
   begin
    if ActiveControl = ListBox1 then begin
     if key = #8 {Backspace (клавиша возврата)} then begin
      if FPrefix[0] <> #0 then begin
       FPrefix[StrLen(FPrefix) - 1] := #0;
      end
     end else begin
      curKey[0] := Key;
      curKey[1] := #0;
      StrCat(FPrefix, curKey);
      ndx := SendMessage(ListBox1.Handle, LB_FINDSTRING,-1, longint(@FPrefix));
      if ndx <> LB_ERR then ListBox1.ItemIndex := ndx;
     end;
     Label1.Caption := StrPas(FPrefix);
     Key := #0;
    end;
   end;

   procedure TFrmLbxSrch.ListBox1Enter(Sender: TObject);
   begin
    FPrefix[0] := #0;
    Label1.Caption := StrPas(FPrefix);
   end;
   end.
   – Ralph Friedman

Табуляция в графическом ListBox'е

   Использование табуляции в ListBox'е когда компонент находится в стандартном режиме не составляет труда. Но что делать если надо использовать графическое отображение элементов списка? Ведь при этом надо самому писать обработчик отрисовки элементов с разбиением на колонки. Элементарное решение — использование API функции TabbedTextOut, однако результаты работы этой функции меня явно не удовлетворили. Пришлось-таки "выкручиваться"… Символ-разделитель можно использовать любой. Например, будем использовать символ "|", тогда обработчик OnDrawItem может выглядеть следующим образом:
   procedure TBrowser.ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
   var
    S, Ss: String;
    P: Integer; // Флаг символа-разделителя
   begin

    begin
     ListBox1.Canvas.FillRect(Rect);
     //Отрисовка графики
     …
     //
     S:=ListBox1.Items.Strings[Index];
     P:=Pos('|', S);
     If P=0 then Ss:=S
     else Ss:=Copy(S, 1, P-1);
     // Если нет табуляции, то пишем всю строку, иначе отрезаем кусок до разделителя
     ListBox1.Canvas.TextOut(Rect.Left + 20, Rect.Top + 2, Ss);
     If P>0 then
      ListBox1.Canvas.TextOut(ListBox1.TabWidth, Rect.Top + 2, Copy(S, P+1, Length(S)-P+2));
    end;
   end;
   Не забудьте перед запуском поставить нужное значение TabWidth.
   Virtualik

Выравнивание в ListBox'е

   Перед тем, как вычислить позицию фразы, необходимо с помощью функции TextWidth вычислить ее ширину.
   Например:
   var J, TempInt, LongPrefixLen, CurrPrefixLen: Integer;
   begin
    {Вычисляем TextWidth по ключевой строке}
    {Устанавливаем CurrPrefixLen в TextWidth ключевого слова строки Indexth}
    LongPrefixLen := 0;
    for J := 0 to ListBox1.Items.Count-1 do
     with ListBox1.Canvas do begin
     TempInt:= TextWidth(Copy(Items[J], 1, Pos(KeyString, Items[J]-1)));
     if LongPrefixLen < TempInt then LongPrefixLen:= TempInt;
     if J = Index then CurrPrefixLen:= TempInt;
    end;
    {PrevTextLeft – TextLeft = Где мы хотим вывести новый элемент}
    TextOut(LongPrefixLen-CurrPrefixLen, Y, Items[I]);
   end;

Создание ListBox во время выполнения программы

   Установка выравнивания ListBox на alLeft вызывает изменение размеров ListBox при любом изменении размеров формы. Установка ширины происходит очень легко (помните о том, что ширина Width, которую вы видите в правой части строки, является свойством Width формы).
   Количество элементов, хранимых ListBox, ограничено только доступной памятью.
   procedure TForm1.CreateListBox;
   var LB : TListBox;
   begin
    LB := TListBox.Create;
    LB.Align := alLeft;
    LB.Width := Width div 2;
   end;
   Вот логика динамического создания ListBox и изменения его размера при изменения размеров формы. Я надеюсь, что помог вам. Также я подозреваю, что данные ListBox ограничены 32 килобайтами.
   unit Unit1;

   interface

   uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls { вам нужно это для ListBox } ;

   type TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
   private
    { Private declarations }
   public
    { Public declarations }
   end;

   var
    Form1: TForm1;
    listbox: TListBox;

   implementation

   {$R *.DFM}

   procedure TForm1.FormCreate(Sender: TObject);
   begin
    listbox := TListBox.Create(self);
    listbox.Parent := self;
    listbox.Top := 0;
    listbox.Left := 0;
    listbox.Width := self.Width div 2;
    listbox.Height := self.Height div 2;
    listbox.items.add('тест 1');
    listbox.items.add('тест 2');
    { и т.д, и т.п. … }
   end;

   procedure TForm1.FormResize(Sender: TObject);
   begin
    listbox.Width := self.Width div 2 ;
    listbox.Height := self.Height div 2 ;
   end;
   end.

Двойной ListBox

   Я расположил на форме два компонента Listbox, и с помощью следующего кода заполнил один из них данными из таблицы:
   tableName.Refresh; {в вашем случае это может и не понадобится}
   tableName.First;   {Убедимся, что мы смотрим первую запись}
   while not tableName.Eof do {проходим в цикле таблицу}
   begin
    listbox1.items.add(tableName.FieldByName('USRID').AsString); {добавляем элемент в listbox1}
    tableName.Next; {переходим к следующей записи}
   end;
   ниже я привел процедуру из моего рабочего кода, в котором я использую эту технологию. Я передаю ей в качестве параметров имя таблицы и имена компонентов listbox1 и listbox2. Я пользуюсь этой процедурой, поскольку у меня есть несколько таблиц с полями одинакового типа:
   procedure TTemplateFrm.buildList(tableName: TTable; SelBox, AvailBox: TListBox);
   begin
    {в этой процедуре мы собираемся добавить данные в listbox'ы}
    {получаем любые новые данные}
    tableName.Refresh;
    {Убедимся, что мы смотрим первую запись}
    tableName.First;
    {Теперь очищаем ListBox'ы}
    SelBox.Clear;
    AvailBox.Clear;
    {Теперь добавляем элементы}
    while not tableName.EOF do begin
     AvailBox.Items.Add(tableName.fieldByName('USRID').AsString + ' ' + tableName.fieldByName('DESCRIPTION').AsString);
     tableName.Next;
    end;
   end;
   Как перемещать данные между этими двумя списками? Если вы хотите использовать технологию «drag and drop» (перетащи и брось), то в обработчике mousedown вашей исходной таблицы воспользуйтесь процедурой begindrag:
   if Button = mbLeft then Tlistbox(sender).BeginDrag(false);
   Затем, в вашем другом ListBox, для «опознания» и получения данных создайте следующий обработчик DragOver:
   if Source = ListBox1 then Accept := true
   else Accept := false;
   Не используйте «Accept := (Source is TListbox)», как это показано в большинстве примеров. У вас имеется два компонента ListBox, следовательно, вам нужно сослаться на имя объекта, а не на его тип, а иначе программа просто не поймет кто есть кто.
   Затем в обработчике dragDrop поместите следующий код, добавляющий данные в ListBox2 и удаляющий их из ListBox1.
   Listbox2.Items.Add(Listbox1.Items[Listbox1.ItemIndex]);
   Listbox1.Items.Delete(Listbox1.ItemIndex);
   И, наконец, добавьте кнопку «Сохранить», если вы хотите сохранить содержимое ListBox2 в базе данных.
   Я надеюсь, что это именно то, что вы искали, и что это окажется вам полезным. Если вы хотите также перемещать данные из ListBox2 в ListBox1, вам необходимо будет создать тот же код, но реверсировать его для получения в коде правильных ссылок на компоненты ListBox.

ListBox — OnChange

   Это было два месяца тому назад. Я нашел это на одном из Delphi-сайтов. Не очень сложно и понятно.
   UNIT Lbox;

   INTERFACE

   USES SysUtils, WinTypes, Messages, Classes, Controls, Graphics, Forms,Menus, StdCtrls;

   Type TCngListBox = Class(TListBox)
   private
    FOnChange : TNotifyEvent;
    FLastSel : integer;
    procedure Click; override;
   protected
    procedure Change; Virtual;
   published
    property OnChange : TNotifyEvent read FOnChange write FOnChange;
   public
    constructor create(AOwner : TComponent); override;
   End;

   Procedure Register;

   IMPLEMENTATION

   procedure TCngListBox.Change;
   begin
    FLastSel := ItemIndex;
    if assigned(FOnChange) then FOnChange(self);
   end;

   procedure TCngListBox.Click;
   begin
    inherited Click;
    if FLastSel <> ItemIndex then Change;
   end;

   constructor TCngListBox.Create;
   begin
    Inherited Create(AOwner);
    FLastSel := –1;
   end;

   procedure Register;
   begin
    RegisterComponents('FreeWare',[TCngListBox]);
   end;
   END.

MainManu

Как рисовать картинки в пунктах меню (через OwnerDraw)?

   Nomadic советует:
   Смотри пример:
   unit DN_Win;

   interface

   uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, Menus, StdCtrls,

   type TDNForm = class(TForm)
    MainMenu1: TMainMenu;
    cm_MainExit: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure cm_MainExitClick(Sender: TObject);
   private
    { Private declarations }
   public
    { Public declarations }
    BM:TBitmap;
    Procedure WMDrawItem(var Msg:TWMDrawItem); message wm_DrawItem;
    Procedure WMMeasureItem(var Msg:TWMMeasureItem); message wm_MeasureItem;
   end;

   var DNForm : TDNForm;

   implementation

   {$R *.DFM}

   var Comm, yMenu : word;

   procedure TDNForm.FormCreate(Sender: TObject);
   begin
    {картинку в меню}
    yMenu:=GetSystemMetrics(SM_CYMENU);
    comm:=cm_MainExit.Command;
    ModifyMenu(MainMenu1.Handle, 0, mf_ByPosition or mf_OwnerDraw, comm, 'Go');
   end;{TDNForm.FormCreate}

   procedure TDNForm.cm_MainExitClick(Sender: TObject);
   begin
    DNForm.Close;
   end;{TDNForm.cmExitClick}

   {для прорисовки меню}
   Procedure TDNForm.WMMeasureItem(var Msg:TWMMeasureItem);
   Begin
    with Msg.MeasureItemStruct^ do begin
     if ItemID=comm then begin
      ItemWidth:=yMenu;
      Itemheight:=yMenu;
     end;
    end;
   End;{WMMeasureItem}
   {}
   Procedure TDNForm.WMDrawItem(var Msg:TWMDrawItem);
   var
    MemDC:hDC;
    BM:hBitMap;
    mtd:longint;
   Begin
    with Msg.DrawItemStruct^ do begin
     if ItemID=comm then begin
      BM:=LoadBitMap(hInstance,'dver');
      MemDC:=CreateCompatibleDC(hDC); {hDC входит в структуру TDrawItemStruct}
      SelectObject(MemDC,BM);
      {rcItem входит в структуру TDrawItemStruct}
      if ItemState=ods_Selected then mtd:=NotSrcCopy
     else mtd:=SrcCopy;
      StretchBlt(hDC, rcItem.left, rcItem.top, yMenu, yMenu, MemDC, 0, 0, 24, 23, mtd);
      DeleteDC(MemDC);
      DeleteObject(BM);
     end;
    end{with}
   End;{TDNForm.WMDrawItem}
   end.

Memo

Получение данных из компонента Memo

   Для получения содержимого буфера используйте метод GetTextBuf, или воспользуйтесь приведенным ниже кодом (естественно, откорректируйте его под себя).
   procedure TForm1.SpeedButton1Click(Sender: TObject);
   var
    LineNo : integer;
    ColNo : integer;
   begin
    LineNo:=SendMessage(Memo1.Handle, EM_LINEFROMCHAR, Memo1.SelStart, 0);
    ColNo:=Memo1.SelStart;
    if LineNo>0 then begin
     While SendMessage(Memo1.Handle, EM_LINEFROMCHAR, ColNo, 0) = LineNo do ColNo:=ColNo-1;
     ColNo:=Memo1.SelStart-ColNo-1;
    end else ColNo:=Memo1.SelStart;
    Panel1.Caption:='Строка '+IntToStr(LineNo)+' ; Колонка '+IntToStr(ColNo);
    {Здесь вы можете получить текст через Memo1.Lines[LineNo].Text[ColNo] …}
   end;
   Предупреждение! Данный код был написан в среде WinNT/D2 с использованием элемента управления richedit. Я тестировал то же самое, но с компонентом Memo и в D1, но этот код я забыл дома. Код выше написан по памяти и не тестировался, но я думаю он должен работать. Если вы переберетесь на D2, измените вызов sendmessage на следующий:
   SendMessage(Memo1.Handle, EM_EXLINEFROMCHAR, 0, ColNo)

Изменение поведения Delete в компоненте Memo

   Просто меняю обработчик Memo OnKeyDown следующим образом:
   if Key = VK_DELETE then begin
    здесь делайте все, что вы хотите
   end;
   if Key = VK_BACK then begin
    аналогично
   end;
   Вероятно, лучшим решением было бы использование конструкции CASE, но я не уверен, что она поймет как нужно VK_??. Возможно, после обработки нужно вызвать унаследованный обработчик, т.е. дать поработать обработчику верхнего уровня, у которого мы стырили управление. Не хотите подумать над этим?
   Чтобы понять, где мы сейчас находимся, используйте SelStart, например, так:
   var
    Lpos, Cpos : Integer;
    Lpos := SendMessage(memo1.Handle, EM_LINEFROMCHAR, Memo1.SelStart, 0);
    Cpos := SendMessage(memo1.Handle, EM_LINEINDEX, Lpos, 0);
    CPos := Memo1.SelStart-CPos;
   Ответ: поскольку vk_? имеет целочисленный тип, то это будет работать:
   case Key of
   VK_DELETE :
    begin
     Key := 0; {этим мы не позволяем сообщению keydown передаваться дальше,
      например, форме или компонентам}
     выполняем нужный код;
    end;
   VK_BACK:
    begin
     Key := 0; {этим мы не позволяем сообщению keydown передаваться дальше,
      например, форме или компонентам}
     выполняем нужный код;
    end;
   end;

Вставка текста в TMemo II

Используйте сообщение Windows API EM_REPLACESEL:

Параметр	Описание
lpszReplace	Значение lParam. Указатель на терминированную нулем строку, содержащую замещающий текст. { Указатель на строку }

   Сделайте список с вашими стандартными фразами, и используйте события "OnClick" или "OnMouseDown" в комбинации с "Alt", "Shift" или "Ctrl". Пример: Когда пользователь нажимает клавишу "Alt" в комбинации с правой кнопкой мыши, выводится список заранее подготовленных фраз и выбранная вставляется в ваш TMemo-компонент.
   Для вставки строки в Memo:
   procedure TForm1.Button1Click(Sender: TObject);
   begin
    with Memo1 do begin
     SelStart:=10;
     SelLength:=0;
     SelText:='Эта строка включается в Memo, начиная с 10-й позиции ';
    end;
   end;
   Для вставки строки и замены некоторого существующего текста:
   procedure TForm1.Button1Click(Sender: TObject);
   begin
    with Memo1 do begin
     SelStart:=10;
     SelLength:=20;
     SelText:='Эта строка включается в Мемо, начиная с 10-й позиции и замещает собой 20 символов ';
    end;
   end;
   Поместите текст, который вы хотите вставить, в переменную PChar, затем вставьте текст в Memo, используя команду SetSelTextBuf, где SelStart устанавливается в позицию курсора TMemo. Это классно работает.
   Другая полезность: вы можете обхойти предел TMemo в 32K в случае, если вы загружаете в него текст, пользуясь методом/командой Lines.LoadfromFile. Компонент имеет внутренний предел в 32K. Если вы загружаете нужный файл в указатель, и используете команду/метод SetTexBuf, то в этом случае в TMemo можно загрузить текста вплоть до 64K.

NoteBook

Включение/Выключение закладки Notebook II

   В обработчике события OnChange вашего TTabbedNotebook разместите код примерно такого содержания:
   if (NewTab = 0) and (IWantToDisableTab0) then AllowChange := False;
   if (NewTab = 1) and (IWantToDisableTab1) then AllowChange := False;
   …
   Да, можно использовать конструкцию Case, но If в данном случае я посчитал удобнее.

OutLine

Раскрытие пути к элементу TOutline по его индексу

   Когда я писал этот код, у меня была цель по индексу TOutlineNode (который являлся результатом поиска) раскрыть его путь (т.е. раскрыть дочерние узлы, ведующие к нему), не затрагивая при это остальные узлы.
   Следующая процедура в качестве параметра принимает индекс, после чего раскрывает путь к элементу с этим индексом.
   Процедура подразумевает работу с объектом TOutline, имеющим имя Outline.
   var Outline: TOutline;
   procedure TSearchDlg.ExpandPathToFoundItem(const FoundItemIndex: Longint);
   {------------------------------------------------------------------------------
    Открываем путь к данному элементу (элемент определяется номером индекса).
    До корневого элемента необходимо раскрывать только родителей.
    -----------------------------------------------------------------------------}
   var
    ItemIndex: Longint;
    Found:     Boolean;
    LastCh:    Longint;
    Path:      String;
    ItemText:  String;
    SepPos:    Integer;
    OldSep:    String;
   begin
    {Сохраняем старый ItemSpearator}
    OldSep:=Outline.ItemSeparator;
    {Устанавливаем новый ItemSeparator}
    Outline.ItemSeparator:='\';
    {Получаем полный путь к TOutlineNode и добавляем '\'. Это делается для упрощения последующего алгоритма}
    Path:=Outline.Items[FoundItemIndex].FullPath+'\';
    {Зацикливаемся до тех пор, пока не будет достигнут конец пути}
    while Length(Path) > 0 do begin
     {Определяем в пути позицию первого '\'}
     SepPos:=Pos('\',Path);
     {Изолируем элемент TOutlineNode}
     ItemText:=Copy(Path,1,SepPos-1);
     {Определяем индекс TOutlineNode}
     ItemIndex:=Outline.GetTextItem(ItemText);
     {Раскрываем его}
     Outline.Items[ItemIndex].Expand;
     {Вырезаем из строки раскрытый TOutlineNode}
     Path:=Copy(Path,SepPos+1,Length(Path)-SepPos+1);
    end;
    {Восстанавливаем оригинальный ItemSeparator}
    Outline.ItemSeparator:=OldSep;
   end;
   Детали
   Давайте присвоим элементу желаемый путь:
   "My Computer\Hardware\SoundCard\Base Adress"
   На первом шаге возвращается приведенный выше путь. Затем изолируется подстрока «My Computer». Затем с помощью метода «GetTextItem» определяется индекс TOutlineNode «My Computer». Метод «Expand» раскрывает это дерево. Впоследствие «My Computer» вырезается из пути, и новым путем становится «Hardware\SoundCard\Base Adress».
   Затем определяется индекс «Hardware», раскрывается, и снова выразается. Данная процедура повторяется до тех пор, пока не останется пути, который можно раскрыть. После чего полностью раскрывается путь передаваемой TOutlineNode.

PageControl

Динамические PageControl/TabSheet I

   Динамическое создание Page Control'ов и Tab Sheet'ов:
   var
    T : TTabSheet;
    P : TPageControl;
   begin
    // Создаем PageControl
    // При создании получаем ссылку на PageControl, чтобы в дальнейшем на него ссылаться.
    P := TPageControl.Create(application);
    with P do begin
     Parent := Form1; // устанавливаем его как элемент управления формы.
     Top := 30;
     Left := 30;
     Width := 200;
     Height := 150;
    end; // with tpagecontrol
    // Создаем 3 страницы
    T := TTabSheet.Create(P);
    with T do begin
     Visible := True;  // Это необходимо, или форма не будет корректно перерисовываться
     Caption := 'Страница 1';
     PageControl := P; // Назначаем Tab в Page Control
    end; // with
    T := TTabSheet.Create(P);
    with T do begin
     Visible := True;  // Это необходимо, или форма не будет корректно перерисовываться
     Caption := 'Страница 2';
     PageControl := P; // Назначаем Tab в Page Control
    end; // with
    T := TTabSheet.Create(P);
    with T do begin
     Visible := True; // Это необходимо, или форма не будет корректно перерисовываться
     Caption := 'Страница 3';
     PageControl := P; // Назначаем Tab в Page Control
    end; // with
    // Создаем 3 кнопки, 1 на страницу
    with tbutton.create(application) do begin
     Parent := P.Pages[0]; // «Указываем» кнопке родительскую страницу
     Caption := 'Привет, страница 1';
     Left := 0;
     Top := 0;
    end; // with
    with tbutton.create(application) do begin
     Parent := P.Pages[1]; // «Указываем» кнопке родительскую страницу
     Caption := 'Привет, страница 2';
     Left := 50;
     Top := 50;
    end; // with
    with tbutton.create(application) do begin
     Parent := P.Pages[2]; // «Указываем» кнопке родительскую страницу
     Caption := 'Привет, страница 3';
     Left := 100;
     Top := 90;
    end; // with
    // Это должно быть сделано, или Tab первоначально не синхронизируется
    // с правильной страницей. Только в случае, если у вас более чем одна страница.
    P.ActivePage := P.Pages[1];
    P.ActivePage := P.Pages[0]; // Реально показываемая страница
   end;

Динамические PageControl/TabSheet II

В данном документе показана технология динамического добавления страниц компонента PageControl (объектов TTabSheet) к элементу управления Windows 95/NT PageControl (объект TPageControl). Оба этих объекта объявлены в модуле ComCtrls. Поэтому убедитесь в том, что ComCtrls указан в списке используемых модулей.

Как динамически создать PageControl

   Прежде, чем мы приступим к динамическому созданию страниц, давайте динамически создадим PageControl (если он еще не на форме). Это делается посредством вызова конструктора TPageControl Create с параметром owner, равным Self. Конструктор Create возвращает объектную ссылку на вновь созданный объект PageControl и назначает его переменной 'PageControl'. Вторым шагом будет установка свойства PageControl Parent в Self. Свойство Parent определяет где должен быть отображен новый PageControl; в нашем случае это будет сама форма. Вот кусок кода, демонстрирующий вышесказанное:
   var
    PageControl : TPageControl;
    PageControl := TPageControl.Create(Self);
    PageControl.Parent := Self;
   Примечание: При разрушении формы разрушаются также PageControl и ее закладки, поскольку они принадлежат форме.

Как динамически создавать закладки

   Существует два основных способа добавления новых страниц к PageControl. Сначала вы должны динамически создать TTabSheet следующим образом:
   var
    TabSheet : TTabSheet;
    TabSheet := TTabSheet.Create(Self);
   Затем ему необходимо присвоить заголовок следующей командой:
   TabSheet.Caption := 'Закладка 1';
   И, наконец, самая важное действие заключается в том, что новой странице необходимо сообщить, какому объекту PageControl она принадлежит. Это делается с помощью присваивания свойством TTabSheet PageControl переменной-ссылки TPageControl, типа той, которую мы создали выше (PageControl). Вот кусок кода, демонстрирующий вышесказанное:
   TabSheet.PageControl := PageControl;

Как динамически добавлять к страницам элементы управления

   Ключевым моментом при создании и размещении элемента управления на странице TabSheet является назначение свойства Parent на переменную-ссылку класса TTabSheet. Вот пример:
   var
    Button : TButton;
    Button := TButton.Create(Self);
    Button.Caption := 'Кнопка 1';
    Button.Parent := TabSheet;
   Более подробно об объектах TPageControl и TTabSheet вы можете узнать в онлайн-документации, или посмотреть код файла ComCtrls.pas, расположенного в вашем каталоге ..\Delphi 2.0\SOURCE\VCL.

Полный код примера

   // Код использует форму с единственной на ней кнопкой.
   unit DynamicTabSheetsUnit;

   interface

   uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons;

   type TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure TestMethod(Sender: TObject);
   private
    { Private declarations }
   public
    { Public declarations }
   end;

   var Form1: TForm1;

   implementation

   uses ComCtrls;

   {$R *.DFM}

   procedure TForm1.Button1Click(Sender: TObject);
   var
    PageControl : TPageControl;
    TabSheet : TTabSheet;
   begin
    // Создаем PageControl
    PageControl := TPageControl.Create(Self);
    PageControl.Parent := Self;
    // Создаем первую страницу и связываем ее с PageControl
    TabSheet := TTabSheet.Create(Self);
    TabSheet.Caption := 'Закладка 1';
    TabSheet.PageControl := PageControl;
    // Создаем первую страницу
    with TButton.Create(Self) do begin
     Caption := 'Кнопка 1';
     OnClick := TestMethod; // Назначаем обработчик события
     Parent := TabSheet;
    end;
    // Создаем вторую страницу и связываем ее с PageControl
    TabSheet := TTabSheet.Create(Self);
    TabSheet.Caption := ' Закладка 2';
    TabSheet.PageControl := PageControl;
   end;

   procedure TForm1.TestMethod(Sender: TObject);
   begin
    ShowMessage('Привет');
   end;
   end.

Клавиши-акселераторы для TPageControl

   Тема: Создание акселераторов, работающих с TPageControl
   TPageControl, расположенный на закладке Win95 палитры компонентов, в настоящий момент не может работать с акселераторами. Тем не менее, в наших силах создать потомок TPageControl, поддерживающий вышеназванную характеристику.
   В приведенном ниже коде показана реализация такого компонента. Наследник TPageControl осуществляет захват и обработку сообщения CM_DIALOGCHAR. Это позволяет перехватывать комбинации клавиш, которые могут быть акселератороми для данной формы. Обработчик события CMDialogChar использует функцию IsAccel, которая позволяет определить, имеет ли отношение перехваченный код клавиш к акселератору одной из страниц TPageControl. В этом случае делаем страницу активной и передаем ей фокус.
   unit tapage;
   interface
   uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls;

   type TAPageControl = class(TPageControl)
   private
    procedure CMDialogChar(var Msg: TCMDialogChar); message CM_DIALOGCHAR;
   end;

   procedure Register;

   implementation

   procedure TAPageControl.CMDialogChar(var Msg: TCMDialogChar);
   var
    i: Integer;
    S: String;
   begin
    if Enabled then
     for I := 0 to PageCount - 1 do
      if IsAccel(Msg.CharCode, Pages[i].Caption) and Pages[I].TabVisible then begin
     Msg.Result := 1;
     ActivePage := Pages[I];
     Change;
     Exit; // выход из цикла.
    end;
    inherited;
   end;

   procedure Register;
   begin
    RegisterComponents('Test', [TAPageControl]);
   end;
   end.

Panel

Создание панелей во время работы приложения

   …я могу просто догадываться, не видя ваш код, но вы установили у панелей свойство parent? Чтобы отобразить элементы управления на вашей форме, вам НЕОБХОДИМО вставить в обработчик события формы OnCreate следующие две строки:
   MyPanel := TPanel.Create(Self);
   MyPanel.Parent := Self;

PopupMenu

Вызов контекстного меню в позиции курсора II

   …вызов popup-меню связан с координатами экрана. Координаты, получаемые в вашем обрабочике события, вероятно относятся к объекту, который создал это сообщение. Для преобразования координат вам необходимо воспользоваться функцией ClientToScreen.
   Вот пример вызова контекстного меню, вызываемого при щелчке правой кнопкой мыши на узле TTreeView. Этот пример не в точности отвечает на ваш вопрос, но у меня нет желания расчитывать wParams прямо сейчас. Я думаю вы можете воспользоваться предложенной мною идеей и развить ее в нужном направлении.
   procedureTfrmExplorer.TreeViewMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
   var P : TPoint;
   begin
    if Button<>mbRight then exit;
    TreeMenu.AutoPopup := False;
    if TreeView.GetNodeAt(X,Y)<>NIL then begin
     TreeView.Selected := TreeView.GetNodeAt(X,Y);
     P.X := X;
     P.Y:=Y;
     P := TreeView.ClientToScreen(P);
     TreeMenu.Popup(P.X,P.Y);
    end;
   end;

Иконки в PopupMenu

   type TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem; /**** Элемент для Menu Bar ****/
    Open1: TMenuItem; /**** Элемент для Menu File ****/
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
   private
    {private declarations}
   public
    {public declarations}
    Icn, Txt, MnuItm: TBitmap;
   end;

   procedure TForm2.FormCreate(Sender: TObject);
   var
    R: TRect;
    HIcn: HIcon;
    Ic: TIcon;
    Index: Word;
    FileName: PChar;
   begin
    /** Получаем иконку определенного приложения **/
    Ic:=TIcon.Create;
    Ic.Handle:=ExtractAssociatedIcon(Hinstance, /* задаем путь и имя файла */, Index);
    /** Создаем для текста изображение **/
    Txt:=TBitmap.Create;
    with Txt do begin
     Width:=Canvas.TextWidth(' Тест');
     Height:=Canvas.TextHeight(' Тест');
     Canvas.TextOut(0, 0, ' Тест');
    end;
    /** Копируем иконку в bitmap для изменения его размера. Вы не можете менять размер иконки **/
    Icn:=TBitmap.Create;
    with Icn do begin
     Width:=32;
     Height:=32;
     Brush.Color:=clBtnFace;
     Canvas.Draw(0, 0, Ic);
    end;
    /** Создаем окончательное изображение, куда мы помещаем иконку и текст **/
    MnuItm:=TBitmap.Create;
    with MnuItm do begin
     Width:=Txt.Width+18;
     Height:=18;
     with Canvas do begin
      Brush.Color:=clBtnFace;
     Pen.Color:=clBtnFace;
      Brush.Style:=bsSolid;
      Rectangle(0, 0, Width, Height);
      CopyMode:=cmSrcAnd;
      StretchDraw(Rect(0, 0, 16, 16), Icn);
      CopyMode:=cmSrcAnd;
      Draw(16, 8-(Txt.Height div 2), Txt);
     end;
    end;
   end;

   procedure TForm2.FormShow(Sender: TObject);
   var
    ItemInfo: TMenuItemInfo;
    hBmp1   : THandle;
   begin
    HBmp1:=MnuItm.Handle;
    with ItemInfo do begin
     cbSize     := SizeOf(ItemInfo);
     fMask      := MIIM_TYPE;
     fType      := MFT_BITMAP;
     dwTypeData := PChar(MakeLong(hBmp1, 0));
    end;
    /** Заменяем MenuItem Open1 законченным изображением **/
    SetMenuItemInfo(GetSubMenu(MainMenu1.Handle, File1.MenuIndex), Open1.MenuIndex, true, ItemInfo);
   end;
   В меню существуют некоторые проблемы масштабированием и палитрой иконки. Я также ищу лучшее решение, но это все, что я вам могу сейчас дать.
   Листинг был изменен для того, чтобы помещать иконки в «чЕкнутое» состояние меню (просто это делает Win95). Это позволяет вам иметь «чЕкнутое» и «нечЕкнутое» состояние.
   unit Unit1;

   interface

   uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Menus,ShellAPI;

   type TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Open1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
   private
    { Private declarations }
   public
    { Public declarations }
    Icn, MnuItm : TBitmap;
   end;

   var Form1: TForm1;

   implementation

   {$R *.DFM}

   procedure TForm1.FormCreate(Sender: TObject);
   var
    R: TRect;
    HIcn: HIcon;
    Ic: TIcon;
    Index: Word;
   begin
    { /** Получаем иконку некоторого приложения **/ }
    Index := 0;
    { 11-я иконка в файле }
    Ic:=TIcon.Create;
    Ic.Handle:=ExtractAssociatedIcon(Hinstance, 'c:\win95\system\shell32.dll', Index);
    { /** Копируем иконку в bitmap для изменения его размера. Вы не можете менять размер иконки **/ }
    Icn:=TBitmap.Create;
    with Icn do begin
     Width:=32;
     Height:=32;
     Canvas.Brush.Color := clbtnface;
     Canvas.Draw(0,0,Ic);
    end;
    { /** Создаем окончательное изображение, куда мы помещаем иконку и текст **/ }
    MnuItm:=TBitmap.Create;
    with MnuItm do begin
     Width :=18;
     Height:=18;
     with Canvas do begin
      Brush.Color:=clbtnface;
      Pen.Color:=clbtnface;
      CopyMode:=cmSrcAnd;
      StretchDraw(Rect(0,0,16,16), Icn);
     end;
    end;
   end;

   procedure TForm1.FormShow(Sender: TObject);
   var
    ItemInfo: TMenuItemInfo;
    hBmp1   : THandle;
   begin
    HBmp1:=MnuItm.Handle;
    with ItemInfo do begin
     cbSize        := SizeOf(ItemInfo);
     fMask         := MIIM_CHECKMARKS;
     fType         := MFT_BITMAP;
     hBmpunChecked := HBmp1; { Неотмеченное (Unchecked) состояние }
     hBmpChecked   := HBmp1; { Отмеченное (Checked) состояние }
    end;
    { /** Заменяем MenuItem Open1 законченным изображением **/ }
    SetMenuItemInfo(GetSubMenu(MainMenu1.Handle, File1.MenuIndex), Open1.MenuIndex, true, ItemInfo);
   end;
   end.

ProgressBar

ProgressBar — невидимка

   Здравствуйте Валентин!
   Заказчик моего проекта обратился с просьбой — "Сделать прогресс индикатор как в приложениях Нортона. Чтоб был в статус строке и НИКАКИХ рамок". ProgressBar в StatusBar — нет проблем, но как быть с рамкой от ProgressBar? ProgressBar всегда вычерчивает рамку и не имеет методов ее управления. Однако появилась интересная идея, воплотившаяся в компонент с новым свойством ShowFrame. Решение оказалось на удивление простым.
   unit SProgress;

   interface
   uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls;

   type TVSProgressBar = class(TProgressBar)
    procedure WMNCPAINT(var Msg: TMessage); message WM_NCPAINT;
   private
    { Private declarations }
    FShowFrame: boolean;
    procedure SetShowFrame(Value: boolean);
   protected
    { Protected declarations }
   public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
   published
    { Published declarations }
    property Align;
    property Anchors;
    property BorderWidth;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Hint;
    property Constraints;
    property Min;
    property Max;
    property Orientation;
    property ParentShowHint;
    property PopupMenu;
    property Position;
    property ShowFrame: boolean read FShowFrame write SetShowFrame;
    property ShowHint;
    property Smooth;
    property Step;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnContextPopup;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
   end;

   procedure Register;

   implementation

   { TVSProgressBar }
   constructor TVSProgressBar.Create(AOwner: TComponent);
   begin
    Inherited;
    FShowFrame:= True;
   end;

   procedure TVSProgressBar.SetShowFrame(Value: boolean);
   begin
    if FShowFrame <> Value then begin
     FShowFrame:= Value;
     RecreateWnd;
    end;
   end;

   procedure TVSProgressBar.WMNCPAINT(var Msg: TMessage);
   var
    DC: HDC;
    RC: TRect;
   begin
    if ShowFrame then begin
     Inherited; // если рамка – родитель сам разберется
     Invalidate;
    end else begin
     DC := GetWindowDC(Handle);
     try
      Windows.GetClientRect(Handle, RC); // площадка под ProgressBar
      with RC do begin // учтем 3D эффект
       Right:= Right + 2;
       Bottom:= Bottom + 2;
      end;
      Windows.FillRect(DC, RC, Brush.Handle); // зальем площадку цветом подложки
     finally
      ReleaseDC(Handle, DC);
     end;
    end;
   end;

   procedure Register;
   begin
    RegisterComponents('Controls', [TVSProgressBar]);
   end;
   end.
   Теперь ProgressBar может появиться на форме «неожиданно», как бы из ничего, если ShowFrame:= False.
   C уважением, VS

Query

Можно ли использовать результаты выполнения одного TQuery для другого TQuery?

   Nomadic отвечает:
   Если Вы работаете с локальными БД, то Вам поможет –
   DbiMakePermanent(SourceQuery.Handle, RName, false);

Можно ли вызвать хранимую процедуру через TQuery, если она не возвращает курсора?

   Nomadic отвечает:
   В случае MS SQL нужно написать:
   Query1.Sql := 'declare @res' + #13#10 + 'exec MyFunc :Param1, :Param2, @res OUTPUT';
   Query1.Open;
   Result := Query1.FieldByName( 'Column1' ).Value;
   Query1.Close;

TQUERY и TDBGRID

   1. После ключевого слова where используйте оператор order
   Select fname, lname, title
   from T_EMPLOYEE
   where title = 'MGR'
   order by lname, fname
   2. Попробуйте использовать событие ColEnter.

Две и более команд в свойстве TQUERY.SQL

   Я предлагаю вас попытаться подключить новый запрос к существующему TQuery.
   Query1.Sql.Clear;
   Query1.Close;
   Query1.Sql.Add('select * from «monitor.dbf» order by location,dept');
   Query1.Open;
   Query1.Refresh;
   Хитрость кроется в закрытии вашего запроса перед назначением нового.

RichEdit

Как вставить в нужное место Rich Text в TRichEdit?

Nomadic советует:
Вы можете послать сообщение EM_STREAMIN с параметром SFF_SELECTION методом Perform для замены текущего Selection. Выдержка из Help:

Value	Meaning
SF_TEXT	Text
SF_RTF Rich-text	format

Как указать максимальный размер текста для TRichEdit?

   Nomadic советует:
   У этого компонента есть свойство MaxLength, которое работает некорректно. Поэтому лучше пользоваться
   RichEdit.Perform(EM_LIMITTEXT, нужный размер, 0);
   Причем перед каждом открытии файла это действие необходимо повторять.
   Если Вы передаете в качестве размера 0, то ОС ограничивает размер OS Specific Default Value. Реально, по результатам моих экспериментов, поставить можно размер, чуть меньший доступной виртуальной памяти. Я ограничился 90% от свободной виртуалки.
   Для того, чтобы не повторять этот вызов (EM_LIMITTEXT), можно воспользоваться сообщением EM_EXLIMITTEXT.

Позиция курсора в TRichEdit

   Procedure TForm1.GetPosition(Sender: TRichEdit);
   var
    iX, iY: Integer;
    TheRichEdit: TRichEdit;
   begin
    iX:= 0;
    iY:= 0;
    TheRichEdit:= TRichEdit(Sender);
    iY:= SendMessage(TheRichEdit.Handle, EM_LINEFROMCHAR, TheRichEdit.SelStart, 0);
    iX:= TheRichEdit.SelStart - SendMessage(TheRichEdit.Handle, EM_LINEINDEX, iY, 0);
    Panel1.Caption:= IntToStr(iY + 1) + ':' + IntToStr(iX + 1);
   end;

   procedure TForm1.RichEditMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
   begin
    GetPosition(RichEdit);
   end;

   procedure TForm1.RichEditKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
   begin
    GetPosition(RichEdit);
   end;

RadioGroup

Группа радиокнопок и ActiveControl

   На форме я имею группу радиокнопок. Я хотел бы вызывать контекстно-зависимую подсказку, если пользователь нажал F1. Для данной конкретной группы радиокнопок я установил HelpContext равным 22, но при любом вызове ActiveControl.HelpContext это возвращает (0). Все другие элементы управления работают как положено. Что я делаю неправильно?
   Нет. Проблема в том, что ActiveControl – RadioButton, а не RadioButtonGroup. Поместите следующий код в обработчик события формы OnShow, он должен решить вашу проблему:
   procedure TForm1.FormShow(Sender: TObject);
   var c: integer;
   begin
    with RadioGroup1 do begin
     for c := 0 to ControlCount – 1 do TRadioButton(Controls[c]).HelpContext := HelpContext;
    end;
   end;
   – Ralph Friedman

ScrollBar

Мерцание ScrollBar

   TScrollBar в Delphi мигает при получении фокуса. Как избежать этого мерцания?
   Такая же проблема и при перемещении стандартного бегунка полосы прокрутки. Лечится одинаково: установкой свойства TabStop в False.
   – Rick Rogers

SpeedButton

Speedbutton и Glyph

   Могу ли я из ресурсов поочередно загружать глифы для кнопок speedbutton и, если да, то как это сделать?
   Например, если в вашем проекте используется TDBGrid, то иконки кнопок компонента DBNavigator могут линковаться вашей программой, и их можно загрузить для использования в ваших speedbutton следующим образом:
   SpeedButton.Caption := '';
   SpeedButton1.Glyph.LoadFromResourcename(HInstance,'DBN_REFRESH');
   SpeedButton1.NumGlyphs := 2;
   Другие зарезервированные имена:
   DBN_PRIOR, DBN_DELETE, DBN_CANCEL, DBN_EDIT, DBN_FIRST, DBN_INSERT, DBN_LAST, DBN_NEXT, DBN_POST
   Все имена должны использовать верхний регистр.
   – Dennis Passmore

StringGrid

Обновление картинки в ячейке StringGrid

   SottNick советует:
   Если в таблице вы используете событие OnDrawCell для помещения в ячейку рисунка, причем различного, в зависимости, например, от соответствующего значения в двумерном массиве, и вам надо, чтобы после изменения значения в массиве обновилось изображение (Refresh не подходит, т.к. будет мелькать), то измените значение у ячейки (DrawGrid не годится):
   StringGrid1.Cells[i,j]:='';
   или
   StringGrid1.Cells[i,j]:=StringGrid1.Cells[i,j];
   если там что-то хранится.

Многострочность в заголовках колонок StringGrid

   У меня есть StringGrid, который выглядит очень красивым, за исключением заголовков колонок, где я хотел бы иметь их размер равным 1 ячейке, но с заголовком, размещенным в нескольких строках, например,
   Индекс Фондовой Биржи
   показывалось бы как
    Индекс
    Фондовой
    Биржи
   было бы классно, если можно было этот заголовок размещать еще и по центру.
   Рисовать сами ячейки вы можете в обработчике события OnDrawCell. Для определения ячейки (заголовок?), обрабатываемой в текущий момент, используйте параметр GridState.
   Я выводил тест с помощью обычных методов рисования (которые хорошо "приживаются" в данном компоненте), с поддержкой вертикального выравнивания, полей и переноса слов. Вот сам код:
   TFTVerticalAlignment = (vaTop, vaMiddle, vaBottom);
   procedure DrawTextAligned(const Text: string; Canvas: TCanvas; var Rect: TRect; Alignment: TAlignment; VerticalAlignment: TFTVerticalAlignment; WordWrap: Boolean);
   var
    P : array[0..255] of Char;
    H : Integer;
    T : TRect;
    F : Word;
   begin
    StrPCopy(P, Text);
    T := Rect;
    with Canvas, Rect do begin
     F := DT_CALCRECT or DT_EXPANDTABS or DT_VCENTER or TextAlignments[Alignment];
     if WordWrap then F := F or DT_WORDBREAK;
     H := DrawText(Handle, P, -1, T, F);
     H := MinInt(H,Rect.Bottom - Rect.Top);
     if VerticalAlignment = vaMiddle then begin
      Top := ((Bottom+Top) - H) div 2;
      Bottom := Top + H;
     end else if VerticalAlignment = vaBottom then Top := Bottom - H - 1;
     F := DT_EXPANDTABS or DT_VCENTER or TextAlignments[Alignment];
     if WordWrap then F := F or DT_WORDBREAK;
     DrawText(Handle, P, –1, Rect, F);
    end;
   end;
   – Rick Roger

StringGrid без выделенной ячейки

   Я пытаюсь показать StringGrid без выделенной ячейки. Первая нефиксированная ячейка всегда имеет состояние "инвертированного" цвета. Я не хочу позволить пользователю редактировать сетку, но эта выделенная ячейка производит впечатление того, что сетка имеет возможность редактирования…
   Вам необходимо создать обработчик события OnDrawCell. Это легче чем вы думаете. Вот образец кода, который сделает вас счастливым:
   procedure TForm.sgrDrawCells(Sender: TObject; Col, Row: Longint; Rect: TRect; State: TGridDrawState);
   var
    ACol: longint absolute Col;
    ARow: longint absolute Row;
    Buf: array[byte] of char;
   begin
    if State = gdFixed then Exit;
    with sgrGrid do begin
     Canvas.Font := Font;
     Canvas.Font.Color := clWindowText;
     Canvas.Brush.Color := clWindow;
     Canvas.FillRect(Rect);
     StrPCopy(Buf, Cells[ACol,ARow]);
     DrawText(Canvas.Handle, Buf, -1, Rect, DT_SINGLELINE or DT_VCENTER or DT_NOCLIP or DT_LEFT);
    end;
   end;
   – Jeff Fisher

Один щелчок на StringGrid вместо трех

   Как сделать так, чтобы после ПЕРВОГО щелчка на ячейке возможно было бы начать редактировать ее содержимое?
   Включите goAlwaysShowEditor в свойство TStringGrid Options.
   – Rick Rogers

StringGrid как DBGrid

   Ну это может выглядеть приблизительно так (возможно нужна некоторая доработка, написал от руки, не проверяя):
   table.first;
   row := 0;
   grid.rowcount := table.recordCount;
   while not table.eof do begin
    for i := 0 to table.fieldCount-1 do
     grid.cells[i,row] := table.fields[i].asString;
    inc(row);
    table.next;
   end;
   У меня тоже имееются свои причины использования TStringGrid. Вот мой код, который загружает данные из отфильтрованной таблицы. Он не очень изящен, т.к. реально является лишь черновиком. У меня это работает, а большего мне и не нужно. Работает очень быстро, даже в случае сотни загруженных колонок. Есть много ссылок на внешние переменные. Надеюсь что они не слишком заумные.
   PROCEDURE TformLookupDB.FillCells;
   VAR
    Row, i :INTEGER
    w      :INTEGER
    grid   :TStringGrid
   BEGIN
    doGrid.RowCount := 0;
    IF NOT ASSIGNED(fDB) THEN EXIT;
    Row := 0;
    FOR i := LOW(fColWidths) TO HIGH(fColWidths) DO fColWidths[i] := 100
    // Данный временный объект-сетка используется для предохранения от огромного
    // количества подразумеваемых событий Application.ProcessMessages,
    // инициируемых базой данных, и вызывающих противное моргание объекта
    // doGrid. Итак, мы загружаем данные в объект-сетку
    // и затем копируем их в стобцы, начиная с верхней части.
    grid := TStringGrid.Create(Self);
    grid.Visible := FALSE;
    WITH fDB DO TRY
     grid.ColCount := fFields.Count;
     DisableControls;
     // Фильтр был установлен с помощью свойства Self.Filter
     First;
     WHILE NOT EOF DO TRY
      grid.RowCount := Row+1;
      FOR i := 0 TO grid.ColCount-1 DO BEGIN
       grid.Cells[i,Row] :=FieldByName(fFields.Strings[i]).AsString
       w := doGrid.Canvas.TEXTWIDTH(grid.Cells[i,Row]);
       IF fColWidths[i]<w THEN fColWidths[i] := w;
      END
      INC(Row);
     FINALLY
      Next;
     END
    FINALLY
     doGrid.RowCount := grid.RowCount;
     doGrid.ColCount := grid.ColCount;
     FOR i := 0 TO grid.ColCount-1 DO BEGIN
      doGrid.Cols[i] := grid.Cols[i];
      doGrid.ColWidths[i] := fColWidths[i] + 4
     END
     grid.Free;
     EnableControls
    END
   END;

`Авторазмер` для StringGrid

   …да, реально это утомляет, но эту проблему можно решить программным путем (это нужно делать после того, как вы загрузите данные, или же, если вы загружаете данные по столбцам, их загружать в самом цикле, приведенном ниже):
   i, j, temp, max: integer;
   for i := 0 to grid.colcount-1 do begin
    max := 0;
    for j := 0 to grid.rowcount-1 do begin
     temp := grid.canvas.textWidth(grid.cells[i,j]);
     if temp > max then max := temp;
    end;
    grid.colWidths[i] := max + grid.gridLineWidth +1;
   end;
   Вероятно, вам необходимо будет добавить +1, чтобы текст не прилипал к границам ячеек.

Выравнивание колонок StringGrid III

   Вот некоторый код, который делает то, что вы хотите:
   procedure WriteText(ACanvas: TCanvas; const ARect: TRect; DX, DY: Integer; const Text: string; Format: Word);
   var
    S: array[0..255] of Char;
    B, R: TRect;
   begin
    with ACanvas, ARect do begin
     case Format of
     DT_LEFT:
     ExtTextOut(Handle, Left + DX, Top + DY, ETO_OPAQUE or ETO_CLIPPED,@ARect, StrPCopy(S, Text), Length(Text), nil);
     DT_RIGHT:
      ExtTextOut(Handle, Right - TextWidth(Text) - 3, Top + DY,ETO_OPAQUE or ETO_CLIPPED, @ARect, StrPCopy(S, Text),Length(Text), nil);
     DT_CENTER:
     ExtTextOut(Handle, Left + (Right - Left - TextWidth(Text)) div 2, Top + DY, ETO_OPAQUE or ETO_CLIPPED, @ARect,StrPCopy(S, Text), Length(Text), nil);
     end;
    end;
   end;

   procedure TBEFStringGrid.DrawCell(Col, Row: Longint; Rect: TRect; State: TGridDrawState);
   var

    procedure Display(const S: string; Alignment: TAlignment);
    const Formats: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
    begin
     WriteText(Canvas, Rect, 2, 2, S, Formats[Alignment]);
    end;

   begin
    { здесь задаем аргументы Col и Row, и форматируем как угодно ячейки }
    case Row of
    0: { Центрирование заголовков колонок }
     if (Col < ColCount) then Display(Cells[Col,Row], taCenter)
     else
      { Все другие данные имеют правое центрирование }
      Display(Cells[Col,Row], taRight);
    end;
   end;

Выравнивание колонок StringGrid IV

   Создайте ваш собственный метод drawcell на примере того, что приведен ниже:
   procedure Tsearchfrm.Grid1DrawCell(Sender: TObject; Col, Row: Longint; Rect: TRect; State: TGridDrawState);
   var l_oldalign : word;
   begin
    if (row=0) or (col<2) then grid1.canvas.font.style:= grid1.canvas.font.style+[fsbold]; {устанавливаем заголовок в жирном начертании}
    if col<>1 then begin
     l_oldalign:=settextalign(grid1.canvas.handle, ta_right);
     {NB использует для рисования правую сторону квадрата}
     grid1.canvas.textrect(rect,rect.right-2, Rect.top+2,grid1.cells[col,row]);
     settextalign(grid1.canvas.handle,l_oldalign);
    end else begin
     grid1.canvas.textrect(rect, rect.left+2, rect.top+2, grid1.cells[col,row]);
    end;
    grid1.canvas.font.style:= grid1.canvas.font.style-[fsbold];
   end;

Покрашенный StringGrid I

   …вы можете попробовать использовать StringGrid. У него имеется свойство Objects, через которое вы можете назначать объекты. Создайте объект, содержащий переменную типа TColor, и назначьте это Objects[col,row], что позволит иметь к нему доступ в любое время. Назначьте событие OnDrawCell StringGrid, позволяющее рисовать текст ячейки правильного цвета. Чтобы убедиться, что ячейка выбрана, воспользуйтесь свойством Selection, содержащим то, что выбрал пользователь. Все это должно выглядеть приблизительно так:
   type TStrColor = class(TObject)
   public
     Color : TColor; {вы могли бы также определить частные и публичные методы доступа}
   end;
   …
   procedure TForm1.FormCreate(Sender:TObject)
   var i,j : Integer;
   begin
    With StringList1 do
     for i := 0 to ColCount-1
      for j := 0 to RowCount-1 Objects[i,j] := TStrColor.Create;
   end;
   …
   procedure TForm1.StringGrid1DrawCell(Sender: TObject; Col, Row: Longint; Rect: TRect; State: TGridDrawState);
   var OldColor : TColor;
   begin
    with StringGrid1.Canvas do begin
     OldColor := Font.Color;
     Font.Color := (StringGrid1.Objects[col,row] as TStrColor).Color;
     TextOut(Rect.Left+2, Rect.Top+2, StringGrid1.Cells[Col,Row]);
     Font.Color := OldColor;
    end;
   end;
   …
   procedure TForm1.ProcessSelection(Sender: TObject);
   var i, j : Integer;
   begin
    With StringGrid1.Selection do
     For i := left to right do
      for j := top to bottom do
       MessageDlg(IntToStr(i) + ',' + IntToStr(j) + '-' + IntToStr((StringGrid1.Objects[i,j] as tstrcolor).color), mtInformation, [mbOk], 0);
   end;
   Этот компонент не позволяет делать многочисленный выбор….

Покрашенный StringGrid II

   В данном модуле демонстрируется техника изменения цвета у выводимого в StringGrid текста.
   unit Strgr;

   interface

   uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, Grids, StdCtrls, DB;

   type TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    procedure StringGrid1DrawCell(Sender: TObject; Col, Row: Longint; Rect: TRect; State: TGridDrawState);
   private
    { Private declarations }
   public
    { Public declarations }
   end;

   var Form1: TForm1;

   implementation

   {$R *.DFM}

   procedure TForm1.StringGrid1DrawCell(Sender: TObject; Col, Row: Longint; Rect: TRect; State: TGridDrawState);
   const CharOffset = 3;
   begin
    with StringGrid1.canvas do begin
     font.color := clMaroon;
     textout(rect.left + CharOffset, rect.top + CharOffset, 'L');
     font.color := clNavy;
     textout(rect.left + CharOffset + TextWidth('L'), rect.top + CharOffset, 'loyd');
    end;
   end;
   end.

Редактирование в StringGrid

   …правда, я этого не пробовал, но в голову пришли две идеи:
   1. Нажмите на втором поле редактировании, переведите фокус на другое поле (например, x.focus, где x не сетка), сбросьте goEditing и selectRow и затем верните фокус назад сетке. (Эта техника работала у меня в нескольких местах, например, в градах и мемах.)
   2. Нажмите на втором поле редактирования, и после сброса goEditing и selectRow, попробуйте создать tGridRect, подсвечивающий нужную вам строку, после чего делайте grid.Selection := gridRect;

Tabbednotebook

Tabbednotebook и куча ресурсов

   Тема: Как избежать использования кучи ресурсов (Resource Heap) при работе с TabbedNotebook
   Данный документ расскажет о том, как с помощью Object Pascal можно управлять числом активных handlesWindows (оконных дескрипторов), в особенности кучей ресурсов пользователя (User Resource heap), а также следить за этими показателями. О чем этот документ? Попробую коротко и доходчиво: Windows следит за каждым элементом, имеющим фокус, через его дескриптор (Handle). Исходя из этого, Windows не может одновременно поддерживать несколько оконных дескрипторов (4-байтных указателей), и в этом совете мы приведем простой пример кода, позволяющего «легко» загружать ресурсы и обходить эти ограничения, встающие перед разработчиками Delphi.
   USER DLL в действительности является библиоткой, распределяющей и поддерживающей ресурсы для всех окон и связанных структур данных, включая элементы управления, имеющие фокус, и другие неупомянутые объекты, но вместе с тем необходимо помнить, что эта библиотека работает под Windows. С этим связаны ограничения при работе с ресурсами USER DLL, и эта та проблема, над которой мы будем работать в этом совете. Данный пример добавляет загрузку ресурса для каждого элемента управления, добавляемого на форму, здесь мы берем 4 байта из кучи USER в 64K^[1].
   Почему мы уверены в том, что у нас это получится? Мы будем разрушать^[2] дескрипторы окон, которые Windows, согласно своей архитектуре, должна помнить. Разрушая эти дескрипторы, мы, таким образом, избегаем освобождения пользовательских (USER) ресурсов, это означает, что нам не нужно будет снова создавать вышеуказанные объекты. Наоборот, текущая архитектура VCL обладает способностью следить за вышеуказанными объектами, которые, в действительности, являются указателями на структуру. Так, зная, что VCL поддерживает дескриптор и windows создаст новый дескриптор КАК ТРЕБУЕТСЯ, то вместо поддержания постоянно одного дескриптора (как это подразумевалось при создании архитектуры Windows), мы можем управлять пользовательскими (USER) ресурсами вручную, позволяя разработчику легко загружать их по мере необходимости.
   Данный пример демонстрирует работу с дескрипторами пользовательских (USER) ресурсов компонента Delphi TTabbedNoteBook (в части освобождения дескрипторов страниц), Delphi DestroyHandle (процедура TWinControl для удаления пользовательских (USER) дескрипторов), и работу вызова Windows API LockWindowUpdate (блокировка нежелательной перерисовки).
   Технология освобождения дескриптора страницы TTabbedNoteBook может работать и с любыми потомками TWinControl. TWinControl – класс предка, который умеет создавать и разрушать оконные дескрипторы; CreateHandle & DestroyHandle.
   Демонстрационный код
   Следующий код с приведенными обработчиками событий является «отрывком» из большого проекта с компонентами TTimer, TTabbedNotebook (с множеством страниц) и большим разнообразием визуальных элементов управления на каждой странице компонента. (Позже мы подчеркнем преимущества кода, приведенного ниже, перед его добавлением в ваш проект) Приведенный код должен располагаться соответственно в обработчиках событий OnTimer компонента TTimer и OnChange компонента TTabbedNotebook. Вот каким должен быть ваш новый код:
   <Модуль с объявленными в нем TTabbedNotebook и TTimer>
   …
   Implementation
   Type TSurfaceWin = class(TWinControl);

   procedure TForm1.Timer1Timer(Sender: TObject);
   begin
    {Данный код заменяет заголовок формы на системную информацию,
    содержащую в процентах free SYSTEM, GDI, &USER для windows.}
    caption := 'SYSTEM: ' +
     inttostr(getfreesystemresources(GFSR_SYSTEMRESOURCES)) + ' GDI: ' +
     inttostr(getfreesystemresources(GFSR_GDIRESOURCES)) + ' USER: ' +
     inttostr(getfreesystemresources(GFSR_USERRESOURCES));
   end;

   procedure TForm1.TabbedNotebook1Change(Sender: TObject; NewTab: Integer; var AllowChange: Boolean);
   begin
    {LockWindowUpdate запрещает перерисовку данного окна}
    LockWindowUpdate(handle);
    {Причина использования TSurfaceWin в том, что вызов DestroyHandle в TWinControl объявлен как абстрактный, поэтому данный вызов возможен только его потомками, реализовавшими данную процедуру. Следующая строка читает индекс текущей страницы TabbedNotebook и разрушает ее дескриптор при перемещении на другую страницу. ПРИМЕЧАНИЕ: Даже если мы уничтожаем дескриптор, Windows помнит страничный объект и переназначает/создает новый при нажатии на другой закладке. }
    TSurfaceWin(TabbedNotebook1.pages.objects[tabbedNotebook1.pageindex]).DestroyHandle;
    {Выключаем блокировку формы, чтобы любой элемент управления мог перерисовывать себя}
    LockWindowUpdate(0);
   end;

Доступ к страницам Tabbednotebook

   При добавлении компонентов во время выполнения программы, вам необходимо присвоить для каждого компонента свойству parent (контейнер) _страницу_ компонента notebook, а не сам notebook.
   Вы можете сделать это следующим образом (пример дан для кнопки):
   MyButton := TButton.Create(Form1); {как обычно…}
   …
   …
   MyButton.Parent := TTabPage(TabbedNotebook1.Pages.Objects[n]);
   { <== где 'n' – индекс желаемой страницы ==> }
   Свойство notebook 'Pages' имеет тип StringList и содержит список заголовков и объектов 'TTabPage'.
   Я сам пользовался этой техникой несколько месяцев. Не могу вспомнить где я сам раздобыл эту информацию, но в документации про это ничего не сказано. Может кто-нибудь знает, где об этом написано?
   При добавлении компонента на страницу TabbedNotebook во время выполнения приложения, указатель на желаемую страницу для свойства Parent нового компонента должен быть назначен перед тем, как он будет реально показан. Способ получить доступ ко всем страницам TTabbedNotebook во время выполнения программы – с помощью свойства-массива Objects свойства TabbedNotebook Pages. Другими словами, страничные компоненты хранятся как объекты, присоединенные к имени страницы в списке строк свойства Pages. В следующим коде показано создание кнопки на второй странице компонента TabbedNotebook1:
   var NewButton : TButton;
   begin
    NewButton := TButton.Create(Self);
    NewButton.Parent := TWinControl(TabbedNotebook1.Pages.Objects[1])
    …
   Вот как страница TNotebook может быть использована в качестве родителя для вновь создаваемого на ней компонента:
   NewButton.Parent := TWinControl(Notebook1.Pages.Objects[1])
   Вот как страница (закладка) TTabSet может быть использована в качестве родителя для вновь создаваемого на ней компонента:
   NewButton.Parent := TWinControl(TabSet1.Tabs.Objects[1])

TabControl

Над какой закладкой курсор?

   YoungHacker советует:
   Получение позиции мышиного курсора для TabControl над какой закладкой находится курсор.
   function Form1.ItemAtPos(TabControlHandle : HWND; X, Y : Integer) : Integer;
   var
    HitTestInfo : TTCHitTestInfo;
    HitIndex : Integer;
   begin
    HitTestInfo.pt.x := X;
    HitTestInfo.pt.y := Y;
    HitTestInfo.flags := 0;
    HitIndex := SendMessage(TabControlHandle, TCM_HITTEST, 0, Longint(@HitTestInfo));
    Result := HitIndex;
   end;

Table

Создание таблицы в модуле

   Объект TTable может быть создан с владельцем, а может и без оного. Поскольку вы объявляете его локально в процедуре, то владелец в этом случае не требуется. Если владелец не задан, то забота об освобождении объекта ложится на вас. В противном случае объект освобождается владельцем всякий раз, когда освобождается сам владелец. Имеет смысл? Чтобы создать таблицу без владельца, сделайте следующее:
   procedure CreateATableInAUnit;
   var myTable : TTable;
   begin
    myTable := TTable.Create(nil);
    try
     myTable.DatabaseName := 'MyDB';
     myTable.TableName := 'MyTable.db';
     mytable.IndexName := 'MyIndex';
     myTable.Open;
     {другой код}
    finally
     myTable.Free;
    end;
   end;

TabSet

Изменение количества закладок в TTabSet во время выполнения программы

   Вначале сделайте где-то в вашем коде следующее объявление:
   TabSet1: TTabSet; { подразумевается, что это принадлежит Form1 }
   Затем следующей строкой мы очищаем заголовки всех закладок:
   Form1.TabSet1.Tabs.Clear;
   Для того, чтобы добавить новую закладку с определенным именем, воспользуйтесь следующим кодом:
   Form1.TabSet1.Tabs.Add('какой-то заголовок');
   Пожалуйста, помните о том, что я назначил имя в предположении, что вы имеете ссылку на юнит, где оно определено [но не исключаю возможности, что вы можете получить ссылку на закладку и через обработчика соответствующего события, что еще проще, но мы то с вами должны знать все!]. Если вам нужно сослаться на объект из другого модуля, просто добавьте к вызову имя модуля (и добавьте этот модуль в список «uses»), например так:
   Unit1.Form1.TabSet1.Tabs.Add('Заголовок');
   Поскольку «TabSet1.Tabs» имеет тип TStrings, вы можете использовать любой из доступных методов этого типа (AddObject, LoadFromFile и т.д.).

Timer

Остановка таймера на `полпути`

   Timer1.Enabled := False;
   Timer1.Enabled := True;
   Это полностью «сбрасывает» таймер, другими словами, перезапускает его.
   BTW: изменение интервала (в другое значение) также производит сброс таймера.
   Вы можете включать и выключать ваш таймерный компонент, устанавливая соответствующее свойство, например:
   Timer1.Enabled := True; { или False, если вы хотите выключить его }
   Но при этом свои 5 секунд таймер продолжает отсчитывать. Если вы хотите изменить это, присвойте ему другой интервал, например так:
   Timer1.Interval := 100;

TreeView

Поточность TreeView

   На пустой форме у меня располагается TTreeView. Затем я сохраняю это в файле, используя WriteComponent. Это работает как положено; я могу из DOS c помощью команды "type" посмотреть двоичный файл и увидеть его содержимое, типа строк TTreeView и имя объекта. По крайней мере файл записывается и создается впечатление его "наполненности".
   Затем я освобождаю компонент TTreeView, открываю поток, делаю ReadComponent и, затем, InsertControl. И получаю исключение "TreeView1 has no parent window" (TreeView1 не имеет родительского окна).
   Это происходит из-за того, что при установке определенных свойств TreeView требуется дескриптор окна элемента управления, а для этого необходимо иметь родителя. Решение заключается в создании пустого TreeView и передаче его в качестве параметра ReadComponent - вы наверняка меня спросите, почему ReadComponent необходим параметр, правильно? Смотрите дальше.
   procedure TForm1.Button1Click(Sender: TObject);
   var TreeView : TTreeView;
   begin
    with TFileStream.Create('JUNK.STR', fmCreate) do try
     WriteComponent(TreeView1);
     TreeView1.Name := 'TreeView';
     Position := 0;
     TreeView := TTreeView.Create(Self);
     TreeView.Visible := false;
     TreeView.Parent := Self;
     ReadComponent(TreeView);
     TreeView.Top := TreeView1.Top + TreeView1.Height + 10;
     TreeView.Visible := true;
    finally
     Free;
    end;
   end;
   Два небольших замечания:
   1. Убедитесь в отсутствии конфликта имен. Данный код делает форму владельцем второго TreeView и при ее освобождении разрушает компонент. Я просто переименовываю существующий TreeView перед загрузкой 'клона'.
   2. Я установил свойство visible в false перед установкой свойства parent, этим я предотвратил показ только что созданного TreeView до момента загрузки его из потока.
    – Mike Scott

Получение доступа к узлам TreeView

   Небольшие хитрости для работы с узлами TreeView:
   Если вы хотите производить поиск по дереву, может быть для того, чтобы найти узел, соответствующий определенному критерию, то НЕ ДЕЛАЙТЕ ЭТО ТАКИМ ОБРАЗОМ:
   for i := 0 to MyTreeView.Items.Count) do begin
    if MyTreeView.Items[i].Text = 'Банзай' then break;
   end;
   …если вам не дорого время обработки массива узлов.
   Значительно быстрее будет так:
   Noddy := MyTreeView.Items[0];
   Searching := true;
   while (Searching) and (Noddy <> nil) do begin
    if Noddy.text = SearchTarget then begin
     Searching := False;
     MyTreeView.Selected := Noddy;
     MyTreeView.SetFocus;
    end else begin
     Noddy := Noddy.GetNext
    end;
   end;
   В моей системе приведенный выше код показал скорость 33 милисекунды при работе с деревом, имеющим 171 узел. Первый поиск потребовал 2.15 секунд.
   Оказывается, процесс индексирования очень медленный. Я подозреваю, что при каждой индексации свойства Items, вы осуществляете линейный поиск, но это нигде не засвидетельствовано, поэтому я могу ошибаться.
   Вам действительно не нужно просматривать все дерево, чтобы найти что вам нужно – получить таким образом доступ к MyTreeView.Items[170] займет много больше времени, чем получения доступа к MyTreeView.Items[1].
   Как правило, для отслеживания позиции в дереве TreeView, нужно использовать временную переменную TTreeNode, а не использовать целочисленные индексы. Возможно, свойство ItemId как раз и необходимо для такого применения, но, к сожалению, я никак не могу понять абзац в электронной документации, касающийся данного свойства:

– Peter Kane

Хочется выделять некоторые стpочки в TTreeView жирным или бледным. Как?

   Nomadic советует:
   Грхм… Господа, но если речь про bold… Матчасть учить надо 8-).
   procedure SetNodeState(node: TTreeNode; Flags: Integer);
   var tvi: TTVItem;
   begin
    FillChar(tvi, Sizeof(tvi), 0);
    tvi.hItem := node.ItemID;
    tvi.mask := TVIF_STATE;
    tvi.stateMask := TVIS_BOLD or tvis_cut;
    tvi.state := Flags;
    TreeView_SetItem(node.Handle, tvi);
   end;
   И вызываем:
   SetNodeState(TreeView1.Selected, TVIS_BOLD); // Текст жирным
   SetNodeState(TreeView1.Selected, TVIS_CUT); // Иконку бледной
   (Ctrl+X)
   SetNodeState(TreeView1.Selected, TVIS_BOLD or TVIS_CUT); // Текст жирным
   SetNodeState(TreeView1.Selected, 0); // Ни того, ни другого
   Когда-то (мечтательно закатив глаза в потолок) в API было еще и TVIS_DISABLE. Снесли собаки. А рекомендуемую стилистику употребления этого добра смотри в MS Internet News.

UpdateSQL

Что нужно знать о принципе и порядке работы с TUpdateSQL для работы с неживыми запросами?

   Nomadic советует:
   Кидаешь UpdateSQL на форму, после чего в том SQL, который ты собираешься редактировать, устанавливаешь в UpdateObject имя этого UpdateSQL. После этих дел по дабл-клику на UpdateSQL выдаётся редактор, в котором ты должен для каждой из таблиц,входящих в твой запрос, указать набор полей, являющихся уникальным ключём таблицы, и набор полей, которые требуется редактировать. В общем случае возможны глюки с редактированием, если в числе изменяемых полей будут элементы ключа. Указав все поля, давишь кнопку Generate SQL и в результате у тебя генерятся запросы на редактирование, добавление и удаление, которые прописываются в том же UpdateSQL. Обычно эти запросы никакого дополнительного редактирования не требуют. После всех этих дел ты можешь нормально редактировать запрос, как обычную таблицу.
   Hекоторые моменты.
   Для того, чтобы всё это нормально работало, нужно, чтобы в TQuery были включены RequestLive и CashedUpdates. Соответственно, для подтверждения изменений нужно вызывать TQuery.ApplyUpdates и TQuery.CommitUpdates, либо TDatabase.ApplyUpdates, а для отмены – CancelUpdates.
   Если меняешь структуру таблиц, то не забывай менять списки полей в UpdateSQL, иначе можешь получить неприятный сюрприз – будешь долго сидеть и думать, почему при редактировании/добавлении некоторые поля не прописываются :-).
   – Отрезано –
   Hасчёт CachedUpdates.
   Сия хреновина придумана для того, чтобы обеспечить сохранение/отмену редактирования/добавления/удаления сразу нескольких записей. Принцип совершенно элементарен: если CachedUpdates включен, то все производимые изменения в датасете по команде Post фиксируются не в базе, а во временном файле на винте клиента. Для того, чтобы прописать изменения в таблице (физически), необходимо вызвать для соответствующего запроса последовательно методы ApplyUpdates и CommitUpdates, а для отмены ВСЕХ изменений (начиная от последнего выполненного CommitUpdates), вызвать CancelUpdates. Кроме того, метод ApplyUpdates у TDataBase. Этому методу нужен список датасетов, и он производит их обновление в одной транзакции.
   Практическое применение, например, такое: на форме редактирования с гридом и набором кнопок Добавить, Удалить, Редактировать, ОК, Отмена, вешаешь на первые три кнопки обработчики с Insert, Delete и Edit соответственно, на OK – такой примерно обработчик:
   with DataSet do begin
    if State in [dsEdit,dsInsert] then Post;
    ApplyUpdates;
    CommitUpdates;
   end;
   а на Отмену такой:
   with DataSet do begin
    if State in [dsEdit,dsInsert] then Cancel;
    CancelUpdates;
   end;
   В результате юзер может редактировать хоть всю таблицу, но если успеет спохватиться, то может отменить все свои художества. Только желательно на выходе из формы проверить, сохранены ли изменения, и если нет, то напомнить/переспросить.
   Лучше использовать конструкцию «State in dsEditModes»

Разное

Создание компонентов для работы с базами данных

   Тема: Создание компонентов для работы с базами данных, позволяющих работать с самими данными
   Обзор
   Данный документ описывает минимально необходимые шаги, необходимые для создания компонента для работы с базами данных, который может отображать данные отдельного поля. Примером такого компонента может служить панель со свойствами DataSource и DataField, похожая на компонент TDBText. Для получения дополнительных примеров обратитесь к Руководству по написанию компонентов "Making a Control Data-Aware".
   Как пользоваться данным документом
   Для наилучшего понимания данного документа, вы должны быть знакомы с механизмом функционирования элементов управления для работы с базами данных и основополагающими принципами создания компонент, такими, как
   • создание компонентов на основе существующих
   • перекрытие конструкторов и деструкторов
   • создание новых свойств
   • чтение и запись значений свойств
   • назначение обработчиков событий
   Основные шаги по созданию компоненты, осуществляющей навигацию по данным
   • Создайте или наследуйте компонент, который допускает свое отображение, но не ввод данных. Например, вы могли бы использовать компонент TMemo с установленным в True свойством ReadOnly. В примере, приведенном в данном документе, мы используем TCustomPanel. TCustomPanel позволяет себя отображать, но не вводить данные.
   • Добавьте к вашему компоненту data-link object (объект для связи с данными). Данный объект позволяет управлять связью между компонентом и таблицей базы данных.
   • Добавьте к компоненту свойства DataField и DataSource.
   • Добавьте методы для получения и установления DataField и DataSource.
   • Добавьте к компоненту метод DataChange, позволяющий управлять событиями OnDataChange объекта data-link.
   • Перекройте конструктор компонента для создания datalink и перехвата метода DataChange.
   • Перекройте деструктор компонента для очищения datalink.
   Создание TDBPANEL
   • Создайте или наследуйте компонент, который допускает свое отображение, но не ввод данных. В качестве отправной точки для нашего примера мы будем использовать TCustomPanel.
   Выберите соответствующий пункт меню для создания нового компонента (он меняется от версии к версии Delphi), определите TDBPanel как имя класса, и TCustomPanel в качестве наследуемого типа. Определите любую страницу Палитры компонентов.
   • Добавьте DB и DBTables в список используемых модулей.
   • Добавьте data-link объект в секцию private вашего компонента. Данный пример отображает данные одного поля, поэтому мы используем TFieldDataLink для обеспечения связи между нашим новым компонентом и DataSource. Имя нового data-link объекта – FDataLink.
   { пример }
   private
    FDataLink: TFieldDataLink;
   • Добавьте к компоненту свойства DataField и DataSource. Мы добавим соответствующий код для методов записи/чтения в последующих шагах.
   Примечание: Наш новый компонент будет иметь свойства DataField и DataSource, FDataLink также будет иметь собственные свойства DataField и Datasource.
   { пример }
   published
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
   • Добавьте частные методы для чтения/записи значений свойств DataField и DataSource, и свойств DataField и DataSource для FDataLink.
   { пример }
   private
    FDataLink: TFieldDataLink;
    function GetDataField: String;
    function GetDataSource: TDataSource;
    procedure SetDataField(Const Value: string);
    procedure SetDataSource(Value: TDataSource);
    .
    .
   implementation
    .
    .
   function TDBPanel.GetDataField: String;
   begin
    Result := FDataLink.FieldName;
   end;

   function TDBPanel.GetDataSource: TDataSource;
   begin
    Result := FDataLink.DataSource;
   end;

   procedure TDBPanel.SetDataField(Const Value: string);
   begin
    FDataLink.FieldName := Value;
   end;

   procedure TDBPanel.SetDataSource(Value: TDataSource);
   begin
    FDataLink.DataSource := Value;
   end;
   • Добавьте частный метод DataChange, назначая событие объекта datalink OnDataChange. В методе DataChange добавьте код для отображения данных поля актуальной базы данных, связь с которой обеспечивает объект data-link. В нашем примере мы назначаем значение поля FDataLink заголовку панели.
   { пример }
   private
   .
   .
   procedure DataChange(Sender: TObject); = nil then Caption := '';
   implementation
   .
   .
   procedure TDBPanel.DataChange(Sender: TObject);
   begin
    if FDataLink.Field
    else Caption := FDataLink.Field.AsString;
   end;
   • Перекройте метод конструктора компонента Create. При реализации Create, создайте объект FDataLink и назначьте частный метод DataChange событию FDataLink OnDataChange.
   { пример }
   public
    constructor Create(AOwner: TComponent); override;
   .
   .
   implementation
   .
   .
   constructor TMyDBPanel.Create(AOwner: TComponent);
   begin
    inherited Create(AOwner);
    FDataLink := TFieldDataLink.Create;
    FDataLink.OnDataChange := DataChange;
   end;
   • Перекройте метод деструктора компонента Destroy. При реализации Destroy, установите OnDataChange в nil (чтобы избежать GPF), и освободите FDatalink.
   { пример }
   public
   .
   .
   destructor Destroy; override;
   .
   .
   implementation
   .
   .
   destructor TDBPanel.Destroy;
   begin
    FDataLink.OnDataChange := nil;
    FDataLink.Free;
    inherited Destroy;
   end;
   • Сохраните модуль и установите компонент (смотрите документацию Users Guide и Component Writers Guide для получения дополнительной информации по сохранению модулей и установке компонентов).
   • Для тестирования функциональности компонента расположите на форме компоненты TTable, TDatasource, TDBNavigator и TDBPanel. Установите TTable DatabaseName и Tablename в 'DBDemos' и 'BioLife', а свойство Active в True. Установите свойство TDatasource Dataset в Table1. Установите TDBNavigator и свойство TDBPanel DataSource в Datasource1. Имя TDBpanel DataField должно быть установлено в 'Common_Name'. Запустите приложение и, используя навигатор и перемещаясь по записям, убедитесь в том, что TDBPanel обнаруживает изменение данных и отображает значение соответствующего поля.
   Полный код компонента
   unit Mydbp;

   interface

   uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, DB, DBTables;

   type TDBPanel = class(TCustomPanel)
   private
    FDataLink: TFieldDataLink;
    function GetDataField: String;
    function GetDataSource: TDataSource;
    procedure SetDataField(Const Value: string);
    procedure SetDataSource(Value: TDataSource);
    procedure DataChange(Sender: TObject);
   public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
   published
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TdataSource read GetDataSource write SetDataSource;
   end;

   procedure Register;

   implementation

   procedure Register;
   begin
    RegisterComponents('Samples', [TDBPanel]);
   end;

   function TDBPanel.GetDataField: String;
   begin
    Result := FDataLink.FieldName;
   end;

   function TDBPanel.GetDataSource: TDataSource;
   begin
    Result := FDataLink.DataSource;
   end;

   procedure TDBPanel.SetDataField(Const Value: string);
   begin
    FDataLink.FieldName := Value;
   end;

   procedure TDBPanel.SetDataSource(Value: TDataSource);
   begin
    FDataLink.DataSource := Value;
   end;

   procedure TDBPanel.DataChange(Sender: TObject);
   begin
    if FDataLink.Field = nil then Caption := ''
    else Caption := FDataLink.Field.AsString;
   end;

   constructor TDBPanel.Create(AOwner: TComponent);
   begin
    inherited Create(AOwner);
    FDataLink := TFieldDataLink.Create;
    FDataLink.OnDataChange := DataChange;
   end;

   destructor TDBPanel.Destroy;
   begin
    FDataLink.Free;
    FDataLink.OnDataChange := nil;
    inherited Destroy;
   end;
   end.

Динамическое создание компонент во время работы приложения

   Использовать формы и компоненты Delphi очень просто. Если управлять этими объектами посредством Инспектора Объектов, то эту задачу можно отнести к числу тривиальных. Динамически создать объект также несложно. В этом документе мы обсудим некоторые вопросы, касающиеся динамического создания компонент во время работы приложения.
   (вам следует помнить, что понятие "динамическое" весьма субъективно, поскольку Delphi все объекты создает динамически. Информация, предоставленная здесь — для программиста, который сам собирается создавать/менять свойства/разрушать объекты во время выполнения программы)
   Все типы (формы или компоненты) могут создаваться динамически. Чтобы это сделать, необходимо объявить переменную нужного типа в секции VAR вашего кода. Это не создает экземпляр объекта, это создает указатель. Данный указатель расположен в сегменте данных (если переменная объявлена глобально) или в стеке (если переменная объявлена локально в процедуре или функции). Для того, чтобы создать экземпляр класса, вам необходимо вызвать конструктор. Это распределит память в глобальной компьютерной куче для экземпляра класса. При попытке получить доступ к компоненте прежде, чем мы распределим память, мы получим ошибку общей защиты.
   Конструктор Create() является классовым методом, наследуемым от класса TObject. Create() возвращает указатель. Данный метод может потребовать (а может и нет) один или несколько параметров. В большинстве компонентов (все объекты, наследуемые от TComponent, имеют право называться компонентами), конструктор на входе требует один параметр, указывающий на "владельца" и имеющий тип TComponent.
   При динамическом создании компонента в большинстве случаев владелецем становится "Self". Если вы в этот момент находитесь в одном из методов формы, "Self" в данном контексте будет ссылаться на саму форму. Если владелец является действительным объектом, освобождение этого объекта влечет за собой автоматическое освобождение "дочернего" компонента. Другим распространенным параметром является "Application". Он может использоваться в случае, когда визуальный компонент не должен быть показан программой пользователю. Тем не менее, большинство компонентов не требуют назначения владельца, так что нет ничего необычного в том, что требуемый параметр owner устанавливается в Nil. Но вы должны помнить о том, что впоследствии вы не сможете изменить владельца объекта. Если конструктору при создании был передан Nil, то после использования компонента вы должны сами освобождать его вызовом Free.
   После создания оконных компонентов (т.е. тех компонентов, которые являются наследниками TWinControl), но еще перед тем, как они будут отображены, у них необходимо установить свойство Parent. Место установки свойства Parent является хорошим местом для установки других свойств экземпляра данного компонента, включая обработчики событий (например, Width, Color, OnClick).
   Обработчики событий идентичны тем, которые определены в Инспекторе Объектов. Просто присвойте имени свойства компонента для события, которое вы хотите обработать, имя метода обработчика события, которое вы ожидаете. В примере 1, приведенном ниже, при нажатии на кнопку будет вызван метод с именем "myclick". Пожалуйста имейте в виду, что список входных параметров одного метода должен в точности соответствовать списку выходных параметров другого.
   Пример 1:
   var b1 : TButton;
   begin
    .
    .
    .
    b1 := TButton.Create(Self);
    with b1 do begin
     Left := 20;
     Top := 20;
     Width := 90;
     Height := 50;
     Caption := 'моя кнопка';
     Parent := Form1;
     OnClick := MyClick; { процедура, определенная где-то еще }
    end;
    .
    .
    .
   end;
   В следующем примере показано как можно во время выполнения программы динамически создать кнопку, щелкая по другой кнопке, размещенной на форме во время проектирования (к этому моменту она уже создана). Это уже другой путь создания кнопки. Все способы рабочие. Также имейте в виду, что кнопки, не освобождаемые в данном коде, будут освобождаться при разрушении формы.
   unit Unit1;
   interface

   uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

   type TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
   private
    { Private declarations }
   public
    { Public declarations }
    procedure myClick(Sender: TObject);
   end;

   var Form1: TForm1;

   const i : integer = 0;

   implementation
   {$R *.DFM}

   procedure TForm1.myClick(Sender: TObject);
   begin
    with Sender as TButton do Self.Caption := ClassName + ' ' + Name;
   end;

   procedure TForm1.Button1Click(Sender: TObject);
   begin
    with TButton.Create(self) do begin
     Left := 20;
     Top := 30 + i;
     Width := 120;
     Height := 40;
     Name := 'ThisButton' + IntToStr(i);
     Caption := 'There' + IntToStr(i);
     OnClick := MyClick; { процедура, определенная где-то еще }
     Parent := Form1;
    end; {end with}
    inc(i, 40);
   end; {end button1.click}
   end.

Решение для динамически создаваемых компонентов

   Предупреждение:
   Если вы просто хотите во время выполнения приложения создавать компоненты необходимого вам типа, ознакомьтесь с файлом delphi\doc\VB2Delph.wri и следуйте его рекомендациям, лучшего способа изучения этой темы пока не существует. Данный совет повествует об использовании в Delphi RTTI.
   Во-первых, в вашем приложении необходимо зарегистрировать все классы, экземпляры которых вы собираетесь в каком-то месте кода создавать. Сделать это можно с помощью функций RegisterClass(), RegisterClasses() и RegisterClassAlias().
   Пример:
   procedure TForm1.FormCreate(Sender: TObject);
   begin
    RegisterClasses([TButton, TEdit, TMemo, TLabel]);
   end;
   Это может навести вас на мысль об ограничениях, но Delphi строгий язык. Если вы хотите истинно динамическое создание объектов в слаботипизированной среде позднего связывания, используйте динамический язык типа Smalltalk. У меня есть подозрение, что Delphi использует этот механизм регистрации для регистрации всех компонентов в DCL при его запуске, позволяя этим самым создавать любой компонент во время разработки.
   Создание компонентов. Используйте функцию FindClass() для получения ссылки на класс компонента, который вы хотите создать, и вызывайте его метод Create. Легко, не правда ли? В примере у меня имеется приведение типа SomeComponent к TControl, после чего я уже могу установить свойство parent (я могу делать это, поскольку я знаю, что все зарегистрированные мною классы являются потомками TControl). Для того, чтобы визуальный компонент появился на форме, вам необходимо установить свойство parent.
   Пример:
   procedure TForm1.CreateClick(Sender: TObject);
   begin
    SomeComponent:= TComponentClass(FindClass(ClassName.Text)).Create(Self);
    (SomeComponent as TControl).Parent := Self;
   end;
   Теперь, когда вы имеете созданный компонент, как установить его свойства без использования самого большого блока case во вселенной? Очень просто: для получения информации о свойстве из структуры run-time type information (RTTI) используется функция GetPropInfo(), после чего для установления значений используется набор функций SetXXXXProp(). (Примечание: эти функции не задокументированы в файлах помощи Delphi. OO-программисты, как я понимаю, пользуются примерами из чужого кода и не изобретают свой велосипед.) У каждой функции SetXXXXProp() имеется функция-сателлит GetXXXXProp(), позволяющая узнать значения свойств объекта.
   Пример:
   procedure TForm1.SetPropertyClick(Sender: TObject);
   var
    PropType: PTypeInfo;
    PropInfo: PPropInfo;
   begin
    PropInfo := GetPropInfo(SomeComponent.ClassInfo, PropertyName.Text);
    PropType := PropInfo^.PropType;
    case PropType^.Kind of
    tkInteger:
     SetOrdProp(SomeComponent, PropInfo, StrToInt(PropertyValue.Text));
    tkChar:
     SetOrdProp(SomeComponent, PropInfo, Ord(PropertyValue.Text[1]));
    tkEnumeration:
     SetOrdProp(SomeComponent, PropInfo, GetEnumValue(PropType, PropertyValue.Text));
    tkFloat:
     SetFloatProp(SomeComponent, PropInfo, StrToFloat(PropertyValue.Text));
    tkString:
     SetStrProp(SomeComponent, PropInfo, PropertyValue.Text);
    end;
   end;
   Вы также можете установить значения свойств Set, Class и Method, но это будет немного сложнее. Немного позже я объясню как это можно сделать.
   Это все. Вы проведете время с большой пользой, изучая исходный код VCL, и удивляясь, когда вы все там увидите собственными глазами.
   Это прекрасный способ, но он имеет потенциал для массового злоупотребления. Необходимо понимание других путей достижения этой цели и выбор соответствующей техники при создании своих проектов в Delphi.

Как правильно создавать органы управления в runtime?

   Nomadic советует:
   Примерно таким образом (Описываем метод-обработчик события OnClick формы):
   { Example }
   procedure TForm1.OnClick(ASender: TObject);
   var btnTemp: TButton;
   begin
    { Creating }
    btnTemp := TButton.Create(Self);
    { You can use 'with btnTemp do' operator below }
    { Inserting to Form }
    btnTemp.Parent := Self;
    { Initialization }
    btnTemp.Caption := 'I''m glad to see You';
    btnTemp.SetBounds(20, 20, 80, 20);
    { You must define this event handler named 'OnBtnTempClick' }
    btnTemp.OnClick := OnBtnTempClick;
    { Ready to show }
    btnTemp.Visible := true;
    { Done. }
   end;

Как создать клон (копию, достаточно близкую к оригиналу) произвольного компонента?

   Nomadic советует:
   { Здесь процедyра CreateClone, которая креатит компоненту ОЧЕНЬ ПОХОЖУЮ на входную. С такими же значениями свойств. Присваивается все, кроме методов. }
   function CreateClone(Src: TComponent): TComponent;
   var F: TStream;
   begin
    F := nil;
    try
     F := TMemoryStream.Create;
     F.WriteComponent(Src);
     RegisterClass(TComponentClass(Src.ClassType));
     F.Position := 0;
     Result := F.ReadComponent(nil);
    finally
     F.Free;
    end;
   end;

Как заставить произвольный компонент реагировать на изменения в TDataSource?

   Nomadic советует:
   TFieldDataLink. За D2 не скажу, а в D1 в Help'е его нет, реализован в \DELPHI\SOURCE\VCL\DBTABLES.PAS.
   type TMyForm = class(TForm)
    {…}
    Table1: TTable;
    DataSource1: TDataSource;
   private
    FDL : TFieldDataLink;
    procedure RecChange(Sender: TObject);
   public
    {...}
   end;

   procedure TMyForm.FormCreate(Sender: TObject);
   begin
    FDL:=TFieldDataLink.Create;
    FDL.OnDataChange := RecChange;
    FDL.DataSource := DataSource1;
    FDL.FieldName := 'MyFieldName';
   end;

   procedure TTabEditDlg.FormDestroy(Sender: TObject);
   begin
    FDL.Free;
   end;

   procedure TTabEditDlg.MasterChange(Sender: TObject);
   begin
    {… тут реагируй на изменения …}
   end;
   За отслеживание различных событий, происходящих с TDataSource, в иерархии VCL отвечает класс TDataLink. TFieldDataLink – наследник, который выполняет маскирование событий, не относящихся к конкретному столбцу набора данных.
   Если надо отслеживать изменения в любом столбце набора, используйте TDataLink. Если необходимо отслеживать события для некоторого подмножества строк набора данных, посмотрите на реализацию TGridDataLink.

Доступ к другим компонентам из базового

   Список-свойство Components[] существует во всех потомках TComponent и используется для хранения ссылок на все собственные компоненты. При вызове «mycomponent := TSomeComponent.Create(aComponent)», ссылка на mycomponent помещается в список aComponent Components[]. В большинстве случаев, в методе Create в качестве владельца компонентов определена форма, и ссылки на компоненты помещаются в список Components[] самой формы.
   Метод FindComponent() (упомянутый где-то еще) только производит поиск компонентов в текущем списке Components[]. Если объект, который вы хотите найти, принадлежит другому компоненту, вы должны просканировать его список компонентов.
   В зависимости от того, как вы создаете свою базу и другие компоненты, вы можете осуществить рекурсивный алгоритм поиска, который стартует в верхней части дерева собственника набора компонентов (вероятно, формы), спускаясь вниз и проходя по списку Components[] каждого вновь найденного компонента, пока желаемый объект не будет найден.
   Хорошей альтернативой может служить способ, при котором вы всегда определяете базовый компонент в качестве владельца всех других ваших «подкомпонентов» (при их создании). После этого будет работать поиск по свойству вашего базового компонента Components[].

CANVAS.TEXTWIDTH

   Установить размер шрифта для панели можно следующим образом:
   With StatusBar1.Panels[1] do begin
    Text := Edit1.Text;
    Canvas.Font.Size := StatusBar1.Font.Size;
    Width := Canvas.TextWidth(Text) + 10;
   end;

Создание компонента

   …чтобы сгруппировать свойства наподобие Font, вам необходимо создать наследника (подкласс) TPersistent. Например:
   TBoolList = class(TPersistent)
   private
    FValue1: Boolean;
    FValue2: Boolean
   published
    property Value1: Boolean read FValue1 write FValue1;
    property Value2: Boolean read FValue2 write FValue2;
   end;
   Затем, в вашем новом компоненте, для этого подкласса необходимо создать ivar. Чтобы все работало правильно, вам =необходимо= перекрыть конструктор.
   TMyPanel = class(TCustomPanel)
   private
    FBoolList: TBoolList;
   public
    constructor Create(AOwner: TComponent); override;
   published
    property BoolList: TBoolList read FBoolList write FBoolList;
   end;
   Затем добавьте следующий код в ваш конструктор:
   constructor TMyPanel.Create(AOwner: TComponent);
   begin
    inherited Create(AOwner);
    FBoolList := TBoolList.Create;
   end;

Циклический опрос компонентов

   procedure TForm1.FormCreate(Sender: TObject);
   var I : integer;
   begin
    for I:= 0 to ComponentCount -1 do
     if (Components[I] IS TEdit) then
      (Components[I] AS TEdit).{Вашпараметр} := {ваше значение};
   end;
   Если вам необходимо идентифицировать конкретный набор edit-компонентов, поместите их на панели и сделайте примерно так:
   procedure TForm1.FormCreate(Sender: TObject);
   var I : integer;
   begin
    with MyPanel do for I:= 0 to ControlCount -1 do
     if (Controls[I] IS TEdit) then
      (Controls[I] AS TEdit).{Вашпараметр} := {Ваше значение};
   end;
   В контексте примера, Edit1, Edit2 и т.д. есть то же самое, что и Edit[1], Edit[2]. Если вы хотите иметь доступ к серии элементов управления как к элементам массива, поместите их в TList.
   MyArr := TList.Create;
   MyArr.Add(Edit1);
   MyArr.Add(Edit2);
   …
   For i := 0 To MyArr.count - 1 Do
    (MyArr.items[i] As TEdit).Enabled := False;
   MyArr.Free;

   procedure TForm1.FormCreate(Sender: TObject);
   var I: Integer;
   begin
    for I := 0 to ComponentCount -1 do
     if Components[I] is TEdit then
      TEdit(Components[I]).Whatever := 10;
   end;
   Для получения доступа используйте:
   TButton(mylist.items[i]).property := sumpin;
   или
   TButton(mylist.items[i]).method;
   Это хорошее решение для пакетной обработки компонентов или для получения доступа при линейном способе. Для решения вашей проблемы есть еще более легкое решение, которое требует предварительной работы в режиме проектирования. Установите свойство tag и получите преимущество в том, что все компоненты являются производными от TComponent и имеют это свойство.
   Procedure TMyForm.MyButtonHandler(Sender: TObject);
   Begin
    Case (Sender As TComponent).Tag Of
    1 : { что-то делаем }
    2 : { делаем что-то еще }
    .
    .
    End;
   End;
   Просто укажите в событии OnClick на MyButtonHandler для тех кнопок, в которых вы хотите использовать общий обработчик события.

Мне надо добавить много строк в TListbox или в TCombobox или в TMemo или в TRichEdit, при этом сам объект постоянно мигает, перерисовываясь. Как избавиться от этого?

Nomadic скупо отвечает:
A: BeginUpdate/EndUpdate.

Как мне создать компонент типа TField?

   Наверное вы хотели создать класс, а не компонент? Класс является программируемым устройством, а не частью формы. Если вы поместили класс в модуль (скажем, myclass.pas) и вставили в вашу программу строку «uses myclass;», то воспользоваться им можно следующим образом:
   type aninstance: tMyclass;
   begin
    new (aninstance);
    {эквивалент aninstance := tMyclass.create; }
    …
    { здесь используем aninstance }
    …
    dispose(aninstance);
    { эквивалент aninstance.free; }
   end;

Инкрементация строкового поля

   Свойства text элемента управления является строкой, в свою очередь являющейся массивом символом. Вы не можете осуществить преобразование символа в строку. Тем не менее, вы можете получить доступ ко всем символам строки через их индекс.
   Попробуйте это:
   var s : string;
   begin
    s := RevField.text;
    s[1] := chr(ord(s[1]) + 1);
    RevField.text := s;
   end;
   Здесь кроются 2 проблемы:
   1. Для увеличения значения вам необходимо извлекать символы из строки.
   2. Хотя вы можете получить доступ к отдельным символам через выделение подстроки, данный метод не срабатывает у некоторых свойств, таких как, например, свойство TStringField Text.
   Лучшим решением, по-видимому, будет написание специфической функции. Например, в случае, если revision-символ всегда является конечным символом строки, функция могла бы выглядеть следующим образом:
   function IncrementTrailingVersionLetter(Str: string): string;
   begin
    Str[Length(Str)] := Char(Ord(Str[Length(Str)]) + 1);
    IncrementTrailingVersionLetter := Str;
   end;
   и использовать ее следующим образом:
   with RevField do Text := IncrementTrailingVersionLetter(Text);

Классы

TForm

fsStayOnTop ~не наверху~

   Тема: fsStayOnTop ~не наверху~
   От: Philip Kapusta 74170,3550
   Почему, если присвоить свойству FormStyle значение fsStayOnTop, форма так и не остается на самом верху?
   Просто добавьте application.RestoreTopMosts в обработчик события формы OnPaint. Это ошибка.
   Могли бы вы рассказать об этом чуть-чуть поподробнее? Delphi где-то в неправильном месте осуществляет вызов NormalizeTopMosts?
   Borland говорит что это Windows, но это случается когда StayonTop-форма НЕ является главной формой. (Некоторые английские программисты чтобы получить эту отговорку потратили несколько сотен долларов, звоня в американскую службу помощи по телефону 1-800).
   – Fred S.

Без иконки в панели задач?

   Если вы не хотите, чтобы ваше приложение имело иконку в панели задач, добавьте следующие строки в исходный код проекта:
   Application.CreateHandle;
   ShowWindow(Application.Handle, SW_HIDE);
   Application.ShowMainForm := FALSE;
   Да, чуть не забыл, есть еще одна вещь. При нормальном поведении TApplication создает дескриптор и показывает окно прежде, чем далее начнет что-то «происходить». Чтобы избежать этого, вам необходимо создать модуль, содержащий единственную строчку в секции initialization:
   IsLibrary := True;
   … и поместить этот модуль ПЕРВЫМ в .DPR-файле в списке используемых модулей. Этим мы «одурачиваем» TApplication, и оно думает что оно запущено из DLL, тем самым изменяя свое обычное поведение.
   – Neil J. Rubenking

Передача переменных форме

   …поможете мне создать функцию, с помощью которой я передам переменные в TFormClass? Проблема в том, что MyDlg.Execute() не захотела компилироваться, поскольку, как сообщил мне компилятор, я не могу использовать MyDlg (определенный как: TForm).
   Эта функция может выглядеть примерно так:
   function ExecuteDialog(FormClass: TFormClass; var Data): Boolean;
   Я могу вам дать еще один совет: сделать все ваши формы наследниками одного класса, в котором объявлены виртуальные методы SetData и GetData.
   { ----------------------- }
   unit ExecFrms;
   interface
   uses Forms, Controls;
   type TExecForm = class(TForm)
   public
    procedure GetData(var Data); virtual; abstract;
    procedure SetData(var Data); virtual; abstract;
   end;
   TExecFormClass = class of TExecForm;

   function ExecuteDialog(FormClass: TExecFormClass; var Data): Boolean;

   implementation

   function ExecuteDialog(FormClass: TExecFormClass; var Data): Boolean;
   begin
    with FormClass.Create(Application) do try
     SetData(Data);
     Result := ShowModal = mrOK;
     if Result then GetData(Data);
    finally
     Release;
    end;
   end;
   end.
   { ----------------------- }
   Как вы можете видеть, я поместил функцию ExecuteDialog в тот же самый модуль.
   После того как Delphi создаст форму, вы должны в модуле формы сделать четыре вещи:
   1. вручную измените предка формы, с TForm на TExecForm;
   2. добавьте ExecFrms в список используемых модулей;
   3. добавьте тип записи для хранения данных, необходимых диалогу; и
   4. перекрыть методы SetData и GetData.
   { ----------------------- }
   unit MyDlgs;
   interface
   uses WinTypes, WinProcs, Classes, Graphics, Forms,Controls, Buttons, StdCtrls, Spin, ExtCtrls, ExecFrms;

   type
    { Запись для данных, необходимых модальной форме... }
    TMyDlgData = record
     FormCaption: string;
     FormWidth: Integer;
    end;

    TMyDlg = class(TExecForm)
     OKBtn: TBitBtn;
     CancelBtn: TBitBtn;
     HelpBtn: TBitBtn;
     Bevel1: TBevel;
     Edit1: TEdit;
     SpinEdit1: TSpinEdit;
    public
     procedure SetData(var Data); override;
     procedure GetData(var Data); override;
    end;

   var MyDlg: TMyDlg;

   implementation

   {$R *.DFM}

   procedure TMyDlg.SetData(var Data);
   begin
    with TMyDlgData(Data) do begin
     Edit1.Text := FormCaption;
     SpinEdit1.Value := FormWidth;
    end;
   end;

   procedure TMyDlg.GetData(var Data);
   begin
    with TMyDlgData(Data) do begin
     FormCaption := Edit1.Text;
     FormWidth := SpinEdit1.Value;
    end;
   end;

   end.
   { ----------------------- }
   Затем создаем и выполняем диалог, который должен выглядеть приблизительно так:
   { Добавьте ExecFrms и MyDlgs в список USES вызывающего модуля. }
   procedure TForm1.GetNewCaptionAndWidthBtnClick(Sender: TObject);
   var Data: TMyDlgData;
   begin
   Data.FormCaption := Caption;
    Data.FormWidth := Width;
    if ExecuteDialog(TMyDlg, Data) then begin
     Caption := Data.FormCaption;
     Width := Data.FormWidth;
    end;
   end;
   Не поверите: данный код работает еще со времён Turbo Vision!
   – Ed Jordan

Освобождение экземпляров формы

   В нашем примере для решения задачи мы передаем конструктору переменную формы. Затем, при закрытии формы, мы сбрасываем эту переменную.
   Естественно, эта технология подразумевает написание некоторого кода, поэтому, если вы не расположены к этому действию, пропустите мое дальнейшее повествование.
   TMyForm = class(TForm)
   …
   private
    FormVar: ^TMyForm;
   public
    constructor Create(AOwner: TComponent; var AFormVar: TMyForm);
    destructor Destroy; override;
   end;

   constructor TMyForm.Create(AOwner: TComponent; var AFormVar: TMyForm);
   begin
    FormVar := @AFormVar;
    inherited Create;
    .....
   end;

   destructor TMyForm.Destroy;
   begin
    FormVar^ := nil;
    inherited Destroy;
   end;

   MyForm := TMyForm.Create(Self, MyForm);
   MyOtherForm := TMyForm.Create(Self, MyOtherForm);
   Этот код при разрушении окна автоматически сбрасывает все, что вы передаете в AFormVar, в nil.
   Как вы, наверное, заметили, частный член FormVar реально является указателем на указатель. Так, читая содержимое памяти, адрес которой содержится в FormVar, мы реально получаем переменную формы. Таким образом мы можем просто установить ее в nil.
   – Jeff Fisher

Условие создания главной формы?

   Существует ли в Delphi возможность создавать главную форму по условию? Я хочу использовать условие IF (в зависимости от передаваемого параметра) для того, чтобы определить какая форма будет главной при старте приложения. Фактически «другую» форму НЕ нужно будет загружать.
   Хитрость здесь заключается в том, что мы предоставляем компилятору весь необходимый для создания форм код, но не допускаем его выполнения (IF FALSE THEN), при этом компилятор не ругается, а мы тем временем (во время выполнения приложения) выбираем и создаем главную форму. Вот пример кода, измененный .DPR-файл, который при старте случайным образом выбирает из друх форм главную:
   begin
    IF FALSE THEN BEGIN
     Application.CreateForm(TForm1, Form1);
     Application.CreateForm(TForm2, Form2);
    END;
    Randomize;
    IF Random < 0.5 THEN Application.CreateForm(TForm1, Form1)
    ELSE Application.CreateForm(TForm2, Form2);
    Application.Run;
   end.
   Пара «подходящих» для CreateForm форм заключено в никогда не выполнимый блок, тем самым приводя компилятор в состояние свинячего восторга.
   – Neil Rubenking

Динамическое создание и циклическое связывание форм

   Тема: Динамическое создание и циклическое связывание форм
   Как сделать простой метод, переключающий между формами?
   Как мне добавить возвращаемые результаты к моей ShowModal-форме?
   Как мне создавать экземпляры форм во время выполнения приложения?
   Необходимый для осуществления этого метод очень прост. В моем примере я использую 3 формы с именами Mainform, Form1 и Form2. На Mainform я установил кнопку, которая выводит Form1, из нее вы можете вызвать любое количество форм (перемещаться между ними) через соответствующие кнопки, расположенные на этих формах. В моем примере "переключение" происходит между формами Form1 и Form2.
   Шаг 1. Разместите следующие две строчки в секции interface той формы, которая у вас будет главной:
   const
    mrNext = 100;
    mrPrevious = 101;
   Шаг 2. Разместите на главной форме кнопку и добавьте следующий код в обработчик события ее нажатия:
   var
    MyForm: TForm;
    R, CurForm: Integer;
   begin
    R := 0;
    CurForm := 1;
    while R <> mrCancel do begin
     Case CurForm of
     1: MyForm := TForm1.Create(Application);
     2: MyForm := TForm2.Create(Application);
     end;
     try
     R := MyForm.ShowModal;
     finally
     MyForm.Free;
     end;
     case R of
     MrNext : Inc(CurForm);
     MrPrevious : Dec(CurForm);
     end;
     // эти 2 строчки позволят нам не выходить за границы
     if CurForm < 1 then CurForm := 2
     else if CurForm > 2 then CurForm := 1;
    end; // while
   end;
   Шаг 3. Добавьте формы 1 и 2 (и любые другие, какие вы хотите иметь) в список используемых модулей формы mainform.
   Шаг 4. В форме Form1 и Form2 добавьте MainForm в список используемых модулей (чтобы они видели константы.)
   Шаг 5. На форму Form1, Form2, и все последующие, добавьте 2 TBitBtn'а, с заголовками «Next» и «Previous». In the Onclick Events for these buttons add the following line of code.
   Если это кнопка Next, добавьте: ModalResult := mrNext;
   Если это кнопка Previous, добавьте: ModalResult := mrPrevious;

Как заставить формы минимизироваться на панель задач с анимацией?

   Nomadic советует:
   Дело-то вот в чем: Главным окном программы дельфийской является не главная форма, а окно TApplication, которое имеет нулевые размеры, поэтому его не видно. Именно для него показывается иконка на панели задач. Когда пользователь нажимает кнопку минимизации на главной форме, команда минимизации передается этому окну, и сворачивается именно оно, а для остальных просто делается hide. А так как окно TApplication имеет нулевые размеры, то и анимации никакой не видно.
   А чтобы этого избежать, необходимо:
   В исходном тесте модуля проекта после вызова Application.Initialize выполнить вызов
   // В исходном тесте модуля проекта после вызова Application.Initialize
   SetWindowLong(Application.Handle, GWL_EXSTYLE, GetWindowLong(Application.Handle, GWL_EXSTYLE) or WS_EX_TOOLWINDOW);
   В исходном тексте модуля главной формы перекрыть следующие методы –
   // // В классе формы
   // Интерфейс
   protected
    procedure CreateParams(var p: TCreateParams); override;
    procedure WMSysCommand(var m: TMessage); message WM_SYSCOMMAND;

   // Реализация
   procedure TMainForm.CreateParams(var p: TCreateParams);
   begin
    inherited;
    p.WndParent := 0;
   end;

   procedure TMainForm.WMSysCommand(var m: TMessage);
   begin
    m.Result := DefWindowProc(Handle, m.Msg, m.wParam, m.lParam);
   end;
   Вместо SetWindowLong в MDI-приложениях лучше использовать
   ShowWindow(Application.Handle, SW_HIDE);

Перемещение формы не за заголовок III

   Ситников Митрий советует:
   В следующем примере показано как можно передвигать форму если пользователь "захватил" Client-пространство:
   unit Main;

   interface

   uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

   type TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
   private
    { Private declarations }
   public
    { Public declarations }
   end;

   var
    Form1: TForm1;
    MX: integer;
    MY: integer;

   implementation

   {$R *.DFM}

   procedure TForm1.Button1Click(Sender: TObject);
   begin
    Close;
   end;

   procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
   begin
    if Shift<>[ssLeft] then begin
     MX:=X;
     MY:=Y;
    end else begin
     Left:=Left+X-MX;
     Top:=Top+Y-MY;
    end;
   end;
   end.

Перемещение формы не за заголовок IV

   Как мне переместить форму, не имеющую заголовка?
   Выберите элемент управления (или саму форму) и напишите это в его (ее) обработчике события OnMouseDown (данный пример дан только для формы):
   procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
   begin
    ReleaseCapture;
    Perform(WM_SYSCOMMAND, SC_MOVE+2, 0);
   end;
   Классно! Намного проще метода NCHitTest, который я предлагал. Хотя многое из того, чтобы вы мне написали, я не понял. Для чего нужно прибавлять 2 к параметру SC_MOVE? В справке по API об этом ничего не сказано.
   Ну хорошо, есть недокументированный способ сообщить Windows о необходимости перемещения окна таким же способом, что и с помощью заголовка (это может вызвать неадекватную реакцию системы, не делайте этого!). Другим способом перемещения окна является перекрытие WMNCHITTEST и возвращения им значения HTCAPTION. Тем не менее, обычно я предпочитаю пользоваться методом SC_MOVE+2, поскольку он не требует создания потомков, а только создание обработчика OnMouseDown. Отчасти аналогично, вы можете добавлять константы SC_SIZE к WM_SYSCOMMAND для получения размера окна подобно тому, как если бы вы потянули его за бордюрчик. В основном мы добавляем код hittest – 9. В следующем классе определена панель, которая сама изменяет свои размеры при щелчке в ее нижнем правом углу, и сама перемещается, если вы щелкнули по ней где-то еще.
   Type TMovablePanel = Class(TPanel)
   Private
    Procedure wmNCHitTest(Var Message : TWMNCHitTest); message WM_NCHITTEST;
   Protected
    Procedure MouseDown(Button : TMouseButton; Shift : TShiftState; X, Y : Integer); override;
   End;

   Procedure TMovablePanel.wmNCHitTest(Var Message : TWMNCHitTest);
   Begin
    With Message, ScreenToClient(Pos) Do
     If (X < Width - 10) And (Y < Height - 10) Then
      Message.Result := HTCAPTION
     Else Message.Result := HTCLIENT;
   End;

   Procedure TMovablePanel.MouseDown(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
   Begin
    If Button = mbLeft Then Begin
     ReleaseCapture;
     Perform(WM_SYSCOMMAND, SC_SIZE + HTBOTTOMRIGHT - 9, 0);
    End Else Inherited MouseDown(Button, SHift, X, Y);
   End;
   – Robert Wittig

Как работать с формой, куда динамически передаются страницы (PageControl) из форм-хранителей (с использованием наследования)?

   Nomadic советует:
   Кидаю проект-болванку, сделанную перед началом работы над основным -
   unit Unit1; //базовая форма хранителя страницы
   interface
   uses ...
   type TBPgFrm = class(TForm)
    Panel1: TPanel;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Label1: TLabel;
   public
    function PgInit: boolean; virtual;
    function PgValid: boolean; virtual;
   end;

   implementation

   {$R *.DFM}

   function TBPgFrm.PgInit: boolean;
   begin
    result:= MessageDlg(Label1.Caption+': PgInit', mtConfirmation, mbOkCancel, 0)=mrOK;
   end;

   function TBPgFrm.PgValid: boolean;
   begin
    result:= MessageDlg(Label1.Caption+': PgValid', mtConfirmation, mbOkCancel, 0)=mrOK;
   end;
   end.

   unit Unit2; //главная форма проекта; содержит первую страницу
   interface //и кнопки Cancel, Prev & Next/Finish.
   uses ...
   type TPagesDlg = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Prev: TButton;
    CancelBtn: TButton;
    Next: TButton;
    Label1: TLabel;
    procedure CancelBtnClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure NextClick(Sender: TObject);
    procedure PrevClick(Sender: TObject);
    privateFrms: TList;
    procedure AddForms;
   end;

   var PagesDlg: TPagesDlg;

   implementation

   uses Unit1, Unit3, Unit4, Unit5;

   {$R *.DFM}

   procedure TPagesDlg.AddForms; //размещение динамических страниц
   var i: word;
   begin
    Frms:= TList.Create;
    Frms.Add(TBPgFrm1.Create(Self));
    Frms.Add(TBPgFrm2.Create(Self));
    for i:= 0 to 1 do TBPgFrm(Frms[i]).TabSheet1.PageControl := PageControl1
   end;

   procedure TPagesDlg.CancelBtnClick(Sender: TObject);
   begin
    Close;
   end;

   procedure TPagesDlg.FormDestroy(Sender: TObject);
   var i: word;
   begin
    for i:= Frms.Count-1 downto 0 do TBPgFrm(Frms[i]).Free;
    Frms.Free;
   end;

   procedure TPagesDlg.NextClick(Sender: TObject);
   var
    i: word;
    vi: Boolean;
   begin
    Next.Enabled:= false;
    if PageControl1.PageCount=1 then AddForms;
    i:= PageControl1.ActivePage.PageIndex;
    if i=0 then vi:= true
    else vi:= TBPgFrm(Frms[i-1]).PgValid;
    if vi then
     with PageControl1 do
     if i=PageCount-1 then begin
      CancelBtnClick(Sender);
     exit;
     end else begin
      ActivePage:= FindNextPage(ActivePage, True, false);
      if ActivePage.PageIndex=PageCount-1 then Next.Caption:= 'Finish';
      Prev.Enabled:= true;
      if TBPgFrm(Frms[i]).PgInit then Next.Enabled:= true
      else PrevClick(Sender);
     end else Next.Enabled:= true;
   end;

   procedure TPagesDlg.PrevClick(Sender: TObject);
   begin
    Prev.Enabled:= false;
    with PageControl1 do begin
     ActivePage:= FindNextPage(ActivePage, false, false);
     Prev.Enabled:= ActivePage.PageIndex>0;
    end;
    Next.Caption:= 'Next';
    Next.Enabled:= true;
   end;

   end.

   unit Unit3; //наследник с RadioGroup.
   interface
   uses ...
   type TBPgFrm3 = class(TBPgFrm)
    RadioValid: TRadioGroup;
   public
    function PgValid: boolean; override;
   end;
   implementation

   {$R *.DFM}

   function TBPgFrm3.PgValid: boolean;
   begin
    result:= RadioValid.ItemIndex=0;
   end;

   end.

   unit Unit4; // наследник с CheckBox.
   interface
   uses ...
   type TBPgFrm2 = class(TBPgFrm)
    CheckValid: TCheckBox;
   public
    function PgValid: boolean; override;
   end;
   implementation

   {$R *.DFM}

   function TBPgFrm2.PgValid: boolean;
   begin
    result:= CheckValid.Checked;
   end;
   end.
   В Delphi 4 появились новые возможности, в частности, возможность докинга визуальных компонент, в частности, форм, на различные DockSite, в том числе и на TPageControl. Это более удобно. Кроме того, Вы имеете возможность использования TFormLoader из библиотеки VG Library.

IMHO файл *.dfm – это компилированный ресурс с определением установок формы. А можно ли как-то увидеть этот ресуpс в исходном виде?

   Nomadic советует:
   1. File|Open… ТвояФорма.DFM – увидишь текст;
   2. «Delphi\bin\convert ТвояФорма.DFM» — получится ТвояФорма.TXT (можно и наоборот).
   Идею в массы: в DN/VC/NC можно настроить viewer'ом .DFM .BAT'ник, который скажет convert;wpview;del – и заглядывать в .DFM не открывая Delphi.
   Кстати, функции, которые реализуют это преобразование, доступны для использования в личных целях :)
   CLASSES.PAS:
   […]
   { Object conversion routines }
   procedure ObjectBinaryToText(Input, Output: TStream);
   procedure ObjectTextToBinary(Input, Output: TStream);

   procedure ObjectResourceToText(Input, Output: TStream);
   procedure ObjectTextToResource(Input, Output: TStream);

Определение перемещения формы

   Кто-нибудь знает как мне определить перемещение пользователем главной формы приложения (не изменение ее размеров), кроме как использования таймера и проверки значений свойств Form.Top и Form.Left?
   Вам можно воспользоваться обработчиками следующих системных сообщений:
   1. WM_WINDOWPOSCHANGING (возникает перед перемещением),
   2. WM_WINDOWPOSCHANGED (возникает после перемещения), или
   3. WM_MOVE (возникает после перемещения)
    – Robert Wittig

Можно ли сделать так – одновременно иметь на экране всегда доступную форму – например, "Навигатор", и, открывая модальные формы, иметь всегда доступ к форме "Навигатор"?

   Nomadic советует:
   Обманом можно все.
   procedure ShowAlmostModal(FormModal:TForm);
   begin
    NavigatorForm.Enabled:=false;
    FormModal.ShowModal
   end;
   И вот это привесь на OnShow почти модальной формы
   procedure FormShow(Sender:Tobject);
   begin
    NavigatorForm.Enabled:=true;
   end;

Как создать окна непрямоугольной формы и работать с ними?

   Nomadic советует:
   Достаточно создать регион нужной формы и вызвать SetWindowRgn —
   HRGN rgn := CreateEllipticRgn(10,10,100,100);
   SetWindowRgn(hMyWnd,rgn); // Вот и будет круглое окно
   При этом регион этот теперь используется Windows и будет уничтожен при закрытии окна.
   Попробуйте вот этот обpаботчик OnCreate : На меня это произвело впечатление.
   procedure TForm1.FormCreate(Sender: TObject);
   const W=36*pi/180;
   var
    R,R1,R2: HRgn;
    X,Y,i:integer;

    function S(a:integer;R:integer):integer;
    begin
     Result:=round(R*sin(W*a));
    end;

    function C(a:integer;R:integer):integer;
    begin
     Result:=round(R*cos(W*a));
    end;

    function GetStarReg(X,Y,R:integer):HRGN;
    var P : array [0..4] of TPoint;
    begin
     P[0] := Point(X, Y-R);
     P[1] := Point(X-S(4,R), Y-C(4,R));
     P[2] := Point(X-S(8,R), Y-C(8,R));
     P[3] := Point(X-S(2,R), Y-C(2,R));
     P[4] := Point(X-S(6,R), Y-C(6,R));
     Result := CreatePolygonRgn(P, 5, WINDING);
    end;

   begin
    X:=Width div 2;
    Y:=Height div 2;
    R:=GetStarReg(X,Y,100);
    i:=1;
    repeat
     R1:=GetStarReg(X-S(i,120),Y-C(i,110),40);
     CombineRgn(R,R,R1,RGN_OR);
     inc(i,2);
    until i>9;
    R1:=GetStarReg(X,Y,30);
    CombineRgn(R,R,R1,RGN_DIFF);
    R1:=CreateEllipticRgn(3,3,Width-6,Height-6);
    R2:=CreateEllipticRgn(20,10,Width-20,Height-10);
    CombineRgn(R1,R1,R2,RGN_DIFF);
    CombineRgn(R,R,R1,RGN_OR);
    SetWindowRgn(Handle, R, True);
   end;

Как запретить кнопку Close [×] в заголовке окна?

   Nomadic советует:
   Вот кусок, который делает все, что тебе нужно:
   procedure TForm1.FormCreate(Sender: TObject);
   var Style: Longint;
   begin
    Style := GetWindowLong(Handle, GWL_STYLE);
    SetWindowLong(Handle, GWL_STYLE, Style And Not WS_SYSMENU);
   end;

   procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
   begin
    if (Key = VK_F4) and (ssAlt in Shift) then begin
     MessageBeep(0);
     Key := 0;
    end;
   end;

   { Disable close button }
   procedure TForm1.Button1Click(Sender: TObject);
   var SysMenu: HMenu;
   begin
    SysMenu := GetSystemMenu(Handle, False);
    Windows.EnableMenuItem(SysMenu, SC_CLOSE, MF_DISABLED or MF_GRAYED);
   end;

   { Enable close button }
   procedure TForm1.Button2Click(Sender: TObject);
   begin
    GetSystemMenu(Handle, True);
    Perform(WM_NCPAINT, Handle, 0);
   end;
   Но это окно можно закрыть из TaskBar'а.

Мерцание формы

   Как бы это осуществить рисование в окне без его дурацкого мерцания и без помощи создания виртуального изображения в памяти? WM_SETREDRAW здесь поможет?
   Попробуйте этот код. Даже если некоторые компоненты имеют пару BeginUpdate / EndUpdate, то для таких компонентов, как TTreeView, интенсивное рисование может послужить причиной перемещения полосы прокрутки и появления других «барабашек». В таких ситуаций вместо дескриптора элемента управления используйте родительский дескриптор.
   procedure BeginScreenUpdate(hwnd : THandle);
   begin
    if (hwnd = 0) then hwnd := Application.MainForm.Handle;
    SendMessage(hwnd, WM_SETREDRAW, 0, 0);
   end;

   procedure EndScreenUpdate(hwnd : THandle; erase : Boolean);
   begin
    if (hwnd = 0) then hwnd := Application.MainForm.Handle;
    SendMessage(hwnd, WM_SETREDRAW, 1, 0);
    RedrawWindow(hwnd, nil, 0, DW_FRAME + RDW_INVALIDATE + RDW_ALLCHILDREN + RDW_NOINTERNALPAINT);
    if (erase) then Windows.InvalidateRect(hwnd, nil, True);
   end;
   – Jeff Johnson

Минимизация модального окна

   Мне нужно открыть из моей формы модальное окно, т.е. приостановить работу в моей форме до обработки этого модального окна. Но при этом я теряю возможность убрать (минимизировать) мою форму
   Nomadic советует:
   function TMyForm.Execute: TModalResult;
   begin
    Show;
    try
     SendMessage(Handle, CM_ACTIVATE, 0, 0);
     ModalResult := 0;
     repeat
      Application.HandleMessage;
      if Application.Terminated then ModalResult := mrCancel;
      if ModalResult = mrCancel then CloseModal;
     until ModalResult <> 0;
     Hide;
     Result := ModalResult;
     SendMessage(Handle, CM_DEACTIVATE, 0, 0);
    finally
     Hide;
    end;
   end;
   Конечно, в TMyForm должно быть FormStyle := fsStayOnTop;

Прозрачная форма

   Dmitry V. Koreyba советует:
   Высылаю прогу которая делает прозрачной форму. Может кому-нибудь поможет в его дизайнерских изысканиях.
   var FullRgn, ClientRgn, CtlRgn : THandle;

   procedure TForm1.DoInvisible;
   var
    AControl : TControl;
    A, Margin, X, Y, CtlX, CtlY : Integer;
   begin
    Margin := (Width - ClientWidth) div 2;
    FullRgn := CreateRectRgn(0, 0, Width, Height);
    X := Margin;
    Y := Height - ClientHeight - Margin;
    ClientRgn := CreateRectRgn(X, Y, X + ClientWidth, Y + ClientHeight);
    CombineRgn(FullRgn, FullRgn, ClientRgn, RGN_DIFF);
    for A := 0 to ControlCount - 1 do begin
     AControl := Controls[A];
     if (AControl is TWinControl) or (AControl is TGraphicControl) then
     with AControl do begin
       if Visible then begin
        CtlX := X + Left;
        CtlY := Y + Top;
       CtlRgn := CreateRectRgn(CtlX, CtlY, CtlX + Width, CtlY + Height);
        CombineRgn(FullRgn, FullRgn, CtlRgn, RGN_OR);
       end;
      end;
    end;
    SetWindowRgn(Handle, FullRgn, TRUE);
   end;

   procedure TForm1.FormDestroy(Sender: TObject);
   begin
    DeleteObject(ClientRgn);DeleteObject(FullRgn);
    DeleteObject(CtlRgn);
   end;

   procedure TForm1.DoVisible;
   begin
    FullRgn := CreateRectRgn(0, 0, Width, Height);
    CombineRgn(FullRgn, FullRgn, FullRgn, RGN_COPY);
    SetWindowRgn(Handle, FullRgn, TRUE);
   end;

   procedure TForm1.FormCreate(Sender: TObject);
   begin
    DoInvisible;
   end;

Каким образом можно изменить системное меню формы?

   Nomadic советует:
   Hе знаю как насчет акселераторов,надо поискать, а вот добавить пункт меню(Item) — пожалуйста
   type TMyForm=class(TForm)
    procedure wmSysCommand(var Message:TMessage); message WM_SYSCOMMAND;
   end;

   const
    ID_ABOUT = WM_USER+1;
    ID_CALENDAR=WM_USER+2;
    ID_EDIT = WM_USER+3;
    ID_ANALIS = WM_USER+4;

   implementation

   procedure TMyForm.wmSysCommand;
   begin
    case Message.wParam of
    ID_CALENDAR:DatBitBtnClick(Self);
    ID_EDIT :EditBitBtnClick(Self);
    ID_ANALIS:AnalisButtonClick(Self);
    end;
    inherited;
   end;

   procedure TMyForm.FormCreate(Sender: TObject);
   var SysMenu:THandle;
   begin
    SysMenu:=GetSystemMenu(Handle,False);
    InsertMenu(SysMenu, Word(-1), MF_SEPARATOR, ID_ABOUT, '');
    InsertMenu(SysMenu, Word(-1), MF_BYPOSITION, ID_Calendar, 'Calendar');
    InsertMenu(SysMenu, Word(-1), MF_BYPOSITION, ID_Analis, 'Analis');
    InsertMenu(SysMenu, Word(-1), MF_BYPOSITION, ID_Edit, 'Edit');
   end;

Как сделать MDI-приложение, в котором способны сливаться не только меню дочернего и главного окна, но и полосы инструментов?

Nomadic советует:

Вариант 1. CoolBar.

   procedure TMainForm.SetBands(AControls: array of TWinControl;ABreaks: array of boolean);
   var i: integer;
   begin
    with CoolBar do begin
     for i:=0 to High(AControls) do begin
      if Bands.Count=succ(i) then TCoolBand.Create(Bands);
     with Bands[succ(i)] do begin
      if Assigned(Control) then Control.Hide;
       MinHeight:=AControls[i].Height;
       Break:=ABreaks[i];
     Control:=AControls[i];
      Control.Show;
       Visible:=true;
      end
     end;
     for i:=High(AControls)+2 to pred(Bands.Count) do Bands[i].Free
    end
   end;
   и
   procedure TMsgForm.FormActivate(Sender: TObject);
   begin
    MainForm.SetBands([ToolBar],[false])
   end;
   Примечание:
   Оба массива равны по длине. CoolBar.Bands[0] должен существовать всегда,.. на нём я размешаю «глобальные» кнопки. СoolBar[1] тоже можно сделать в DesignTime с Break:=false и придвинуть поближе с началу. При CoolBar.AutoSize:=true возможно «мигании» (при добавлении на новую строку) так что можно добавить:
   AutoSize:=false; try … finally AutoSize:=true;

Вариант 2.

   TMainForm
   …
   object SpeedBar: TPanel
    ...
    Align = alTop
    BevelOuter = bvNone
    object ToolBar: TPanel
     ...
     Align = alLeft
     BevelOuter = bvNone
    end
    object RxSplitter1: TRxSplitter
     ...
     ControlFirst = ToolBar
     ControlSecond = ChildBar
     Align = alLeft
     BevelOuter = bvLowered
    end
    object ChildBar: TPanel
     ...
     Align = alClient
     BevelOuter = bvNone
    end
   end
   TMdiChild {прародитель всех остальных}
   ..
   object pnToolBar: TPanel
    …
    Align = alTop
    BevelOuter = bvNone
    Visible = False
   end
   end;

   procedure TMDIForm.FormActivate(Sender: TObject);
   begin
    pnToolBar.Parent:=MainForm.ChildBar;
    pnToolBar.Visible:=True;
   end;

   procedure TMDIForm.FormDeactivate(Sender: TObject);
   begin
    pnToolBar.Visible:=false;
    pnToolBar.Parent:=self
    {pnToolBar.Visible:=false}
   end;

Заполнение изображением MDI-формы IV

   Nomadic советует:
   Я делал так:
   type
   …. = class(TForm)
    ....
    procedure FormCreate(Sender:TObject);
    procedure FormDestroy(Sender:TObject);
    ....
   private
    FHBrush: HBRUSH;
    FCover: TBitmap;
    FNewClientInstance: TFarProc;
    FOldClientInstance: TFarProc;
    procedure NewClientWndProc(var Message:TMessage);
    ....
   protected
    ....
    procedure CreateWnd; override;
    ....
   end;

   .....

   implementation

   {$R myRes.res} //ресурс с битмапом фона

   procedure .FormCreate(...);
   var LogBrush:TLogbrush;
   begin
    FCover:=TBitmap.Create;
    FCover.LoadFromResourceName(hinstance,'BMPCOVER');
    With LogBrush do begin
     lbStyle:=BS_PATTERN;
     lbHatch:=FCover.Handle;
    end;
    FHBrush:=CreateBrushIndirect(Logbrush);
   end;

   procedure .FormDestroy(...);
   begin
    DeleteObject(FHBrush);
    FCover.Free;
   end;

   procedure .CreateWnd;
   begin
    inherited CreateWnd;
    if (ClientHandle <> 0) then begin
     if NewStyleControls then
      SetWindowLong(ClientHandle, GWL_EXSTYLE, WS_EX_CLIENTEDGE or GetWindowLong(ClientHandle, GWL_EXSTYLE));
     FNewClientInstance:=MakeObjectInstance(NewClientWndProc);
     FOldClientInstance:=pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
     SetWindowLong(ClientHandle, GWL_WNDPROC, longint(FNewClientInstance));
    end;
   end;

   procedure .NewClientWndProc(var Message:TMessage);

    procedure Default;
    begin
     with Message do
      Result := CallWindowProc(FOldClientInstance, ClientHandle, Msg, wParam, lParam);
    end;

   begin
    with Message do begin
     case Msg of
     WM_ERASEBKGND:
      begin
       FillRect(TWMEraseBkGnd(Message).DC, ClientRect,FHBrush);
       Result := 1;
      end;
     else
      Default;
     end;
    end;
   end;

Предотвращение закрытия формы

   Igor Nikolaev aKa The Sprite советует:
   Следующий текст убирает команду закрыть из системного меню и одновременно делает серой кнопку закрыть в заголовке формы:
   procedure TForm1.FormCreate(Sender: TObject);
   var hMenuHandle:HMENU;
   begin
    hMenuHandle := GetSystemMenu(Handle, FALSE);
    IF (hMenuHandle <> 0) THEN DeleteMenu(hMenuHandle, SC_CLOSE, MF_BYCOMMAND);
   end;

Немедленный TrayIcon после старта приложения

   Нужно чтобы при запуске приложения сразу исчезала с экрана главная форма и появлялась TrayIcon. В Ваших «Советы по Дельфи» на данный вопрос я нашел два решения (раздел Классы/TForm) к сожалению ни одно решения на моем компьютере не работало :-(. В связи с этим было решено продолжить поиск, и решение было найдено:
   На Главную форму приложения помещаем компонент (TEdit или другой любой, который может иметь фокус), затем устанавливаем свойства:
   Visible:=True;
   TabOrder:=0;
   В обработчик события OnEnter записываем (этот код взял из «Советов по Дельфи»):
   Application.Minimize;
   ShowWindow(Application.Handle, SW_HIDE);
   Button1.SetFocus; //Устанавливаем фокус на другой компонент формы (у меня был Button1 )
   Edit1.Visible:=False; //Делаем добавочный компонент невидимым – т.к. он больше нам не нужен
   Механизм работы:
   При запуске приложения создается форма и фокус получает компонент со свойством TabOrder:=0, при получении фокуса вызывается процедура OnEnter для нашего компонента и происходит скрытие формы.
   Для восстановления формы необходим код:
   ShowWindow(Application.Handle, SW_RESTORE);
   Application.Restore;
   Для реализации TrayIcon был использован компонент TRxTrayIcon из библиотеки RxLib ver.2.75 Данное решение имеет один недостаток – незначительное мерцание формы при ее сворачивании.
   -----------------------------------------------------------------
   С уважением Пащенко Андрей Владимирович (Bibigon)
   г.Архангельск, 2000.

Заполнение формы изображением

   Почитал я тут ваши 'Советы ……' и решил дополнить ответ по теме создание фона на форме раздела классы\tform
   Чтобы заполнить вашу форму повторяющимся изображением нужно
   1. Разместить на форме image
   2. Присвоить его свойству visible значение false
   3. В обработчике события формы OnCreate разместить следующий код :
   form1.brush.bitmap:=image1.picture.bitmap;
   Хочу заметить , что при использовании этого св-ва св-ва color & style не действительны! А самое главное при изменении размеров формы ваше повторяюшееся изображение будет автоматически перересовываться и вам не понадобится обрабатывать событие paint & resize.
   С уважением, Dmitry Morsin

Создание консольных приложений

   Создание консольных приложений. (Об этом в советах немножко есть, но очень не конкретно)
   Как уже отмечалось в совете [000092] (да и в Хелпе) в консольных приложениях в Delphi можно использовать в принципе весь дельфийский арсенал. Правда и работать они будут лишь под Windows. (Кстати этот способ можно применить для модернизации программ на Паскале под Windows).
   Этот код был использован для вывода результатов работы программы проверки (неважно чего) чтобы не приходилось смотреть файл с результатами. Главная проблема была в том, что консоль (если запуск был из Windows) оставалась висеть позади формы до её закрытия. Вреда конечно никакого, но не приятно. Если же запуск из Нортона или т.п., то всё идёт нормально
   Program MyProgram;
   {$APPTYPE CONSOLE}
   uses
    Windows, Forms, Dialogs, SysUtils, StdCtrls, Controls; // и (или) т.п.
    …
   var
    …
    SH,SW: integer;
    MainForm: TForm; // если нужна форма
    Memo: TMemo;
    // могут быть также любые другие визуальные компоненты
    …
    // здесь могут быть процедуры и функции, т.е всё как в обычном Паскале

   Begin
    … // здесь какой-то код
    { а здесь, перед выводом формы, есть два пути:}
    { так}
    FreeConsole; // Отцепиться от консоли, т.е она просто исчезнет (в случае запуска из Windows) и останется только форма
    { или так}
    // Handle:= GetForegroundWindow; // Получить Handle консоли
    // ShowWindow(Handle, SW_HIDE); // Спрятать консоль
    // а в конце, перед завершением
    // ShowWindow(Handle, SW_SHOW); // Показать консоль

    { для помещения формы в центр экрана}
    SH:= Screen.Height;
    SW:= Screen.Width;
    MainForm:= TForm.Create(nil);
    with MainForm do try
     BorderStyle:= bsSizeable;
     Height:= 390;
     Width:= 390;
     Left:= (SW - Width) div 2;
     Top:= (SH - Height) div 2;
     Caption:= 'Моя программа';
     // здесь могут быть и другие компоненты
     Memo:= TMemo.Create(MainForm);
     with Memo do begin
      Parent:= MainForm;
      Align:= alClient;
      BorderStyle:= bsNone;
      Font.Name:= 'Courier New Cyr';
      Font.Size:= 9;
      ScrollBars:= ssVertical;
      Lines.LoadFromFile('MyProgram.txt');
     end;
     ShowModal;
    finally
     Free;
    end;
    { или можно вывести сообщение, например в случае неудачи (или наоборот)}
    with CreateMessageDialog('Текст сообщения', mtInformation, [mbOk]) do try
     Caption := 'Заголовок';
     ShowModal;
    finally
     Free;
    end;

    // это для второго пути, иначе она так и останется висеть свёрнутой
    // ShowWindow(Handle, SW_SHOW); // Показать консоль
   End.
   С уважением, Михаил Чумак.

События приложения

…проблема в том, что когда приложение Delphi минимизировано, десктиптор окна в этом случае совершенно другой. Объект Application в действительности дескриптор собственного окна! Application.Handle является окном, которое активно при минимизированном приложении. Когда вы минимизируете ваше приложение, все формы просто прячутся (hidden). Обратите внимание на методы Application Minimize и Restore. Также обратите внимание, что у TApplication есть два недокументированных события, OnMinimize и OnRestore. Они принадлежат приложению, поскольку в TForm нет обработчиков событий, возникающих при минимизации главного окна. Немного странно. Я думаю так сделано для поддержки SDI-приложений.

Нужны ли мне формы в сервере приложений?

   Nomadic отвечает:
   Да.
   Необязательно, чтобы они были видимы, но должна присутствовать хотя бы одна. Чтобы сделать главную форму невидимой, установите
   Application.ShowMainForm := False
   в файле проекта.
   Пример:
   begin
    Application.ShowMainForm := False;
    Application.Initialize;
    Application.CreateForm(TForm1, Form1);
    Application.Run;
   end.

Создание формы на основе строки

Обзор

В данном документе рассказывается о том, как в Delрhi можно создать экземпляр формы на основе строки, содержащей имя типа. Код примера прилагается.

На кого расчитан данный документ?

На любого программиста, имеющего начальные знания для работы с Delphi. Имеет отношение к любой версии Delphi.

Создание формы на основе строки

   Чтобы можно было создать экземпляр формы на основе строки, содержащей имя типа, вы должны в первую очередь зарегистрировать данный тип в Delphi. Это выполняется функцией "RegisterClass". RegisterClass описан следующим образом:
   procedure RegisterClass(AClass: TPersistentClass);
   AClass – класс TPersistent. Другими словами, класс, который вы хотите регистрировать, в какой-то точке должен наследоваться от TPersistent. Поскольку все элементы управления Delphi, включая формы, соблюдают это требование, то проблем быть не должно. Но такой способ не пройдет, если регистрируемые классы наследуются непосредственно от TObject.
   После регистрации класса, вы можете найти указатель на тип, передавая строку в FindClass. Функция возвратит ссылку на класс, которую можно использовать для создания формы. Небольшой поясняющий пример:
   procedure TForm1.Button2Click(Sender: TObject);
   var
    b : TForm;
    f : TFormClass;
   begin
    f := TFormClass(findClass('Tform2'));
    b := f.create(self);
    b.show;
   end;
   Данный код создаст тип TForm2, который мы зарегистрировали с помощью RegisterClass.

Демонстрационный проект

   Создайте новый проект, затем добавьте 4 формы так, чтобы в общей сложности получилось 5. В реальном проекте вы можете заполнить их необходимыми элементами управления, для данного же примера это не важно.
   В первой форме разместите поле редактирования и кнопку. Удалите все формы, кроме главной, из списка AutoCreate. Наконец, скопируйте приведенный ниже код в unit1, он позволит вам создавать форму по имени типа класса, введенному в поле редактирования.
   unit Unit1;

   interface

   uses Unit2, Unit3, Unit4, Unit5, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

   type TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
   private
    { Private declarations }
   public
    { Public declarations }
   end;

   var Form1: TForm1;

   implementation

   {$R *.DFM}

   procedure TForm1.FormCreate(Sender: TObject);
   begin
    RegisterClass(Tform2);
    RegisterClass(Tform3);
    RegisterClass(Tform4);
    RegisterClass(Tform5);
   end;

   procedure TForm1.Button1Click(Sender: TObject);
   var f : Tformclass;
   begin
    f := tformclass(findClass(edit1.text));
    with f.create(self) do show;
   end;

Показ логотипа при запуске приложения III

   Своим опытом делится Nomadic :
   A: Смотрите пример в X:\DELPHI\DEMOS\DB\MASTAPP\mastapp.dpr.
   Удобно использовать функцию ShowSplashWindow из rxLib.

Показ логотипа при запуске приложения IV

   Как добавить логотип к вашему приложению
   Логотип (заставка) является важной составляющей вашего приложения. Он позволяет занять время во время загрузки и сообщить пользователю дополнительные сведения о программе. Логотип сделает ваше приложение более профессиональным.
   Кроме того, заставка позволяет не только отличить ваше приложение от другого, но и отличить одну версию приложения от другой.
   Имеется множество типов заставок (Splash Screen). Самый распространный тип - показ логотипа во время загрузки приложения. Обычно такие экраны отображают имя приложения, автора, версию, авторские права и изображение или иконку, идентифицирующую приложение.
   Также, некоторые приложения используют этот экран для показа линейки прогресса при выполнении длительного процесса. Примером такого типа экрана может быть диалог с выводом числа процентов выполненного запроса к базе данных, файловая задача, или задача обработки чисел. При длительных процессах наличие такого диалога означает вежливость программы по отношению к пользователю.
   Надеюсь, вы оценили преимущества заставок. Давайте теперь попробуем создать простую заставку своими руками.
   1. Добавьте форму в ваш проект --> File | New Form.. Комментарий: Заставка (Splash Screen) похожа на любую другую форму.
   2. Измените свойство формы Name на SplashScreen
   3. Измените свойство формы BorderStyle на bsNone
   4. Измените свойство формы Position на poScreenCenter
   5. Сделайте заставку привлекательной и функциональной путем добавления на нее необходимых компонентов и изображений. (компоненты Label, Panel, Image, Shape и Bevel)
   6. Отредактируйте свойства добавленных компонентов
   7. Выберите в меню Delphi IDE Options | Project
   8. Уберите SplashScreen-форму из списка Auto-create-списка (списка автоматически создаваемых форм)
   Комментарий: Вы динамически создаете экземпляр заставки
   9. Добавьте модуль, содержащий TSplashScreen, в список используемых модулей главной формы вашего приложения. Пример:
   unit Unit1;
   interface
   uses SysUtils, WinTypes, WinProcs, Messages, Classes,Graphics, Controls, Forms, Dialogs, StdCtrls, unit2; <– поместите сюда
   Комментарий: В нашем примере TSplashScreen объявлен в Unit2
   10. Выберите в меню Delphi IDE View | Project Source
   11. Вставьте между ключевым словом begin и перед любым Application.Create() следующий код:
   SplashScreen := TSplashScreen.Create(Application);
   SplashScreen.Show;
   SplashScreen.Refresh;
   12. Измените поведение главной формы приложения при наступлении события OnShow. Добавьте следующий код:
   SplashScreen.Free;
   Комментарий: Реализация заставки с линейкой прогресса ничуть не сложнее, чем приведенный выше пример. Необходимо всего лишь вовремя выводить ее на экран: перед тем, как процесс начнется, и убирать только после того, как он закончится. Различие заключается в осуществлении связи (реализации механизма) между процессом и заставкой для правильного обновления линейки прогресса.
   13. Запустите приложение. В приведенном выше примере, если скорость вашего компьютера значительна, то заставки вы можете и не увидеть. Следующий код демонстрирует технику создания заставки для вашего приложения — только будьте осмотрительней при его использовании.
   Добавьте следующий код на этапе #11:
   for x:= 1 to 10000000 do begin
    x:=x;
   end;

   {PROJECT1.DPR}
   program Project1;
   uses Forms, Unit1 in 'UNIT1.PAS' {Form1}, Unit2 in 'UNIT2.PAS' {SplashScreen};

   {$R *.RES}
   var x: longint;
   begin
    SplashScreen:= TSplashScreen.Create(Application);
    SplashScreen.Show;SplashScreen.Refresh;
    for x:= 1 to 10000000 do begin
     x:=x;
     x:=x;
    end;
    Application.CreateForm(TForm1, Form1);
    Application.Run;
   end.

   {UNIT1.PAS}
   unit Unit1;
   interface
   uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, unit2;
   type TForm1 = class(TForm)
    procedure FormShow(Sender: TObject);
   private
    { Private declarations }
   public
    { Public declarations }
   end;

   var Form1: TForm1;
   implementation
   {$R *.DFM}
   procedure TForm1.FormShow(Sender: TObject);
   begin
     splashscreen.free;
   end;
   end.

   {UNIT2.PAS}
   unit Unit2;
   interface
   uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls;
   type TSplashScreen = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Shape1: TShape;
    Shape2: TShape;
    Shape3: TShape;
   private
    { Private declarations }
   public
    { Public declarations }
   end;

   var SplashScreen: TSplashScreen;
   implementation
    {$R *.DFM}
   end.

Как правильно закрыть и удалить форму? Почему моя MDI Child форма при закрывании просто минимизируется?

Своим опытом делится Nomadic:
A: Обрабатывайте событие OnClose для формы и выставляйте в нем параметр Action в caFree. Дело в том, что его значение по умолчанию для MDI Child форм caMinimize. Кстати, если сделать Action := caNone, то форму нельзя будет закрыть.

Как установить максимальный и минимальный размер формы

   Если вы хотите контролировать изменение пользователем размера вашей формы, воспользуйтесь установкой значения MinMax. (Если для этих целей вы используете метод resize, это работает, но выглядит не так хорошо.)
   Примечание: Чтобы совсем запретить пользователю изменять размеры формы, задайте одинаковые значения для ее минимального и максимального значения. Вот пример того, как можно объявить и использовать в вашем приложении обработку системного сообщения wm_GetMinMaxInfo:
   unit MinMax;

   interface

   uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs;

   type TForm1 = class(TForm)
   private
    { Private declarations }
    procedure WMGetMinMaxInfo(var MSG: Tmessage); message WM_GetMinMaxInfo;
   public
    { Public declarations }
   end;

   var Form1: TForm1;

   implementation

   {$R *.DFM}

   procedure TForm1.WMGetMinMaxInfo(var MSG: Tmessage);
   Begin
    inherited;
    with PMinMaxInfo(MSG.lparam)^ do begin
     with ptMinTrackSize do begin
     X := 300;
      Y := 150;
     end;
     with ptMaxTrackSize do begin
      X := 350;
      Y := 250;
     end;
    end;
   end;
   end.

TIniFile

Проблемы ini-файла

   Кто-нибудь имел какие-нибудь проблемы при использовании модуля TIniFile? Я думаю здесь какая-то детская проблема с кэшированием!!!
   Вот что я делал:
   (* c:\test.ini уже существует *)
   myIni := TIniFile.Create('c:\test.ini');
   With myIni do begin
    …. (добавляем новую секцию в test.ini
   end;
   myIni.Free;
   RenameFile('c:\test.ini', 'c:\test1.ini');
   Что я получил:
   1. test1.ini НЕ ИМЕЕТ добавленной мною секции;
   2. всякий раз при создании или открытии нового файла в том же самом каталоге с помощью File Manager, 'c:\test.ini' появляется вновь, и у него СУЩЕСТВУЕТ секция, которую я добавлял.
   Я решил эту проблему добавлением следующей строки перед IniFile.Free:
   WritePrivateProfileString(nil, nil, nil, PChar(IniFileName));
   Для получения дополнительной информации обратитесь к электронной справке к разделу 'WritePrivateProfileString'.
   – Tony Chang

Как создать Ini-файл в директории программы?

   По умолчанию ini-файл создается в Windows-директории (например: TIniFile.Create('MFile.ini')), что приводит к «захламлению» оной. Более (эко-)логично (за исключением случаев, когда программа делается для CD-ROM) если ini-файл создается в той же директории что и главная программа. Вот пример чтения и записи ini файла из директории программы:
   function ReadIni(ASection, AString : String) : String;
   var
    sIniFile: TIniFile;
    sPath : String[60];
   begin
    GetDir(0,sPath);
    sIniFile := TIniFile.Create(sPath + '\Name.INI');
    Result := sIniFile.ReadString(ASection, AString, S);
    sIniFile.Free;
   end;

   procedure WriteIni(ASection, AString, AValue: String);
   var
    sIniFile: TIniFile;
    sPath : String[60];
   begin
    GetDir(0,sPath);
    sIniFile := TIniFile.Create(sPath + '\Name.INI');
    sIniFile.WriteString(ASection, AString, AValue);
    sIniFile.Free;
   end;

TRegistry

Дополненный TRegistry, умеет работать с значениями типа REG_MULTI_SZ (Windows NT, Windows 2000)

   Кондратюк Виталий советует:
   unit Reg;
   {$R-,T-,H+,X+}

   interface

   uses Registry, Classes, Windows, Consts, SysUtils;

   type TReg = class(TRegistry)
   public
    procedure ReadStringList(const name : string; list : TStringList);
    procedure WriteStringList(const name : string; list : TStringList);
   end;

   implementation

   //*** TReg *********************************************************************
   //------------------------------------------------------------------------------
   // Запись TStringList ввиде значения типа REG_MULTI_SZ в реестр
   //------------------------------------------------------------------------------
   procedure TReg.WriteStringList(const name : string; list : TStringList);
   var
    Buffer  : Pointer;
    BufSize : DWORD;
    i, j, k : Integer;
    s       : string;
    p       : PChar;
   begin
    {подготовим буфер к записи}
    BufSize := 0;
    for i:=0 to list.Count-1 do inc(BufSize, Length(list[i])+1);
    inc(BufSize);
    GetMem(Buffer, BufSize);
    k := 0;
    p := Buffer;
    for i:=0 to list.Count-1 do begin
     s := list[i];
     for j:=0 to Length(s)-1 do begin
      p[k] := s[j+1];
      inc(k);
     end;
     p[k] := chr(0);
     inc(k);
    end;
    p[k] := chr(0);
    {запись в реестр}
    if RegSetValueEx(CurrentKey, PChar(name), 0, REG_MULTI_SZ, Buffer, BufSize) <> ERROR_SUCCESS then raise ERegistryException.CreateResFmt(@SRegSetDataFailed, [name]);
   end;

   //------------------------------------------------------------------------------
   // Чтение TStringList ввиде значения типа REG_MULTI_SZ из реестра
   //------------------------------------------------------------------------------
   procedure TReg.ReadStringList(const name : string; list : TStringList);
   var
    BufSize,DataType: DWORD;
    Len, i: Integer;
    Buffer: PChar;
    s: string;
   begin
    if list = nil then Exit;
    {чтение из реестра}
    Len := GetDataSize(Name);
    if Len < 1 then Exit;
    Buffer := AllocMem(Len);
    if Buffer = nil then Exit;
    try
     DataType := REG_NONE;
     BufSize := Len;
     if RegQueryValueEx(CurrentKey, PChar(name), nil, @DataType, PByte(Buffer), @BufSize) <> ERROR_SUCCESS then raise ERegistryException.CreateResFmt(@SRegGetDataFailed, [name]);
     if DataType <> REG_MULTI_SZ then raise ERegistryException.CreateResFmt(@SInvalidRegType, [name]);
     {запись в TStringList}
     list.Clear;s := '';
     for i:=0 to BufSize-2 do begin
     // BufSize-2 т.к. последние два нулевых символа
      if Buffer[i] = chr(0) then begin
       list.Add(s);
       s := '';
      end else s := s + Buffer[i];
     end;
    finally
     FreeMem(Buffer);
    end;
   end;
   end.

Как я могу определить доступные сервера приложений на этой машине через Registry?

   Nomadic советует:
   Прочитайте ключ под HKEY_CLASSES_ROOT\CLSID\*, просматривая его насчёт ключей, которые имеют подключ "Borland DataBroker". Эти вхождения и являются серверами приложений.
   Ниже пример, который загружает имена доступных серверов приложений в Listbox:
   uses Registry;
   procedure TForm1.FormCreate(Sender: TObject);
   var
    I: integer;
    TempList: TStringList;
   begin
    TempList := TStringList.Create;
    try
     with TRegistry.Create do try
      RootKey := HKEY_CLASSES_ROOT;
      if OpenKey('CLSID', False) then GetKeyNames(TempList);
      CloseKey;
      for I := 1 to TempList.Count - 1 do
       if KeyExists('CLSID\' + TempList[I] + '\Borland DataBroker') then begin
        if OpenKey('CLSID\' + TempList[I] + '\ProgID', False) then begin
         Listbox1.Items.Add(ReadString(''));
         CloseKey;
        end;
       end;
     finally
      Free;
     end;
    finally
     TempList.Free;
    end;
   end;

OLE+

ActiveX

Ошибка 'EOLESYS..OPERATION UNAVAILABLE' (операция недоступна) при использовании GETACTIVEOLEOBJECT

   Это происходит при использовании сервера автоматизации Delphi, или когда сервер автоматизации (например, word.basic) не запущен.
   procedure TForm1.Button1Click(Sender: TObject);
   var V: OleVariant;
   begin
    V := GetActiveOleObject('Word.Basic');
    V.FileNew;
    V.Insert('тест');
   end;
   GetActiveOleObject определен в ComObj.pas. Он преобразует имя класса в guid и передает его при вызове Windows api функции GetActiveObject.
   function GetActiveOleObject(const ClassName: string): IDispatch;
   var
   ClassID: TCLSID;
    Unknown: IUnknown;
   begin
   ClassID := ProgIDToClassID(ClassName);
    OleCheck(GetActiveObject(ClassID, nil, Unknown));
    OleCheck(Unknown.QueryInterface(IDispatch, Result));
   end;
   GetActiveOleObject использует интерфейс с именем IRunningObjectTable. Мы не регистрируем это автоматически в таблице, поэтому, чтобы воспользоваться его функциональным назначением, вы должны получить этот интерфейс и использовать его методы для регистрации.

Ошибка 'TACTIVEFORMX DECLARATION MISSING OR INCORRECT' (определение TACTIVEFORMX отсутствует или неправильно)

   Обычно это происходит при неправильном порядке изменения имени ActiveForm (смотри README.TXT). Если сначала изменяется имя CoClass, а затем делается обновление (refresh), возникает AV. При дальнейшей попытке изменить имя в Инспекторе Объектов вы получите ошибку «TActiveFormX declaration missing or incorrect» (определение TActiveFormX отсутствует или неправильно). Для решения проблемы откройте .DFM-файл и измените строчку:
   object ActiveFormX: TActiveFormX
   на
   object MyForm: TMyForm

Лицензирование активных форм и ActiveX

   Почему ACTIVEX и активные формы иногда не отображаются в INTERNET EXPLORER? Все, что появляется, это .HTM-страница с пустым квадратом и красным «X» в нем.
   Вероятно, при создании ActiveForm вы выбрали опцию лицензирования и не поместили .LIC-файл в ваш .OCX-файл. Обычно с ActiveForms/ActiveXs лицензирование не используется, поскольку активные элементы в основном используются для повышения привлекательности Интернет-сервера и «распространяются» свободно. Чтобы выключить лицензию времени разработки (Design-Time Licensing), найдите секцию initialization в вашем ActiveForm XXXImpl-файле и замените предпоследний параметр вызова TActiveXControlFactory.Create на пустую строку:
   initialization
    TActiveXControlFactory.Create( ComServer, TAnimateX, TAnimate, Class_AnimateX, 1, '', 0);
   end.
   Так когда мне нужно будет использовать Design-Time Licensing?
   Ваш элемент управления должен использовать design-time-лицензию только в случае, если вы продаете ActiveX или ActiveForm другим разработчикам, которые встраивают их в продаваемые ими приложения для конечных пользователей. То есть, элемент управления работает в среде разработки (например, Delphi, C++Builder, VB и пр.) только когда LIC-файл присутствует, но это не работает когда .LIC-файл отсутствует во время выполнения приложения без среды разработки (например, в приложении для конечного пользователя).
   Если вы распространяете ваш ActiveX в Интернете, то вы должны задать режим разработки для конечного пользователя (в противоположность передачи другим разработчикам), и вам в этом случае не потребуется лицензия времени разработки.
   Кроме того, для показа ActiveForm необходимо установить в Internet Explorer уровень «Active content security» (безопасность активного содержимого) в medium (средняя). Чтобы это сделать, войдите в Панель Управления и щелкните на иконке Internet. Перейдите на страницу безопасности и нажмите на кнопку «Safety Level» (уровень безопасности). Убедитесь в том, что уровень находится на отметке «средний».
   Примечание: Данный совет отностится только если вы разрабатываете собственные элементы управления. Потенциально хакерские элементы ActiveX могут нанести вред компьютеру!

Добавление IPERSISTPROPERTYBAG к активным элементам управления

   Данный совет рассказывает о том, как можно добавить интерфейс IPersistPropertyBag к элементу управления ActiveX. Существует возможность установки свойств элемента управления ActiveX с помощью HTML тэгов PARAM. Добавление интерфейса IPersistPropertyBag в элемент управления ActiveX также позволяет изменять его свойства с помощью инструментов типа ActiveX Control Pad.
   Добавление интерфейса IPersistPropertyBag к элементу управления ActiveX очень простая процедура. Все, что необходимо сделать, это добавить интерфейс к определению класса объекта и реализовать три метода интерфейса. Приведенный здесь пример покажет вам эту технологию шаг за шагом, где наш элемент управления ActiveX будет базироваться на TButton. Для упрощения примера мы покажем реализацию функциональности для свойства "Caption" (заголовок). Для реализации полной функциональности можно экстраполировать данный пример на все доступные свойства элемента управления.
   Начнем с использования ActiveX Control Wizard и создадим элемент управления ActiveX на основе TButton.
   Активизируйте пункт меню File|New и выберите в диалоге New Item (новый элемент) закладку ActiveX. Затем в списке выберите элемент "ActiveX Control". В появившемся диалоговом окне выберите TButton для VCL Class Name. Все остальные настройки можете не трогать и оставить как есть. После нажатия на кнопку OK Delphi сгенерирует базовый код для вашего элемента управления.
   Следующим шагом будет добавление интерфейса IPersistPropertyBag к определению класса. Измените первую строку определения, декларирующую тип…
   type TButtonX = class(TActiveXControl, IButtonX)
   на…
   type TButtonX = class(TActiveXControl, IButtonX, IPersistPropertyBag)
   Теперь интерфейс IPersistPropertyBag добавлен к объявлению типа. Затем объявите необходимые методы, добавляя следующие строки в секцию protected:
   function IPersistPropertyBag.InitNew = PersistPropBagInitNew;
   function IPersistPropertyBag.Load = PersistPropBagLoad;
   function IPersistPropertyBag.Save = PersistPropBagSave;
   function PersistPropBagInitNew: HResult; stdcall;
   function PersistPropBagLoad(const pPropBag: IPropertyBag; const pErrorLog: IErrorLog): HResult; stdcall;
   function PersistPropBagSave(const pPropBag: IPropertyBag; fClearDirty: BOOL; fSaveAllProperties: BOOL): HResult;
   stdcall;
   Затем, конечно, реализуйте эти функции…
   // – реализация PersistPropBagInitNew
   function TButtonX.PersistPropBagInitNew: HResult;
   begin
    Result := S_OK;
   end;

   // -- реализация PersistPropBagLoad
   function TButtonX.PersistPropBagLoad(const pPropBag: IPropertyBag; const pErrorLog: IErrorLog): HResult; stdcall;
   var v: OleVariant;
   begin
    if pPropBag.Read('Caption', v, pErrorLog) = S_OK then FDelphiControl.Caption := v;
    Result := S_OK;
   end;

   // -- реализация PersistPropBagSave
   function TButtonX.PersistPropBagSave(const pPropBag: IPropertyBag; fClearDirty: BOOL; fSaveAllProperties: BOOL) : HResult; stdcall;
   var v: OleVariant;
   begin
    v:= FDelphiControl.Caption;
    pPropBag.Write('Caption', v);
    Result := S_OK;
   end;
   Добавлением этого кода завершается создание элемента управления. Продолжаем дальше: соберите (build) элемент управления ActiveX и разместите его в сети. Сделайте это с помощью мастера Web Delpoy Wizard. Просто сделайте необходимые настройки на странице Project|Web Delpoyment Options и разместите ActiveX через Project| Web Deploy.
   Мастер Web Deployment Wizard создаст HTML-страницу, содержащую тэг OBJECT, которая должна выглядеть приблизительно так:
   <OBJECT classid="clsid:324EB783-20A4-11D1-AB11-0020AF3E6306" codebase="ActiveX/ButtonXControl.ocx" width=100 height=50 align=center hspace=0 vspace=0> </OBJECT>
   Эта страница должна заработать без проблем. Тем не менее, теперь у вас имеется возможность задания заголовка для кнопок через HTML простым добавлением тэга PARAM. Вам измененный тэг OBJECT должен выглядеть таким образом:
   <OBJECT classid="clsid:324EB783-20A4-11D1-AB11-0020AF3E6306" codebase="ActiveX/ButtonXControl.ocx" width=100 height=50 align=center hspace=0 vspace=0> <Param Name="Caption» Value="Привет"> </OBJECT>
   Заголовок кнопки теперь будет говорить вам «Привет». В нашем примере заголовок будет доступен только с помощью данного метода. Для того, чтобы рулить другими свойствами, следуйте нашему примеру и изменяйте имя свойства, которое вы хотите использовать.

Использование ChartFX

   Это код, который я использую для установки chartfx.

   chart1.Opendata[cod_values]:=makelong(no_of_series, no_of_classes);
   {установка последовательных значений}
   chart1.closedata[cod_values]:=0;

   unit TstChart;

   interface

   uses= WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Menus, Dialogs, StdCtrls, Buttons, ExtCtrls, Tabs, ChartFX, {Похоже, действительно необходимо включить этот модульв список, чтобы иметь доступ к константам, например к COD_VALUES} VBXCtrl, Chart2fx;

   type TF_Chart = class(TForm)
    SpeedPanel: TPanel;
    ExitBtn: TSpeedButton;
    NB: TNotebook;
    TB: TTabSet;
    Chart1: TChartFX;
    Chart2: TChartFX;
    procedure ExitItemClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure TBClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
   private
    { Private declarations }
   public
    { Public declarations }
    Procedure Build1(Ch : TChartFX);
    Procedure Build2(Ch : TChartFX);
   end;

   var F_Chart: TF_Chart;

   implementation

   {$R *.DFM}

   procedure TF_Chart.ExitItemClick(Sender: TObject);
   begin
    Close;
   end;

   procedure TF_Chart.FormCreate(Sender: TObject);
   begin
    TB.Tabs := NB.Pages;
    NB.PageIndex := 0;
    Build1(Chart2);
    Build2(Chart2); {добавляем значения для Chart2: length... и т.д.}
   end;

   procedure TF_Chart.TBClick(Sender: TObject);
   begin
    NB.PageIndex := TB.TabIndex;
   end;

   Procedure TF_Chart.Build1(Ch : TChartFX);
   begin
    {Эта процедура изменяет свойства, которые могут устанавливаться во время разработки или временя выполнения. В коментариях подробно указано чем занимается метод Design}
    with Ch do begin
     Adm[CSA_GAP] := 25.0;
     {Design: Используйте свойство AdmDlg для изменения координаты Y}
     pType := BAR or CT_LEGEND;
     {Design: Изменяем свойство ChartType с 1 - lineна 2 - bar.}
     DecimalsNum[CD_YLEG] := 0;
     {Design: Изменяем свойство Decimals с 2 до 0}
     Stacked := CHART_STACKED;
     {Design: Изменяем свойство Stacked с 0 - None на 1 - Normal}
     RightGap := 20;
     {Design: Тоже}
     OpenData[COD_COLORS] := 2;
     Color[0] := clBlack;
     Color[1] := clYellow;
     CloseData[COD_COLORS] := 0;
     {Фу!!}
     {Design: Для изменения цветов 2 серий:1) Убедитесь, что ThisSerie установлен в 0. ИзменитеThisColor на clBlack.2) Установите ThisSerie в 1. Измените ThisColor наclYellow.}
     Title[CHART_TOPTIT] := 'Статьи и заголовки';
     Title[CHART_LEFTTIT] := 'CCM';
     Title[CHART_BOTTOMTIT] := 'Карты';
     {Design: щелкните на свойстве TitleDlg и установите верхний, левый и нижний заголовки}
    end;
   end;

   Procedure TF_Chart.Build2(Ch : TChartFX);
    {Данная процедура устанавливает свойства, которые не могут (насколько я определил это) быть установлены в режиме разработки}
   const
    XAbbrevs : array[0..4] of string[4] =('Acc', 'Bar', 'Mas', 'Amex', 'Din');
    SeriesTitles : array[0..1] of string[8] =('Статьи', 'Заголовки');
    XTitles : array[0..4] of string[20] = ('Access', 'Barclaycard', 'Mastercard', 'American Express', 'Diners');
    {естественно, вы должны нормально читать из базы данных xTitles и значения}
    Values : array[0..1, 0..4] of double =((50, 60, 70, 80, 90),(30, 35, 25, 37, 42));
   var i, SerieNo : integer;
   begin
    with Ch do begin
     LegendWidth := 120;
     {Установка количества серий, количества значений ******************}
     OpenData[COD_INIVALUES] := MAKELONG(2, 5);
     CloseData[COD_INIVALUES] := 0;
     {*********************************************************}
     OpenData[COD_VALUES] := 2;
     {если вы пропускаете приведенное выше утверждение, (в котором вы вводите номер SERIES и VALUES), и CloseData ниже, назначение значений не создает ошибки, но и не работает! Назначение значений Legend и KeyLeg работает без OpenData/CloseData}
     ThisSerie := 0;
     for i := 0 to 1 do SerLeg[i] := SeriesTitles[i];
     for i := 0 to 4 do= begin
      Legend[i] := XTitles[i];
      KeyLeg[i] := XAbbrevs[i];
     end;
     SerieNo := 0;
     for SerieNo := 0 to 1 do begin
      ThisSerie := SerieNo;
      for i := 0 to 4 do Value[i] := Values[SerieNo, i];
     end;
     CloseData[COD_VALUES] := 0;
    end;
   end;

   procedure TF_Chart.FormResize(Sender: TObject);
   var w, h : longint;
   begin
    w := NB.Width;
    H := NB.Height;
    {при необходимости увеличиваем/уменьшаем размер диаграммы}
    Chart1.Width := W – 18;
    Chart1.Height := H – 12;
    Chart2.Width := W – 18;
    Chart2.Height := H – 12;
    {перемещаем кнопку выхода в правый угол}
    ExitBtn.Left := SpeedPanel.Width – 32;
   end;
   end.

CHARTFX – минимум максимум

   Так можно сделать с ChartFX в Delphi 2…. Я думаю то же самое будет и в D1…
   cfxStockTrends.Adm[CSA_MIN] := X; //устанавливаем минимум по оси Y
   cfxStockTrends.Adm[CSA_MAX] := Y; //Устанавливаем максимум по оси Y

Пример CHARTFX

   Документация, поставляемая с Delphi, слишком запутанна и тяжела, особенно если вы не пользователь VBX…
   Следующий пример устанавливает некоторые значения и пр. для ChartFX:
   {Код получает данные из базы данных и рисует их}
   begin
    MyTable.active := True; {открываем базу данных}
    MyTable.first;
    MyChart.title[CHART_BOTTOMTIT] := 'Заголовок по оси X';
    MyChart.title[CHART_LEFTTIT] := 'Заголовок по оси Y';
    MyChart.OpenData[COD_XVALUES] := MakeLong(numOfSeries,numofPoints);
    MyChart.OpenData[COD_VALUES] := MakeLong(numOfSeries, NumofPoints);
    MyChart.ThisSerie := SeriesNum; {начинаем с 0}
    While MyTable.EOF <> True do begin
     MyChart.value[i] := MyTable.FieldByName('SOMEFIELD').AsFloat;
     MyChart.Xvalue[i] := MyTable.FieldByName('SOMEOTHERFIELD').AsFloat;
     MyTable.next;
     i:=i+1; {естественно, вам необходимо определить и инициализировать 'i'}
    end;
    MyChart.CloseData[COD_Values] := 0;
    MyChart.CloseData[COD_XValues] := 0;
    MyTable.active := False; {закрываем базу данных}
   end;
   {Обратите внимание на то, что данный код отностится к диаграмме типа xy scatter. Если вы хотите сменить тип диаграммы ChartFX, вам не нужно устанавливать значения для COD_XVALUES}

Управление свойством Font через сервер автоматизации

   Данный документ предназначен главным образом тем программистам, кто использует OLE/COM и хочет встроить объект Font (типа Delphi-го TFont) в свой сервер автоматизации. Интерфейс IFontDisp для COM будет иметь ту же функциональность, что и Delphi-ий TFont. Например, если у вас имеется клиент автоматизации, содержащий объект со свойством Font, и в сервере автоматизации для изменения атрибутов текста вы хотите иметь те же методы (наприр, имя шрифта, жирное или наклонное начертание). Для хранения и управления шрифтом сервер автоматизации может применять реализацию интерфейса IFontDisp.
   Приведенный ниже демонстрационный проект содержит элементы и шаги, необходимые для реализации интерфейса IFontDisp в сервере автоматизации COM, и осуществление взаимодействия между клиентом автоматизации COM и интерфейсом. Ниже вы найдете полный листинг исходных модулей, и некоторые комментарии относительно проекта.
   Демонстрационный проект содержит следующие модули:
   Project1_TLB: Паскалевская обертка для библиотеки типов, содержащей определение интерфейса.
   Unit1: Реализация интерфейса: код, содержащий описание свойств интерфейса и реализующий его методы.
   Unit2: Главная форма сервера автоматизации. Данный модуль не является обязательным, но он в ходе тестирования обеспечивает обратную связь, так что мы можем видеть как отрабатываются вызовы наших методов.
   FontCli: Клиент автоматизации, получающий ссылку на интерфейс, и использующий его методы.
   Ниже приведены общие шаги для достижения цели. Вы можете сравнить каждый из этих шагов с кодом модулей, приведенных ниже.
   1. Выберите пункт меню File|New|ActiveX|Automation Object и в Мастере Automation Object Wizard выберите в качестве имени класса MyFontServer. Создайте единственное свойство с именем MyFont и типом IFontDisp. Для получения дополнительной информции смотри Developer's Guide, chapter 42 (руководство разработчика, глава 42), там подробно описана работа с библиотеками типов и создание интерфейсов в редакторе библиотеки типов.
   2. В предыдущем шаге при добавлении интерфейса с помошью редактора библиотеки типов вы должны были получить паскалевский модуль-обертку (в нашем примере модуль имеет имя Unit1). Unit1 будет содержать обертку реализаций методов получения и назначения свойства MyFont. На данном этапе вы обеспечите хранение значений свойства MyFont в форме FFont (TFont) и добавите код реализации, наполняющий функциональностью методы получения и установки (get/set).
   Unit1 использует Unit2. Unit2 содержит форму, компонент Memo и StatusBar для отображения каждого реализованного метода, для диагностических целей.
   3. Создайте Unit2, содержащий форму с компонентами TMemo и TStatusBar. Форма используется для отображения жизнедеятельности в модуле Unit1.pas. Это шаг не является строго обязательным, он помогает понять что происходит в данный момент между клиентом автоматизации и сервером.
   4. Создайте клиент автоматизации. В нашем случае модуль имеет имя FontCli, содержит метку, показывающую текущий шрифт и кнопку, устанавливающую MyFont на сервере.
   unit Project1_TLB;

   { Данный файл содержит паскалевские декларации, импортированные из библиотеки типов. Данный файл записывается во время каждого импорта или обновления (refresh) в редакторе библиотеки типов. Любые изменения в данном файле будут потеряны в процессе очередного обновления. }
   { Библиотека Project1 }
   { Версия 1.0 }

   interface

   uses Windows, ActiveX, Classes, Graphics, OleCtrls, StdVCL;

   const LIBID_Project1: TGUID = '{29C7AC94-0807-11D1-B2BA-0020AFF2F575}';

   const
    { GUID'ы класса компоненты }
    Class_MyFontServer: TGUID = '{29C7AC96-0807-11D1-B2BA-0020AFF2F575}';

   type
    { Предварительные объявления: Интерфейсы }
    IMyFontServer = interface;
    IMyFontServerDisp = dispinterface;

    { Предварительные объявления: CoClasse'ы }
    MyFontServer = IMyFontServer;

    { Диспинтерфейс для объекта MyFontServer }
    IMyFontServer = interface(IDispatch)['{29C7AC95-0807-11D1-B2BA-0020AFF2F575}']
     function Get_MyFont: IFontDisp; safecall;
     procedure Set_MyFont(const Value: IFontDisp); safecall;
     property MyFont: IFontDisp read Get_MyFont write Set_MyFont;
    end;

    { Объявление диспинтерфейса для дуального интерфейса IMyFontServer }
    IMyFontServerDisp = dispinterface['{29C7AC95-0807-11D1-B2BA-0020AFF2F575}']
     property MyFont: IFontDisp dispid 1;
    end;

    { MyFontServerObject }
    CoMyFontServer = class
     class function Create: IMyFontServer;
     class function CreateRemote(const MachineName: string): IMyFontServer;
    end;

   implementation

   uses ComObj;

   class function CoMyFontServer.Create: IMyFontServer;
   begin
    Result := CreateComObject(Class_MyFontServer) as IMyFontServer;
   end;

   class function CoMyFontServer.CreateRemote(const MachineName: string): IMyFontServer;
   begin
    Result := CreateRemoteComObject(MachineName, Class_MyFontServer) as IMyFontServer;
   end;

   end.
   {--------------------------------------------------------------------}

   unit Unit1;

   interface

   uses ComObj, Project1_TLB, ActiveX, Graphics;

   type TMyFontServer = class(TAutoObject, IMyFontServer)
   private
    FFont: TFont;
   public
    procedure Initialize; override;
    destructor Destroy; override;
    function Get_MyFont: IFontDisp; safecall;
    procedure Set_MyFont(const Value: IFontDisp); safecall;
   end;

   implementation

   uses ComServ, AxCtrls, Unit2;

   procedure TMyFontServer.Initialize;
   begin
    inherited Initialize;
    FFont := TFont.Create;
   end;

   destructor TMyFontServer.Destroy;
   begin
    FFont.Free;
    inherited Destroy;
   end;

   function TMyFontServer.Get_MyFont: IFontDisp;
   begin
    FFont.Assign(Form2.Label1.Font);
    GetOleFont(FFont, Result);
   end;

   procedure TMyFontServer.Set_MyFont(const Value: IFontDisp);
   begin
    SetOleFont(FFont, Value);
    Form2.Label1.Font.Assign(FFont);
   end;

   initialization
    TAutoObjectFactory.Create(ComServer, TMyFontServer, Class_MyFontServer, ciMultiInstance);
   end.
   {--------------------------------------------------------------------}

   unit Unit2;

   interface

   uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

   type TForm2 = class(TForm)
    Label1: TLabel;
   end;

   var Form2: TForm2;

   implementation

   {$R *.DFM}

   end.
   {--------------------------------------------------------------------}

   unit FontCli1;

   interface

   uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, StdVCL, Project1_TLB;

   type TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    FontDialog1: TFontDialog;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
   public
    MyFontServer: IMyFontServer;
   end;

   var Form1: TForm1;

   implementation

   uses ActiveX, AxCtrls;

   {$R *.DFM}

   procedure TForm1.Button1Click(Sender: TObject);
   var Temp: IFontDisp;
   begin
    if (FontDialog1.Execute) then begin
     Label1.Font.Assign(FontDialog1.Font);
     GetOleFont(Label1.Font, Temp);
     MyFontServer.Set_MyFont(Temp);
    end;
   end;

   procedure TForm1.FormCreate(Sender: TObject);
   begin
    MyFontServer := CoMyFontServer.Create;
   end;

   end.
   {--------------------------------------------------------------------}
   Так для чего нам Unit1, создающий реализацию интерфейса? Интерфейс Ole, такой как, например, IFontDisp, может считаться соглашением о том, что свойства и функции будут определены в заданном формате, а функции будут реализованы как определено (для получения дополнительной информации смотри Руководство Разработчика, главу 36, «An Overview of COM» (Обзор COM). Тот факт, что интерфейс определен, не означает, что он реализован. Например, чтобы заставить определенный вами интерфейс IFontDisp быть полезным, необходимо обеспечить хранение шрифта и механизм добавления и извлечения информации об атрибутах шрифта, таких, как имя шрифта, наклонное начертание, размер и пр.
   Примечание:
   GetOleFont и SetOleFont определены в AxCtrls.pas. IFontDisp определен в ActiveX.pas

Использование CHARTFX.VBX

Хотя это можно было бы пообсуждать и здесь, но для ChartFX существует контекстно-зависимая подсказка. Киньте компонент на форму, выберите его и нажмите F1.

VBX в приложениях DELPHI: как распространять?

Чтобы использовать любые элементы управления VBX с компилированным Delphi EXE-файлом, вам необходимо распространить BIVBX11.DLL (расположен в каталоге \WINDOWS\SYSTEM – Borland при установке копирует его туда).

Расскажите, как использовать ChartFX?

   Nomadic советует:
   Лyчше на простеньком примере.
   unit Chart;
    .......................
    with ChartFX do begin
     Visible := false;
     { Устанавливаем режим ввода значений }
     { 1 – количество серий (в нашем случае 1), 3 – количество значений }
     OpenData[COD_VALUES] := MakeLong(1,3);
     { Hомер текущей серии }
     ThisSerie := 0;
     { Value[i] – значение с индексом i }
     { Legend[i] – комментарий к этому значению }
     Value[0] := a;
     Legend[0] := 'Значение переменной A';
     Value[1] := b;
     Legend[1] := 'Значение переменной B';
     Value[2] := c;
     Legend[2] := 'Значение переменной C';
     { Закрываем режим }
     CloseData[COD_VALUES] := 0;
     { Ширина поля с комментариями на экране (в пикселах) }
     LegendWidth := 150;
     Visible := true;
    end;
   end;
   end.

Как осуществить минимальный тест на корректность глобального идентификатора (GUID), и интерфейсов, унаследованных от IDispatch?

   Как осуществить минимальный тест на корректность глобального идентификатора (GUID), и интерфейсов, унаследованных от IDispatch (и, следовательно, поддерживающих методы автоматизации)?
   Nomadic советует:
   Вызовите CreateRemoteComObject, передав GUID интерфейса и имя компьютера, к которому Вы пытаетесь подключиться. Если функция вернет ошибку, то наличествует проблема сервера, иначе возможная проблема относится к клиенту.
   const MyGUID = '{444…111}'; //Whatever the guid is…
   var
    Unk: IUnknown;
    Disp: IDispatch;
   begin
    { Make sure this line works correctly }
    Unk := CreateRemoteComObject('server1', StringToGUID(MyGUID));
    { If it does, then cast it to a IDispatch }
    Disp := Unk as IDispatch;
   end;
   Если этот кусок кода работает, а проблема остается, то Вам требуется шаг за шагом пройти через код клиента и найти, где он дает трещину. Если не сможете этого обнаружить, Вам придется запустить сервер под отладчиком и установить связь с клиентом, чтобы Вы могли произвести отладку рядом со местом, дающем слабину.

DCOM

В чем разница между сокетами, 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;
   • требуется настройка клиентов;
   • поддержка обратных вызовов (методов);

DDE

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-программ. Воспользуйтесь синхронизацией, позволяющей понять при отладке правильность действий.

Управление 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.

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;

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

   Кстати, достаточно легко: следующий пример демонстрирует как можно научить общаться клиентскую программу с программой-сервером. Обе программы полностью созданы на Delphi. В итоге мы имеем 2 проекта, 3 формы и 3 модуля. Для работы с DDE-запросами данный пример использует методы DDE ML API.
   Сервер должен начать свою работу перед тем, как клиент будет загружен. Данный пример демонстрирует 3 способа взаимодействия между клиентом и сервером:
   1. Клиент может "пропихивать" (POKE) данные на сервер.
   2. Сервер может автоматически передавать данные клиенту, после чего клиент обновляет свой вид на основе результатов, полученных от сервера.
   3. Данные сервера изменяются, после чего клиент делает запрос серверу для получения новых данных и обновляет свой вид.
   Как работает программа.
   Ниже приведены 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 = 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 "заинтересованным" клиентам.
   Данный сервер предоставляет свои услуги (сервисы) для данных со следующими именами:
    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 = OK
    BtnBorderStyle = 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 = OK
     BtnClickGlyph.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 *** }

Как добавить группу в 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;

OLE

OLE-автоматизация в Delphi 1

Delphi 16 также может осуществлять автоматизацию OLE, как она может и многое другое. Другое дело, что у нее нет компонентов-инкапсуляторов, и нет традиционных объектов, делающих работу с OLE такой же легкой, как это происходит с другими вещами в Delphi. Delphi32 таки должен иметь какие-то характеристики для работы с OLE (я так надеюсь).
Так, если вы собираетесь делать какие-то действия с любым типом OLE-сервера, то для этого вам необходимо будет использовать все нудные и противные рутинки из набора Windows SDK. Но будет лучше, если всем этим будет заправлять специализированный компонент. Но этот вопрос уже не к Borland.

OLE сервер

   Следующий код компилируется без проблем. Он не так ясен и понятен, но он может вам помочь:
   unit Unit1;
   interface
   function OLEfunction(x, y, z: integer): integer; cdecl; export;

   implementation

   function OLEfunction(x, y, z: integer): integer;
   begin
   end;

   procedure buildOLEstructure;
   var F: pointer;
   begin
    F := @OLEfunction; { Компилируется без проблем … }
   end;

   end.
   Используйте метод, приведенный ниже. Вы должны объявить одну вызывающую функцию к каждой комбинации параметров, которые вы собираетесь передавать. Затем вы вызываете вызывающую функцию (сорри) и передаете ей как указатель функцию, которую вы хотите вызвать (еще раз сорри). Непонятно? Поясню на примере:
   library pcdecl;
   function olefunction(a1: pchar; a2: longint; x: integer): integer; cdecl; export;
   begin
   end;

   function callolefunction(func: pointer; a1: pchar; a2: longint; x: integer): integer; assembler;
   asm
    push x { помещаем параметры в обратном порядке }
    push word ptr a2 + 2 { если 32-битная величина передается в этих двух шагах, то начинаем с самой «высокой» (high) части }
    push word ptr a2
    push word ptr a1 + 2
    push word ptr a1
    call func
    add sp, 10 { восстанавливаем стек добавлением вытолкнутых байтов. Обратите внимание на то, что func не была вытолкнута }
   end;

   procedure buildolefunction;
   var
    f: pointer;
    reslt: integer;
   begin
    f := @olefunction;
    { --- }
    reslt := callolefunction(f, 'Здравствуй, мир', 1000000, 25);
    { --- }
   end;

   begin
    { --- }
   end.
   На моем компьютере это компилируется без проблем. Должно работать и у вас. Предупреждение. Обращение к методам должно быть немного другим, нежели к функциям.

Как я могу избавиться от 'зарегистрированного' имени сервера, если я не хочу использовать его далее?

   Nomadic советует:
   Запустите исполняемый файл сервера с ключом /UNREGSERVER:
   MYSERVER.EXE /UNREGSERVER
   Это обычный путь разрегистрации саморегистрирующегося сервера автоматизации OLE.

Миграция

Ошибки

DLL

Продукты третьих фирм

Разное

Ресурсы

Пример ресурсной таблицы строк

   Как мне создать ресурсную таблицу строк (Resource String Table), про которую упоминается в функции FmtLoadStr, но не сказано как создать эту таблицу, про это вообще нигде не сказано!
   Создайте файл в приведенном ниже формате и обзовите его, скажем (подойдите к этому творчески), strings.rc:
   STRINGTABLE LOADONCALL MOVEABLE DISCARDABLE
   {
    1, "UNPACK.INI"
    2, "AcrobatClass"
    3, "ACROEXCH.EXE"
    4, "^.PDF"
    5, "Extensions"
    6, "ACROEXCH.EXE"
    7, "PDF"
    8, "AABSETUP.EXE"
    9, "DelFiles-"
    10, "INI-"
    11, "UNPACK.INI"
    12, "ACROSRCH.DLL"
    13, "Regedit"
    14, "ACROREAD.EXE"
    15, "ACRO_LE.EXE"
   }
   Затем, с помощью компилятора ресурсов Borland (BRCC.EXE в вашем каталоге Delphi\Bin), скомпилируйте это в файл ресурсов:
   BRCC strings.rc
   Вы получите файл с именем strings.res. В вашем .DPR-файле после строки {$R *.RES} добавьте строку {$R STRINGS.RES}, после этого строковые ресурсы будут компилироваться с вашим exe-файлом.
   – Ralph Friedman

Компиляция ресурсов

   У меня имеется приблизительно 36 маленьких растровых изображений, которые я хочу сохранить в файле и затем прилинковать его к exe. Как мне поместить их в res-файл?
   Самый простой путь – создать файл с именем «BITMAPS.RC» и поместить в него список ваших .BMP-файлов:
   BMAP1 BITMAP BMAP1.BMP
   BMAP2 BITMAP BMAP2.BMP
   CLOCK BITMAP CLOCK.BMP
   DBLCK BITMAP DBLCK.BMP
   DELOK BITMAP DELOK.BMP
   LUPE BITMAP LUPE.BMP
   OK BITMAP OK.BMP
   TIMEEDIT BITMAP TIMEEDIT.BMP
   Затем загрузите Resource Workshop (RW) и выберите пункт меню File|Project Open. В выпадающем списке «File Type» (тип файла) выберите RC-Resource Script и откройте файл, который вы только что создали. После того, как RW загрузит ваш файл, выберите пункт меню File|Project save as. Выберите объект RES-Resource из выпадающего списка «File Type» (тип файла). В поле редактирования «New File name» задайте имя нового файла, скажем, BITMAPS.RES. Нажмите OK. Теперь у вас есть файл ресурса. В вашем модуле Delphi добавьте после строки {$R *.RES} строку {$R BITMAPS.RES}. После компиляции вы получите exe-файл с скомпилированными ресурсами. Для получения доступа к ресурсам во время выполнения программы нужно сделать следующее:
   myImage.Picture.Bitmap.Handle := LoadBitmap(HInstance, 'TIMEEDIT');
   В качестве предостережения: убедитесь в том, что имена (в самой левой колонке) изображений в .RC файле написаны в верхнем регистре, при вызове также необходимо писать их имена в верхнем регистре.
   -Ralph Friedman

Ошибка дублирования идентификатора ресурса

У вас есть исходный код VCL? Если да, то в этом случае ее можно всю перекомпилировать, добавив каталог к вашему библиотечному пути (Library path) в опциях среды (Environment Options | Library). Я думаю это нужно сделать, чтобы отделаться от этой ошибки. При другом способе необходимо вычислить вызывающую проблему директиву $R, временно удалить ее, и осуществить перекомпиляцию. Временно выключить директиву $R можно добавлением '.' перед $ (но это не единственный путь выключить ее).
Вероятно, вы сабкласситесь от VCL. Убедитесь в том, что идентификатор ресурса для вашей иконки уникальный. Просто загрузите ее в любой редактор ресурсов, и измените ее номер. После этого вы должны пересобрать вашу библиотеку.

Сохранение и выдёргивание ресурсов в DLL или EXE

   Иногда возникает необходимость вшить ресурсы в исполняемый файл Вашего приложения (например чтобы предотвратить их случайное удаление пользователем, либо, чтобы защитить их от изменений). Данный пример показывает как вшить любой файл как ресурс в EXE-шнике. Совместимость: Delphi 3.x (или выше)
   Далее рассмотрим, как создать файл ресурсов, содержащий корию какого-либо файла. После создания такого файла его можно легко прицепить к Вашему проекту директивой {$R}. Файл ресурсов, который мы будем создавать имеет следующий формат:
   + заголовок
   + заголовок для нашего RCDATA ресурса
   + собственно данные - RCDATA ресурс
   В данном примере будет показано, как сохранить в файле ресурсов только один файл, но думаю, что так же легко Вы сможете сохранить и несколько файлов.
   Заголовок ресурса выглядит следующим образом:
   TResHeader = record
    DataSize: DWORD;        // размер данных??????
    HeaderSize: DWORD;      // размер этой записи
    ResType: DWORD;         // нижнее слово = $FFFF => ordinal
    ResId: DWORD;           // нижнее слово = $FFFF => ordinal
    DataVersion: DWORD;     // *
    MemoryFlags: WORD;
    LanguageId: WORD;       // *
    Version: DWORD;         // *
    Characteristics: DWORD; // *
   end;
   Поля, помеченные звёздочкой, Мы не будем использовать. Приведённый код создаёт файл ресурсов и копирует его в данный файл:
   Листинг 1:
   procedure CreateResourceFile(
    DataFile, ResFile: string; // имена файлов
    ResID: Integer //    id ресурсов
   );
   var
    FS, RS: TFileStream;
    FileHeader, ResHeader: TResHeader;
    Padding: array[0..SizeOf(DWORD)-1] of Byte;
   begin
    { Open input file and create resource file }
    FS := TFileStream.Create( // для чтения данных из    файла
     DataFile, fmOpenRead);
    RS := TFileStream.Create( // для записи файла    ресурсов
     ResFile, fmCreate);
    { Создаём заголовок файла ресурсов - все    нули, за исключением HeaderSize, ResType и ResID }
    FillChar(FileHeader, SizeOf(FileHeader), #0);
    FileHeader.HeaderSize := SizeOf(FileHeader);
    FileHeader.ResId := $0000FFFF;
    FileHeader.ResType := $0000FFFF;
    { Создаём заголовок данных для RC_DATA файла
    Внимание: для создания более одного ресурса необходимо повторить следующий процесс,    используя каждый раз различные ID ресурсов }
    FillChar(ResHeader, SizeOf(ResHeader), #0);
    ResHeader.HeaderSize := SizeOf(ResHeader);
    // id ресурса - FFFF означает "не строка!"
    ResHeader.ResId := $0000FFFF or (ResId shl 16);
    // тип ресурса - RT_RCDATA (from Windows unit)
    ResHeader.ResType := $0000FFFF or (WORD(RT_RCDATA) shl 16);
    // размер данных - есть размер файла
    ResHeader.DataSize := FS.Size;
    // Устанавливаем необходимые флаги памяти
    ResHeader.MemoryFlags := $0030;
    { Записываем заголовки в файл ресурсов }
    RS.WriteBuffer(FileHeader, sizeof(FileHeader));
    RS.WriteBuffer(ResHeader, sizeof(ResHeader));
    { Копируем файл в ресурс }
    RS.CopyFrom(FS, FS.Size);
    { Pad data out to DWORD boundary - any oldrubbish will do!}
    if FS.Size mod SizeOf(DWORD) <> 0 then
     RS.WriteBuffer(Padding, SizeOf(DWORD) - FS.Size mod SizeOf(DWORD));
    { закрываем файлы }
    FS.Free;
    RS.Free;
   end;
   Данный код не совсем красив, и отсутствует обработка ошибок. Правильнее будет создать класс, включающий в себя данный пример. Извлечение ресурсов из EXE теперь рассмотрим пример, показывающий, как извлекать ресурсы из исполняемого модуля. Вся процедура заключается в создании потока ресурса, создании файлового потока и копировании из потока ресурса в поток файла.
   Листинг 2:
   procedure ExtractToFile(Instance:THandle; ResID: Integer; ResType, FileName:String);
   var
    ResStream: TResourceStream;
    FileStream: TFileStream;
   begin
    try
     ResStream := TResourceStream.CreateFromID(Instance, ResID, pChar(ResType));
     try
      //if FileExists(FileName) then
      //DeleteFile(pChar(FileName));
      FileStream := TFileStream.Create(FileName, fmCreate);
      try
       FileStream.CopyFrom(ResStream, 0);
      finally
       FileStream.Free;
      end;
     finally
      ResStream.Free;
     end;
    excepton E:Exception do
     begin
      DeleteFile(FileName);
      raise;
     end;
    end;
   end;
   Всё, что требуется, это получить Instance exe-шника или dll (у Вашего приложения это Application.Instance или Application.Handle, для dll Вам прийдётся получить его самостоятельно :) ResID тот же самый ID , который был присвоен ресурсу ResType WAVEFILE, BITMAP, CURSOR, CUSTOM – это типы ресурсов, с которыми возможно работать, но у меня получилось успешно проделать процедуру только с CUSTOM FileName – это имя файла, который мы хотим создать из ресурса
   Пока ..
   Igor Nikolaev aKa The Sprite
   [spritesoft@bos.ru]

IDE

Копирование проекта в новый каталог

   …я скопировал все файлы (и программу, и базу данных) демонстрационного приложения в новый каталог, чтобы поэкспериментировать с программой, не трогая оригинал…
   Самый простой путь сделать это:
   1. «Save Project As» (сохранить проект как) в ваш новый каталог.
   2. Для каждого PAS-файла проекта сделайте операцию «Save As» (сохранить как)
   3. Запустите View/ProjectManager для проверки отсутствия ссылок на старый каталог
   Если вы уже скопировали PAS-файлы в новый каталог, то в качестве альтернативы к п.(2) могу предложить воспользоваться кнопками плюс/минус в Менеджере Проекта (Project Manager), это поможет вам удалить старое и добавить файлы из нового каталога.
   – Mike Orriss

Использование Tools Interface

   …я все еще ищу *крутой* способ отрисовки содержимого окна редактирования IDE, и уже добрался до списка дескрипторов окон. Я так понял, что для этого нужно использовать инструментальный интерфейс (Tools Interface), только c помощью него, да? Ну и как этим чудом воспользоваться?
   Приведенный ниже код может использоваться для включения заголовка исходного кода, представляющего собой шапку с информацией об авторских правах, авторе, версии и пр. при добавлении нового модуля или формы к вашему проекту. TIAddInNotifier - класс, реализованный в ToolIntf и позволяющий "захватывать" такие события, как открытие файлов, их закрытие, открытие и закрытие проекта и др. Я перекрыл процедуру FileNotification для захвата событий AddedToProject и RemovedFromProject. В обработчике события AddedToProject вы можете получить доступ к новому модулю проекта, особенно это касается процедуры InsertHeader. Я создал наследника класса TIEditorInterface, расположенного в файле EditIntf.pas, и создал собственную процедуру InsertHeader.
   VCSNotifier создается в другом модуле и здесь не показан. Приведенный ниже код является частью моей программы, осуществляющей контроль версий dll. При создании код "живет" до тех пор, пока работает Delphi. При получении кода AddedToProject, я проверяю наличие файла (должен быть новым), и что он является .pas-файлом. Затем я создаю VCSEditorInterface, мой унаследованный интерфейс, и использую мою процедуру InsertHeader.
   В самой процедуре InsertHeader я создаю экземпляр TIEditReader для чтения нового модуля и TIEditWriter для его изменения.
   unit VCSNtfy;

   interface

   uses SysUtils, Dialogs, Controls, ToolIntf, EditIntf;

   type
   TIVCSNotifier = class(TIAddInNotifier)
    public
     procedure FileNotification(NotifyCode: TFileNotification; const FileName: string; var Cancel: Boolean); override;
    end;

    TIVCSEditorInterface = class(TIEditorInterface)
    public
     procedure InsertHeader;
    end;

   var
    VCSNotifier : TIVCSNotifier;
    VCSModuleInterface : TIModuleInterface;
    VCSEditorInterface : TIVCSEditorInterface;

   implementation

   uses FITIntf, FITStr, Classes;

   { *************************   Начало VCSNotifier **************************** }

   procedure TIVCSNotifier.FileNotification(NotifyCode: TFileNotification; const FileName: string; var Cancel : Boolean);
   var TmpFileName : string;
   begin
    case NotifyCode of
    fnRemovedFromProject:
     VCSProject.Remove(LowerCase(ExtractFileName(FileName)));
    fnAddedToProject:
     begin
      if (not FileExists(FileName)) and (ExtractFileExt(FileName) = '.pas') then begin
       { новый файл с исходным кодом }
       VCSModuleInterface := ToolServices.GetModuleInterface(FileName);
       if VCSModuleInterface <> nil then begin
        VCSEditorInterface := TIVCSEditorInterface(VCSModuleInterface.GetEditorInterface);
        VCSEditorInterface.InsertHeader;
        VCSEditorInterface.Free;
       end;
       VCSModuleInterface.Free;
      end;
      TmpFileName := LowerCase(ExtractFileName(FileName));
      if VCSProject.RecycleExists(TmpFileName) then begin
       if MessageDlg('Вы хотите извлечь текущие ' + ' записи из таблицы Recycle' + #13 + #10 + '           ' + VCSProject.ProjectName + '/' + TmpFileName + '?', mtConfirmation,[mbYes,mbNo], 0 ) = mrYes then begin
         VCSProject.Recycle(TmpFileName);
        end;
       end;
     end;
    end;
   end;

   { *************************    Конец TIVCSNotifier   *************************** }

   { *********************   Начало TIVCSEditorInterface ************************ }
   procedure TIVCSEditorInterface.InsertHeader;
   var
    Module, TmpFileName, UnitName, InsertText, Tmp : string;
    Reader : TIEditReader;
    Writer : TIEditWriter;
    APos : Integer;
    F : TextFile;
   begin
    TmpFileName := ExtractFileName(FileName);
    UnitName := SwapStr(TmpFileName, '.pas', '');
    SetLength(Module, 255);
    Reader := CreateReader;
    try
     Reader.GetText(0, PChar(Module), Length(Module));
    finally
     Reader.Free;
    end;
    APos := Pos('unit ' + UnitName, Module);
    if APos > 0 then begin
     try
      InsertText := '';
      AssignFile(F, VCSConfig.HeaderFileLocation);
      Reset(F);
      while not EOF(F) do begin
       Readln(F, Tmp);
       InsertText := InsertText + #13 + #10 + Tmp;
      end;
      CloseFile(F);
      InsertText := InsertText + #13 + #10;
      Writer := CreateWriter;
      try
       Writer.CopyTo(APos - 1);
       Writer.Insert(PChar(InsertText));
      finally
       Writer.Free;
      end;
     except On E : EStreamError do
      MessageDlg('Не могу создать шапку', mtInformation, [mbOK], 0);
     end;
    end;
   end;
   { *********************   Конец TIVCSModuleInterface ************************** }
   end.
   – Jim Poe

Зависание Delphi 4(5)

   Сергей Сахаров советует:
   Delphi 4(5) виснут при запуске. Видеокарта S3 Virge.
   Решение:
   Добавьте в реестр строку:
   [HKEY_CURRENT_CONFIG\Display\Settings]
   "BusThrottle"="on"
   Если не помогает, то попробуйте добавить в system.ini:
   [Display] "BusThrottle"="On"
   Эта проблема устранена в Delphi 4sp3.

Ошибка 1157 cmplib32.dll

   Cannot open c:\delphi 2.0\bin\cmplib32.dll Error code 1157 (Не могу открыть c:\delphi 2.0\bin\cmplib32.dll, код ошибки 1157).
   Что за ошибка такая с кодом 1157? Я пробовал удалить все DCU-файлы и переустановить PAS– и DFM-файлы, но ошибка не исчезла. Как это исправить?
   Убедитесь в том, что все требуемые DLL находятся в search-пути.
   – Mike Orriss

2% ресурсов, в режиме редактирования

Если у вас открыты все формы (показаны или минимизированы), а в редакторе кода открыты все модули, ресурсы очень быстро исчерпываются. Попробуйте закрыть все формы и модули, и открыть только те, которыми вы будете пользоваться. В противном случае при компиляции вы можете завесить Delphi и саму машину.

Активизация и использование в IDE окна CPU

   Предупреждение: Окно CPU еще до конца не оттестировано и может иногда приводить к ошибкам. Если у вас есть проблемы с отладчиком, или при запуске вашей программы вы не можете им воспользоваться, окно CPU может помочь решить ваши проблемы. Обычно его не требуется включать, если только у вас не «особый случай».
   В Delphi 2 эта характеристика встроена, но по умолчанию выключена, называется это окно CPU window, или DisassemblyView. Она легка в использовании, может быть полезной в отладке и сравнении кода при его оптимизации.
   Для активизации этой характеристики, запустите REGEDIT и отредактируйте регистры описанным ниже образом. Найдите ключ HKEY_CURRENT_USER\Software\Borland\Delphi\2.0\Debugging. Создайте по этому пути строковый ключ с именем «ENABLECPU». Значение нового ключа должно быть строкой «1». Это все. Теперь в Delphi IDE появился новый пункт меню View|CPUWindow. При его активизации выводится новое окно.
   Теперь, чтобы понять какое мощное средство оказалось в ваших руках, сделаем сравнительный анализ генерируемого кода для двух примеров, имеющих одинаковую функциональность, но достигающую ее разными путями.
   Создайте 2 одинаковых обработчика события. В каждом обработчике события разместите приведенный ниже код. Установите точку прерывания на первой строчке каждого обработчика. Запустите приложение и активизируйте события. Сравните ассемблерный код обоих методов. Один короче? В этом случае он будет исполняться быстрее.
   Достойными для такого рода анализа могут быть участки кода, многократно выполняемые в процессе работы программы, или критические ко времени выполнения.
   Хорошим примером, где различный код выполняет одну и ту же работу, но делает это с разной скоростью, является использование конструкции «with object do». Исходный код с многократным использованием конструкции «with object do» будет длиннее, но ассемблерный код короче. Вспомните, сколько раз вы устанавливали свойства для динамически создаваемых объектов? Код:
   with TObject.create do begin
    property1 := ;
    property2 := ;
    property3 := ;
   end;
   будет выполняться быстрее, чем
   MyObj := TObject.create;
   MyObj.Property1 := ;
   MyObj.Property2 := ;
   MyObj.Property3 := ;

Описание типов файлов для Delphi

   Формат .CAB-файлов
   Это формат файлов, который Delphi предлагает теперь своим пользователям для размещения в Интернете. Cabinet-формат является эффективным средством для упаковки нескольких файлов. Cabinet-формат имеет две ключевых характеристики: в отдельном кабинете (.cab-файл) могут храниться несколько файлов, и сжатие данных выполняется в зависимости от типа файлов, что значительно увеличивает коэффициент сжатия. Создание Cabinet-файла зависит также от количества упаковываемых файлов и ожидаемого к ним типа доступа (последовательный, произвольный, одновременный ко всем файлам или доступ к нескольким файлам в одно и тоже время). Delphi не пользуется преимуществами сжатия файлов в зависимости от их типа.
   Формат .LIC-файлов
   В действительности, как такового, формата .lic-файла не существует. Обычно это такие же текстовые файлы, содержащие одну или две ключевых строки.
   Формат .INF-файлов
   Все inf-файлы состоят из секций и пунктов. Каждая именованная секция содержит соответствующие пункты. Все inf-файлы начинаются с заголовочной секции. После заголовка включенные секции могут располагаться в любом порядке. Каждый заголовок представляет собой строку с [Именем Заголовка]. Далее следуют пункты: ItemA = ItemDetail. Для получения дополнительной информации обратитесь к документу «Device Information File Reference».
   Формат .dpr-файлов
   .dpr-файл является центральным файлом delphi-проекта. Для программы он является первой точкой входа. dpr содержит ссылки на другие файлы проекта и связывает формы с соответствующими модулями. Данный файл нужно редактировать с предельной осторожностью, так как неумелые действия могут привести к тому, что вы не сможете загрузить ваш проект. Этот файл является критическим при загрузке и перемещении (копировании) проекта.
   Формат .pas-файлов
   Это стандартный текстовый файл, который можно редактировать в текстовом редакторе. Данный файл нужно редактировать с некоторой долей осторожности, поскольку это может закончиться потерей некоторых преимуществ двух других инструментов. К примеру, добавление кода для кнопки с декларацией типа никак не отразится на соответствующем .dfm-файле формы. Все pas-файлы являются критическими при пересборке проекта.
   Формат .dfm-файлов
   Данный файл содержит описание объектов, расположенных на форме. Содержимое файла можно увидеть в виде текста, вызвав правой кнопкой мыши контекстное меню и выбрав пункт «view as text», или же с помощью конвертора convert.exe (расположенного в каталоге bin), также позволяющего перевести файл в текстовый вид и обратно. Данный файл нужно редактировать очень осторожно, поскольку это может закончиться тем, что IDE не сможет загрузить форму. Этот файл является критическим при перемещении и пересборке проекта.
   Формат .DOF-файлов
   Данный текстовый файл содержит текущие установки для опций проекта, как например, настройки компилятора и компоновщика, каталоги, условные директивы и параметры командной строки. Данные установки могут быть изменены пользователем путем изменений настроек проекта.
   Формат .DSK-файлов
   Данный текстовый файл хранит информацию относительно состояния вашего проекта, как например, открытое окно и его координаты. Подобно .DOF-файлу, данный файл создается на основе текущей обстановки проекта.
   Формат .DPK-файлов
   Данный файл содержит исходный код пакета (аналогично .DPR-файлу стандартного проекта Delphi). Подобно файлу .DPR, .DPK-файл также является простым текстовым файлом, который можно редактировать (см. предупреждение выше) в стандартном редакторе. Одной из причин, по которой вы можете это сделать – использование компилятора командной строки.
   Формат .DCP-файлов
   Данный бинарный image-файл состоит фактически из реально скомпилированного пакета. Информация о символах и дополнительных заголовках, требуемых IDE, полностью содержится в .DCP-файле. Чтобы собрать (build) проект, IDE должен иметь доступ к этому файлу.
   Формат .DPL-файла
   В действительности это выполняемый runtime-пакет. Данный файл является Windows DLL с интегрированными Delphi-специфическими характеристиками. Данный файл необходим в случае развертывания приложения, использующего пакеты.
   Формат .DCI-файла
   Данный файл содержит как стандартные, так и определенные пользователем шаблоны кода, используемых в IDE. Файл может редактироваться стандартным текстовым редактором, или в самой IDE. Как и любой текстовый файл данных, используемый Delphi, редактировать его самостоятельно не рекомендуется.
   Формат .DCT-файла
   Это «частный» бинарный файл, содержащий информацию об определенных пользователями шаблонах компонентов. Данный файл не может быть отредактирован никакими способами через IDE. Поскольку данный файл является «личным» файлом IDE, то совместимость с последующими версиями Delphi не гарантируется.
   Формат .TLB-файла
   .TLB-файл является «частным» двоичным файлом библиотеки типов. Обеспечивает информацией для идентификации типов объектов и интерфейсов, доступных в ActiveX сервере. Подобно модулю или заголовочному файлу, .TLB служит в качестве хранилища для необходимой символьной информации приложения. Поскольку данный файл является «личным», то совместимость с последующими версиями Delphi не гарантируется.
   Формат .DRO-файла
   Данный текстовый файл содержит информацию об объектном хранилище. Каждый пункт данного файла содержит специфическую информацию о каждом доступном элементе в хранилище объектов. Хотя этот файл и является простым текстовым файлом, мы настоятельно не рекомендуем править его вручную. Хранилище может редактироваться только с помощью меню Tools|Repository в самом IDE.
   Формат .RES-файла
   Это стандартный двоичный windows-формата файл ресурсов, включающий в себя информацию о приложении. По умолчанию, Delphi создает новый .RES-файл при каждой компиляции проекта в исполняемое приложение.
   Формат .DB-файла
   Файлы с таким расширением – стандартные файлы Paradox.
   Формат .DBF-файла
   Файлы с таким расширением – стандартные dBASE-файлы.
   Фомат .GDB-файла
   Файлы с таким расширением – стандартные Interbase-файлы.
   Формат .DMT-файла
   Этот «частный» бинарный файл содержит встроенные и определенные пользователем шаблоны меню. Данный файл не может быть отредактирован никакими способами через IDE. Поскольку данный файл является «личным», то совместимость с последующими версиями Delphi не гарантируется.
   Формат .DBI-файла
   Данный текстовый файл содержит информацию, необходимую для инициализации Database Explorer. Данный файл не может быть отредактирован никакими способами через Database Explorer.
   Формат .DEM-файла
   Данный текстовый файл содержит некоторые стандартные, привязанные к стране, форматы компонента TMaskEdit. Как и любой текстовый файл данных, используемый Delphi, редактировать его самостоятельно не рекомендуется.
   Формат .OCX-файла
   .OCX-файл является специализированной DLL, которая содержит все или несколько функций, связанных с элементом управления ActiveX. Файл OCX задумывался как «обертка», которая содержала бы сам объект, и средства для связи с другими объектами и серверами.

Определение работы Delphi III

   function DelphiLoaded : boolean;
   { Определение работающей Delphi. Во всяком случае, дает правильный результат если Delphi минимизирован, или имеет открытый проект. Также, правильный результат получается, если вызывающее приложение автономно, или запущено из-под IDE. Код написан на основе идей Wade Tatman wtatman@onramp.net - Mike O'Hanlon, The Pascal Factory, найденных в Delphi-Talk List. }

    function WindowExists(ClassName, WindowName: string): boolean;
    { Проверяем наличие определенного окна Window, используя для этого паскалевские строки вместо PChars. }
    var
     PClassName, PWindowName: PChar;
     AClassName, AWindowName: array[0..63] of char;
    begin
     if ClassName = '' then PClassName := nil
     else PClassName := StrPCopy(@AClassName[0], ClassName);
     if WindowName = '' then PWindowName := nil
     else PWindowName := StrPCopy(@AWindowName[0], WindowName);
     if FindWindow(PClassName, PWindowName) <> 0 then WindowExists := true
     else WindowExists := false;
    end; {WindowExists}

   begin {DelphiLoaded}
    DelphiLoaded := false;
    if WindowExists('TPropertyInspector', 'Object Inspector') then
     if WindowExists('TMenuBuilder', 'Menu Designer') then
     if WindowExists('TApplication', 'Delphi') then
       if WindowExists('TAlignPalette', 'Align') then
       if WindowExists('TAppBuilder', '') then DelphiLoaded := true;
   end; {DelphiLoaded}
   Следующая программа возвращает TRUE при запуске в Delphi IDE (ПРИМЕЧАНИЕ: это _не_ сработает, если подпрограмма в DLL).
   function InIDE: Boolean;
   begin
    Result := Bool(PrefixSeg) and Bool(PWordArray(MemL[DSeg:36])^[8]));
   end; { InIDE }

Работа с IDE из программы

   Вот три подпрограммы, работающие у меня в связке D1 и Win 3.1x:
   function LaunchedFromDelphiIDE: Boolean;
   {----------------------------------------------------------------}
   { Осуществляем проверку запущенности приложения из-под Delphi    }
   { IDE. Идея взята из сообщения в Delphi-Talk от Ed Salgado       }
   { из Eminent Domain Software.                                    }
   {----------------------------------------------------------------}
   begin
    LaunchedFromDelphiIDE := Bool(PrefixSeg) {т.е. не DLL}
     and Bool(PWordArray(MemL[DSeg:36])^[8]);
   end; {LaunchedFromDelphiIDE}

   function DelphiLoaded: Boolean;
   {----------------------------------------------------------------}
   { Проверяем, загружена ли Delphi. Дает правильные результаты     }
   { - если вызывающее приложение запущено отдельно, или из-под IDE}
   { - если Delphi имеет открытый проект                           }
   { - если Delphi минимизирована.                                 }
   { Автор идеи Wade Tatman (wtatman@onramp.net).                   }
   {----------------------------------------------------------------}
   begin
   DelphiLoaded := false;
    if WindowExists('TPropertyInspector', 'Object Inspector') then
     if WindowExists('TMenuBuilder', 'Menu Designer') then
      if WindowExists('TAppBuilder', '(AnyName)') then
      if WindowExists('TApplication', 'Delphi') then
        if WindowExists('TAlignPalette', 'Align') then
         DelphiLoaded := true;
   end; {DelphiLoaded}

   function DelphiInstalled: Boolean;
   {----------------------------------------------------------------}
   { Проверяем наличие Delphi.ini, ищем в нем путь к Библиотеке     }
   { Компонентов, после чего проверяем ее наличие по этому пути.    }
   {----------------------------------------------------------------}
   var IniFile: string;
   begin
    DelphiInstalled := false;
    IniFile := WindowsDirectory + '\Delphi.ini';
    if FileExists(IniFile) then
     if FileExists(GetIni(IniFile, 'Library', 'ComponentLibrary')) then
     DelphiInstalled := true;
   end; {DelphiInstalled}
   Я уверен, что один из приведенных выше методов вам поможет. Последние две подпрограммы используют некоторые другие инкапсуляции Windows API и классов Delphi, и они определены следующим образом:
   function WindowExists (WindowClass, WindowName: string): Boolean;
   {----------------------------------------------------------------}
   { С помощью паскалевских строк проверяем наличие определенного   }
   { окна. Для поиска только имени окна (WindowName), используем    }
   { WindowClass '(AnyClass)'; для поиска только класса окна        }
   { (WindowClass), используем WindowName '(AnyName)'.              }
   {----------------------------------------------------------------}
   var
    PWindowClass, PWindowName: PChar;
    AWindowClass, AWindowName: array[0..63] of Char;
   begin
    if WindowClass = '(AnyClass)' then PWindowClass := nil
    else PWindowClass := StrPCopy(PChar(@AWindowClass), WindowClass);
    if WindowName = '(AnyName)' then PWindowName := nil
    else PWindowName := StrPCopy(PChar(@AWindowName), WindowName);
    if FindWindow(PWindowClass, PWindowName) <> 0 then WindowExists := true
    else WindowExists := false;
   end; {WindowExists}

   function WindowsDirectory: string;
   {----------------------------------------------------------------}
   { Возвращаем путь к каталогу Windows (без обратной косой черты) }
   {----------------------------------------------------------------}
   const BufferSize = 144;
   var ABuffer: array[0..BufferSize] of Char;
   begin
    if GetWindowsDirectory(PChar(@ABuffer), BufferSize) = 0 then WindowsDirectory := ''
    else WindowsDirectory := StrPas(PChar(@ABuffer));
   end; {WindowsDirectory}

   function GetIni(const IniFile, Section, Entry: string): string;
   {----------------------------------------------------------------}
   { Получаем инициализационную 'profile' строку из определенного   }
   { пункта (Entry) определенной секции [Section] определенного     }
   { INI-файла (дополняем '.ini', если отсутствует). Возвращаем     }
   { нулевую строку, если IniFile, Section или Entry не найден.     }
   {----------------------------------------------------------------}
   var
    IniFileVar: string;
    IniFileObj: TIniFile;
   begin
    if StrEndsWith(IniFile, '.ini') then IniFileVar := IniFile
    else IniFileVar := IniFile + '.ini';
    IniFileObj := TIniFile.Create(IniFileVar);
    GetIni := IniFileObj.ReadString(Section, Entry, '');
    IniFileObj.Free;
   end; {GetIni}

Как исправить проблемы с вызовом помощи при одновременно стоящих Delphi 1 и Delphi 2?

   Nomadic отвечает:
   A: (AP): Решаются так…
   В regedit убейте из секции HKLM\SOFTWARE\Microsoft\Windows\Help все, что равно «…\help».
   Изменив соответствующие пути, импортируйте в реестр следующий файлик:
   REGEDIT4
   [HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\AppPaths\delphi32.exe]
   @="C:\\DELPHI2\\BIN\\delphi32.exe
   "Path"="C:\\DELPHI2\\HELP"

Защита

Борьба с SoftIce

   Igor Nikolaev aKa The Sprite пишет:
   Hаткнулся в инете на некий модуль StopIce, и любопытство сделало своё дело. Как долго я смеялся… :))))
   Для тех, кто не в курсе: посмотрите export NmSymIsSoftIceLoaded (или что-то подобное) в nmtrans.dll.
   Вот полный юнит против SOFTICE, при обнаружении отладчика перезагружает компьютер:
   unit StopIce;

   interface

   implementation

   uses Windows;

   Function IsSoftIce95Loaded: boolean;
   Var hFile: Thandle;
   Begin
    result := false;
    hFile := CreateFileA('\\.\SICE', GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
    if (hFile <> INVALID_HANDLE_VALUE) then begin
     CloseHandle(hFile);
     result := TRUE;
    end;
   End;

   Function IsSoftIceNTLoaded: boolean;
   Var hFile: Thandle;
   Begin
    result := false;
    hFile := CreateFileA('\\.\NTICE', GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
    if (hFile <> INVALID_HANDLE_VALUE) then begin
     CloseHandle(hFile);
     result := TRUE;
    end;
   End;

   function WinExit(flags: integer): boolean;
    function SetPrivilege(privilegeName: string; enable: boolean): boolean;
    var
     tpPrev, tp: TTokenPrivileges;
     token: THandle;
     dwRetLen: DWord;
    begin
     result := False;
     OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, token);
     tp.PrivilegeCount := 1;
     if LookupPrivilegeValue(nil, pchar(privilegeName), tp.Privileges[0].LUID) then begin
      if enable then tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
      else tp.Privileges[0].Attributes := 0;
      dwRetLen := 0;
      result := AdjustTokenPrivileges(token, False, tp, SizeOf(tpPrev), tpPrev, dwRetLen);
     end;
     CloseHandle(token);
    end;

   begin
    if SetPrivilege('SeShutdownPrivilege', true) then begin
     ExitWindowsEx(flags, 0);
     SetPrivilege('SeShutdownPrivilege', False)
    end;
   end;

   initialization
    if IsSoftIce95Loaded or IsSoftIceNTLoaded then begin
     WinExit(EWX_SHUTDOWN or EWX_FORCE);
     Halt;
    end;
   end.

Файлы помощи

Не могу открыть файл помощи…

   Я создал файл помощи для моего приложения и назвал его KidsHelp.hlp
   При запуске в системе, в которой файл был создан, программа находит его без проблем. Данная машина имеет конфигурацию Pentium 120 с установленной Windows 95. При запуске программы на второй системе, с Windows 3.1, при выборе пункта меню «Using Help» программа не может открыть файл. Я создал файл помощи с помощью программы «HC31.exe». В самом проекте я не указывал полный путь к файлу помощи, я указал только его имя.
   1. Для решения этой проблемы я делаю две вещи:
   2. Всегда располагаю файл помощи в том же каталоге, что и приложение
   Назначаю файл помощи в обработчике события главной формы OnCreate таким образом:
   Application.HelpFile := ChangeFileExt(Application.ExeName, '.HLP');
   – Neil Rubenking

Как сделать так, чтобы в приложении вызывался хелп с окошечком для поиска раздела?

   Nomadic советует:
   1.
   unit {$IFDEF WIN32} Windows {$ELSE} WinProcs {$ENDIF};
   function WinHelp(Wnd: HWnd; HelpFile: PChar; Command: Word; Data: LongInt): Bool;
   Здесь цитата из WinAPI Help:

   2. То же самое, что делает макрос «Search()» для WinHelp-а.
   procedure TForm1.HelpSearchFor;
   var S: String;
   begin
    S := '';
    Application.HelpFile := 'C:\MYAPPPATH\MYHELP.HLP';
    Application.HelpCommand(HELP_PARTIALKEY, LongInt(@S));
   end;

Как заставить Help-файлы нормально отображать русский текст под Windows 3.x?

   Nomadic советует:
   Удалось вылечить дописыванием в файл проекта в графу Options строчки FORCEFONT=Arial Cyr, причем HC31 ругается что нет такого шрифта, но зато хелп потом нормально показывается практически под любой руссифицированной виндой.
   Проверял с [Win31+CyrWin], [Win311Rus], [Win95PE], [Win95Rus].
   На NT не проверял.
   Причем шрифты в тексте ноомально переключаются и будут не только Arial.
   Вот кусок который надо вставить в HPJ файл перед компиляцией –
   [OPTIONS]
   FORCEFONT=Arial Cyr

Графика

256-цветное изображение из res-файла

   Вот функция, правильно читающая 256-цветные изображения из файла ресурсов.
   function LoadBitmap256(hInstance: HWND; lpBitmapName: PChar): HBITMAP;
   var
    hPal, hRes, hResInfo: THandle;
    pBitmap: PBitmapInfo;
    nColorData: Integer;
    pPalette: PLogPalette;
    X: Integer;hPalette: THandle;
   begin
    hResInfo:= FindResource(hInstance, lpBitmapName, RT_BITMAP);
    hRes:= LoadResource(hInstance, hResInfo);
    pBitmap:= Lockresource(hRes);
    nColorData:= pBitmap^.bmiHeader.biClrUsed;
    hPal := GlobalAlloc(GMEM_MOVEABLE, (16 * nColorData));
    {hPal := GlobalAlloc(GMEM_MOVEABLE, (SizeOf(LOGPALETTE) + (nColorData * SizeOf(PALETTEENTRY)));}
    pPalette := GlobalLock(hPal);
    pPalette^.palVersion := $300;
    pPalette^.palNumEntries := nColorData;
    for x := 0 to nColorData do begin
     pPalette^.palPalentry[X].peRed   := pBitmap^.bmiColors[X].rgbRed;
     pPalette^.palPalentry[X].peGreen := pBitmap^.bmiColors[X].rgbGreen;
     pPalette^.palPalentry[X].peBlue := pBitmap^.bmiColors[X].rgbBlue;
    end;
    hPalette := CreatePalette(pPalette^);
    GlobalUnlock(hRes);
    GlobalUnlock(hPal);
    GlobalFree(hPal);
   end;
   end.
   – Mark Lussier

Как записать содержимое окна OpenGL в 'bmp' файл?

   Nomadic советует:
   Вот что попробовал – вроде получилось:
   bt := TBitmap.Create;
   bt.Width := gr.Width;
   bt.Height := gr.Height;
   bt.Canvas.CopyRect(ClientRect, gr.Canvas, gr.ClientRect);
   bt.SaveToFile('e:\bt.bmp');
   bt.Free;
   (gr – объект, в канве которого я рисую с помощью OpenGL)

Как создать disable'ный битмап из обычного (emboss etc)?

   Nomadic советует:
   CreateMappedBitmap() :-)
   Один из параметров указатель на COLORMAP, в нем для 16 основных цветов делаешь перекодировку, цвета подберешь сам из принципа:
   • все самые яркие → в GetSysColor(COLOR_3DLIGHT);
   • самые темные → GetSysColor(COLOR_3DSHADOW);
   • нейтральные, которые бyдyт прозрачными → GetSysColor(COLOR_3DFACE);
   Так на самом деле вот как делается данная задача:
   procedure Tform1.aaa(bmpFrom, bmpTo:Tbitmap);
   var
    TmpImage,Monobmp:TBitmap;
    IRect:TRect;
   begin
    MonoBmp := TBitmap.Create;
    TmpImage:=Tbitmap.Create;
    TmpImage.Width := bmpFrom.Width;
    TmpImage.Height := bmpFrom.Height;
    IRect := Rect(0, 0, bmpFrom.Width, bmpFrom.Height);
    TmpImage.Canvas.Brush.Color := clBtnFace;
    try
     with MonoBmp do begin
      Assign(bmpFrom);
      Canvas.Brush.Color := clBlack;
      if Monochrome then begin
       Canvas.Font.Color := clWhite;
       Monochrome := False;
       Canvas.Brush.Color := clWhite;
      end;
      Monochrome := True;
     end;
     with TmpImage.Canvas do begin
      Brush.Color := clBtnFace;
      FillRect(IRect);
      Brush.Color := clBlack;
      Font.Color := clWhite;
      CopyMode := MergePaint;
      Draw(IRect.Left + 1, IRect.Top + 1, MonoBmp);
      CopyMode := SrcAnd;
      Draw(IRect.Left, IRect.Top, MonoBmp);
      Brush.Color := clBtnShadow;
      Font.Color := clBlack;
      CopyMode := SrcPaint;
      Draw(IRect.Left, IRect.Top, MonoBmp);
      CopyMode := SrcCopy;
      bmpTo.assign(TmpImage);
      TmpImage.free;
     end;
    finally
     MonoBmp.Free;
    end;
   end;

   procedure TForm1.Button1Click(Sender: TObject);
   begin
    aaa(image1.picture.bitmap,image2.picture.bitmap);
    Image2.invalidate;
   end;
   Писал это не я. Это написал сам Борланд (некузявно было бы взглянуть на класс TButtonGlyph. Как раз из него я это и выдернул). Ну а если уже совсем хорошо разобраться, то можно заметить функцию ImageList_DrawEx, в которой можно на 25 и 50 процентов уменьшить яркость (но визуально это очень плохо воспринимается). Соответственно параметры ILD_BLEND25, ILD_BLEND50, ILD_BLEND-A-MED. Естественно, что последний абзац работает только с тройкой.
   Denis Tanayeff
   Это кусочек из рабочей проги на Си, Вроде все лишнее я убрал.
   #define CO_GRAY 0x00C0C0C0L
   hMemDC = CreateCompatibleDC(hDC);
    hOldBitmap = SelectObject(hMemDC, hBits);
   // hBits это собственно картинка, которую надо «засерить»
   GetObject(hBits, sizeof(Bitmap), (LPSTR) &Bitmap);
   if (GetState(BS_DISABLED)) // Blt disabled
   {
    hOldBrush = SelectObject(hDC, CreateSolidBrush(CO_GRAY));//CO_GRAY
    PatBlt(hDC, BD_BORDERWIDTH, BD_BORDERWIDTH, Bitmap.bmWidth, Bitmap.bmHeight, PATCOPY);
    DeleteObject(SelectObject(hDC, hOldBrush));
    lbLogBrush.lbStyle = BS_PATTERN;
    lbLogBrush.lbHatch =(int)LoadBitmap(hInsts, MAKEINTRESOURCE(BT_DISABLEBITS));
    hOldBrush = SelectObject(hDC, CreateBrushIndirect(&lbLogBrush));
    BitBlt(hDC, BD_BORDERWIDTH, BD_BORDERWIDTH, Bitmap.bmWidth, Bitmap.bmHeight, hMemDC, 0, 0, 0x00A803A9UL); // DPSoa
    DeleteObject(SelectObject(hDC, hOldBrush));
    DeleteObject((HGDIOBJ)lbLogBrush.lbHatch);
   }

Компонент для работы с FLIC-анимацией

   Новостная группа: comp.lang.pascal.delphi.components
   Тема: Компонент для работы с FLIC-анимацией: отправной пункт.
   От: Paul Kuczora <paul@kuczora.demon.co.uk>
   Дата: Чет, 03 Авг 95 16:51:19 GMT
   В качество ответа на целый круг вопросов, я включил в свой ответ два файла:
   aaplay1.inc — include-файл с интерфейсом для библиотеки aaplay.dll
   aaplay1.pas — сырой скелет компонента для проигрывания FLIC-анимации
   Я разработал это глядя на другой компонент (это был полнофункциональный плейер, работающий как форма), и вынужден был сохранить некоторые вещи неприкосновенными (попробуй тут сделай иначе :-)
   Для работы вам понадобится библиотека aaplay.dll от Autodesk, которую вы можете найти на множестве мест (например, я так предполагаю, на Encarta CD). Для полного счастья вы можете обратиться к файлу помощи для Animation Player for Windows, который, не удивляйтесь, содержит справку для этой DLL — на первой странице найдите в ее самой нижней части указание на эту библиотеку, и перед вами предстанет полная справка по вызовам этой самой DLL.
   Надеюсь что помог вам…
   ВНИМАНИЕ! Это мой первый код, написанный для Windows (спасибо Delphi), поэтому он рекомендуется только для ознакомления.
   { ============================================================================ }
   { aaplay1.inc }
   { (c) P W Kuczora }
   { 17-го апреля 1995 }
   { Заголовочный файл, содержащий константы и определения типов для aaplay1.pas }
   const
    NULL = 0;
    NULLPTR = ^0;
    {
     Доступные Флаги wMode: integer;
     Используются в aaLoad, aaReLoad
     Первые восемь бит wMode используются в aa_flags.
    }
    AA_MEMORYLOAD = $1;     { Загрузка в память }
    AA_HIDEWINDOW = $2;     { Скрывать окно анимации }
    AA_NOPALETTE = $4 ;     { Анимация без палитры }
    AA_RESERVEPALETTE = $8; { Резервировать при старте всю палитру }
    AA_LOOPFRAME = $10;     { Циклическая загрузка кадров }
    AA_FULLSCREEN = $20;    { Использовать полноэкранный режим воспроизведения }
    AA_STOPNOTIFY = $40;    { Исключать любые уведомляющие сообщения }
    AA_STOPSTATUS = $80;    { Исключать сообщения об изменении статуса }
    AA_NOFAIL = $100;       { Уменьшение типа нагрузки при ошибке }
    AA_DONTPAINT = $200;    { Не делать paByVal-анимацию при загрузке }
    AA_BUILDSCRIPT = $400;  { lpzFileName – скрипт, не имя }
    AA_ALLMODES = $FF;
    {
     Доступные флаги для режимов звука – wMode: integer;
     Используются в aaSound
    }

    AA_SNDFREEZE = $1;       { Заморозка кадров при проигрывании звуков }
    AA_SNDDEVICEID = $100;   { ID устройства, не имя }
    AA_SNDBUILDALIAS = $200; { создавать псевдоним звукового устройства }
    {
     aaNotify позволяет извещать приложение о проигрывании определенных кадров.
     lPosition – позиция, на которой должно происходить уведомление.
     wParam для этого сообщения – hAa, а lParam копируется из этого вызова.
     При установке сообщения возвращается TRUE.
     Следующее значение определяет необходимость завершения цикла анимации по окончании проигрывания звука. Если звук отсутствует, анимация зацикливается навсегда.
    }
    AA_LOOPSOUND = $FFFF;
    {
     Автоматическое уведомление посылается при перезагрузке в скрипте анимации.
     lParam для этого сообщения определен ниже
    }
    AA_ANIMATIONLOADED = 0;
    {
     Типы параметров
     Используется с aaGetParm и aaSetParm.
    }
    AA_STATUS = 1;              { Получить текущий статус }
    AA_FILETYPE = 2;            { Получить тип анимации на диске }
    AA_MODE = 3;                { Получить/установить флаги анимации }
    AA_WINDOW = 4;              { Установить/получить окно анимации }
    AA_SPEED = 5;               { Установить/получить текущую скорость }
    AA_DESIGNSPEED = 6;         { Получить скорость на этапе дизайна }
    AA_FRAMES = 7;              { Получить число кадров }
    AA_POSITION = 8;            { Установить/получить позицию текущего кадра }
    AA_LOOPS = 9;               { Установить/получить число циклов }
    AA_X = 10;                  { Установить/получить позицию выводимого окна }
    AA_Y = 11;                  { Установить/получить позицию выводимого окна }
    AA_CX = 12;                 { Установить/получить размеры выводимого окна }
    AA_CY = 13;                 { Установить/получить размеры выводимого окна }
    AA_ORGX = 14;               { Установить/получить начало выводимого окна }
    AA_ORGY = 15;               { Установить/получить начало выводимого окна }
    AA_WIDTH = 16;              { Получить ширину анимации }
    AA_HEIGHT = 17;             { Получить высоту анимации }
    AA_RPTSOUND = 18;           { Установить/получить повторения звуков }
    AA_PAUSE = 19;              { Установить/получить время паузы }
    AA_DELAYSND = 20;           { Установить/получить время задержки звука }
    AA_TRANSIN = 21;            { Установить/получить тип входного перехода }
    AA_TRANSOUT = 22;           { Установить/получить тип выходного перехода }
    AA_TIMEIN = 23;             { Установить/получить время входного перехода }
    AA_TIMEOUT = 24;            { Установить/получить время выходного перехода }
    AA_CALLBACK = 25;           { Установить/получить окно обратного вызова }
    AA_ANIMWND = 26;            { Получить дескриптор окна анимации }
    AA_MODFLAG = 100;           { Установить/получить флаг изменения скрипта }
    AA_SCRIPTNAME = 101;        { Установить/получить имя скрипта }
    AA_ANIMATION = 102;         { Получить/установить скрипт анимации }
    AA_ANIMATIONCOUNT = 103;    { Получить счетчик скрипта анимации }
    AA_SCRIPTCONTENTS = 104;    { Получить содержание скрипта }
    AA_LASTERROR = 1001;        { Получить код последней ошибки }
    AA_LASTERRORMESSAGE = 1002; { Получить/установить сообщение о последней ошибке }
    {
     Типы параметров
     Используется с aaSetParmIndirect
    }
    AA_SETMODE = $1;         { Получить/установить флаги анимации }
    AA_SETWINDOW = $2;       { Установить/получить окно анимации }
    AA_SETSPEED = $4;        { Установить/получить текущую скорость }
    AA_SETPOSITION = $8;     { Установить/получить позицию текущего кадра }
    AA_SETLOOPS = $10;       { Установить/получить число циклов }
    AA_SETX = $20;           { Установить/получить левую координату выводимого окна }
    AA_SETY = $40;           { Установить/получить левую координату выводимого окна }
    AA_SETCX = $80;          { Установить/получить верхнюю координату выводимого окна }
    AA_SETCY = $100;         { Установить/получить верхнюю координату выводимого окна }
    AA_SETORGX = $200;       { Установить/получить ширину выводимого окна }
    AA_SETORGY = $400;       { Установить/получить ширину выводимого окна }
    AA_SETRPTSOUND = $800;   { Установить/получить повторения звуков }
    AA_SETPAUSE = $1000;     { Установить/получить время паузы }
    AA_SETDELAYSND = $2000;  { Установить/получить время задержки звука }
    AA_SETTRANSIN = $4000;   { Установить/получить тип входного перехода }
    AA_SETTRANSOUT = $8000;  { Установить/получить тип выходного перехода }
    AA_SETTIMEIN = $10000;   { Установить/получить время входного перехода }
    AA_SETTIMEOUT = $20000;  { Установить/получить время выходного перехода }
    AA_SETCALLBACK = $40000; { Установить/получить окно обратного вызова }
    AA_ALL = $FFFFFFFF;      { Получить/установить все параметры }
    {
     Значения статуса для анимации
    }
    AA_STOPPED = 1; { Загружена, но не воспроизводится }
    AA_QUEUED = 2;  { Анимация ожидает воспроизведение }
    AA_PLAYING = 3; { Анимация воспроизводится }
    AA_PAUSED = 4;  { Анимация в режиме паузы }
    AA_DONE = 5;    { Анимация закончила воспроизведение }
                    { и ожидает вызов aaStop }
    {
     Определения типов файла
    }
    AA_FLI = $1;      { Формат Autodesk Animator Fli }
    AA_DIB = $2;      { Формат Windows DIB }
    AA_NUMTYPES = $2; { Количество типов }
    AA_SCRIPT = $3;   { Скрипт без анимации }
    {
     Типы переходов
    }
    AA_CUT = 0;        { Простая остановка одной и запуск другой }
    AA_FADEBLACK = $1; { Уход/выход из черного }
    AA_FADEWHITE = $2; { Уход/выход из белого }
    {
     Коды ошибок, возвращаемые aaGetParm(xxx, AA_LASTERROR)
    }
    AA_ERR_NOERROR = 0; { Неизвестная ошибка }
    AA_ERR_NOMEMORY = $100; { 256 – Ошибка нехватки памяти }
    AA_ERR_BADHANDLE = $101; { 257 – Плохой дескриптор }
    AA_ERR_NOTIMERS = $102; { 258 – Невозможно запустить таймер }
    AA_ERR_BADSOUND = $103; { 259 – Плохое звуковое сопровождение }
    AA_ERR_NOSCRIPT = $104; { 260 – Требуется скрипт }
    AA_ERR_WRITEERR = $105; { 261 – Ошибка записи (для сценария) }
    AA_ERR_BADANIMATION = $106; { 262 – Невозможно открыть анимацию }
    AA_ERR_BADWINDOWHANDLE = $200; { 512 – Плохой дескриптор окна }
    AA_ERR_WINDOWCREATE = $201; { 513 – Невозможно создать окно }
    AA_ERR_DLGERROR = $202; { 514 – Ошибка диалога }
    AA_ERR_INVALIDSTATUS = $300; { 768 – Неверный статус }
    AA_ERR_BADDIBFORMAT = $301; { 769 – Плохой dib-файл }
    AA_ERR_BADFLIFORMAT = $302; { 770 – Плохой fli-файл }
    AA_ERR_UNRECOGNIZEDFORMAT = $303; { 771 – Нераспознанный формат }
    AA_ERR_NOSOUND = $304; { 772 – Звук не поддерживается }
    AA_ERR_NOTVALIDFORSCRIPTS = $305; { 773 – Неправильный сценарий }
    AA_ERR_INVALIDFILE = $306;     { 774 – Плохой дескриптор файла }
    AA_ERR_NOSCRIPTS = $307;       { 775 – Нет файлов-скриптов }
    AA_ERR_SPEED = $400;           { 1024 – Неверная скорость }
    AA_ERR_LOOPS = $401;           { 1025 – Неверные циклы }
    AA_ERR_RPTSOUND = $402;        { 1026 – Неверный повтор звука }
    AA_ERR_PAUSE = $403;           { 1027 – Неверная пауза }
    AA_ERR_TRANSIN = $404;         { 1028 – Неверный переход }
    AA_ERR_TIMEIN = $405;          { 1029 – Неверный переход }
    AA_ERR_TRANSOUT = $406;        { 1030 – Неверное время перехода }
    AA_ERR_TIMEOUT = $407;         { 1031 – Неверное время перехода }
    AA_ERR_DELAYSND = $408;        { 1032 – Неверная задержка звука }
    AA_ERR_INVALIDTYPE = $409;     { 1033 – Неверный тип параметра }
    AA_ERR_DUPLICATENOTIFY = $500; { 1280 – Дублирование уведомления }
    AA_ERR_NOSWITCH = $600;        { 1536 – Отсутствие ключей в скрипте }
    AA_ERR_PARSELOOPS = $601;      { 1537 – Плохие циклы в скрипте }
    AA_ERR_PARSESPEED = $602;      { 1538 – Плохая скорость в скрипте }
    AA_ERR_BADRPTSOUND = $603;     { 1539 – Плохое повторение звука в скрипте }
    AA_ERR_PARSEPAUSE = $604;      { 1540 – Плохая пауза в скрипте }
    AA_ERR_PARSETRANS = $605;      { 1541 – Плохой переход в скрипте }
    AA_ERR_PARSEDELAYSND = $606;   { 1542 – Плохая задержка звука в скрипте }
    AA_ERR_TOOMANYLINKS = $607;    { 1543 – Слишком много ссылок }
    {
     dwFlags: integer; может быть любым из нижеперечисленных
     Используется в aaGetFile.
    }
    AA_GETFILE_MUSTEXIST = $1;
    AA_GETFILE_NOSHOWSPEC = $2;
    AA_GETFILE_SAVE = $4;
    AA_GETFILE_OPEN = $8;
    AA_GETFILE_USEDIR = $10;
    AA_GETFILE_USEFILE = $20;
    AA_GETFILE_SOUND = $40;
    AA_GETFILE_SCRIPT = $80;
    AA_GETFILE_ANIMATION = $100;
    {
     wMode: integer; Значения
     Используется в aaSave
    }
    AA_SAVE_IFMODIFIED = $1;
    AA_SAVE_AS = $2;
    AA_SAVE_CANCEL = $4;
    {
     Возможности
     Используется в aaGetCaps
    }
    AA_CAP_TIMER = 1;
    AA_CAP_SOUND = 2;
    AA_CAP_SCRIPT = 3;
    {
     Статусные сообщения анимации
     Используйте RegisterWindowMessage для получения номеров реальных сообщений.
    }
    AA_NOTIFY = 'AAPLAY Уведомление'; { Сообщение-уведомление }
    AA_STOP = 'AAPLAY Стоп';          { Стоп-сообщение }
    {
     Это посылается в первом слове lParam с сообщением AA_ERROR.
     Это указывает на возникшую ошибку
    }
    AA_BADPLAY = 1;   { Ошибка при попытке воспроизведения }
    AA_BADNOTIFY = 2; { Ошибка при попытке послать уведомление }
    AA_BADSCRIPT = 3; { Ошибка в сценарии при попытке }
                     { воспроизведения }

   { ========================================================================== }
   unit TMediaPlayer)
   procedure OpenAA;

   private
    { Private declarations }
   protected
    { Protected declarations }
   public
    { Public declarations }
    AAParameters: AAPARMS;
    FlicHandle: AAHandle;
    PlayWinHandle: THandle;
    StatusWinHandle: THandle;
    CallbackWinHandle: THandle;
   published
    { Published declarations }
   end;

   procedure Register;

   { Внешние вызовы AAPLAY.DLL }
   function aaOpen : boolean;
   procedure aaClose;
   function aaGetCaps(wType: word) : word;
   function aaLoad(lpzFileName: PChar; WinHnd: HWnd; wMode: word; x, y, wid, hght, orgx, orgy: integer): AAHandle;
   function aaReLoad(hAa: AAHandle; lpzFileName: PChar; wMode, wMask: word) : boolean;
   function aaUnload(hAa: AAHandle): boolean;
   function aaPlay(hAa: AAHandle) : boolean;
   function aaNotify(hAa: AAHandle; lPosition, lParam: longint) : boolean;
   function aaCancel(hAa: AAHandle; lLoPos, lHiPos: longint) : word;
   function aaStop(hAa: AAHandle) : boolean;
   function aaPause(hAa: AAHandle) : boolean;
   function aaPrompt(hAa: AAHandle; lpName: PChar) : boolean;
   function aaGetParm(hAa: AAHandle; wType: word) : longint;
   function aaGetParmIndirect(hAa: AAHandle; lpAp: AAPARMSPtr; wSize: word) : boolean;
   function aaSetParm(hAa: AAHandle; wType: word; wValue1, lValue2: longint): AAHandle;
   function aaSetParmIndirect(hAa: AAHandle; dwType: longint; lpAp: AAPARMSPtr; wMask: word): boolean;
   function aaShow(hAa: AAHandle; bShow: boolean) : boolean;
   function aaSound(hAa: AAHandle; device, ffile: PChar; wMode: word): boolean;
   function aaGetFile(dwFlags: word; lpszPath: PChar; wBufLen: word; lpszDriver: PChar; wDrvLen: word) : integer;
   function aaSave(hAa: AAHandle; wMode: word) : integer;

   implementation

   { =========================================================================== }
   procedure Register;
   begin
    RegisterComponents('Samples', [TAAPlayer]);
   end;

   { --------------------------------------------------------------------------- }
   procedure TAAPlayer.OpenAA;
   var
    FileSuffix, tempstr: string[12];
    a,b: integer;
   begin
    { tempstr := ExtractFilename(AAPlayer.Filename); }
    { a := StrPos(tempstr,'.');
    if (a > 0) then begin
     b := a;
     while (b <= StrLen(tmpstr)) do begin
      FileSuffix := FileSuffix + StrUpper(tempstr[b]);
      b := b+1;
     end;
     if ((FileSuffix = '.FLC') or (FileSuffix = '.FLI')) then begin }
    { AutoEnable := False;
      EnabledButtons := [btRecord,btEject];
    }{ end;
    end;
   }
   end;

   { =========================================================================== }
   { Внешние вызовы 'AAPLAY.DLL' }
   {$F+}
   { =========================================================================== }

   { --------------------------------------------------------------------------- }
   function aaOpen : boolean; external 'AAPLAY';

   { --------------------------------------------------------------------------- }
   procedure aaClose; external 'AAPLAY';
   {
    ' AAOpen и AAClose в действительности не нужны, за исключением обработки
    ' ошибки в Windows, которая предохраняет освобождение библиотек в процедуре
    ' выхода Windows (Windows Exit Proc, WEP).
    '
    ' Поэтому мы используем AAClose для освобождения библиотек при закрытии
    ' последней задачей AAPlay DLL.
   }

   { --------------------------------------------------------------------------- }
   function aaGetCaps(wType: word) : word; external 'AAPLAY';
   {
    ' Получение возможностей
   }

   { --------------------------------------------------------------------------- }
   function aaLoad(lpzFileName: PChar; WinHnd: HWnd; wMode: word; x, y, wid, hght, orgx, orgy: integer): AAHandle; external 'AAPLAY';
   {
    ' aaLoad загружает анимацию.
    '
    ' Имя файла в lpzFileName
    ' и режим загрузки в wMode.
   }

   { --------------------------------------------------------------------------- }
   function aaReLoad(hAa: AAHandle; lpzFileName: PChar; wMode, wMask: word): boolean; external 'AAPLAY';
   {
    ' aaReLoad загружает файл новый анимации
    ' "в дескриптор" старой анимации.
    '
    ' Уведомления теряются, но палитра и окно
    ' сохраняются.
   }

   { --------------------------------------------------------------------------- }
   function aaUnload(hAa: AAHandle): boolean; external 'AAPLAY';
   {
    ' aaUnload выгружает загруженную анимацию.
    '
    ' Возвращается FALSE, если
    ' hAa не является дескриптором загруженной анимации.
   }

   { --------------------------------------------------------------------------- }
   function aaPlay(hAa: AAHandle) : boolean; external 'AAPLAY';
   {
    ' aaPlay воспроизводит загруженную анимацию.
    '
    ' Возвращается TRUE, если после возврата aaPlay анимация не останавливается.
   }

   { --------------------------------------------------------------------------- }
   function aaNotify(hAa: AAHandle; lPosition, lParam: longint) : boolean; external 'AAPLAY';
   {
    ' aaNotify позволяет извещать приложение о воспроизведении
    ' определенных кадров анимации.
    '
    ' lPosition -позиция, в которой должно происходить уведомление.
    '
    ' wParam для данного сообщения - hAa, а lParam копируется из этого вызова.
    '
    ' Возвращается TRUE, если уведомление установлено.
   }

   { --------------------------------------------------------------------------- }
   function aaCancel(hAa: AAHandle; lLoPos, lHiPos: longint) : word; external 'AAPLAY';
   {
    ' aaCancel позволяет приложению отменить уведомления, установленные aaNotify.
    '
    ' lLoPos и lHiPos задает верхний и нижний предел позициям.
    '
    ' Возвращает количество отмененных уведомлений.
   }

   { --------------------------------------------------------------------------- }
   function aaStop(hAa: AAHandle) : boolean; external 'AAPLAY';
   {
    ' aaStop прекращает воспроизведение анимации.
    '
    ' При остановке воспроизведения aaStop возвращает TRUE.
   }

   { --------------------------------------------------------------------------- }
   function aaPause(hAa: AAHandle) : boolean; external 'AAPLAY';
   {
    ' aaPause приостанавливает воспроизведение.
    '
    ' Возвращается TRUE, если после возврата aaPause анимация переходит в режим паузы.
    '
    ' Для продолжения воспроизведения анимации используйте aaPlay.
   }

   { --------------------------------------------------------------------------- }
   function aaPrompt(hAa: AAHandle; lpName: PChar) : boolean; external 'AAPLAY';
   {
    ' aaPrompt позволяет выводить диалог для получения данных от пользователя.
    '
    ' При получении данных дескриптор меняется, и, таким образом, вступают
    ' в силу новые параметры. Старый дескриптор не уничтожается до тех пор,
    ' пока не будет создан новый.
    '
    ' Если новый дескриптор не может быть создан, aaPrompt возвращает NULL,
    ' в противном случае возвращается новый дескриптор.
   }

   { --------------------------------------------------------------------------- }
   function aaGetParm(hAa: AAHandle; wType: word) : longint; external 'AAPLAY';
   {
    ' aaGetParm возвращает информацию об анимации.
    '
    ' Некоторая информация может быть установлена с помощью aaSetParm,
    ' и другая информация - информация о состоянии, поддерживаемая AAPLAY.
   }

   { --------------------------------------------------------------------------- }
   function aaGetParmIndirect(hAa: AAHandle; lpAp: AAPARMSPtr; wSize: word): boolean; external 'AAPLAY';
   {
    ' aaGetParmIndirect возвращает ту же информацию, что и aaGetParm,
    ' в структуре, удобной для легкого доступа из приложений Visual Basic.
   }

   { --------------------------------------------------------------------------- }
   function aaSetParm(hAa: AAHandle; wType: word; wValue1, lValue2: longint): AAHandle; external 'AAPLAY';
   {
    ' aaSetParm устанавливает информацию для анимации
   }

   { --------------------------------------------------------------------------- }
   function aaSetParmIndirect(hAa: AAHandle; dwType: longint; lpAp: AAPARMSPtr; wMask: word): boolean; external 'AAPLAY';
   {
    ' aaSetParmIndirect устанавливает параметры анимации из структуры.
   }

   { --------------------------------------------------------------------------- }
   function aaShow(hAa: AAHandle; bShow: boolean) : boolean; external 'AAPLAY';
   {
    ' aaShow позволяет показать в окне отдельный кадр анимации.
    '
    ' Mode определяет способ рисования анимации.
    '
    ' Параметры окна возможно задать с помощью aaSetParm или aaSetParmIndirect.
    '
    ' aaShow возвращает TRUE, если анимация была отрисована без ошибок.
   }

   { --------------------------------------------------------------------------- }
   function aaSound(hAa: AAHandle; device, ffile: PChar; wMode: word): boolean; external 'AAPLAY';
   {
    ' aaSound открывает и закрывает канал звукового сопровождения анимации.
    '
    ' Звуковой канал будет открыт, если аргумент file не будет равен null
    ' и не будет пустым, в противном случае канал будет закрыт.
    '
    ' Если устройство равно null, то для выбора подходящего устройства
    ' используется формат файла.
   }

   { --------------------------------------------------------------------------- }
   function aaGetFile(dwFlags: word; lpszPath: PChar; wBufLen: word; lpszDriver: PChar; wDrvLen: word) : integer; external 'AAPLAY';
   {
    ' Открывает системного диалоговое окно стандартного типа ("открыть файл"),
    ' предлагающее пользователю выбрать файл.
    '
    ' <dwFlags> определяет характеристики диалогового окна.
    ' Список возможных флагов:
    '  AA_GETFILE_MUSTEXIST  Выбранный файл должен удовлетворять условиям
    '                        флагов OpenFile(), в противном случае диалог
    '                        издаст системный звук.
    '  AA_GETFILE_NOSHOWSPEC НЕ показывать путь в поле редактирования.
    '                        По умолчанию путь к файлу показывается.
    '  AA_GETFILE_SAVE       Кнопка Ok имеет заголовок "Save".
    '  AA_GETFILE_OPEN       Кнопка Ok имеет заголовок "Open".
    '  AA_GETFILE_USEFILE    Взять имя файла из параметра lpszPath
    '  AA_GETFILE_UDEDIR     Взять каталог из параметра lpszPath
    '  AA_GETFILE_SOUND      Получить звуковой файл и драйвер
    '  AA_GETFILE_SCRIPT     Получить файл со скриптом
    '  AA_GETFILE_ANIMATION  Получить файл анимации (без скриптов)
    '
    ' <lpszPath> - строковый буфер LPSTR, куда после выполнения диалога
    ' пишется полное имя пути.
    ' <wBufLen> - длина данного буфера.
    '
    ' <lpszDriver> - строковый буфер LPSTR для хранения выбранного
    ' звукового устройства.
    ' <wDrvLen> - длина данного буфера.
    '
    ' Возвращаемые значения: 0, если была нажата кнопка Cancel
    '                        -1, если OpenFile() потерпело неудачу,
    '                        а AA_GETFILE_MUSTEXIST не определен.
    '                        В противном случае возвращается дескриптор DOS-файла.
    '                        При возврате из aaOpenFile данный дескриптор "не открыт".
   }

   { --------------------------------------------------------------------------- }
   function aaSave(hAa: AAHandle; wMode: word) : integer; external 'AAPLAY';
   {
    ' Сохранение скрипта
   }

   { --------------------------------------------------------------------------- }

   {$F-}
   { Окончание внешних вызовов 'AAPLAY.DLL' }
   { =========================================================================== }
   end.
   { =========================================================================== }
   Dr Paul Kuczora.
   -
   Paul Kuczora c home.london.uk
   (на создание файла потрачен один день)

Как сделать, чтобы орган управления, например, сложная линия, хваталась только за некий контур, и пропускала мышь под себя в других местах?

   Nomadic советует:
   Надо обрабатывать сообщение CM_HITTEST (Это сообщение получают даже потомки от TGraphicsControl, не имеющего своего HWND).
   Например, так:
   procedure TLine.CMHitTest(var Message: TWMNCHitTest);
   begin
    if PointInLineReg(Message.XPos, Message.YPos) then begin
     Message.Result := 1;
    end else begin
     Message.Result := 0;
    end;
   end;
   Для органов управления Windows, если Вы не используете VCL, требуется обрабатывать сообщение WM_NCHITTEST.

Как быстро нарисовать тень в заданном регионе?

   Nomadic советует:
   procedure TForm2.DrawShadows(WDepth, HDepth : Integer);
   var
    Dst, RgnBox : TRect;
    hOldDC : HDC;
    OffScreen : TBitmap;
    Pattern : TBitmap;
    Bits : array[0..7] of WORD;
   begin
    Bits[0] := $0055;
    Bits[1] := $00aa;
    Bits[2] := $0055;
    Bits[3] := $00aa;
    Bits[4] := $0055;
    Bits[5] := $00aa;
    Bits[6] := $0055;
    Bits[7] := $00aa;
    hOldDC := Canvas.Handle;
    Canvas.Handle := GetWindowDC(Form1.Handle);
    OffsetRgn(ShadeRgn, WDepth, HDepth);
    GetRgnBox(ShadeRgn, RgnBox);
    Pattern := TBitmap.Create;
    Pattern.ReleaseHandle;
    Pattern.Handle := CreateBitmap(8, 8, 1, 1, @(Bits[0]));
    Canvas.Brush.Bitmap := Pattern;
    OffScreen := TBitmap.Create;
    OffScreen.Width := RgnBox.Right-RgnBox.Left;
    OffScreen.Height := RgnBox.Bottom-RgnBox.Top;
    Dst := Rect(0, 0, OffScreen.Width, OffScreen.Height);
    OffsetRgn(ShadeRgn, 0, –RgnBox.Top);
    FillRgn(OffScreen.Canvas.Handle, ShadeRgn, Canvas.Brush.Handle);
    OffsetRgn(ShadeRgn, 0, RgnBox.Top);
    // BitBlt работает быстрее CopyRect
    BitBlt(OffScreen.Canvas.Handle, 0, 0, OffScreen.Width, OffScreen.Height, Canvas.Handle, RgnBox.Left, RgnBox.Top, SRCAND);
    Canvas.Brush.Color := clBlack;
    FillRgn(Canvas.Handle, ShadeRgn, Canvas.Brush.Handle);
    BitBlt(Canvas.Handle, RgnBox.Left, RgnBox.Top, OffScreen.Width, OffScreen.Height, OffScreen.Canvas.Handle, 0, 0, SRCPAINT);
    OffScreen.Free;
    Pattern.Free;
    OffsetRgn(ShadeRgn, –WDepth, –HDepth);
    ReleaseDC(Form1.Handle, Canvas.Handle);
    Canvas.Handle := hOldDC;
   end;
   Комментарии:
   Функция рисует тень сложной формы на форме Form2 (извиняюсь за стиль). Для определения формы тени используется регион ShadeRgn, который был создан где-то раньше (например в OnCreate). Относительно регионов см. Win32 API.

Как рисовать на органе управления, например, на TPanel?

   Nomadic советует:
   У всех компонентов, порожденных от TCustomControl, имеется свойство Canvas типа TCanvas.
   Если свойство Canvas недоступно, Вы можете достучаться до него созданием потомка и переносом этого свойства в раздел Public.
   { Example. We recommend You to create this component through Component Wizard.
    In Delphi 1 it can be found as 'File|New Component…', and can be found
    as 'Component|New Component…' in Delphi 2 or above. }
   type
    TcPanel = class(TPanel)
   public
    property Canvas;
   end;
   У меня есть маленькое замечание.
   Если у объекта нет свойства Canvas (у TDBEdit вроде-бы нет), то, по крайней меpе в D3, можно использовать класс TControlCanvas. Примерное использование:
   var
    cc: TControlCanvas;
    …
    cc := TControlCanvas.Create;
    cc.Control := yourControl;
    …
   и далее как обычно можно использовать методы Canvas.

Как мне из Handle битовой картинки, получить адрес битового изображения в памяти?

   Nomadic советует:
   Вот кусок одного моего класса, в котором есть две интересные вещицы — проецирование файлов в память и работа с битмэпом в памяти через указатель.
   Сразу оговорюсь, что все это работает только под Win95/NT.
   type
    TarrRGBTriple=array[byte] of TRGBTriple;
    ParrRGBTriple=^TarrRGBTriple;

   {организует битмэп размером SX,SY;true_color}
   procedure TMBitmap.Allocate(SX,SY:integer);
   var DC:HDC;
   begin
    if BM<>0 then DeleteObject(BM); {удаляем старый битмэп, если был}
    BM:=0;
    PB:=nil;
    fillchar(BI,sizeof(BI),0);
    with BI.bmiHeader do {заполняем структуру с параметрами битмэпа}
    begin
     biSize:=sizeof(BI.bmiHeader);
     biWidth:=SX;
     biHeight:=SY;
     biPlanes:=1;
     biBitCount:=24;
     biCompression:=BI_RGB;
     biSizeImage:=0;
     biXPelsPerMeter:=0;
     biYPelsPerMeter:=0;
     biClrUsed:=0;
     biClrImportant:=0;
     FLineSize:=(biWidth+1)*3 and (-1 shl 2); {размер строки(кратна 4 байтам)}
     if (biWidth or biHeight)<>0 then begin
      DC:=CreateDC('DISPLAY',nil,nil,nil);
      {замечательная функция (см.HELP), возвращает HBITMAP, позволяет сразу разместить выделяемый битмэп в спроецированном файле, что позволяет ускорять работу и экономить память при генерировании большого битмэпа}
      {!} BM:=CreateDIBSection(DC,BI, DIB_RGB_COLORS, pointer(PB), nil, 0);
      DeleteDC(DC); {в PB получаем указатель на битмэп-----^^}
      if BM=0 then Error('error creating DIB');
     end;
    end;
   end;

   {эта процедура загружает из файла true-color'ный битмэп}
   procedure TMBitmap.LoadFromFile(const FileName:string);
   var
    HF:integer; {file handle}
    HM:THandle; {file-mapping handle}
    PF:pchar; {pointer to file view in memory}
    i,j: integer;
    Ofs:integer;
   begin
    {открываем файл}
    HF:=FileOpen(FileName,fmOpenRead or fmShareDenyWrite);
    if HF<0 then Error('open file '''+FileName+'''');
    try
     {создаем объект-проецируемый файл}
     HM:=CreateFileMapping(HF,nil,PAGE_READONLY,0,0,nil);
     if HM=0 then Error('can''t create file mapping');
     try
      {собственно проецируем объект в адресное }
      PF:=MapViewOfFile(HM,FILE_MAP_READ,0,0,0);
      {получаем указатель на область памяти, в которую спроецирован файл}
      if PF=nil then Error('can''t create map view of file');
      try
       {работаем с файлом как с областью памяти через указатель PF}
       if PBitmapFileHeader(PF)^.bfType<>$4D42 then Error('file format');
       Ofs:=PBitmapFileHeader(PF)^.bfOffBits;
       with PBitmapInfo(PF+sizeof(TBitmapFileHeader))^.bmiHeader do begin
        if (biSize<>40) or (biPlanes<>1) then Error('file format');
        if (biCompression<>BI_RGB) or (biBitCount<>24) then Error('only true-color BMP supported');
        {выделяем память под битмэп}
        Allocate(biWidth,biHeight);
       end;
       for j:=0 to BI.bmiHeader.biHeight-1 do
   for i:=0 to BI.bmiHeader.biWidth-1 do
         {Pixels - это property, возвр. указатель на соотв. RGBTriple в битмэпе}
         Pixels[i,j]^.Tr:=ParrRGBTriple(PF+j*FLineSize+Ofs)^[i];
      finally
       UnmapViewOfFile(PF);
      end;
     finally
      CloseHandle(HM);
     end;
    finally
     FileClose(HF);
    end;
   end;

   {эта функция - реализация Pixels read}
   function TMBitmap.GetPixel(X,Y:integer):PRGB;
   begin
    if (X>=0) and (X<BI.bmiHeader.biWidth) and (Y>=0) and (Y<BI.bmiHeader.biHeight) then
    Result:=PRGB(PB+(Y)*FLineSize+X*3)
    else Result:=PRGB(PB);
   end;
   Если у вас на форме есть компонент TImage, то можно сделать так:
   var BMP:TMBitmap;
   B:TBitmap;
   …
   BMP.LoadFromFile(…);
   B:=TBitmap.Create;
   B.Handle:=BMP.Handle;
   Image1.Picture.Bitmap:=B;
   и загруженный битмэп появится на экране.

Можно ли запустить OpenGL под Windows'95, и как поставлять его с программой?

   Nomadic советует:
   Надо сразу отметить, что для работы Microsoft OpenGL 1.1 требуется только наличие в системе двух динамических библиотек. Они различны для Windows 95 и для Windows NT. Они всегда инсталлируется вместе с системой, если эта система – Windows 95 OSR2 или более поздняя, или если это Windows NT. Однако, если Вы столкнулись с машиной, где OpenGL отсутствует (Windows 95 OSR1 и более ранние), то достаточно их взять из диcтpибyтива OSR2 (GLU32.DLL и OPENGL32.DLL) и записать в GetSystemDirectory – и запycкайте OpenGL-приложения на здоpовье.
   Более эффективную реализацию OpenGL для Win32 от фирмы SGI я бы советовал стянуть с www.sgi.com или www.opengl.org (SGI OpenGL for Windows). Кроме того, оттуда же советую скачать дополнительную библиотеку функций-утилит, позволяющую упростить работу в OpenGL (GLUT). Возможно, что Вам понравится какой-нибудь API более высокого уровня, типа SCiTech MGL (www.scitechsoft.com).

Как вывести на экран текст с 'красивым' обрезанием по длине (если текст не помещается на экране)?

Nomadic советует:
Используй вызов DrawTextEx, установив в параметре dwDTFormat значение DT_PATH_ELLIPSIS.

При работе программ на Delphi 1 под Windows 95 в hicolor-режимах на иконках TBitBtn'ов обнаруживаются странные коричневые артефакты. Как от них избавиться?

Nomadic советует:
A: (AB): Залить фон битмапа синим цветом.

Получение контекста устройства для элемента управления

   {Bitmap в TImage}
   HDC := TImage.Picture.bitmap.canvas.handle;
   DC – что нибудь с Canvas.handle

Отладка

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

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

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

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

Разное

Переустановка Delphi 2.0

   Данный совет поможет вам в вопросе переустановки Delphi 2.0. Если вам понадобиться дополнительная помощь, пожалуйста, свяжитесь со службой «Горячей линии» по телефону (408) 461-9195.
   Рекомендации по переустановке Delphi 2
   • Перед переустановкой Delphi 2.0, запустите утилиту удаления, щелкнув на иконке «add/remove program» (добавить/удалить программу) в Панели Управления Windows 95, или щелкнув на иконке «uninstall» в программной группе Delphi 2.0 в Windows NT.
    ‣ Не запускайте процедуру удаления с Delphi 2.0 CD.
   • Перед удалением и переустановкой Delphi 2.0 завершите работу приложений, использующих Borland Database Engine и закройте Local InterBase Server (если он запущен), щелкнув на иконке Local InterBase (правой кнопкой мыши в системной панели задач Windows 95) и выбрав «shutdown».
   • Установка Delphi 2.0 в Windows NT требует Windows NT версии 3.51 или более поздней.
   • Перед установкой Delphi 2.0 убедитесь в том, что в Windows установлен самый последний service pack. Пакеты Service pack распространяются фирмой Microsoft Corporation. Хорошим источником является Интернет-сервер корпорации, расположенный по адресу www.microsoft.com.
   • Если в вашей системе уже установлена Delphi 1.0, Delphi 2.0 вы должны установить в другой каталог. Единственный каталог, рекомендуемый для общего пользования обоими версиями Delphi, каталог IDAPI.
   • Перед установкой убедитесь в том, что вы имеете права администратора системы.
   • Установка Delphi 2.0 на сетевой сервер не поддерживается.
   • Для установки Delphi 2.0 на компьютере, не имеющего привода CD-ROM, используйте сетевое соединение, или соединение через последовательный порт с использованием кабеля для параллельного или последовательного порта, копируйте установочные файлы с Delphi 2.0 CD во временный каталог компьютера, на котором вы хотите провести установку, и затем запустите программу установки из временного каталога компьютера, не имеющего CD-ROM. После успешной установки вы можете удалить файлы, которые вы скопировали во временный каталог.
   • Если на компьютере запущен stacker, переименуйте VSTACKER.386 (расположенный в вашем каталоге windows\system) в VSTACKER.$$$. Перезапустите Windows и снова запустите программу установки.
   • Если вы выключили поддержку виртуальной памяти, вам необходимо ее снова активизировать, так как программе установки требуется по меньшей мере 64Мб виртуальной памяти.
   • Ваша операционная система должна поддерживать длинные имена файлов.
   • Если на машине установлен Paradox, то перед установкой Delphi снимите со всех файлов блокировки.
   Ошибки установки
   • Если мастер онлайн-регистрации не завершил до конца процедуру онлайновой регистрации, запустите снова процедуру установки и нажмите кнопку Cancel (отмена) на запрос онлайновой регистрации. Пожалуйста заполните и вышлите регистрационную карточку, включаемую в поставку вашего продукта Delphi 2.0.
   • Если в процессе установки вы получите пустое диалоговое окно, отмените установку и пробуйте снова, пока установка не пройдет успешно.
   • Если в процессе установки вы получите одно из следующих сообщений об ошибке:
   «out of disk space» (недостаточно места на диске),
   «no temp var» (нет временных переменных),
   «error 101» (ошибка 101)
   «error 102"(ошибка 102)
   Освободите дисковое пространство и/или убедитесь в наличие переменных среды и временного каталога. На диске, куда устанавливается Delphi, во временном каталоге должно быть достаточно свободного места.
   • Если в процессе установки вы получите следующую ошибку:
   «Install Shield error filename –51» (ошибка Install Shield при работе с файлом –51),
   то попробуйте сделать следующее:
   1. Скопируйте все файлы (КРОМЕ CTL3D32.DLL) из каталога runimage\delphi20\windows\system32, расположенного на Delphi 2.0 CD, во временную директорию вашего жесткого диска.
   2. Сбросьте флажок «read only» (только для чтения) во всех файлах, скопированных во временный каталог.
   3. Скопируйте файлы в ваш каталог windows\system, или windows\system32 для системы Windows NT.
   4. Снова запустите установку.
   Другая информация, необходимая для успешной установки
   • Попробуйте выполнить установку с вашего жесткого диска. Чтобы сделать это, удалите Delphi 2.0, затем просто скопируйте файлы из каталога установки Delphi 2.0 CD во временный каталог вашего диска, после чего запустите из этого каталога программу установки. После успешной установки скопированные во временный каталог файлы можно удалить.
   • Временно переименуйте файл win.ini (расположенный в вашем каталоге Windows) в win.in$, перезагрузите систему и переустановите или перезапустите Delphi 2.0. Если это поможет, то причиной невозможности в установке Delphi могут быть любые программы, указанные в секции run или load файла win.ini, или нестандартные драйверы принтера.
   • Загрузите стандартный видеодрайвер, поставляемый с вашей системой Windows.
   • Проверьте атрибут «read-only» (только для чтения) для файлов, расположенных в каталогах Windows и windows\system.
   Вопросы, которые могут возникнуть после установки
   • Если при попытке установки 32-битного ODBC драйвера для BDE вы получаете сообщение об ошибке «odbc is corrupt or not installed correctly» (ODBC испорчен или неправильно установлен) или «BDECFG32.EXE Error» (ошибка BDECFG32.EXE), то в первую очередь вам нужно установить 32-битный менеджер ODBC, доступный в InterSolv и Microsoft. Хорошим источником является Интернет-сервер корпорации Microsoft, расположенный по адресу www.microsoft.com.
   • Если вы установили Delphi 1.0 после установки Delphi 2.0, и Delphi 2.0 загружает файлы помощи от Delphi 1.0, удалите любые ссылки на файлы помощи Delphi 1.0 из файла WINHELP.INI, расположенного в вашем каталоге Windows.

Как проводить локализацию своих приложений?

   Nomadic советует:
   В Delphi 3 и 4 есть специальные механизмы, позволяющие приложение «переделать» на любой язык после компиляции. Для D3 надо посмотреть в хелпе, по-моему, internationalization или что-то в этом роде. Для D4 вообще все делается ОЧЕНЬ просто:
   1. берется проект, компилируется;
   2. тут-же, не закрывая проект, вызвается New|Resource DLL Wizard, в нем указывается, какие формы и модули должны подвергнуться переводу на другой язык;
   3. в результате работы Wizard появляется проект (sic!) с RC и DFM. Открываем формы, и переделываем все сообщения + размер (соотв. длине сообщений);
   4. Компилируем. В результате получается файл xxxxxxx.rus, где xxxxxxx – название исходного проекта;
   5. Запускаем xxxxxxx.exe. Видим некий не наш язык. Подкладываем в каталог с этим exe изготовленный файл xxxxxxx.rus, и запускаем exe повторно. Видим абсолютно ВЕЗДЕ переведенные сообщения.
   p.s. файл RUS можно подставлять и убирать по вкусу.

crtdll.dll в программах на Delphi

   Здравствуйте.
   Тут открыл кое-что, возможно, давным давно всем известное. :) Поделюсь на всякий случай.
   Сначала немного о корнях проблемы. Не секрет, что в Delphi модуль Math поставляется только с Enterprise-версией программы. А платить больше тысячи долларов только за то, чтобы воспользоваться парой функций совсем не хочется (мне, например, простенькой atan2 часто не хватало).
   Простым решением является «заимствование» модуля Math из пиратской Enterpise-версии, но это, вообще-то, воровство. Самому же создавать матеатическую библитеку с нуля – занятие неблагодарное (по крайней мере достаточно трудоёмкое).
   Не работая плотно на MSVC я как-то был не в курсе наличия библиотеки crtdll.dll в Windows (насколько мне удалось выяснить, она таки является частью операционной системы, по крайней мере ставится вместе с Windows 9x/NT/2000). С её помощью можно решить указанную проблему, воспользовавшись готовым решением, а именно – объявить все необходые функции из math.h в своей программе и наслаждаться. :)
   Пример с atan2:
   function atan2(x, y: double): Double; stdcall; external 'crtdll.dll' name 'atan2';
   Проверено – работает. Поскольку метод открылся буквально только что, я ещё не успел сделать модуль-обёртку для всех математических функций. Видимо, сделаю и отдам во всеобщее пользование.
   Да, в crtdll.dll много фукнций, не связанных с математикой, в частности, если вы в программе используете PChar, то можно воспользоваться набором сишных strcmp, strcpy…, так же доступны isalpha, isdigit…, и, наконец, bsearch и qsort. :)
   С уважением,
   Марк Шевченко.

Как сказать VCL, чтобы клавиши shortcut пунктов главного меню главной формы действовали только в этой форме (но не в модальных окнах, к примеру)?

   Nomadic советует:
   Знакомая проблема. Лечится так:
   function WindowHook(var Message: TMessage): Boolean;

   procedure .FormCreate(Sender: TObject);
   begin
    // MainForm
    Application.HookMainWindow(WindowHook);

   function .WindowHook;
   begin
    Result := False;
    with Message do
     case Msg of
     CM_APPKEYDOWN, CM_APPSYSCOMMAND: Msg := WM_NULL;

При использовании MS SQL Server 6.5 в NT Performance Monitor исчезли все датчики, кроме SQL

   Nomadic советует:
   Кто виноват:
   Дело в следующем – при инсталляции NT страна была поставлена US, затем сменена на Russia. В реестре для Perfomance Monitor существует (может существовать) сколь угодно подуровней с названием счетчиков и описанием к ним. При инсталляции все естестественно ставилось в ветвь 409 (US), а ветви 419 (Russia) просто не было. Потом default location была сделана Russia. Perfomance Monitor не мог найти 419 и брал все счетчики из 409. Hо тут пришел SQL и как умная программа при инсталляции создал ветвь 419 и запихал туда свои счетчики. Теперь Perfomance Monitor видит что текущая locale 419, в реестре она есть и берет оттуда счетчики, а они там только для SQL естественно.
   Что делать:
   Запускаешь regedit (regedt32), находишь где лежат описания счетчиков. Точно я не помню, под рукой NT нет, но примерно так – HKEY_LOCAL_MACHINE/System/CurrentControlSet/Control/PerfLib/409 (419). В каждом разделе по два ключа – список названий счетчиков и список их описаний. Заходишь в 409, открываешь ключ для изменений и при помощи Ctrl-Ins копируешь его содержимое в буфер обмена и жмешь Cancel. Теперь идешь в 419 открываешь тот же ключ, идешь в начало списка и при помощи Shift-Ins вставляешь, жмешь Ok. Так надо сделать и для названий счетчиков и для их описания. Для полного счастья можно и SQL счетчики из 419 в 409 (в конец) скопировать.

xWindows — FAQ

   Артем Федюк прислал свой сборник любимых функций:
   (*
   Функции собрал Артем Федюк (Киев, 27.11.2000)E-Mail: xartrain@hotmail.comсообщите, пожалуйста о найденных ошибках*)
   {H+}//use huge strings
   unit XWindows;

   INTERFACE
   uses classes, windows, shellApi, shlobj, sysUtils, forms, mmsystem, controls, Messages, Registry, IniFiles;

   {***************************ПРОЦЕССЫ И УПРАВЛЕНИЕ ИМИ**************************}
   procedure execWait(const comLine:string);
   procedure shellExec(const fileName:string);
   //также можно использовать Sleep(ms:DWORD);
   procedure Delay(msecs : DWORD);
   //фактически определяется запущена ли сейчас среда Delphi
   function isDelphiRunning:boolean;
   function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL';
   procedure applicationInCtrlAltDelList(visi:boolean);
   procedure applicationInTaskBar(visi:boolean);
   //Запретить/разрешить Ctrl-Alt-Del
   procedure CtrlAltDel(state:boolean);
   //Окно без закладки в TaskBar
   procedure noAppInTaskbar;
   //Определение какие приложения уже запущены
   procedure ApplicationList(formHandle:THandle; var stringList:TStringList);

   {***************************ВРЕМЯ**********************************************}
   function SetTime(DateTime:TDateTime):Boolean;
   //обновить часы - SendMessage(HWND_TOPMOST,WM_TIMECHANGE,0,0);

   {***************************ИНТЕРФЕЙС WINDOWS**********************************}
   //Cache,Cookies,Desktop,Favorites,Fonts,Personal,Programs,SendTo,Start Menu,Startup
   function ShellFolder(const folderType:string):string;
   procedure refreshWindowsDesktop;
   procedure Startbutton(visi:boolean);
   //убрать/показать TaskBar
   procedure TaskBar(visi:boolean);
   //оч2истить меню "Документы"
   procedure clearDocuments;
   //добавить документ в меню 'Документы'
   // Для данного файла должно быть зарегистрировано средство просмотра
   procedure addFileToDocuments(const fileName:string);
   //Значение функции TRUE если мелкий шрифт
   function SmallFonts:Boolean;
   {! проверить}procedure setWallPaper(const fileName:string; tile:boolean);

   {***************************МОНИТОР********************************************}
   procedure RunCurrentScreenSaver;
   //use application:TApplication object
   procedure monitorState(state:boolean);

   {***************************КЛАВИАТУРА*****************************************}
   procedure RussianKbdLayout;
   procedure EnglishKbdLayout;
   procedure UkrainianKbdLayout;

   {***************************МЫШЬ***********************************************}
   //относительные координаты в абсолютные - function ClientToScreen(Pt:TPoint):TPoint;
   procedure mouseEmul(absPoint:TPoint; up,down:boolean);
   procedure mouseCursor(visi:boolean);
   //просимулировать нажатие клавиши мыши
   {! Не проверено}procedure SendMouseClick(x,y:integer;wHandle:THandle);

   {**8*************************ДИСКОВЫЕ ФУНКЦИИ**********************************}
   //8FAT,FAT32,CDFS,NWCOMPA
   //0-"A",1-"B",2-"C"
   function GetFileSysName(Drive : Byte) : String;
   function GetVolumeName(Drive : Byte) : String;
   function DriveExists(Drive : Byte) : Boolean;
   //'?';'Path2 does not exists';'Removable';'Fixed';'Remote';'CD-ROM';'RAMDISK'
   function CheckDriveType(Drive : Byte) : String;
   //Определение готовности дисковода к работе
   function DiskInDrive(const Drive: char): Boolean;
   function HDDSerialNum(const drivePath:string{'C:\'}):integer;

   {***************************CD-ROM*********************************************}
   function getCdromPath:string;
   procedure CDROMOpen;
   procedure CDROMClose;

   {***************************REGISTRY*******************************************}
   procedure StartFromRegistry(appName,appPath:string);
   //запускается до WindowsLogon
   procedure StartServiceFromRegistry(appName,appPath:string);
   procedure StartFromWinIni(appPath:string);
   function IsInstalled (FileExe: String): Boolean;

   IMPLEMENTATION
   (*
   Вопрос:
   Можно ли как-то уменьшить мерцание при перерисовке компонента?

   Ответ:
   Если добавить флаг csOpaque (непрозрачный) к свойству ControlStyle компонента - то фон компонента перерисовываться не будет.

   Пример:
   constructor TMyControl.Create;
   begin
    inherited;
    //проверка "if not inIDE" должна быть вставлена в том случае, когда TMyControl - компонент
    //чтобы среда IDE Delphi не глючила на этапе разработки
    if not inIDE then ControlStyle := ControlStyle + [csOpaque];
   end;
   ...
   procedure Register;
   begin
    RegisterComponents('MyGraphics', [TMyControl]);
    inIDE:=True;
   end;
   *)

   procedure mouseCursor(visi:boolean);
   Var CState:Integer;
   Begin
    CState:= ShowCursor(True);
    if visi then begin
     //Включение курсора
     while CState<0 do CState:=ShowCursor(True);
    end else begin
     //Выключение курсора
     while Cstate >= 0 do Cstate := ShowCursor(False);
    end;
   End;

   //Cache,Cookies,Desktop,Favorites,Fonts,Personal,Programs,SendTo,Start Menu,Startup
   function ShellFolder(const folderType:string):string;
   var registry:TRegistry;
   begin
    result:='';
    Registry := TRegistry.Create;
    try
     Registry.RootKey := HKey_Current_User;
     Registry.OpenKey('Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders', False);
     result:= Registry.ReadString(folderType);
    finally
     Registry.Free;
    end;
   end;

   procedure SetWallpaper(const fileName:string;tile:boolean);
   var Reg: TRegIniFile;
   begin
    Reg:=TRegIniFile.Create('Control Panel');
    Reg.WriteString('desktop', 'Wallpaper', fileName);
    if tile then Reg.WriteString('desktop', 'TileWallpaper', '1')
    else Reg.WriteString('desktop', 'TileWallpaper', '0');
    Reg.Free;
    SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, nil, SPIF_SENDWININICHANGE);
   end;

   {procedure setWallPaper(fileName:string);
   begin
    SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, pChar(fileNAme), 0);
   end;}

   procedure refreshWindowsDesktop;
   begin
    SendMessage(FindWindow('Progman', 'Program Manager'), WM_COMMAND, $A065, 0);
   end;

   procedure mouseEmul(absPoint:TPoint; up,down:boolean);
   begin
    //Положение курсора мыши задается в "абсолютных" координатах ("Mickeys"),
    //где 65535 "Mickeys" равно ширине экрана.
    absPoint.x := Round(absPoint.x * (65535 / Screen.Width));
    absPoint.y := Round(absPoint.y * (65535 / Screen.Height));
    {Переместим курсор мыши}
    Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MOVE, absPoint.x, absPoint.y, 0, 0);
    if down then Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTDOWN, absPoint.x, absPoint.y, 0, 0);
    if up then Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTUP, absPoint.x, absPoint.y, 0, 0);
   end;

   //просимулировать нажатие клавиши мыши
   procedure SendMouseClick(x,y:integer;wHandle:THandle);
   begin
    sendmessage(wHandle, WM_LBUTTONDOWN, MK_LBUTTON, x+(y shl 16));
    sendmessage(wHandle, WM_LBUTTONUP, MK_LBUTTON, x+(y shl 16));
    application.processMessages;
   end;

   procedure monitorState(state:boolean);
   begin
    if state then SendMessage(Application.Handle, wm_SysCommand, SC_MonitorPower, -1)
    else SendMessage(Application.Handle, wm_SysCommand, SC_MonitorPower, 0);
   end;

   procedure execWait(const comLine:string);
   var
    si:Tstartupinfo;
    p:Tprocessinformation;
   begin
    fillChar(Si, SizeOf(Si), 0);
    with Si do begin
     cb := SizeOf(Si);
     dwFlags := startf_UseShowWindow;
     wShowWindow := 4;
    end;
    Createprocess(nil, pChar(comLine), nil, nil, false, Create_default_error_mode, nil, nil, si, p);
    Waitforsingleobject(p.hProcess, infinite);
   end;

   procedure shellExec(const fileName:string);
   begin
    shellExecute(0, Nil, pChar(fileName), Nil, Nil, SW_NORMAL);
   end;

   procedure Delay(msecs : DWORD);
   var
    FirstTick : DWORD;
   begin
    FirstTick:=GetTickCount;
    repeat
     Application.ProcessMessages;
    until GetTickCount-FirstTick >= msecs;
   end;

   function HDDSerialNum(const drivePath:string{'C:\'}):integer;
   var
    SerialNum:Pdword;
    a,b:Dword;
    buffer:array [0..255] of char;
   begin
    result:=0;
    new(SerialNum);
    if getVolumeInformation(pChar(drivePath), buffer, sizeof(buffer), SerialNum, a, b, nil, 0) then result:=SerialNum^;
    Dispose(SerialNum);
   end;

   //фактически определяется запущена ли сейчас среда Delphi
   function isDelphiRunning:boolean;
   var H1, H2, H3, H4 : Hwnd;
   const
    A1 : array[0..12] of char = 'TApplication'#0;
    A2 : array[0..15] of char = 'TAlignPalette'#0;
    A3 : array[0..18] of char = 'TPropertyInspector'#0;
    A4 : array[0..11] of char = 'TAppBuilder'#0;
   begin
    result:=false;
    H1 := FindWindow(A1, nil);
    H2 := FindWindow(A2, nil);
    H3 := FindWindow(A3, nil);
    H4 := FindWindow(A4, nil);
    if (H1 <> 0) and (H2 <> 0) and (H3 <> 0) and (H4 <> 0) then result:=true;
   end;

   function getCdromPath:string;
   var
    w:dword;
    Root:string;
    i:integer;
   begin
    result:='';
    w:=GetLogicalDrives;
    Root := '#:\';
    for i := 0 to 25 do begin
     Root[1] := Char(Ord('A')+i);
     if (W and (1 shl i))>0 then
      if GetDriveType(Pchar(Root)) = DRIVE_CDROM then begin
       result:=Root;
       exit;
      end;
    end;
   end;

   //Определение готовности дисковода к работе
   function DiskInDrive(const Drive: char): Boolean;
   var
    DrvNum: byte;
    EMode: Word;
   begin
    result := false;
    DrvNum := ord(Drive);
    if DrvNum >= ord('a') then dec(DrvNum, $20);
    EMode := SetErrorMode(SEM_FAILCRITICALERRORS);
    try
     if DiskSize(DrvNum-$40) <> -1 then result := true
     else messagebeep(0);
    finally
     SetErrorMode(EMode);
    end;
   end;

   function soundCardExists:boolean;
   begin
    if WaveOutGetNumDevs>0 then result:=true
    else result:=false;
   end;

   function SetTime(DateTime:TDateTime):Boolean;
   var
    st:TSystemTime;
    ZoneTime: TTimeZoneInformation;
   begin
    GetTimeZoneInformation(ZoneTime);
    DateTime:=DateTime+ZoneTime.Bias/1440;
    with st do begin
     DecodeDate(DateTime, wYear, wMonth, wDay);
     DecodeTime(DateTime, wHour, wMinute, wSecond, wMilliseconds);
    end;
    result:=SetSystemTime(st);
    SendMessage(HWND_TOPMOST, WM_TIMECHANGE, 0, 0);
   end;

   //Окно без закладки в TaskBar
   procedure noAppInTaskbar;
   begin
    ShowWindow(Application.Handle, sw_Hide);
   end;

   //Определение какие приложения уже запущены
   procedure ApplicationList(formHandle: THandle; var stringList: TStringList);
   var
     nd : hWnd;
    buff: ARRAY [0..127] OF Char;
   begin
    stringList.Clear;
    Wnd := GetWindow(formHandle, gw_HWndFirst);
    WHILE Wnd <> 0 DO BEGIN
    {Не показываем:}
     IF (Wnd <> Application.Handle) AND {-Собственное окно}
      IsWindowVisible(Wnd) AND {-Невидимые окна}
      (GetWindow(Wnd, gw_Owner) = 0) AND {-Дочернии окна}
      (GetWindowText(Wnd, buff, sizeof(buff)) <> 0) {-Окна без заголовков}
      THEN BEGIN
       GetWindowText(Wnd, buff, sizeof(buff));
       stringList.Add(StrPas(buff));
      END;
     Wnd := GetWindow(Wnd, gw_hWndNext);
    END;
   end;

   procedure CDROMOpen;
   begin
    mciSendString('Set cdaudio door open wait', nil, 0, 0);
   end;

   procedure CDROMClose;
   begin
    mciSendString('Set cdaudio door closed wait', nil, 0, 0);
   end;

   //Запретить/разрешить Ctrl-Alt-Del
   procedure CtrlAltDel(state:boolean);
   var old:Boolean;
   begin
    old:=True;
    if state then
     //Восстановить
     SystemParametersInfo(SPI_SCREENSAVERRUNNING, 0, @old, 0)
    else
     //Убрать
     SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, @old, 0);
   end;

   procedure StartButton(visi:boolean);
   Var
    Tray, Child : hWnd;
    C : Array[0..127] of Char;
    S : String;
   Begin
    Tray := FindWindow('Shell_TrayWnd', NIL);
    Child := GetWindow(Tray, GW_CHILD);
    While Child <> 0 do Begin
     If GetClassName(Child, C, SizeOf(C)) > 0 Then Begin
      S := StrPAS(C);
      If UpperCase(S) = 'BUTTON' then begin
       If Visi then ShowWindow(Child, 1)
       else ShowWindow(Child, 0);
      end;
     End;
     Child := GetWindow(Child, GW_HWNDNEXT);
    End;
   End;

   //убрать/показать TaskBar
   procedure TaskBar(visi:boolean);
   begin
    if visi then ShowWindow(FindWindow('Shell_TrayWnd', nil), SW_SHOW) // Показать Taskbar
    else ShowWindow(FindWindow('Shell_TrayWnd', nil), SW_HIDE); //Скрыть TaskBar
   end;

   procedure applicationInCtrlAltDelList(visi:boolean);
   begin
    if visi then begin
     //Show
     RegisterServiceProcess(GetCurrentProcessID, 0);
    end else begin
     //Hide
     RegisterServiceProcess(GetCurrentProcessID, 1);
    end;
   end;

   procedure applicationInTaskBar(visi:boolean);
   begin
    if visi then windows.ShowWindow(FindWindow(nil, @Application.Title[1]), SW_SHOW)
    else windows.ShowWindow(FindWindow(nil, @Application.Title[1]), SW_HIDE);
   end;

   procedure RussianKbdLayout;//На русский
   var Layout: array[0..KL_NAMELENGTH] of char;
   begin
    LoadKeyboardLayout(StrCopy(Layout, '00000419'), KLF_ACTIVATE);
   end;

   procedure EnglishKbdLayout;//На английский
   var Layout: array[0..KL_NAMELENGTH] of char;
   begin
    LoadKeyboardLayout(StrCopy(Layout, '00000409'), KLF_ACTIVATE);
   end;

   procedure UkrainianKbdLayout;//На украинский
   var Layout: array[0..KL_NAMELENGTH] of char;
   begin
    LoadKeyboardLayout(StrCopy(Layout, pChar(intToHex(LANG_UKRAINIAN+$400, 8))), KLF_ACTIVATE);
   end;

   //запустить текущий ScreenSaver
   procedure RunCurrentScreenSaver;
   begin
    SendMessage(Application.Handle, WM_SYSCOMMAND, SC_SCREENSAVE, 0);
   end;

   //очистить меню "Документы"
   procedure clearDocuments;
   begin
    SHAddToRecentDocs(SHARD_PATH, nil);
   end;

   //добавить документ в меню 'Документы'
   // Для данного файла должно быть зарегистрировано средство просмотра
   procedure addFileToDocuments(const fileName:string);
   begin
    SHAddToRecentDocs(SHARD_PATH, pchar(fileName));
   end;

   //Значение функции TRUE если мелкий шрифт
   function SmallFonts:Boolean;
   var DC:HDC;
   begin
    DC:=GetDC(0);
    Result:=(GetDeviceCaps(DC, LOGPIXELSX) = 96);
    { В случае крупного шрифта будет 120}
    ReleaseDC(0, DC);
   end;

   function DriveExists(Drive : Byte) : Boolean;
   begin
    Result := Boolean(GetLogicalDrives AND (1 SHL Drive))
   end;

   //'?';'Path does not exists';'Removable';'Fixed';'Remote';'CD-ROM';'RAMDISK'
   function CheckDriveType(Drive : Byte) : String;
   var
    DriveLetter : Char;
    DriveType   : UInt;
   begin
    DriveLetter := Char(Drive + $41);
    DriveType   := GetDriveType(PChar(DriveLetter + ':\'));
    Case DriveType of
    0               : Result := '?';
    1               : Result := 'Path does not exists';
    DRIVE_REMOVABLE : Result := 'Removable';
    DRIVE_FIXED     : Result := 'Fixed';
    DRIVE_REMOTE    : Result := 'Remote';
    DRIVE_CDROM     : Result := 'CD-ROM';
    DRIVE_RAMDISK   : Result := 'RAMDISK'
    Else Result := 'Unknown';
    end;
   end;

   //GetVolumeInformation
   function GetFileSysName(Drive : Byte) : String;
   var
    DriveLetter : Char;
    NoMatter    : DWORD;
    FileSysName : Array[0..MAX_PATH] of Char;
   begin
    DriveLetter := Char(Drive + $41);
    GetVolumeInformation(PChar(DriveLetter + ':\'), Nil, 0, nil, NoMatter, NoMatter, FileSysName, SizeOf(FileSysName));
    Result := FileSysName;
   end;

   function GetVolumeName(Drive : Byte) : String;
   var
    DriveLetter : Char;
    NoMatter    : DWORD;
    VolumeName  : Array[0..MAX_PATH] of Char;
   begin
    DriveLetter := Char(Drive + $41);
    GetVolumeInformation(PChar(DriveLetter + ':\'), VolumeName, SizeOf(VolumeName), nil, NoMatter, NoMatter, Nil, 0);
    Result := VolumeName;
   end;

   procedure StartFromRegistry(appName,appPath:string);
   var reg: TRegistry;
   begin
    reg := TRegistry.Create;
    reg.RootKey := HKEY_LOCAL_MACHINE;
    reg.LazyWrite := false;
    reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', true{canCreate});
    reg.WriteString(appname, appPath);
    reg.CloseKey;
    reg.free;
   end;

   procedure StartServiceFromRegistry(appName,appPath:string);
   var reg: TRegistry;
   begin
    reg := TRegistry.Create;
    reg.RootKey := HKEY_LOCAL_MACHINE;
    reg.LazyWrite := false;
    reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\RunServices', true{canCreate});
    reg.WriteString(appname, appPath);
    reg.CloseKey;
    reg.free;
   end;

   procedure StartFromWinIni(appPath:string);
   var
    WinIni : TIniFile;
    WinIniFileName : array[0..MAX_PATH] of char;s : string;
   begin
    GetWindowsDirectory(WinIniFileName, sizeof(WinIniFileName));
    StrCat(WinIniFileName, '\win.ini');
    WinIni := TIniFile.Create(WinIniFileName);
    s := WinIni.ReadString('windows', 'run', '');
    if s = '' then s := appPath
    else s := s + ';' + appPath;
    WinIni.WriteString('windows', 'run', s);
    WinIni.Free;
   end;

   function IsInstalled(FileExe: String): Boolean;
   var
   reg : TRegistry;
    temp: String;
   begin
    result:=False;
    reg:= Tregistry.Create;
    try
     reg.RootKey:= HKEY_LOCAL_MACHINE;
     if reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\App Paths\'+FileExe, false) then begin
      if reg.ValueExists('') then begin
       temp := reg.readString('Path');
       result := FileExists(temp+'\'+FileExe);
      end;
     end;
    finally
     reg.Free;
    end;
   end;

   END.

Каким именно релизом Delphi вообще стоит пользоваться для каждой конкретной версии?

   Nomadic отвечает:
   A: Во-первых, вы можете узнать точную версию Delphi, если в окошке Help | About нажмете кнопку Alt и, не отпуская, наберете «VERSION».
   Delphi 1 следует апгрейдить до версии 1.02 с помощью патчей.
   Delphi 2 следует апгрейдить до версии 2.01. Это полноценный дистрибутив. Эту версию можно, в частности, узнать по странице «Internet» в палитре компонентов. Ее точная версия 2.0.76.0.
   Delphi 3 следует взять версии 3.02. Это полноценный дистрибутив 3.01 и патчи до 3.02.
   Delphi 4 же должна быть обновлена вторым, а затем третьим Service Pack'ами, которые можно взять на сайте Inprise.
   Версии Delphi 4.3 и 4.5 являются обманными версиями. В действительности это ранние беты Delphi 4.0.

Советы по Delphi. Версия 1.4.3 от 1.1.2001

Валентин Озеров

Что такое "Советы по Delphi"?

Предупреждение

Алгоритмы

Преобразования

Преобразование дробной и целой части REAL-числа в два целых

Есть ли функция, выполняющая пpеобpазование пеpеменной real в integer?

Почему непpавильно pаботает функция StrToFloat?

Число строкой X

Даты

Добавление даты и времени в компонент Memo

Вычисление даты Пасхи II

Преобразование даты в количество секунд

Преобразование даты в неделю

Преобразование даты

Преобразование даты — добавление столетия

Приведение даты

Даты и недели

Количество дней между двумя датами I

Количество дней между двумя датами II

Конвертирование даты

Число текущей недели

Разница во времени

Проблема со временем

Переменная времени

Математика

Как научить Delphi делать правильное округление дробных чисел?

Разное

Генерация еженедельных списков задач

Генерация случайного пароля

Проверка ISBN

API

Переменные среды

Как раскрыть строки с подстановками вида '%SystemRoot%\IOSUBSYS\'?

Изменение системного времени из Delphi II

Завершение работы Windows

Определение завершения работы Windows

Как консольное приложение может узнать, что Винды завершаются?

Как корректно перехватить сигнал выгрузки операционной системы, если в моей программе нет окна?

Постепенное умирание

Разное

Как не допустить запуск второй копии программы VIII

Как не допустить запуск второй копии программы IX

Файл TPrevInstUnit

Как не допустить запуск второй копии программы X

Как не допустить запуск второй копии программы XI

Как не допустить запуск второй копии программы XII

Как правильно завершить некое приложение?

Как отчитывать промежутки времени с точностью, большей чем 60 мсек?

Как сделать чтобы при событиях моя программа отпpавляла кому-либо сообщение на мой компьютеp?

Вызов других программ

Получение списка запущеных приложений

Открытие выбранного файла в работающем приложении

Убиваем активное приложение

Комментарии

Pascal

Объекты

Проблема циклических ссылок

Создание множества экземпляров

Параметры

Передача функции как параметра

Проблема передачи записи

Указатели

Указатель на функцию I

Указатель на функцию II

Использование указателей на целое

Память

Функция MemAvail для Delphi2?

Как работать с блоками памяти размером более 64K?

События

Назначение обработчика события OnClick пункту меню, созданному во время выполнения программы

События для компонентов, созданных во время работы программы I

События для компонентов, созданных во время работы программы II

Массивы

Динамические массивы V

Динамические массивы VI

Динамические массивы VII

Динамические массивы VIII

Пример массива констант (Array of Const) III