Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

ВИДЕОКУРС ВЗЛОМ
выпущен 3 апреля!


УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



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

Microsoft выпустила новую клавиатуру с дополнительной педалью, которая нажимает сразу три клавиши, и новый корпус, у которого по кнопке Reset можно бить кулаком.


 //На русский
 procedure TForm1.Button1Click(Sender: TObject);
 var
   Layout: array[0.. KL_NAMELENGTH] of char;
 begin
   LoadKeyboardLayout( StrCopy(Layout,'00000419'),KLF_ACTIVATE);
 end;
 
 //На английский
 procedure TForm1.Button2Click(Sender: TObject);
 var
   Layout: array[0.. KL_NAMELENGTH] of char;
 begin
   LoadKeyboardLayout(StrCopy(Layout,'00000409'),KLF_ACTIVATE);
 end;
 




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

Если Админ в 09:00 на рабочем месте - значит, сервер не работает.

Данный документ содержит информацию, позволяющую осуществить подключение к базе данных 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

Предостережение: Данный документ не гарантирует установление соединения с сервером, он демонстрирует самый лучший и быстрый способ сделать это.




Преобразовать код символа в скан-код клавиши

Автор: Sniknik

для буквы 'Ф' его и не будет, 0 невозможно преобразовать. посмотри ее значение (Ord) чему равно? а клавиш всего 101шт. (но не все так просто, 101 это наоборот скэн коды надо считать) в твоем случае букву 'Ф' надо переводить в анг. вариант 'A' и тогда MapVirtualKey(Key,0) дает скэн код. короче не работает с MapVirtualKey с локализованными раскладками а AnsiMapVirtualKey пока нет.


 procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
 var st: string;
 begin
  if WinKey <  Key then begin
    WinKey:= Key;
    Edit1.Text:= 'Key : '+IntToStr(Key)+' Char : '+Chr(Key);
  end;
  // MapVirtualKey
  Memo1.Lines.Add('Key : '+IntToStr(Key)+' Char : '+Chr(Key)+' MVK : '+
   IntToStr(MapVirtualKey(Key,0)));
  if ssShift in Shift then st:= '1'
  else st:= '0';
  if ssAlt in Shift then st:= st + '1'
  else st:= st+'0';
  if ssCtrl in Shift then st:= st + '1'
  else st:= st+'0';
 
  if ssLeft in Shift then st:= st + '1'
  else st:= st+'0';
  if ssRight in Shift then st:= st + '1'
  else st:= st+'0';
  if ssMiddle in Shift then st:= st + '1'
  else st:= st+'0';
  if ssDouble in Shift then st:= st + '1'
  else st:= st+'0';
  Memo1.Lines.Add('State Shift/Alt/Ctrl/Left/Right/Middle/Double : '+st);
  {
  GetNumberofConsoleInputEvents
  if Key = VK_F1 then Form1.Caption := 'F1';
  WM_KEYDOWN
  MapVirtualKeyEx, OemKeyScan, VkKeyScanEx
  }
 end;
 




Симфония на клавиатуре


-Рабинович, а вы выписали на следующий год какие-нибудь газеты?
-Нет,зачем,если есть Internet.
- А в туалет с клавиатурой ходить будете?

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

События клавиатуры, наряду с событиями мыши, являются основными элементами взаимодействия пользователя с программой. В данной статье пойдёт речь о трёх событиях, которые позволяют отлавливать нажатия клавиш в приложении Delphi: OnKeyDown, OnKeyUp и OnKeyPress.

Для получения ввода с клавиатуры, приложения Delphi могут использовать два метода. Самый простой способ, это воспользоваться одним из компонентов, автоматически реагирущем на нажатия клавиш, таким как Edit. Второй способ заключается в создании процедур в форме, которые будут обрабатывать нажатия и отпускания клавиш. Эти обработчики могут обрабатывать как нажатия одиночных клавиш, так и комбинаций. Итак, вот эти события:

OnKeyDown - вызывается, когда на клавиатуре нажимается любая клавиша. OnKeyUp - вызывается, когда любая клавиша на клавиатуре отпускается. OnKeyPress - вызывается, когда нажимается клавиша, отвечающая за определённый ASCII символ.

Теперь самое время посмотреть, как выглядят в программе заголовки обработчиков:


 procedure TForm1.FormKeyDown
 (Sender: TObject; var Key: Word; Shift: TShiftState);
 ...
 procedure TForm1.FormKeyUp
 (Sender: TObject; var Key: Word; Shift: TShiftState);
 ...
 procedure TForm1.FormKeyPress
 (Sender: TObject; var Key: Char);
 

Все события имеют один общий параметр, обычно называемый Key. Этот параметр используется для передачи кода нажатой клавиши. Параметр Shift (в процедурах OnKeyDown и OnKeyUp), указывает на то, была ли нажата клавиша в сочетании с Shift, Alt, и Ctrl.

Фокус

Фокус, это способность получать пользовательский ввод через мышь или клавиатуру. Получать события от клавиатуры могут только те объекты, которые имеют фокус. На форме активного приложения в один момент времени может быть активным (иметь фокус) только один компонент.

Некоторые компоненты, такие как TImage, TPaintBox, TPanel и TLabel не могут получать фокус, другими словами, это компоненты, наследованные от TGraphicControl. Так же не могут получать фокус невидимые компоненты, такие как TTimer.

OnKeyDown, OnKeyUp

События OnKeyDown и OnKeyUp обеспечивают самый низкий уровень ответа клавиатуры. Обработчики OnKeyDown и OnKeyUp могут реагировать на все клавиши клавиатуры, включая функциональные и комбинации с клавишами Shift, Alt, и Ctrl.

События клавиатуры - не взаимоисключающие. Когда пользователь нажимает клавишу, то генерируются два события OnKeyDown и OnKeyPress, а когда отпускает, то только одно: OnKeyUp. Если пользователь нажмёт одну из клавиш, которую OnKeyPress не сможет определить, то будет сгенерировано только одно событие OnKeyDown, а при отпускании OnKeyUp.

OnKeyPress

OnKeyPress возвращает различные значения ASCII для 'g' и 'G,'. Однако, OnKeyDown и OnKeyUp не делают различия между верхним и нижним регистром.

Параметры Key и Shift

Параметр Key можно изменять, чтобы приложение получило другой код нажатой клавиши. Таким образом можно ограничивать набор различных символов, которые пользователь может ввести с клавиатуры. Например разрешить вводить только цифры. Для этого добавьте в обработчик события OnKeyPress следующий код и установите KeyPreview в True (см. ниже).


 if Key in ['a'..'z'] + ['A'..'Z'] then
   Key := #0;
 

Это выражение проверяет, содержит ли параметр Key символы нижнего регистра ('a'..'z') и символы верхнего регистра ('A'..'Z'). Если так, то в параметр заносится значение нуля, чтобы предотвратить ввод в компонент Edit (например).

В Windows определены специальные константы для каждой клавиши. Например, VK_RIGHT соответствует коду клавиши для правой стрелки.

Чтобы получить состояния специальных клавиш, таких как TAB или PageUp можно воспользоваться API функцией GetKeyState. Клавиши состояния могут находиться в трёх состояниях: отпущена, нажата, и включена. Если старший бит равен 1, то клавиша нажата, иначе отпущена. Для проверки этого бита можно воспользоваться API функцией HiWord. Если младший бит равен 1, то клавиша включена. Вот пример получения сосотояния специальной клавиши:


 if HiWord(GetKeyState(vk_PageUp)) <> 0 then
   ShowMessage('PageUp - DOWN')
 else
   ShowMessage('PageUp - UP');
 

В событиях OnKeyDown и OnKeyUp, Key является беззнаковым двухбайтовым (Word) значением, которое представляет виртуальную клавишу Windows. Для получания значения символа можно воспользоваться функцией Chr. В событии OnKeyPress параметр Key является значением Char, которое представляет символ ASCII.

События OnKeyDown и OnKeyUp имеют параметр Shift с типом TShiftState. В Delphi тип TShiftState определён как набор флагов, определяющих состояние Alt, Ctrl, и Shift при нажатии клавиши.

Например, следующий код (из обработчика OnKeyUp) соединяет строку 'Ctrl +' с нажатой клавишей и отображает результат в заголовке формы:


 if ssCtrl in Shift then
   Form1.Caption:= 'Ctrl +' + Chr(Key);
 

Если нажать Ctrl + A, то будут сгенерированы следующие события:


 KeyDown  (Ctrl)   // ssCtrl
 KeyDown  (Ctrl+A) // ssCtrl + 'A'
 KeyPress (A)
 KeyUp    (Ctrl+A)
 

Переадресация событий клавиатуры в форму

Клавиатурный обработчик может работать на двух уровнях: на уровне компонентов и на уровне формы. Свойство формы KeyPreview определяет, будут ли клавиатурные события формы вызываться перед клавиатурными событиями компонентов, так как форма может получать все нажатия клавиш, предназначенные для компонента имеющего в данный момент фокус.

Чтобы перехватить нажатия клавиш на уровне формы, до того как они будут переданы компонентам на форме, необходимо установить свойство KeyPreview в True. После этого компонент как и раньше будет получать события, однако сперва они будут попадать в форму, чтобы дать возможность программе разрешить или запретить ввод различных символов.

Допустим, У Вас на форме есть несколько компонентов Edit и процедура Form.OnKeyPress выглядит следующим образом:


 procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
 begin
   if Key in ['0'..'9'] then
     Key := #0
 end;
 

Если один из компонентов Edit имеет фокус и свойство KeyPreview установлено в False, то этот код не будет выполнен - другими словами, если пользователь нажмёт клавишу '5', то в компоненте Edit, имеющем фокус, появится символ "5".

Однако, если KeyPreview установлено в True, то событие формы OnKeyPress будет выполнено до того, как компонент Edit увидит нажатую клавишу. Поэтому, если пользователь нажмёт клавишу '5', то в Key будет подставлено нулевое значение, предотвращая тем самым попадание числовых символов в Edit.




Синхронизировать время на 2-х компьютерах в локальной сети

Жена:
- Ва-ань, дома есть нечего! Муж:
- Отстань...
- Ва-ань, последние носки тебе штопаю!
- Свали.
- Ва-ань, старшему завтра в лагерь, а у него ботинки развалились...
- Да отцепись ты! У меня за Интернет не плачено, а ты тут со всякой ерундой лезешь!

Синхронизация времени с сервера/раб. станции "nts2"


 WinExec('net time \\nts2 /set /yes',SW_HIDE);
 




Синхронизация DLL с открытым набором данных

Тема: Синхронизация DLL с открытым набором данных

В данном совете показано как с помощью Object Pascal динамически, на лету, связать DLL с активной базой данных, таким образом дающей программисту возможность воспользоваться Modularize-характеристикой. (Независимо от текущего режима, будь то разработка приложения, или его выполнение)

Технология динамической линковки DLL к EXE полезна во многих случаях. Например, работа с пакетами для создания 'plug-in' модулей (A/R, A/P, General Ledger и др.) или Point of Sale package с Current Stock, FIFO/LIFO Ordering, Vendor Tracking, и пр. модули.

Данная статья дает работающий пример того, как это сделать с единственной dll, 'Editdll.dll', и предоставит разработчику материал, расказывающий о том, как организовать в вашем приложении подключаемые модули.

Предварительные условия:

Хорошее знание работы компонента TTable, умение использовать DLL, BDE API и знание BDE hCursor. *WIN API для динамической загрузки любых DLL.

Пример приложения

Приведенная ниже форма, EditForm, работает с таблицей COUNTRY, расположенной в каталоге DBDEMO. При нажатии пользователем кнопки 'Edit' или при двойном щелчке на записи (строке), возникает диалоговое окно, расположенное в 'EditDll.dll' и демонстрирующее специфическую информацию, относящуюся к данной записи. В этой "точке" DLL синхронизирует себя не только с набором данных (и сессией), но и с текущей записью. Это означает, что полозователь изменяет те же самые данные, что он видит в EditForm! Ну а теперь углубимся в код демонстрационного приложения. (Для удобства просто скопируйте отсюда эти файлы и вставьте в ваше приложение)


 // Проект главной формы
 
 { MAINDB.DPR }
 program maindb;
 
 uses
   Forms,
   mainform in 'mainform.pas' {DBMainForm};
 
 {$R *.RES}
 
 begin
   Application.Initialize;
   Application.CreateForm(TDBMainForm, DBMainForm);
   Application.Run;
 end.
 
 { MAINFORM.PAS }
 unit mainform;
 
 interface
 
 uses
   SysUtils, Windows, Messages, Classes, Graphics, Controls,
   StdCtrls, Forms, DBCtrls, DB, DBGrids, DBTables, Grids, ExtCtrls, BDE;
 
 type
   TDBMainForm = class(TForm)
     Table1Name: TStringField;
     Table1Capital: TStringField;
     Table1Continent: TStringField;
     Table1Area: TFloatField;
     Table1Population: TFloatField;
     DBGrid1: TDBGrid;
     DBNavigator: TDBNavigator;
     Panel1: TPanel;
     DataSource1: TDataSource;
     Panel2: TPanel;
     Table1: TTable;
     EditButton: TButton;
     procedure FormCreate(Sender: TObject);
     procedure EditButtonClick(Sender: TObject);
     procedure DBGrid1DblClick(Sender: TObject);
   private
     { private declarations }
   public
     { public declarations }
   end;
 
 var
   DBMainForm: TDBMainForm;
 
 implementation
 
 {$R *.DFM}
 
 procedure TDBMainForm.FormCreate(Sender: TObject);
 begin
   Table1.Open;
 end;
 
 // {ПРИМЕЧАНИЕ: DBHandle - дескриптор базы данных & DSHandle - курсор
 //  рассматриваемой записи. Кроме того, если вы имеете цель в
 //  динамической загрузке DLL во время выполнения приложения,
 //  используйте вызовы API LoadLibrary, GetProcAddress и
 //  FreeLibrary вместо подразумевающихся вызовов загрузки при
 //  запуске. Пример использования API для динамической загрузки: }
 // Type
 //  {Для GetProcAddress}
 //  BDEDataSync =
 //    function(const DBHandle: HDBIDB; const DSHandle: HDBICur): Boolean;
 //             stdcall;
 //  {Организация перехвата ошибок загрузки DLL}
 //  EDLLLoadError = class(Exception);
 // var h: hwnd;
 //     p: BDEDataSync;
 //     LastError: DWord;
 // begin
 // UpdateCursorPos;
 // Try
 //   h := loadLibrary('EDITDLL.DLL');
 //   {Примечание для пользователей Delphi 1.0: Поскольку Win32
 //    LoadLibrary при неудачной загрузке DLL возвращает NULL,
 //    поэтому для поиска ошибки необходим вызов GetLastError,
 //    Win16 LoadLibrary возвращает значение ошибки (меньше чем
 //    HINSTANCE_ERROR), которая для выяснения причин неудачной
 //    загрузки может затем провериться с помощью Win16API SDK.}
 //   if h = 0 then begin
 //      LastError := GetLastError;
 //      Raise EDLLLoadError.create(IntToStr(LastError) +
 //                                 ': Невозможно загрузить DLL');
 //      end;
 //   try
 //      p := getProcAddress(h, 'EditData');
 //      if p(DBHandle, Handle) then Resync([]);
 //   finally
 //      freeLibrary(h);
 //   end;
 // Except
 //   On E: EDLLLoadError do
 //     MessageDLG(E.Message, mtInformation, [mbOk],0);
 // end;
 // end;
 // {или}
 
 function EditData(const DBHandle: HDBIDB; const DSHandle: HDBICur):
   Boolean; stdcall external 'EDITDLL.DLL' name 'EditData';
 
 procedure TDBMainForm.EditButtonClick(Sender: TObject);
 
 begin
   with Table1 do
   begin
     UpdateCursorPos;
     // Вызываем процедуру EditData из EditDll.dll.
     if EditData(DBHandle, Handle) then
       Resync([]);
   end;
 end;
 
 procedure TDBMainForm.DBGrid1DblClick(Sender: TObject);
 begin
   EditButton.Click;
 end;
 
 end.
 
 // Проект EDIT DLL
 
 { EDITDLL.DPR }
 library editdll;
 
 uses
   SysUtils,
   Classes,
   editform in 'editform.pas' {DBEditForm};
 
 exports
   EditData;
 
 begin
 end.
 
 { EDITFORM.PAS }
 unit editform;
 
 interface
 
 uses
   SysUtils, Windows, Messages, Classes, Graphics, Controls, StdCtrls,
   Forms, DBCtrls, DB, DBTables, Mask, ExtCtrls, BDE;
 
 type
   TTableClone = class;
 
   TDBEditForm = class(TForm)
     ScrollBox: TScrollBox;
     Label1: TLabel;
     EditName: TDBEdit;
     Label2: TLabel;
     EditCapital: TDBEdit;
     Label3: TLabel;
     EditContinent: TDBEdit;
     Label4: TLabel;
     EditArea: TDBEdit;
     Label5: TLabel;
     EditPopulation: TDBEdit;
     DBNavigator: TDBNavigator;
     Panel1: TPanel;
     DataSource1: TDataSource;
     Panel2: TPanel;
     Database1: TDatabase;
     OKButton: TButton;
   private
     TableClone: TTableClone;
   end;
 
   { TTableClone }
 
   TTableClone = class(TTable)
   private
     SrcHandle: HDBICur;
   protected
     function CreateHandle: HDBICur; override;
   public
     procedure OpenClone(ASrcHandle: HDBICur);
   end;
 
 function EditData(const DBHandle: HDBIDB; const DSHandle: HDBICur): Boolean;
   stdcall;
 
 var
   DBEditForm: TDBEditForm;
 
 implementation
 
 {$R *.DFM}
 
 { Экспорт }
 
 function EditData(const DBHandle: HDBIDB; const DSHandle: HDBICur): Boolean;
   stdcall;
 var
   DBEditForm: TDBEditForm;
 begin
   DBEditForm := TDBEditForm.Create(Application);
   with DBEditForm do
   try
     // Устанавливаем дескриптор Database1 на открытую в текущий момент базу данных
     Database1.Handle := DBHandle;
     TableClone := TTableClone.Create(DBEditForm);
     try
       TableClone.DatabaseName := 'DB1';
       DataSource1.DataSet := TableClone;
       TableClone.OpenClone(DSHandle);
       Result := (ShowModal = mrOK);
       if Result then
       begin
         TableClone.UpdateCursorPos;
         DbiSetToCursor(DSHandle, TableClone.Handle);
       end;
     finally
       TableClone.Free;
     end;
   finally
     Free;
   end;
 end;
 
 { TTableClone }
 
 procedure TTableClone.OpenClone(ASrcHandle: HDBICur);
 begin
   SrcHandle := ASrcHandle;
   Open;
   DbiSetToCursor(Handle, SrcHandle);
   Resync([]);
 end;
 
 function TTableClone.CreateHandle: HDBICur;
 begin
   Check(DbiCloneCursor(SrcHandle, False, False, Result));
 end;
 
 end.
 
 { EDITFORM.DFM }
 object DBEditForm: TDBEditForm
   Left = 201
     Top = 118
     Width = 354
     Height = 289
     ActiveControl = Panel1
     Caption = 'DBEditForm'
     Font.Color = clWindowText
     Font.Height = -11
     Font.Name = 'MS Sans Serif'
     Font.Style = []
     Position = poScreenCenter
     PixelsPerInch = 96
     TextHeight = 13
     object Panel1: TPanel
     Left = 0
       Top = 0
       Width = 346
       Height = 41
       Align = alTop
       TabOrder = 0
       object DBNavigator: TDBNavigator
       Left = 8
         Top = 8
         Width = 240
         Height = 25
         DataSource = DataSource1
         Ctl3D = False
         ParentCtl3D = False
         TabOrder = 0
     end
     object OKButton: TButton
       Left = 260
         Top = 8
         Width = 75
         Height = 25
         Caption = 'OK'
         default = True
         ModalResult = 1
         TabOrder = 1
     end
   end
   object Panel2: TPanel
     Left = 0
       Top = 41
       Width = 346
       Height = 221
       Align = alClient
       BevelInner = bvLowered
       BorderWidth = 4
       Caption = 'Panel2'
       TabOrder = 1
       object ScrollBox: TScrollBox
       Left = 6
         Top = 6
         Width = 334
         Height = 209
         HorzScrollBar.Margin = 6
         HorzScrollBar.Range = 147
         VertScrollBar.Margin = 6
         VertScrollBar.Range = 198
         Align = alClient
         AutoScroll = False
         BorderStyle = bsNone
         TabOrder = 0
         object Label1: TLabel
         Left = 6
           Top = 6
           Width = 28
           Height = 13
           Caption = 'Name'
           FocusControl = EditName
       end
       object Label2: TLabel
         Left = 6
           Top = 44
           Width = 32
           Height = 13
           Caption = 'Capital'
           FocusControl = EditCapital
       end
       object Label3: TLabel
         Left = 6
           Top = 82
           Width = 45
           Height = 13
           Caption = 'Continent'
           FocusControl = EditContinent
       end
       object Label4: TLabel
         Left = 6
           Top = 120
           Width = 22
           Height = 13
           Caption = 'Area'
           FocusControl = EditArea
       end
       object Label5: TLabel
         Left = 6
           Top = 158
           Width = 50
           Height = 13
           Caption = 'Population'
           FocusControl = EditPopulation
       end
       object EditName: TDBEdit
         Left = 6
           Top = 21
           Width = 135
           Height = 21
           DataField = 'Name'
           DataSource = DataSource1
           MaxLength = 0
           TabOrder = 0
       end
       object EditCapital: TDBEdit
         Left = 6
           Top = 59
           Width = 135
           Height = 21
           DataField = 'Capital'
           DataSource = DataSource1
           MaxLength = 0
           TabOrder = 1
       end
       object EditContinent: TDBEdit
         Left = 6
           Top = 97
           Width = 135
           Height = 21
           DataField = 'Continent'
           DataSource = DataSource1
           MaxLength = 0
           TabOrder = 2
       end
       object EditArea: TDBEdit
         Left = 6
           Top = 135
           Width = 65
           Height = 21
           DataField = 'Area'
           DataSource = DataSource1
           MaxLength = 0
           TabOrder = 3
       end
       object EditPopulation: TDBEdit
         Left = 6
           Top = 173
           Width = 65
           Height = 21
           DataField = 'Population'
           DataSource = DataSource1
           MaxLength = 0
           TabOrder = 4
       end
     end
   end
   object DataSource1: TDataSource
     Left = 95
       Top = 177
   end
   object Database1: TDatabase
     DatabaseName = 'DB1'
       LoginPrompt = False
       SessionName = 'Default'
       Left = 128
       Top = 176
   end
 end
 




Синхронизация таблицы и StringList

Автор: OAmiry (Borland)

Допустим что вы имеете TTable с именем Table1 и DBGrid с именем DBGrid1:

  1. В секции модуля interface объявите переменную:

  2.  FieldLst: TStringList;
     

  3. Установите свойство формы KeyPreview в TRUE
  4. В обработчике события формы OnCreate добавьте:

  5.  FieldLst := TStringList.Create;
     

  6. В обработчике события формы OnDestroy добавьте:

  7.  FieldLst.Free;
     

  8. В обработчике события формы OnKeyUp добавьте:

  9.  if (ssCtrl in Shift) and (Key in [Ord('D'), Ord('d')]) then
     if (FieldLst.Count > 0 ) then
     begin
     {Если вам необходимы все предыдущие данные полей}
     {for nFld := 0 to Table1.FieldCount - 1 do
     Table1.Fields[nFld].AsString := FieldLst.Strings[nFld] ;}
     
     
     {Если вы хотите только поле, с которым сейчас имеете дело }
     DBGrid1.Fields[DBGrid1.SelectedIndex].AsString := FieldLst.Strings[DBGrid1.SelectedIndex];
     end ;
     

  10. Обработчик события таблицы BeforeInsert должен выглядеть следующим образом:

  11.  procedure TForm1.Table1BeforeInsert(DataSet: TDataset);
     var
     nFld: Integer ;
     bmPos: TBookMark ;
     begin
     if (not Table1.BOF) and (Assigned( FieldLst )) then
     try
     bmPos := Table1.GetBookMark ;
     Table1.DisableControls ;
     Table1.Prior ;
     FieldLst.Clear ;
     for nFld := 0 to Table1.FieldCount - 1 do
     FieldLst.Add( Table1.Fields[nFld].AsString ) ;
     Table1.GotoBookMark( bmPos ) ;
     Table1.FreeBookMark( bmPos ) ;
     Table1.EnableControls ;
     except
     on E: EOutOfMemory do ShowMessage( E.Message ) ;
     end ;
     end;
     

Надеюсь, что это будет работать. {Обратите внимание, что при обработке события OnKeyUp вы можете воспользоваться закомментаренными строками, которые позволят вам с помощью комбинации клавиш Ctrl-D получить все предыдущие данные полей. Если вы уберете этот комментарий, то не забудьте прокомментировать строку с DBGrid1....}




Синхронизация двух компонентов ScrollBox

Решить задачу помогут обработчики событий OnScroll (в данном примере два компонента ScrollBox (ScrollBar1 и ScrollBar2) расположены на форме TMainForm):


 procedure TMainForm.ScrollBar1Scroll(Sender: TObject;
 ScrollCode: TScrollCode; var ScrollPos: Integer);
 begin
   ScrollBar2.Position:=ScrollPos;
 end;
 
 procedure TMainForm.ScrollBar2Scroll(Sender: TObject;
 ScrollCode: TScrollCode; var ScrollPos: Integer);
 begin
   ScrollBar1.Position := ScrollPos;
 end;
 
 




Вызов стандартного системного окна О программе

Автор: Алексей

Hовый русский в компьютерном магазине:
- У вас операционные системы есть?
- Есть.
- Многозадачные есть?
- Есть.
- Мне 600-задачную!


 uses ShellAPI;
 
 procedure ShowAbout;
 begin
   ShellAbout(Form1.Handle, 'Напиши здесь название программы',
   'Заяви здесь о своих авторских правах на программу' + #13#10 +
   'можно в две строки', Application.Icon.Handle);
 end;
 




Как сделать окно системно-модальным

Используйте функцию Windows API SetSysModalWindow(). Код ниже демонстрирует технологию работы с этой функцией. В любой момент времени может быть возможен только один модально-системны диалог, чей дескриптор возвращается функцией SetSysModalWindow(). Вам необходимо запомнить возвращаемую функцией величину для того, чтобы завершить показ диалога таким образом. Вот как примерно это должно выглядеть:


 procedure TForm1.Button1Click(Sender: TObject);
 var
   x: word ;
 begin
   x := SetSysModalWindow(AboutBox.handle) ;
   AboutBox.showmodal ;
   SetSysModalWindow(x) ;
 end;
 




Перехват нажатия на системные кнопки формы (закрытие, минимизация)

Сообщение WM_SYSCOMMAND приходит перед выполнением соответствующей команды, что дает возможность переопределить код.


 WM_SYSCOMMAND
   uCmdType = wParam;     // type of system command requested
   xPos = LOWORD(lParam); // horizontal postion, in screen coordinates
   yPos = HIWORD(lParam); // vertical postion, in screen coordinates
 

Например, перехват события минимизации окна приложения:


 type
   TMain = class(TForm)
   protected
     procedure WMGetSysCommand(var message : TMessage);
     message WM_SYSCOMMAND;
 end;
 ...
 
 // Обработка сообщения WM_SYSCOMMAND
 procedure TMain.WMGetSysCommand(var message : TMessage) ;
 begin
   if (message.wParam = SC_MINIMIZE) then
     Main.Visible := False
   else
     inherited;
 end;
 




Оповещение о том, что изменили системные настройки

Парадокс. На Западе система Юникс бесплатна, а за Винды надо заплатить 384 доллара. А в России и Юникс стоит восемьдесят рублей и Винды те же восемьдесят.


 SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, Nil, SPIF_SENDWININICHANGE );
 




Создаём системную горячую клавишу

В некотором царстве в некотором государстве на 39 уровне жил был Кащей Бесcмертный и было у него 4 жизни и лабиринт, а смерть его была ctrl+alt +delete. Тут и сказочке Esc, а кто не понял F1.


 {
   The following example demonstrates registering hot keys with the
   system to globally trap keys.
 }
 
 unit Unit1;
 
 interface
 
 uses
   Windows, Messages, Forms, Dialogs;
 
 type
   TForm1 = class(TForm)
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
   private
     // Hotkey Ids 
     id1, id2, id3, id4: Integer;
     procedure WMHotKey(var Msg: TWMHotKey); message WM_HOTKEY;
     { Privat-Declarations}
   public
     { Public-Declarations}
   end;
 
 var
   Form1: TForm1;
 
 implementation
 
 {$R *.DFM}
 
 // Trap Hotkey Messages 
 procedure TForm1.WMHotKey(var Msg: TWMHotKey);
 begin
   if Msg.HotKey = id1 then
     ShowMessage('Ctrl + A was pressed !');
   if Msg.HotKey = id2 then
     ShowMessage('Ctrl + Alt + R was pressed !');
   if Msg.HotKey = id3 then
     ShowMessage('Win + F4 was pressed !');
   if Msg.HotKey = id4 then
     ShowMessage('Print Screen was pressed !');
 end;
 
 
 procedure TForm1.FormCreate(Sender: TObject);
   // Different Constants from Windows.pas 
 const
   MOD_ALT = 1;
   MOD_CONTROL = 2;
   MOD_SHIFT = 4;
   MOD_WIN = 8;
   VK_A = 65;
   VK_R = 82;
   VK_F4 = 115;
 begin
   // Register Hotkey Ctrl + A 
   id1 := GlobalAddAtom('Hotkey1');
   RegisterHotKey(Handle, id1, MOD_CONTROL, VK_A);
 
   // Register Hotkey Ctrl + Alt + R 
   id2 := GlobalAddAtom('Hotkey2');
   RegisterHotKey(Handle, id2, MOD_CONTROL + MOD_Alt, VK_R);
 
   // Register Hotkey Win + F4 
   id3 := GlobalAddAtom('Hotkey3');
   RegisterHotKey(Handle, id3, MOD_WIN, VK_F4);
 
   // Globally trap the Windows system key "PrintScreen" 
   id4 := GlobalAddAtom('Hotkey4');
   RegisterHotKey(Handle, id4, 0, VK_SNAPSHOT);
 end;
 
 // Unregister the Hotkeys 
 procedure TForm1.FormDestroy(Sender: TObject);
 begin
   UnRegisterHotKey(Handle, id1);
   UnRegisterHotKey(Handle, id2);
   UnRegisterHotKey(Handle, id3);
   UnRegisterHotKey(Handle, id4);
 end;
 
 end.
 
 {
   RegisterHotKey fails if the keystrokes specified for the hot key have
   already been registered by another hot key.
 
   Windows NT4 and Windows 2000/XP: The F12 key is reserved for use by the
   debugger at all times, so it should not be registered as a hot key. Even
   when you are not debugging an application, F12 is reserved in case a
   kernel-mode debugger or a just-in-time debugger is resident.
 }
 




Динамические создание объектов в TabbedNotebook


 procedure TForm1.TabbedNotebook1Click(Sender: TObject);
 var
   myE: TEdit;
 begin
   with TabbedNotebook1 do
   begin
     if PageIndex = 1 then
     begin
       myE := TEdit.Create(Self);
       myE.Left := 12;
       myE.Top := 12;
       myE.Parent := Pages.Objects[PageIndex] as TWinControl;
       myE.Show;
     end;
   end;
 end;
 




Динамические создание объектов в TabbedNotebook 2

Как мне поместить кнопку (во время выполнения программы) на страницу TabbedNoteBook?


 procedure TForm1.Button1Click(Sender: TObject);
 var
   Button2:Tbutton;
 begin
   button2:=tbutton.create(self);
   button2.parent:=TabbedNotebook1.Pages.Object[0] as TTabPage;
   button2.setbounds(30,30,60,30);
 end;
 




Недоступная закладка в компоненте TabbedNotebook

Есть ли возможность в компоненте Tabbednotebook сделать какую-либо страницу недоступной? То есть не позволять пользователю щелкать на ней и видеть ее содержимое?

Да, такая возможность существует. Самый простой путь - удалить страницу, например так:


 with TabbedNotebook do
   Pages.Delete(PageIndex);
 

и снова включить ее (при необходимости), перегрузив форму.

Блокировка (а не удаление) немного мудренее, поскольку необходима организация цикла в процедуре создания формы, присваивающая имена закладкам компонента TabbedNotebook. Например так:


 J := 0;
 with TabbedNotebook do
 for I := 0 to ComponentCount - 1 do
 if Components[I].ClassName = 'TTabButton' then
 begin
 Components[I].Name := ValidIdentifier(TTabbedNotebook(
 Components[I].Owner).Pages[J]) + 'Tab';
 Inc(J);
 end;
 

где ValidIdentifier ValidIdentifier - функция, которая возвращает правильный Pascal-идентификатор, производный от строки 'Tab':


 function ValidIdentifier (theString: str63): str63;
 {--------------------------------------------------------}
 { Конвертирует строку в правильный Pascal-идентификатор, }
 { удаляя все неправильные символы и добавляя символ '_', }
 { если первый символ - цифра                             }
 {--------------------------------------------------------}
 var
 I, Len: Integer;
 begin
 Len := Length(theString);
 for I := Len downto 1 do
 if not (theString[I] in LettersUnderscoreAndDigits) then
 Delete(theString, I, 1);
 if not (theString[1] in LettersAndUnderscore) then
 theString := '_' + theString;
 ValidIdentifier := theString;
 end; {ValidIdentifier}
 

Затем мы можем сделать закладку компонента TabbedNotebook недоступной:


 with TabbedNotebook do
 begin
 TabIdent := ValidIdentifier(Pages[PageIndex]) + 'Tab';
 TControl(FindComponent(TabIdent)).Enabled := False;
 { Переключаемся на первую доступную страницу: }
 for I := 0 to Pages.Count - 1 do
 begin
 TabIdent := ValidIdentifier(Pages[I]) + 'Tab';
 if TControl(FindComponent(TabIdent)).Enabled then
 begin
 PageIndex := I;
 Exit;
 end;
 end; {for}
 end; {with TabbedNotebook}
 

следующий код восстанавливает доступность страницы:


 with TabbedNotebook do
 for I := 0 to Pages.Count - 1 do
 begin
 TabIdent := ValidIdentifier(Pages[I]) + 'Tab';
 if not TControl(FindComponent(TabIdent)).Enabled then
 TControl(FindComponent(TabIdent)).Enabled := True;
 end; {for}
 




Доступ к страницам 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])
 




Tabbednotebook и куча ресурсов

Данный документ расскажет о том, как с помощью Object Pascal можно управлять числом активных handlesWindows (оконных дескрипторов), в особенности кучей ресурсов пользователя (User Resource heap), а также следить за этими показателями. О чем этот документ? Попробую коротко и доходчиво: Windows следит за каждым элементом, имеющим фокус, через его дескриптор (Handle). Исходя из этого, Windows не может одновременно поддерживать несколько оконных дескрипторов (4-байтных указателей), и в этом совете мы приведем простой пример кода, позволяющего "легко" загружать ресурсы и обходить эти ограничения, встающие перед разработчиками Delphi.

USER DLL в действительности является библиоткой, распределяющей и поддерживающей ресурсы для всех окон и связанных структур данных, включая элементы управления, имеющие фокус, и другие неупомянутые объекты, но вместе с тем необходимо помнить, что эта библиотека работает под Windows. С этим связаны ограничения при работе с ресурсами USER DLL, и эта та проблема, над которой мы будем работать в этом совете. Данный пример добавляет загрузку ресурса для каждого элемента управления, добавляемого на форму, здесь мы берем 4 байта из кучи USER в 64К *.

Почему мы уверены в том, что у нас это получится? Мы будем разрушать** дескрипторы окон, которые Windows, согласно своей архитектуре, должна помнить. Разрушая эти дескрипторы, мы, таким образом, избегаем освобождения пользовательских (USER) ресурсов, это означает, что нам не нужно будет снова создавать вышеуказанные объекты. Наоборот, текущая архитектура VCL обладает способностью следить за вышеуказанными объектами, которые, в действительности, являются указателями на структуру. Так, зная, что VCL поддерживает дескриптор и windows создаст новый дескриптор КАК ТРЕБУЕТСЯ, то вместо поддержания постоянно одного дескриптора (как это подразумевалось при создании архитектуры Windows), мы можем управлять пользовательскими (USER) ресурсами вручную, позволяя разработчику легко загружать их по мере необходимости.

Данный пример демонстрирует работу с дескрипторами пользовательских (USER) ресурсов компонента Delphi TTabbedNoteBook (в части освобождения дескрипторов страниц), Delphi DestroyHandle (процедура TWinControl для удаления пользовательских (USER) дескрипторов), и работу вызова Windows API LockWindowUpdate (блокировка нежелательной перерисовки).

Технология освобождения дескриптора страницы TTabbedNoteBook может работать и с любыми потомками TWinControl. TWinControl - класс предка, который умеет создавать и разрушать оконные дескрипторы; CreateHandle & DestroyHandle.

* 64К для Win3.1 & 64К только для 16-битной подсистемы Win95. Для получения дополнительной информации обратитесь в Microsoft или к MSDN.
** Как побочный эффект при разрушении вышеописанных дескрипторов, TTabbedNotebook, используемый в данном примере, гораздо быстрее выполняет перемещение страниц.

Демонстрационный код

Следующий код с приведенными обработчиками событий является "отрывком" из большого проекта с компонентами 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;
 




Печать табуляторов с помощью TextOut

Автор: Bob Fisher

Я пытаюсь напечатать некий текст с помощью Printer.Canvas.TextOut. Моя строка содержит табуляторы, но они почему-то печатаются на бумаге в виде черных прямоугольников. Как мне правильно напечатать строку, содержащую табуляторы?

Обратите внимание на функцию API "TabbedTextOut". Ваш холст (canvas) воспользоваться ей не сможет, но вы можете просто вызвать эту API функцию и передать ей дескриптор холста.




Над какой закладкой курсор в 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;
 




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

Автор: grisha@mira.com

4 Mb - это не память. Это склероз

Вот пример InMemoryTable. Свободен для использования, модификации и всего остального. Ну и как в отношении других вещей: я не даю никаких гарантий. Я не несу никакой ответственности за ущерб, который может причинить код. Позвольте, я повторю это:

ВНИМАНИЕ! ДАННЫЙ КОД НЕ ПРЕДУСМАТРИВАЕТ НИКАКИХ ГАРАНТИЙ!

ИСПОЛЬЗУЙТЕ ЕГО НА СВОЙ СТРАХ И РИСК - ВЫ ЕДИНСТВЕННЫЙ ЧЕЛОВЕК, ОТВЕТСТВЕННЫЙ ЗА ЛЮБОЙ УЩЕРБ, КОТОРЫЙ МОЖЕТ ПОВЛЕЧЬ ЗА СОБОЙ ИСПОЛЬЗОВАНИЕ ДАННОГО КОДА - - Я ВАС ПРЕДУПРЕДИЛ!

Благодарю Steve Garland за предоставленную помощь. Он создал свой собственный "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.
 
 {Данный код взят из файлов помощи Ллойда!}
 




Таблицы строк

Поймал програмер мышь мышеловкой и давай по коврику таскать ее, а стрелка на месте стоит: "Наверное, ее почистить надо", - подумал програмер.

Ресурсы в виде таблиц строк (Stringtable) являются очень полезным подспорьем, когда ваше приложение должно хранить большое количество строк для их вывода во время выполнения приложения. Вы должны побороть искушение непосредственной вставки строк в вашу программу, поскольку использование таблиц строк имеет два неоспоримых преимущества: 1) Строки, хранимые в ресурсах, не занимают память до тех пор, пока они не будут загружены вашим приложением. 2) Stringtables легко редактировать, создавая таким образом локализованные (переведенные) версии вашего приложения.

Таблицы строк компилируются в ".res"-файл, который включается в exe-файл приложения во время сборки. Даже после того, как вы распространите ваше приложение, таблицы строк, содержащиеся в вашем приложении могут редактироваться редактором ресурсов. Моим любимым редактором ресурсов является Borland Resource Workshop, поставляемый в комплекте с Delphi. Он позволяет в режиме WYSIWYG редактировать как 16-, так и 32-битные ресурсы, как автономные, так и имплантированные в exe или dll-файлы.

Тем более это удобно, если учесть что вместе со всеми версиями Delphi поставляется компилятор ресурсов из командной строки (Borland Resource Command Line Compiler) (BRCC.EXE и BRCC32.EXE), расположенный в Delphi-директории Bin.

В нашем примере мы создадим интернациональное приложение, отображающее всего две кнопки. Кнопки будут иметь заголовки "Да" и "Нет", имеющие представления для английского, испанского и шведского языков.

Если вы вознамерились создавать мультиязыковые приложения с помощью Delphi, вам просто необходимо взглянуть на другие продукты фирмы Borland - Delphi Translation Suite и Language Pack software. Данные продукты позволяют изменять язык приложения одним щелчком!

Пример: Для начала в каталоге с исходным кодом приложения мы должны создать текстовый файл, содержащий строковые ресурсы. Пока вы можете создать файл с любым именем (главное, чтобы он имел расширение ".rc") и файл без разширения - главное, чтобы их имя не совпадало с именами файлов модулей и файла проекта. Это очень важно, поскольку Delphi автоматически создает множество файлов с ресурсами для вашего приложения с теми же именами и переписывает их, не заботясь о наличии таких же файлов, но созданных вашими руками.

Вот содержание .rc-файла для нашего примера. Файл содержит слова "Yes" и "No" на английском, испанском и шведских языках:

STRINGTABLE
 {
  1, "&Yes"
  2, "&No"
  17, "&Si"
  18, "&No"
  33, "&Ja"
  34, "&Nej"
 }
 
Файл начинается с ключевого слова stringtable, обозначая, что следом располагается таблица строк. Сами строки находятся внутри скобок, таким образом таблица должна быть обрамлена двумя скобками - открывающей и закрывающей. Каждая строка должна содержать идентификатор, сопровождаемый строкой, заключенной в кавычки. Строка может содержать вплоть до 255 символов. Если вам нужно вставить нестандартный символ, напишите его восьмиричный код и предварите его обратной косой чертой. Единственное исключение - когда вам нужно вставить саму обратную черту - в этом случае понадобиться использование двух таких символов. Вот два примера:

1, "A two\012line string"
 
 2, "c:\\Borland\\Delphi"
 
Используемый номер индекса абсолютно не важен для компилятора. Вы должны иметь в виду, что таблицы строк располагаются в памяти в 16 битных сегментах (Win 3.xx).

Для компиляции .rc-файла в .res-файл, который можно прилинковать к вашему приложению, вы должны набрать в командной строке полный путь к компилятору ресурсов и полный путь к компилируемому .rc-файлу. Вот пример:

c:\Delphi\Bin\brcc32.exe c:\Delphi\strtbl32.rc
После окончания процесса компиляции в указанном каталоге появляется файл с тем же именем, что и у .rc-файла, но имеющий расширение ".res".

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

{$R ResFileName.RES}

После того, как .res-файл прилинкуется к приложению, вы можете воспользоваться связанными ресурсами из любого модуля вашего проекта, даже если вы определили директиву $R в секции реализации (implementation) другого модуля.

Вот пример использования Windows API функции LoadString() для загрузки в массив символов третьей строки из таблицы строк:


 if LoadString(hInstance, 3, @a, sizeof(a)) <> 0 then ....
 

В этом примере функция LoadString() передает дескриптор (hInstance) модуля, содержащего ресурс, индекс требуемой строки, адрес массива символов, куда будет передана строка и размер самого массива. Функция LoadString возвращает количество реально переданных символов без учета терминатора. Будьте внимательны: при использовании UNICODE количество загружаемых байт будет другим.

Ниже приведен исчерпывающий пример создания многоязыкового приложения с помощью Delphi. Приложение совместимо как с 16, так и с 32-битными версиями Delphi.

Для этого вам придется создать два идентичных .rc-файла, один для 16-битной версии, второй для 32-битной, т.к. используемые ресурсы для каждой платформы свои. В данном примере мы создадим один файл с именем STRTBL16.rc, а другой с именем STRTBL32.rc. Скомпилируйте файл STRTBL16.rc с помощью 16-битного компилятора BRCC.exe (расположен в каталоге BIN Delphi 1) и файл STRTBL32.rc с помощью BRCC32.exe (расположен в той же директории 32-битной версии Delphi).

Во время работы приложения мы выясняем язык операционной системы, установленный по умолчанию. Метод получения такой информации отличается для 16- и 32-битной версии Windows. Чтобы сделать код более читабельным, мы позаимствовали "языковые" константы из файла Windows.pas, применяемого в 32-битной версии Delphi.


 {$IFDEF WIN32}
 
 {$R STRTBL32.RES}
 {$ELSE}
 
 {$R STRTBL16.RES}
 const
   LANG_ENGLISH = $09;
 const
   LANG_SPANISH = $0A;
 const
   LANG_SWEDISH = $1D;
 {$ENDIF}
 
 function GetLanguage: word;
 {$IFDEF WIN32}
 {$ELSE}
 
 var
   s: string;
   i: integer;
 {$ENDIF}
 begin
 {$IFDEF WIN32}
 
   GetLanguage := GetUserDefaultLangID and $3FF;
 {$ELSE}
 
   s[0] := Char(GetProfileString('intl',
     'sLanguage',
     'none',
     @s[1],
     sizeof(s) - 2));
   for i := 1 to length(s) do
     s[i] := UpCase(s[i]);
   if s = 'ENU' then
     GetLanguage := LANG_ENGLISH
   else if s = 'ESN' then
     GetLanguage := LANG_SPANISH
   else if s = 'SVE' then
     GetLanguage := LANG_SWEDISH
   else
     GetLanguage := LANG_ENGLISH;
 {$ENDIF}
 end;
 
 procedure TForm1.FormCreate(Sender: TObject);
 var
   a: array[0..255] of char;
   StrTblOfs: integer;
 begin
   {Получаем текущий язык системы и начало соответствующих строк в таблице}
   case GetLanguage of
     LANG_ENGLISH: StrTblOfs := 0;
     LANG_SPANISH: StrTblOfs := 16;
     LANG_SWEDISH: StrTblOfs := 32;
   else
     StrTblOfs := 0;
   end;
 
   {Загружаем и устанавливаем заголовок кнопки "Yes" в соответствии с языком}
   if LoadString(hInstance,
     StrTblOfs + 1,
     @a,
     sizeof(a)) <> 0 then
     Button1.Caption := StrPas(a);
 
   {Загружаем и устанавливаем заголовок кнопки "No" в соответствии с языком}
   if LoadString(hInstance,
     StrTblOfs + 2,
     @a,
     sizeof(a)) <> 0 then
     Button2.Caption := StrPas(a);
 end;
 




Извлечение данных индекса таблицы

Получить во время выполнения приложения список индексов, ассоциированных с таблицей также просто, как вызвать метод GetIndexNames для компонентов TTable, TQuery или TStoredProc. Метод GetIndexNames возвращает список, доступный в наборе данных для компонента TStrignList, установленного на форме (для нашего примера), или других визуальных компонентов, таких как TListBox, через свойство Items:


 ListBox1.Clear;
 Table1.GetIndexNames(ListBox1.Items);
 

Естественно, список TStrings, возвращаемый методом GetIndexNames, не должен использоваться визуальным компонентом. Он может представлять собой массив имен индексов, храниться в памяти и использоваться в качестве списка или массива.

Но существует возможность получения дополнительной информации об индексах таблицы, а не только их имена. Другие описываемые атрибуты представляют собой имя каждого индекса, имена полей, включающие каждый индекс и опции индекса, используемые при их создании. Получение этих величин немного труднее, чем простое использование GetIndexNames. В основном, данные значения можно получить с помощью простой итерации свойства IndexDefs компонента TTable, TQuery или TStoredProc. Свойство IndexDefs по существу является массивом записей, по одной записи на каждый индекс таблицы.

Каждая индексная запись (index record) содержит информацию об индексе. Процесс получения массива записей, содержащих информацию отдельно о каждом индексе, достаточно прост в реализации.

Свойство IndexDefs компонента TTable содержит информацию об индексах таблицы, используемой компонентом TTable, TQuery или TStoredProc. Само свойство IndexDefs в свою очередь также имеет различные свойства, содержащие специфическую информацию об извлекаемых индексах. Объект IndexDefs содержит два свойства:

    Count: type Integer;
доступно только во время выполнения программы и имеет флаг только для чтения; указывает на количество элементов в свойстве Items (например, количество индексов в таблице).
  Items: type TIndexDef;
доступно только во время выполнения программы и имеет флаг только для чтения; массив объектов TIndexDef, каждый объект описывает один индекс таблицы.

Свойство Count объекта IndexDefs является основой для создания счетчика цикла, в теле которого с помощью элементов свойства Items извлекается информация о каждом индексе таблицы. Каждый объект IndexDef, содержащийся в свойстве Items, состоит из множества свойств, описывающих характеристики каждого индекса в отдельности. Все свойства объекта IndexDef доступны только во время выполнения программы и имеют флаг "только для чтения". Вот эти свойства:

  Expression: type String; содержит выражение, использующееся
                            для dBASE multi-field индексов
                            (индексов для нескольких полей).
   Fields:     type String; содержит поле или несколько полей,
                            на основе которых создан индекс.
   Name:       type String; имя индекса.
   Options:    type TIndexOptions; характеристики индекса
                            (ixPrimary,  ixUnique и др.).
Перед получением любой информации об индексе (Count или Items) необходимо вызвать метод Update объекта IndexDefs. Это обновляет (или инициализирует) набор индексов для объектов IndexDef.

Примеры

Вот пример простого For-цикла, использующего в качестве счетчика свойство Count объекта IndexDefs, и извлекающего имя каждого индекса (если какой-либо существует) таблицы, представленной компонентом TTable с именем Table1:


 procedure TForm1.ListBtnClick(Sender: TObject);
 var
   i: Integer;
 begin
   ListBox1.Items.Clear;
   with Table1 do
   begin
     if IndexDefs.Count > 0 then
     begin
       for i := 0 to IndexDefs.Count - 1 do
         ListBox1.Items.Add(IndexDefs.Items[i].Name)
     end;
   end;
 end;
 

Ниже приведен пример, показывающий как можно извлечь информацию об индексах во время выполнения программы с выводом ее в компонент TStringGrid (с именем SG1).


 procedure TForm1.FormShow(Sender: TObject);
 var
   i: Integer;
   S: string;
 begin
   with Table1 do
   begin
     Open;
     {Обновляем объект IndexDefs}
     IndexDefs.Update;
     if IndexDefs.Count > 0 then
     begin
       {Устанавливаем колонки и строки сетки для соответствия элементам IndexDefs}
       SG1.ColCount := 4;
       SG1.RowCount := IndexDefs.Count + 1;
       {Устанавливаем заголовки колонок сетки согласно именам свойств TIndexDef}
       SG1.Cells[0, 0] := 'Name';
       SG1.ColWidths[0] := 200;
       SG1.Cells[1, 0] := 'Fields';
       SG1.ColWidths[1] := 200;
       SG1.Cells[2, 0] := 'Expression';
       SG1.ColWidths[2] := 200;
       SG1.Cells[3, 0] := 'Options';
       SG1.ColWidths[3] := 300;
       {Цикл с опросом IndexDefs.Items}
       for i := 0 to IndexDefs.Count - 1 do
       begin
         {Заполняем ячейки сетки в текущей колонке}
         SG1.Cells[0, i + 1] := IndexDefs.Items[i].Name;
         SG1.Cells[1, i + 1] := IndexDefs.Items[i].Fields;
         SG1.Cells[2, i + 1] := IndexDefs.Items[i].Expression;
         if ixPrimary in IndexDefs.Items[i].Options then
           S := 'ixPrimary, ';
         if ixUnique in IndexDefs.Items[i].Options then
           S := S + 'ixUnique, ';
         if ixDescending in IndexDefs.Items[i].Options then
           S := S + 'ixDescending, ';
         if ixCaseInsensitive in IndexDefs.Items[i].Options then
           S := S + 'ixCaseInsensitive, ';
         if ixExpression in IndexDefs.Items[i].Options then
           S := S + 'ixExpression, ';
         if S > ' ' then
         begin
           {Отфильтровываем ", "}
           System.Delete(S, Length(S) - 1, 2);
           SG1.Cells[3, i + 1] := S;
         end;
       end;
     end;
   end;
 end;
 

Специфичные особенности

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

Таблицы dBASE

При работе с индексами dBASE, свойства Fields и Expression заполняются в зависимости от типа индекса, который может быть как простым (основанным на одном поле), так и сложным (базирующимся на нескольких полях или dBASE-выражениях). Если индекс является простым, свойство Fields будет содержать имя поля таблицы, на основе которого построен индекс, а свойство Expression будет пустым. Если индекс сложный, свойство Expression будет содержать выражение, на основе которого был построен индекс (например, "Field1+Field2"), а свойство Fields будет пустым.

Таблицы Paradox

При работе с первичными индексами Paradox, свойство Name будет пустым, свойство Fields будет содержать поле(я), на основе которых создан индекс, а свойство Options будет содержать ixPrimary. При работе со вторичными индексами, свойство Name будет содержать имя вторичного индекса, свойство Fields будет содержать поле(я), на основе которых создан индекс, а свойство Options может как содержать какое-либо значение, так и быть пустым.

Свойство Fields у индексов, основанных более чем на одном поле, содержит имена полей, разделенных точкой с запятой. Индексы, основанные только на одном поле, в свойстве Fields содержат имя только данного поля.

Таблицы InterBase

Для обоих типов индексов, построенных как на основе одного, так и нескольких полей, свойство Expression будет пустым. Для индексов, построенных на основе одного поля, свойство Fields будет содержать имя поля, на основе которого был создан индекс. Свойство Fields у индексов, основанных более чем на одном поле, содержит имена полей, разделенных точкой с запятой.

Индексы, определенные в команде CREATE TABLE как PRIMARY, в свойстве Name будут содержать значение "RDB$PRIMARYn", где n - порядковый номер символа, однозначно определяющий первичный индекс в пределах метаданных БД. Вторичные индексы содержат фактическое имя индекса.

Внешние ключи также содержат индексы, созданные системой. Такие индексы будут содержаться в свойстве IndexDefs и иметь имя "RDB$FOREIGNn", где n - порядковый номер символа, однозначно определяющий индекс в пределах метаданных БД.

Свойство Fields у индексов, основанных более чем на одном поле, содержит имена полей, разделенных точкой с запятой. Индексы, основанные только на одном поле, в свойстве Fields содержат имя только данного поля.




Как сохранить содержимое таблицы в текстовый файл

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


 procedure DatasetRecordToInfFile(aDataset: TDataSet; aStrList: TStrings);
 var
   i: integer;
 begin
   for i := 0 to (aDataset.FieldCount-1) do
     aStrList.Add(aDataset.Fields[i].FieldName + '=' +
     aDataset.Fields[i].AsString);
 end;
 
 procedure DatasetToInfFile(aDataset: TDataSet; aStrList: TStrings);
 begin
   aDataSet.First;
   while not aDataSet.EOF do
   begin
     DatasetRecordToInfFile(aDataset,aStrList);
     aDataSet.Next;
   end;
 end;
 
 procedure TForm1.Button1Click(Sender: TObject);
 begin
   DatasetRecordToInfFile(Table1,Memo1.Lines);
 end;
 
 procedure TForm1.Button2Click(Sender: TObject);
 begin
   DatasetToInfFile(Table1,Memo1.Lines);
 end;
 




Синхронизация TabSet c ListBox

Что-то аналогичное я делал раньше, тем не менее, вместо Listbox я использовал dbGrid со следующими опциями:

[dgAlwaysShowEditor,dgTabs,dgRowSelect,dgAlwaysShowSelection,dgConfirmDelete, dgCancelOnExit]

Кроме того, я привел код, который я использовал в ответ на щелчок на закладке, таким образом изменяя запись в dbgrid.


 procedure TForm1.TabSet1Change(Sender: TObject; NewTab: Integer;
   var AllowChange: Boolean);
 begin
   Table1.FindNearest([Chr(NewTab+65)]);
   Table2.FindNearest([Chr(NewTab+65)]);
 end;
 


 procedure TForm1.TabSet1Click(Sender: TObject);
 var
   I: integer;
 begin
   with TabSet1 do
   begin
     if TabIndex > -1 then
     begin
       with ListBox1 do
       begin
         for I := 0 to Items.Count - 1 do
         begin
           if Pos(Tabs[TabIndex], Items[I]) = 1 then
           begin
             ItemIndex := I;
             break;
           end;
         end;
       end;
     end;
   end;
 end;
 




Перемещение на страницу TabSet по имени

Разместите компоненты Tabset(TabSet1) и Edit (Edit1) на вашей форме. Измените свойство компонента Tabset Tabs для размещения в списке строк следующих четерых закладок:

  • Hello
  • World
  • Of
  • Delphi

Создайте обработчик события onChange компонента Edit1 как показано ниже:


 procedure TForm1.Edit1Change(Sender: TObject);
 var
   I: Integer;
 begin
   for  I:= 0 to tabset1.tabs.count-1 do
     if  edit1.text = tabset1.tabs[I] then
       tabset1.tabindex:=I;
 end;
 

Теперь при наборе любого из существующих имен в edit1 соотвутствующая закладка будет выведена на передний план.




Как определить, что была нажата клавиша Tab

Нажмите какую-нибудь клавишу для выхода или любую другую для продолжения.

На уровне формы клавиша tab обычно обрабатывается Windows. В примере создается обработчик события CM_Dialog для перехвата Dialog keys


 type
   TForm1 = class(TForm)
   private
     procedure CMDialogKey( var msg: TCMDialogKey );
     message CM_DIALOGKEY;
 end;
 
 var
   Form1: TForm1;
 
 implementation
 {$R *.DFM}
 
 procedure TForm1.CMDialogKey(var msg: TCMDialogKey);
 begin
   if msg.Charcode <> VK_TAB then
     inherited;
 end;
 
 procedure TForm1.FormKeyDown(Sender: TObject;
 var Key: Word; Shift: TShiftState);
 begin
   if Key = VK_TAB then
     Form1.Caption := 'Tab Key Down!';
 end;
 




Имитация Tab


 SelectNext(screen.ActiveControl, True, True);
 

Разместите приведенный код в обработчике одного из собитий. SelectNext - защищенный метод TWinControl со следующим прототипом:


 procedure SelectNext(CurControl: TWinControl;
 GoForward, CheckTabStop: Boolean);
 

Так как форма также является потомком TWinControl, то она имеет доступ к защищенным методам.




События KeyPress и KeyDown не вызываются для Tab - как определить ее нажатие


 type
   TForm1 = class(TForm)
   private
     procedure CMDialogKey(var msg: TCMDialogKey);
       message CM_DIALOGKEY;
   end;
 
 var
   Form1: TForm1;
 
 implementation
 
 {$R *.DFM}
 
 procedure TForm1.CMDialogKey(var msg: TCMDialogKey);
 begin
   if msg.Charcode <> VK_TAB then
     inherited;
 end;
 
 procedure TForm1.FormKeyDown(Sender: TObject; var Key:
   Word; Shift: TShiftState);
 begin
   if Key = VK_TAB then
     Form1.Caption := 'Tab Key Down!';
 end;
 




Tab как Enter в StringGrid

Данный код переводит ввод на другую колонку. При достижении конца колонок, ввод перемещается на следующую строку. При достижении самого конца сетки, управление перемещается в ее самое начало - естественно, вы можете изменить это поведение, и передавать управление в этом случае другому элементу управления.


 procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);
 begin
   if Key = #13 then
     with StringGrid1 do
       if Col < ColCount - 1 then {следующая колонка!}
         Col := Col + 1
       else if Row < RowCount - 1 then
       begin {следующая строка!}
         Row := Row + 1;
         Col := 1;
       end
       else
       begin {Конец сетки! - Снова перемещаемся наверх!}
         Row := 1;
         Col := 1;
         {или вы можете передать управление другому элементу управления}
       end;
 end;
 




Ошибка 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
 




Как пpинимать яpлыки пpи пеpетягивании их на контpол

Автор: Nomadic


 TForm1 = class(TForm)
   ...
   private
     { Private declarations }
     procedure WMDropFiles(var M: TWMDropFiles); message WM_DROPFILES;
   ...
 end;
 
 var
   Form1: TForm1;
 
 implementation
 
 uses
   StrUtils, ShellAPI, ComObj, ShlObj, ActiveX;
 
 procedure TForm1.FormCreate(Sender: TObject);
 begin
   ...
   DragAcceptFiles(Handle, True);
   ...
 end;
 
 procedure TForm1.FormDestroy(Sender: TObject);
 begin
   ...
   DragAcceptFiles(Handle, False);
   ...
 end;
 
 procedure TForm1.WMDropFiles(var M: TWMDropFiles);
 var
   hDrop: Cardinal;
   n: Integer;
   s: string;
 begin
   hDrop := M.Drop;
   n := DragQueryFile(hDrop, 0, nil, 0);
   SetLength(s, n);
   DragQueryFile(hDrop, 0, PChar(s), n + 1);
   DragFinish(hDrop);
   M.Result := 0;
   FileOpen(s);
 end;
 
 procedure TForm1.FileOpen(FileName: string);
 begin
   if CompareText(ExtractFileExt(FileName), '.lnk') = 0 then
     FileName := ResolveShortcut(Application.Handle, FileName);
   DocName := ExtractFileName(FileName);
   Caption := Application.Title + ' - ' + DocName;
   ...
 end;
 
 function ResolveShortcut(Wnd: HWND; ShortcutPath: string): string;
 var
   obj: IUnknown;
   isl: IShellLink;
   ipf: IPersistFile;
   pfd: TWin32FindDataA;
 begin
   Result := '';
   obj := CreateComObject(CLSID_ShellLink);
   isl := obj as IShellLink;
   ipf := obj as IPersistFile;
   ipf.Load(PWChar(WideString(ShortcutPath)), STGM_READ);
   with isl do
   begin
     Resolve(Wnd, SLR_ANY_MATCH);
     SetLength(Result, MAX_PATH);
     GetPath(PChar(Result), Length(Result), pfd, SLGP_UNCPRIORITY);
     Result := PChar(Result);
   end;
 end;
 




Набрать номер по модему. Голосовой звонок. Использование TAPI

Инетчик звонит по телефону.
- Позовите пожалуйста Лену к телефону.
- Такой здесь нет. "User unknown" , - подумал И-нетчик.

До слова implementation напишите такой код:


 {tapi Errors}
 const TAPIERR_CONNECTED = 0;
 const TAPIERR_DROPPED = -1;
 const TAPIERR_NOREQUESTRECIPIENT = -2;
 const TAPIERR_REQUESTQUEUEFULL = -3;
 const TAPIERR_INVALDESTADDRESS = -4;
 const TAPIERR_INVALWINDOWHANDLE = -5;
 const TAPIERR_INVALDEVICECLASS = -6;
 const TAPIERR_INVALDEVICEID = -7;
 const TAPIERR_DEVICECLASSUNAVAIL = -8;
 const TAPIERR_DEVICEIDUNAVAIL = -9;
 const TAPIERR_DEVICEINUSE = -10;
 const TAPIERR_DESTBUSY = -11;
 const TAPIERR_DESTNOANSWER = -12;
 const TAPIERR_DESTUNAVAIL = -13;
 const TAPIERR_UNKNOWNWINHANDLE = -14;
 const TAPIERR_UNKNOWNREQUESTID = -15;
 const TAPIERR_REQUESTFAILED = -16;
 const TAPIERR_REQUESTCANCELLED = -17;
 const TAPIERR_INVALPOINTER = -18;
 
 {tapi size constants}
 const TAPIMAXDESTADDRESSSIZE = 80;
 const TAPIMAXAPPNAMESIZE = 40;
 const TAPIMAXCALLEDPARTYSIZE = 40;
 const TAPIMAXCOMMENTSIZE = 80;
 const TAPIMAXDEVICECLASSSIZE = 40;
 const TAPIMAXDEVICEIDSIZE = 40;
 
 function tapiRequestMakeCallA(DestAddress : PAnsiChar;
 AppName : PAnsiChar;
 CalledParty : PAnsiChar;
 Comment : PAnsiChar) : LongInt;
 stdcall; external 'TAPI32.DLL';
 
 function tapiRequestMakeCallW(DestAddress : PWideChar;
 AppName : PWideChar;
 CalledParty : PWideChar;
 Comment : PWideChar) : LongInt;
 stdcall; external 'TAPI32.DLL';
 
 function tapiRequestMakeCall(DestAddress : PChar;
 AppName : PChar;
 CalledParty : PChar;
 Comment : PChar) : LongInt;
 stdcall; external 'TAPI32.DLL';
 

Нажатие кнопки обработайте следующим образом:


 procedure TForm1.Button1Click(Sender: TObject);
 var
   DestAddress : string;
   CalledParty : string;
   Comment : string;
 begin
   DestAddress := '000-00-00'; {phone number}
   CalledParty := '___Nikolay';
   Comment := 'Calling to ___Nikolay';
   tapiRequestMakeCall(pChar(DestAddress),
   PChar(Application.Title),
   pChar(CalledParty),
   PChar(Comment));
 end;
 




Сделать кнопку на TaskBar для каждого окна

У многооконного приложения, как Delphi, обычно только одна кнопка на TaskBar. Если же вам понадобилось, чтобы у каждого окна была своя кнопка, воспользуйтесь функцией SetWindowLong, добавив флаг WS_EX_APPWINDOW.

В модуле первого окна:


 uses Unit2, Unit3;
 
 {$R *.DFM}
 
 procedure TForm1.Button1Click(Sender: TObject);
 begin
   ShowWindow(Application.Handle, SW_HIDE);
   Form1.Hide;
   Form2.Show;
   Form3.Show;
 end;
 

В модуле второго окна:


 uses Unit3;
 
 {$R *.DFM}
 
 procedure TForm2.FormCreate(Sender: TObject);
 begin
   SetWindowLong(Handle, GWL_EXSTYLE,
   GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_APPWINDOW);
 end;
 
 procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
 begin
   if Form3.Visible = false then
     Application.Terminate;
 end;
 

В модуле третьего окна:


 uses Unit2;
 
 {$R *.DFM}
 
 procedure TForm3.FormCreate(Sender: TObject);
 begin
   SetWindowLong(Handle, GWL_EXSTYLE,
   GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_APPWINDOW);
 end;
 
 procedure TForm3.FormClose(Sender: TObject; var Action: TCloseAction);
 begin
   if Form2.Visible = false then
     Application.Terminate;
 end;
 




Определение координат расположения TaskBar

Чем мы Винду сильнее любим, тем дольше грузится она.

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


 uses .., ShellApi;
 
 var
   AppBarData  : TAppBarData;
   bAlwaysOnTop: Boolean; {Поверх окон}
   bAutoHide   : boolean; {Авт. убирать с экрана}
   ClRect      : TRect;   {Клиентские области}
   Rect        : TRect;
   Edge        : UInt;    {Местоположение TaskBar}
 
 procedure DetectTaskBar;
 begin
   AppBarData.hWnd   := FindWindow('Shell_TrayWnd', nil);
   AppBarData.cbSize := sizeof(AppBarData);
   bAlwaysOnTop      := (SHAppBarMessage(ABM_GETSTATE, AppBardata) and  ABS_ALWAYSONTOP) < >  0;
   bAutoHide         := (SHAppBarMessage(ABM_GETSTATE, AppBardata) and  ABS_AUTOHIDE) < > 0;
   GetClientRect(AppBarData.hWnd, ClRect.rc);
   GetWindowRect(AppBarData.hwnd, rect);
   if (Rect.top >  0) Then
    Edge := ABE_BOTTOM
   else
   if (Rect.Bottom <  Screen.Height) Then
    Edge := ABE_TOP
   else
   if Rect.Right <  Screen.Width Then
    Edge := ABE_LEFT
   else
    Edge := ABE_RIGHT;
 end;
 




Работа с TaskBar


 unit TaskBar;
 
 interface
 
 uses Windows, ShellAPI;
 
 const
   // Дублируем описания из ShellAPI, чтобы не писать его в Uses
   // везде, где мы используем этот модуль
   NIF_TIP = ShellAPI.NIF_TIP;
   NIF_ICON = ShellAPI.NIF_ICON;
 
 function TaskBarAddIcon(
   hWindow: THandle; // окно, создавшее значок
   ID: Cardinal; // идентификатор значка
   ICON: hIcon; // иконка
   CallbackMessage: Cardinal; // сообщение, которое будет посылаться окну
   Tip: PChar // ToolTip
   ): Boolean;
 
 function TaskBarModifyIcon(
   hWindow: THandle;
   ID: Cardinal;
   Flags: Cardinal;
   ICON: hIcon;
   Tip: PChar): Boolean;
 
 function TaskBarDeleteIcon(
   hWindow: THandle;
   ID: Integer): Boolean;
 
 implementation
 
 function TaskBarAddIcon(
   hWindow: THandle;
   ID: Cardinal;
   ICON: hIcon;
   CallbackMessage: Cardinal;
   Tip: PChar): Boolean;
 var
   NID: TNotifyIconData;
 begin
   FillChar(NID, SizeOf(TNotifyIconData), 0);
   with NID do
   begin
     cbSize := SizeOf(TNotifyIconData);
     Wnd := hWindow;
     uID := ID;
     uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
     uCallbackMessage := CallbackMessage;
     hIcon := Icon;
     lstrcpyn(szTip, Tip, SizeOf(szTip));
   end;
   Result := Shell_NotifyIcon(NIM_ADD, @NID);
 end;
 
 function TaskBarModifyIcon(
   hWindow: THandle;
   ID: Cardinal;
   Flags: Cardinal;
   ICON: hIcon;
   Tip: PChar): Boolean;
 var
   NID: TNotifyIconData;
 begin
   FillChar(NID, SizeOf(TNotifyIconData), 0);
   with NID do
   begin
     cbSize := SizeOf(TNotifyIconData);
     Wnd := hWindow;
     uID := ID;
     uFlags := Flags;
     hIcon := Icon;
     lstrcpyn(szTip, Tip, SizeOf(szTip));
   end;
   Result := Shell_NotifyIcon(NIM_MODIFY, @NID);
 end;
 
 function TaskBarDeleteIcon(
   hWindow: THandle;
   ID: Integer): Boolean;
 var
   NID: TNotifyIconData;
 begin
   FillChar(NID, SizeOf(TNotifyIconData), 0);
   with NID do
   begin
     cbSize := SizeOf(TNotifyIconData);
     Wnd := hWindow;
     uID := ID;
   end;
   Result := Shell_NotifyIcon(NIM_DELETE, @NID);
 end;
 
 end.
 




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

Два компа по сети связались, один - другому:
- Мой хозяин вчера на одном сайте таких девочек разглядывал - ну C:\ твою формать!
- Потише ты, без ненормативной лексики, у меня тут дети в "Тетрис" играют.

... вы все делаете правильно. BatchMove не может пересобирать индексы. Тем не менее, следующая процедура все же поможет вам сделать это (создать индексы заново). Задайте ей необходимые параметры (.DBF. Name, исходная и целевая таблица, Source и Target) и попробуйте ее в деле!


 procedure TForm1.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;
 




Как поместить TCheckBox в TRichEdit


Для использования следующего примера, необходимо создать новую форму, перетащить на неё TRichEdit (RichEdit1) и создать checkbox (acb) в событии FormCreate().


 procedure TForm1.FormCreate(Sender: TObject);
 var
   Acb: TCheckBox;
 begin
   RichEdit1.Left := 20;
 
   Acb := TCheckBox.Create(RichEdit1);
   Acb.Left := 30;
   Acb.Top := 30;
   Acb.Caption := 'Delphi World is COOL !!!';
   Acb.Parent := RichEdit1;
 end;
 




TCheckListBox - использование методов LoadFromFile и SaveToFile

Автор: Bjarne Winkler

Пример показывает как можно сохранять в файл содержимое TCheckListBox и соответственно восстанавливать из файла ранее сохранённые состояния Чекбоксов.

На самом деле всё просто. Метод SaveToFile просто напросто сохраняет в обычном текстовом виде значения чекбоксов. Но предварительно нам нужно преобразовать состояния чекбоксов в текстовый вид, соответственно “1” или “0”.

Далее задача метода LoadFromFile считать эти значения и преобразовать сначало в числовой вид, а затем в логический (true или false).


 procedure TFrameRuleEngine.SaveRules;
 var
   i: Integer;
 begin
   i := 0;
   while i < CheckListBoxRule.Items.Count do
   begin
     if CheckListBoxRule.Items[i] = '' then
     begin
       // Если ячейка пустая, то удаляем её
       CheckListBoxRule.Items.Delete(i);
     end
     else
     begin
       // Добавляем 1 или 0 соответственно checked или not checked
       CheckListBoxRule.Items[i] :=
       IntToStr(Integer(CheckListBoxRule.Checked[i])) +
       CheckListBoxRule.Items[i];
       Inc(i);
     end;
   end;
   // Сохраняем весь список
   CheckListBoxRule.Items.SaveToFile(ExtractFilePath(Application.ExeName) +
   'Rule.Txt');
 end;
 
 procedure TFrameRuleEngine.LoadRules;
 var
   sChecked: string;
   i: Integer;
 begin
   if FileExists(ExtractFilePath(Application.ExeName) + 'Rule.Txt') then
   begin
     // Считываем файл
     CheckListBoxRule.Items.LoadFromFile(ExtractFilePath(Application.ExeName) +
     'Rule.Txt');
     i := 0;
     while i < CheckListBoxRule.Items.Count do
     begin
       if CheckListBoxRule.Items[i] = '' then
       begin
         // Удаляем пустую ячейку
         CheckListBoxRule.Items.Delete(i);
       end
       else
       begin
         // получаем состояние чекбокса
         sChecked := Copy(CheckListBoxRule.Items[i], 1, 1);
         CheckListBoxRule.Items[i] := Copy(CheckListBoxRule.Items[i], 2,
         Length(CheckListBoxRule.Items[i]));
         // Обновляем свойство Checked
         CheckListBoxRule.Checked[i] := Boolean(StrToInt(sChecked));
         Inc(i);
       end;
     end;
   end;
 end;
 




Информация о TClass

TObject - "корневой" объект.

TClass определен как Class of TObject. Переменная Class НЕ является указателем на экземпляр объекта. Это указатель на *ТИП* объекта Class.


 Var
   Obj1: TWinControl;
   Class1: Class of TWinControl;
 

Class1 := TWinControl - правильное присваивание. Мы не распределяем память, у нас нет экземпляра TWinControl, мы не можем вызвать Class1.OnClick.

Class1 - это *тип* TWinControl с тем же контекстом использования, что и "TWinControl".

Поскольку мы можем использовать TWinControl.Create, то также мы можем использовать и Class1.Create, при этом создавая новый экземпляр TWinControl.

С тех пор как TEdit - наследник TWinControl, Class1 := TEdit правильное присваивание и Class1.Create создает экземпляр TEdit.

Если у меня имеется переменная Obj2: TWinControl, и даже если я присвоил экземпляр TListbox Obj2, я не могу ссылаться на Obj2.Items, поскольку Obj2 определен как TWinControl, а TWinControl не имеет свойства Items.

Те же характеристики верны и для Class1. Class1 определен как Class of TWinControl, поэтому они имеют общий конструктор, определенный в классе TWinControl.

Это не пугает меня при создании дополнительных типов:


 TMyObj1 = class(TEdit)
   constructor CreateMagic; virtual;
 end;
 TMyObj2 = class(TMyObj1)
   constructor CreateMagic; override;
 end;
 
 TMyClass = class of TMyObj;
 var
   MyObj1: TMyObj1;
   MyObj2: TMyObj2;
 
 function MakeAnother(AClass: TMyClass): TMyObj1;
 begin
   Result := AClass.CreateMagic;
 end;
 
 begin
   MyObj2 := TMyObj2.CreateMagic;
   MyObj1 := MakeAnother(MyObj2.ClassType);
 end.
 




TClientDataSet. Утечка памяти при загрузке XML

Автор: Sergei Romancha

Hапpимеp, если делаем:


 ClientDataSet.LoadFromFile('c:\tmp\1.xml');
 ClientDataSet.Close;
 

то видим, что память выделилась, но не освободилась.

Если даже делать ClientDataSet.Create и ClientDataSet.Free то все pавно будут утечки.

Пpобовал также пеpед закpытием:


 ClientDataSet.EmptyDataSet;
 ClientDataSet.CancelUpdates;
 ClientDataSet.LogChanges := False;
 ClientDataSet.MergeChangeLog;
 ClientDataSet.FieldDefs.Clear;
 ClientDataSet.IndexDefs.Clear;
 ClientDataSet.Params.Clear;
 ClientDataSet.Aggregates.Clear;
 ClientDataSet.IndexName := '';
 ClientDataSet.IndexFieldNames := '';
 

Все pавно не помогает.

Решения не нашел. Тестировал под D5 под W2000, W98. Также брал midas.dll от D6. Проблема осталась.

КОММЕНТАРИЙ

Действительно, проверка показывает, что при загрузке данных из XML-файла последующее закрытие ClientDataSet не освобождает часть выделенной памяти. Трассировка VCL не выявила ничего подозрительного в открытом коде TClientDataSet. Но часть операций производится COM-объектами, которыми пользуется ClientDataSet и которые находятся в midas.dll.

Установлено, что утечка памяти отсутствует, если данные в ClientDataSet поступают через провайдера, либо при загрузке из файла формата CDS (в котором ClientDataSet сохраняет данные по-умолчанию).

Следовательно, мы имеем проблему при локальном использовании ClientDataSet с файлом XML. Вероятно, в midas.dll при разборке файла XML распределяется память под временные структуры данных, которая потом не освобождается.




TColor

Что такое TColor

Для хранения цвета существует свой собственный тип, который называется TColor. Этот тип содержит информацию, как о самом цвете, так и том, каким образом его заменить, если, например, цветовая палитра системы не поддерживает этот цвет (скажем, установлено всего 256 цветов, а цвет, заданный в переменной, вылезает далеко за пределы этих 256 цветов).

Тип TColor состоит из четырех байт. Первый байт - указатель на замену цвета (о нем поговорим позже). Второй байт - яркость красного цвета от 0 до 255 (от 00 до FF). Третий байт - яркость зеленого цвета от 0 до 255 (от 00 до FF). И, наконец, четвертый байт - яркость синего цвета, также, от 0 до 255 (от 00 до FF).

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

Поговорим теперь о первом байте - указателе на замену цвета. Итак, этот байт может принимать три различных значения - ноль ($00), единицу ($01) или двойку ($02). Что это значит:

  • Ноль ($00) - цвет, который не может быть воспроизведен точно, заменяется ближайшим цветом из системной палитры.
  • Единица ($01) - цвет, который не может быть воспроизведен точно, заменяется ближайшим цветом из палитры, которая установлена сейчас.
  • Двойка ($02) - цвет, который не может быть воспроизведен точно, заменяется ближайшим цветом из палитры, которую поддерживает текущее устройство вывода (в нашем случае - монитор).

Видимо, всегда лучше устанавливать значение первого байта равным нулю ($00), по крайней мере, так происходит при получении типа TColor при помощи функции RGB.

И, напоследок, несколько примеров:


 $00FFFFFF - белый цвет;
 $00000000 - черный цвет;
 $00800000 - темно-красный цвет.
 




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

Вы можете использовать вызов IDAPI dbiGetDatabaseDesc. Вот быстрая справка (не забудьте добавить DB в список используемых модулей):


 var
   pDatabase: DBDrsc:
 begin
   { pAlias - PChar, содержащий имя псевдонима }
   dbiGetDatabaseDesc ( pAlias, @pDatabase ) ;
 

Для получения дополнительной информации обратитесь к описанию свойства pDatabase.szDbType.




Информация о TDataLink

Автор: James Thorpe (CSA Australasia)

Вот тексовое описание TDatalink, которое взято из моего учебного материала. Оригинал имеет еще несколько диаграмм и рисунков, которые не могут быть включены в данный совет. Также рекомендую заглянуть в исходный код модуля DB.PAS.

TFieldDatalink - производный класс от TDataLink, являющийся базовым классом для объекта, используемого компонентами для работы с базами данных и осуществляющий функцию связи с набором данных DataSet (TTable или TQuery). DataLink используется DataSet'ом для информирования всех БД-компонентов об изменении записи, о необходимости обновления записи перед помещением ее в базу данных, о том, что DataSet сменила свое состояние на активное или неактивное, и т.д.. И наоборот, DataLink используется БД-компонентами для обновления DataSet, например, его статуса.

DataSet может быть связан с несколькими источниками данных DataSource, каждый DataSource может быть связан с несколькими DataLink, и каждый DataLink может быть связан с единственным БД-компонентом. В большинстве случаев, отдельный компонент использует только один DataLink, тем не менее, имеются компоненты, такие как, например, DBLookupList или DBLookupCombo, использующих два DataLink. В этих элементах управления первый DataLink используется для чтения данных из lookup DataSet, второй DataLink используется для записи этих данных (при их изменении) во второй имеющийся DataSet. Каждый DataSet поддерживает связанный с ним список DataSource и, аналогично этому, каждый DataSource поддерживает список связанных с ним Datalink'ов.

В момент, когда DataSet должен уведомить БД-компоненты о наступлении какого-то события, например, при изменении пользователем какой-либо записи, он рассылает это сообщение всем DataSource, находящимся в его списке. Каждый DataSource затем повторяет этот процесс и рассылает сообщение всем Datalink'ам, находящимся в его списке. Другими словами, связь не зависит от элемента управления, при этом логика программирования должна отслеживать передачу сообщения каждому элементу управления, пользующемуся услугами DataLink и изолировать только те события, на которые элементу необходимо отреагировать. Связывая компонент с набором данных другим способом, мы не получим в свое распоряжение столько управляющих функций, гибкости и мониторинга, сколько даст нам один DataSet, соединенный с помощью DataLink.

Кроме функции обеспечения поддержания коммуникационного канала между DataSet и ДБ-компонентами, DataLink также обеспечивает управление буфером для каждого компонента. Большинство элементов управления, таких как, например, TDBEdit, отображающий только отдельно взятую запись, буферизация не требуется, тем не менее, таким компонентам, как, например, TDBGrid и TDBLookupList, отображающим множество записей, буферизация нужна. Физически DataLink данные не буферизирует, эта функция выполняется DataSet. Всесто этого DataLink поддерживает виртуальный буфер, который, в сущности, небольшое "окно" в физический буфер DataSet. Размер этого виртуального буфера может быть установлен с помощью свойства DataLinks BufferCount, а количество записей, реально в нем хранимых, с помощью свойства RecordCount.




Записать TDataSet в Excel файл


 {....}
 
 uses DB;
 {....}
 
   private
     procedure SendToExcel(aDataSet: TDataSet);
 
 {....}
 
 
 uses
   ComObj, ActiveX, Excel2000; // or Excel97 
 
 procedure TForm1.SendToExcel(aDataSet: TDataSet);
 var
   PreviewToExcel: TExcelApplication;
   RangeE: Excel2000.Range; //or RangeE: Excel97.Range 
   I, Row: Integer;
   Bookmark: TBookmarkStr;
 begin
   PreviewToExcel := TExcelApplication.Create(Self);
   PreviewToExcel.Connect;
   PreviewToExcel.Workbooks.Add(NULL, 0);
   RangeE := PreviewToExcel.ActiveCell;
 
   for I := 0 to aDataSet.Fields.Count - 1 do
   begin
     RangeE.Value := aDataSet.Fields[I].DisplayLabel;
     RangeE := RangeE.Next;
   end;
 
   aDataSet.DisableControls;
   try
     Bookmark := aDataSet.Bookmark;
     try
       aDataSet.First;
       Row := 2;
       while not aDataSet.EOF do
       begin
         //Write down Record As Row in msExcel 
         RangeE := PreviewToExcel.Range['A' + IntToStr(Row), 'A' + IntToStr(Row)];
         for I := 0 to aDataSet.Fields.Count - 1 do
         begin
           RangeE.Value := aDataSet.Fields[I].AsString;
           RangeE := RangeE.Next;
         end;
         aDataSet.Next;
         Inc(Row);
       end;
     finally
       aDataSet.Bookmark := Bookmark;
     end;
   finally
     aDataSet.EnableControls;
   end;
 
   //Creating Preview from Range A1..ColumnX 
   //Calculating ASCII 64 (Character Before "A") With Dataset FieldsCount 
   //This Method can only handle range A1..Z?, if want to be excel column type 
   //support, exp "AA"/"IV" 
   RangeE := PreviewToExcel.Range['A1', chr(64 + aDataSet.Fields.Count) + IntToStr(Row - 1)];
 
   RangeE.AutoFormat(8, NULL, NULL, NULL, NULL, NULL, NULL);
   PreviewToExcel.Visible[0] := True;
   PreviewToExcel.Disconnect;
 end;
 
 
 // Beispiel: 
 // Example: 
 procedure TForm1.Button1Click(Sender: TObject);
 begin
   SendToExcel(Table1);
 end;
 




Экспорт TDataSet в XML файл

Как пpогpаммист узнает о ядеpной войне?
Выглядит это примерно так:
Pinging calf.bk.ru [212.188.13.93] with 32 bytes of data:

Request timed out.
Request timed out.
Request timed out.
Request timed out.

Ping statistics for 1.1.1.1:
Packets: Sent = 4, Received = 0, Lost = 4 (100% loss),
Approximate round trip times in milli-seconds:
Minimum = 0ms, Maximum = 0ms, Average = 0ms


 {Unit to export a dataset to XML}
 unit DS2XML;
 
 interface
 
 uses
   Classes, DB;
 
 procedure DatasetToXML(Dataset: TDataSet; FileName: string);
 
 implementation
 
 uses
   SysUtils;
 
 var
   SourceBuffer: PChar;
 
 procedure WriteString(Stream: TFileStream; s: string);
 begin
   StrPCopy(SourceBuffer, s);
   Stream.Write(SourceBuffer[0], StrLen(SourceBuffer));
 end;
 
 procedure WriteFileBegin(Stream: TFileStream; Dataset: TDataSet);
 
   function XMLFieldType(fld: TField): string;
   begin
     case fld.DataType of
       ftString: Result   := '"string" WIDTH="' + IntToStr(fld.Size) + '"';
       ftSmallint: Result := '"i4"'; //?? 
       ftInteger: Result  := '"i4"';
       ftWord: Result     := '"i4"'; //?? 
       ftBoolean: Result  := '"boolean"';
       ftAutoInc: Result  := '"i4" SUBTYPE="Autoinc"';
       ftFloat: Result    := '"r8"';
       ftCurrency: Result := '"r8" SUBTYPE="Money"';
       ftBCD: Result      := '"r8"'; //?? 
       ftDate: Result     := '"date"';
       ftTime: Result     := '"time"'; //?? 
       ftDateTime: Result := '"datetime"';
       else
     end;
     if fld.Required then
       Result := Result + ' required="true"';
     if fld.ReadOnly then
       Result := Result + ' readonly="true"';
   end;
 var
   i: Integer;
 begin
   WriteString(Stream, '<?xml version="1.0" standalone="yes"?><!-- Generated by SMExport -->  ' +
     '<DATAPACKET Version="2.0">');
   WriteString(Stream, '<METADATA><FIELDS>');
 
   {write th metadata}
   with Dataset do
     for i := 0 to FieldCount - 1 do
     begin
       WriteString(Stream, '<FIELD attrname="' +
         Fields[i].FieldName +
         '" fieldtype=' +
         XMLFieldType(Fields[i]) +
         '/>');
     end;
   WriteString(Stream, '</FIELDS>');
   WriteString(Stream, '<PARAMS DEFAULT_ORDER="1" PRIMARY_KEY="1" LCID="1033"/>');
   WriteString(Stream, '</METADATA><ROWDATA>');
 end;
 
 procedure WriteFileEnd(Stream: TFileStream);
 begin
   WriteString(Stream, '</ROWDATA></DATAPACKET>');
 end;
 
 procedure WriteRowStart(Stream: TFileStream; IsAddedTitle: Boolean);
 begin
   if not IsAddedTitle then
     WriteString(Stream, '<ROW');
 end;
 
 procedure WriteRowEnd(Stream: TFileStream; IsAddedTitle: Boolean);
 begin
   if not IsAddedTitle then
     WriteString(Stream, '/>');
 end;
 
 procedure WriteData(Stream: TFileStream; fld: TField; AString: ShortString);
 begin
   if Assigned(fld) and (AString <> '') then
     WriteString(Stream, ' ' + fld.FieldName + '="' + AString + '"');
 end;
 
 function GetFieldStr(Field: TField): string;
 
   function GetDig(i, j: Word): string;
   begin
     Result := IntToStr(i);
     while (Length(Result) < j) do
       Result := '0' + Result;
   end;
 var
   Hour, Min, Sec, MSec: Word;
 begin
   case Field.DataType of
     ftBoolean: Result := UpperCase(Field.AsString);
     ftDate: Result    := FormatDateTime('yyyymmdd', Field.AsDateTime);
     ftTime: Result    := FormatDateTime('hhnnss', Field.AsDateTime);
     ftDateTime:
       begin
         Result := FormatDateTime('yyyymmdd', Field.AsDateTime);
         DecodeTime(Field.AsDateTime, Hour, Min, Sec, MSec);
         if (Hour <> 0) or (Min <> 0) or (Sec <> 0) or (MSec <> 0) then
           Result := Result + 'T' + GetDig(Hour, 2) + ':' + GetDig(Min,
             2) + ':' + GetDig(Sec, 2) + GetDig(MSec, 3);
       end;
     else
       Result := Field.AsString;
   end;
 end;
 
 procedure DatasetToXML(Dataset: TDataSet; FileName: string);
 var
   Stream: TFileStream;
   bkmark: TBookmark;
   i: Integer;
 begin
   Stream       := TFileStream.Create(FileName, fmCreate);
   SourceBuffer := StrAlloc(1024);
   WriteFileBegin(Stream, Dataset);
 
   with DataSet do
   begin
     DisableControls;
     bkmark := GetBookmark;
     First;
 
     {write a title row}
     WriteRowStart(Stream, True);
     for i := 0 to FieldCount - 1 do
       WriteData(Stream, nil, Fields[i].DisplayLabel);
     {write the end of row}
     WriteRowEnd(Stream, True);
 
     while (not EOF) do
     begin
       WriteRowStart(Stream, False);
       for i := 0 to FieldCount - 1 do
         WriteData(Stream, Fields[i], GetFieldStr(Fields[i]));
       {write the end of row}
       WriteRowEnd(Stream, False);
 
       Next;
     end;
 
     GotoBookmark(bkmark);
     EnableControls;
   end;
 
   WriteFileEnd(Stream);
   Stream.Free;
   StrDispose(SourceBuffer);
 end;
 
 end.
 
 // Example: 
 
 uses DS2XML;
 
 procedure TForm1.Button1Click(Sender: TObject);
   begin  DatasetToXML(Table1, 'test.xml');
   end;
 




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

Автор: Nomadic


 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
   {... тут pеагиpуй на изменения ...}
 end;
 

За отслеживание различных событий, происходящих с TDataSource, в иерархии VCL отвечает класс TDataLink. TFieldDataLink - наследник, который выполняет маскирование событий, не относящихся к конкретному столбцу набора данных.

Если надо отслеживать изменения в любом столбце набора, используйте TDataLink. Если необходимо отслеживать события для некоторого подмножества строк набора данных, посмотрите на реализацию TGridDataLink.




Внимание! TDateTime 1899

Автор: Kenneth D. James

Вчера программист Иванов отметил свой юбилей. Ему исполнилось 32 года.

Для обратной сортировки во многих моих таблицах я использую инвертирование поля типа дата (12/31/9999 минус реальная дата).

В первой версии Delphi все было нормально, но во второй это не сработало, зато вот что я обнаружил в на странице 135 Reference Library Guide:

Delphi 1.0 вычислял дату первого года с 1899. Для преобразования даты Delphi 1.0 в формат даты Delphi 2.0, необходимо вычесть 693594.0 из даты Delphi 1.0. Формат даты был изменен для обеспечения совместимости с OLE 2.0 Automation.




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

Автор: Steve Flynn

Краткое руководство по преодолению последствий нарушений трудовой дисциплины.
(Для несознательных компьютерщиков)
Ситуация 1:
Вы опаздываете на работу. На проходной стоит шеф. Ваши действия:
а)Зимний вариант.Снять и спрятать где-нибудь верхнюю одежду. Показать шефу пачку сигарет, объяснив мимоходом, что Вы уже на месте, просто выскочили на секунду в табачный ларек;
б)Летний вариант. Найти пустую коробку (желательно побольше), положить туда что-нибудь потяжелее и поживописнее изобразить погрузочно-разгрузочные работы (с потением и кряхтением);
Ситуация 2:
Вы вышли с товарищем на чашку кофе. Шеф в течении часа ожидает Вас на Вашем рабочем месте. Ваши действия:
а)Сказать,что из винчестера высыпалось несколько кластеров. Пришлось идти занимать у соседей;
б)Сделать удивленное лицо и сказать, что сами целый час торчали под дверью кабинета шефа, для консультации как раз по тому же самому вопросу;
Ситуация 3:
Шеф делает замечание, что после посещения коллеги-компьютерщика от Вас попахивает спиртным и требует объяснений. Ваши действия:
а) Предложите шефу купить новый суперсовременный компьютер, чтобы сэкономить на промывке спиртом контактов и разъёмов.
б) Объясните, что промывали базу данных техническим спиртом;
Ситуация 4:
Вы серьезно превысили лимит работы в Internet'e, просидев несколько часов в bk.ru Ваши действия:
а)Напишите в объяснительной, что новоприобретенная программа пыталась самостоятельно связаться через Internet с разработчиками для согласования каких-то технических деталей;
б)Поясните это возросшим объемом переписки с зарубежными фирмами, которые засыпали Вас выгодными предложениями о работе.
Ситуация 5:
Вы задержались на несколько часов после работы, чтобы добить свою левую халтуру. Шеф интересуется причиной переработки. Ваши действия:
а)Поблагодарите шефа за заботу, в нескольких словах расскажите о своей любви к фирме и намекните на прибавку к зарплате;
б)Объясните,что Вы хотя бы так пытаетесь компенсировать свои частые опоздания на работу и несанкционированные отлучки. Намекните про снятие выговора за опоздания.

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

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

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


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

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




TDBMemo в TDBCtrlGrid

Автор: Pat Ritchey

Останавливает ГИБДДшник машину, из машины вываливается сильно пьяный водитель. ГИБДДшник спрашивает:
- Ваши права?
Водитель отвечает (с трудом ворочая языком):
- Root!

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

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


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




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS