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

Курс видеоуроков программирования и крэкерства 4.0
(актуальность: сентябрь 2016)
Свежие инструменты, новые видеоуроки!

  • 300+ видеоуроков
  • 800 инструментов
  • 80 свежих книг и статей

УЗНАТЬ БОЛЬШЕ >>

Секреты современного программирования 2016 ВИДЕОКУРС
Новинка! Впервые вышел!
Узнай все секреты программирования

  • Топовые языки программирования
  • Лучшие ВИДЕОУРОКИ
  • выпущен 20 сентября 2016 года

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

БОЛЬШОЙ FAQ ПО DELPHI



Обработчик динамически созданного пункта меню

Автор: Dennis Passmore

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

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


 unit Tunit1;
 
 interface
 
 uses
   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
   Forms, Dialogs, StdCtrls, Menus;
 
 type
   TForm1 = class(TForm)
     Edit1: TEdit; { Просто "место для щелчка" и отображения результатов }
     procedure Edit1Click(Sender: TObject);
   private
     { Private declarations }
     FPopupMenu: TPopupMenu; { Общий Popup для использования "кем нужно" }
     FPopupResult: Longint; { Результат последнего выполненного FPopupMenu }
     procedure FPopupMenuClick(Sender: TObject);
   public
     { Public declarations }
   end;
 
 var
   Form1: TForm1;
 
 implementation
 
 {$R *.DFM}
 
 procedure TForm1.FPopupMenuClick(Sender: TObject);
 begin
   with (Sender as TMenuItem) do
     FPopupMenu.Tag := Tag; { передаем значение TMenuItem.Tag в FPopupMenu.Tag }
 end;
 
 procedure TForm1.Edit1Click(Sender: TObject);
 var
   tx, ty, tz: integer;
   FMenuItem: TMenuItem;
 begin
   tx := Left + (Width - ClientWidth) + (Sender as TEdit).Left;
   ty := Top + (Height - ClientHeight) + (Sender as TEdit).Top;
   FPopupMenu := TPopupMenu.Create(Self);
   FPopupMenu.AutoPopup := false;
   FPopupMenu.Tag := 0;
   for tz := 1 to 5 do
   begin
     FMenuItem := TMenuItem.Create(Self);
     with FMenuItem do
     begin
       Tag := tz;
       OnClick := FPopupMenuClick; { все сделает один OnClick }
       Caption := 'Выбор #' + IntToStr(tz);
     end;
     FPopupMenu.Items.Add(FMenuItem)
   end;
   FPopupMenu.Popup(tx, ty);
   Application.Processmessages; { даем время для обработки события OnClick }
   if FPopupMenu.Tag <> 0 then { они действительно выбрали что-то ? }
   begin
     FPopupResult := FPopupMenu.Tag;
     Edit1.Text := ' Выбор #' + IntToStr(FPopupResult);
   end;
   { FPopupMenu.Tag может храниться в ГЛОБАЛЬНОЙ переменной и использоваться
   позже как порядковое значение в блоках CASE OF или IF THEN
   для организации в коде условного перехода. }
   FPopupMenu.Free;
   FPopupMenu := nil;
 end;
 
 end.
 




Рисование на GroupBox

Автор: Ralph Friedman

Я хочу рисовать на холсте (Canvas) моего компонента GroupBox. Но когда я пробую рисовать на Component.Parent.Canvas, рисование происходит на форме, а не на моем компоненте GroupBox. Что я делаю неправильно?

Canvas - защищенное свойство TGroupBox и, поэтому, недоступное. Вы можете сделать его доступным следующим образом:


 type
   TMyGroupBox = class(TGroupBox)
     public
       property Canvas;
   end;
 
 procedure SomeProcedure;
 begin
   ...
   with TMyGroupBox(GroupBox1).Canvas do
     CopyRect(ClipRect, Image1.Canvas, ClipRect);
   ...
 end;
 




Включить или выключить флажок у другого приложения


 {
   The function CheckCheckBox() checks or unchecks a Checkbox in another
   window.
 
   Parameter:
   hApp : Handle to the parent window of the Checkbox.
   ClassName: Class name of the Checkbox.
   (For Delphi-Applications: TCheckBox. For C, VB,..: Checkbox)
   bValue: Determines whether the check box is in the checked state.
   CheckBoxNr: Number of the CheckBox (useful if there are several Checkboxes)
 }
 
 procedure CheckCheckBox(hApp: HWND; ClassName: string; bValue: Boolean; CheckBoxNr: Integer);
 var
   i: Word;
   hCheckBox: HWND;
 begin
   if not IsWindow(hApp) then Exit;
   for i := 0 to CheckBoxNr do
     hCheckBox := FindWindowEx(hApp, hCheckBox, PChar(ClassName), nil);
   if IsWindow(hCheckBox) then
     SendMessage(hCheckBox, BM_SETCHECK, Integer(bValue), 0);
 end;
 
 procedure TForm1.Button1Click(Sender: TObject);
 begin
   CheckCheckBox(Handle, 'TCheckBox', True, 1);
   // Or / Oder 
   // CheckCheckBox(Handle, 'CheckBox', True, 1); 
 end;
 




По волнам интеграции

Чтобы запустить человека на Луну, потребовалось вычислительная мощность всего трех С64 процессоров, а для того, чтоб запустить Windows, нужен 486 процессор. Что-то здесь не так...

Я родом из DOS. Кто-нибудь помнит, что это такое? Кто-нибудь помнит те компьютеры, на которых это крутилось? А какие усилия прилагались для того, чтобы сделать программу с минимальными требованиями к памяти и диску. Как использовали сначала EMS, а потом X MS с одной единственной целью - оптимизация. Много времени с тех пор прошло (старею что ли?).

Сейчас другие времена (наконец-то!). Кругом Win32, OLE, пара-тройка гигабайт на процесс, «безразмерные» диски. Кто сейчас придает значение лишним четырем килобайтам? Сотня килобайт - туда, сотня - сюда. Вот и я сейчас буду утверждать, что интеграция прило жений (мегабайты потерь оперативной памяти) - это правильно. Да, наверно это правильно, когда ты начинаешь использовать функциональность программ, которых ты не писал. Просто, эти самые программы умеют больше, чем можешь ты сам. А аналог написать слабо - пару лет попыхтишь и на пенсию по несостоятельности (мне уже давно пора!).

А зачем оно нужно?

Собственно, цель этой статьи мне понятна - поделиться своим опытом с народом. Делюсь…

Итак, зачем нам, лучшим в мире программистам, нужен Excel, порождение "злого" гения Microsoft? Конечно, часто это лишнее - «юзать» Excel для отчетов. Напечатать «платежку» можно и в QReport-е. Но…

Есть заказчики, готовые отдать «кучищи» денег за то, что они будут знать все и всегда о своем предприятии. Да еще, чтоб это было красиво и со вкусом.

Приезжает один из моих заказчиков (немец - они повсюду! курорты Испании просто куплены ими - это знаю наверняка) на свое местное предприятие и начинает задавать интересные вопросы. Как трудились за время его отсутствия, сколько продукции выпустили, кому с колько отгрузили, в разных валютах, итого в USD и пр.? А я ему в ответ открываю отчет, неслабый такой, - сводная таблица по движению готовой продукции (посвященные знают, что это 40-ой счет в бухгалтерии). А в ней одних PageField-ов десяток. И на каждый е го вопрос я начинаю отвечать не напрягаясь, потихоньку перетаскивая поля таблицы туда-сюда, фильтрую кое-что, строю диаграммы. Что, вы думаете, было потом? Он, как маленький ребенок, сидел за этой сводной таблицей несколько часов, все восхищался. И правил ьно, наши программисты круче ихних! Заодно и мы спокойно поработали (ему занятие нашлось). О деньгах тут вообще не говорим.

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

Я бы привел еще несколько примеров, но, думаю, читатели уже поняли меня. Excel - вещь практически незаменимая во всяческих анализах (не путать с поликлиникой). А для тех, кто не понял, я еще напишу. Отдельно.

Так как же с ним работать?

А просто. Создал "Excel.Application", использовал его по назначению, "убил" и готово. Вот именно об этом я и попытаюсь написать здесь.

Важно!

Параллельно с написанием статьи создавался демо-проект (точнее два - для Delphi 4 и 5), где вы сможете найти весь код примеров статьи. Проект для Delphi 4.0 использует импортированную Type Library из Excel 97. Здесь я использую ранее связывание, ибо Creat eOLEObject отлично описал мой любимый классик в "Delphi 4 Unleashed" (мне ли с ним тягаться?). Кроме того, обращайтесь к комментариям в исходных текстах этого проекта. Местами там написано намного понятней, нежели здесь. Delphi 5 содержит более удобный ме ханизм импорта библиотек типов с поддержкой событий и прекрасной генерацией ко-классов. Специально для счастливых обладателей Delphi 5 (я тоже им являюсь) я создал проект, но уже применительно к TexcelApplication (правда ли, что импортированный MS Office есть только в версии Enterprise?). Примеры кода я буду приводить сначала для Delphi 4, потом для Delphi 5. Заранее приношу прощения за дублирование информации в комментариях и в статье - писал сразу везде. И еще. Эффективная работа с Excel-ом из Delphi-приложений немыслима без знания одной важной вещи. И имя ей - интерфейс. Мне, конечно, хотелось бы написать о принципах работы с интерфейсами здесь, в этой статье. Более того, я обещал сделать это самой Корол еве. Но...

Мне ли (совсем еще не профессионалу - и это так!) пытаться сделать это лучше, чем классики этой области. Я честно признаюсь, что не смогу этого сделать быстро (в небольшом объеме) и качественно. Поэтому всякого, не знакомого еще с этой областью программир ования, я с глубочайшими извинениями отсылаю к книге Чеппела "OLE Inside".

Достойную помощь (уже применительно к Delphi) может вам оказать "Delphi 4 Unleashed" Чарльза Калверта.

Создание экземпляра Excel.Application.

Модуль импортированной Excel TLB (неважно, для D4 или D5) содержит описания всех интерфейсов, которые правильные программисты из Microsoft решили выставить наружу. Там есть все необходимое: типы, константы и интерфейсы. Этого вполне достаточно для работы с Excel-ом из Delphi-приложения (во написал! а что еще нужно-то?). Я создаю Excel для последующего его использования с помощью такого кода:

Delphi 4.0


 procedure TForm1.CreateExcel(NewInstance: boolean);
 var IU: IUnknown;
     isCreate: boolean;
 begin
   // FIXLSApp - private-поле у формы
   //            у меня в привычке добавлять букву I для всех интерфейсов
   //            понятно почему FI… ?
   if not Assigned(FIXLSApp) then begin // а зачем создавать, если уже есть?
     isCreate := NewInstance or
       (not SUCCEEDED( GetActiveObject(CLASS_Application_, nil, IU) ) );
     if isCreate then
       FIXLSApp := CreateComObject(CLASS_Application_) as _Application
     else
       FIXLSApp := IU as _Application;
   end;
 end;
 
 

Этот достаточно простой код вы найдете практически во всех книгах, посвященных работе с интерфейсами. Как и везде, я напишу, что в результате выполнения этого кода создастся объект COM с CLSID-ом «{00024500-0000-0000-C000-000000000046}» (читайте и перечит ывайте Калверта, это не только укрепляет сон!).

Delphi 5.0


 procedure TForm1.CreateExcel(NewInstance: boolean);
 begin
   if not Assigned(IXLSApp) then begin
     FIXLSApp := TExcelApplication.Create(Self);
     if NewInstance then FIXLSApp.ConnectKind := ckNewInstance;
     FIXLSApp.Connect;
   end;
 end;
 

В отличие от предыдущих версий, Delphi 5.0 предоставляет более удобный сервис при импорте библиотек типов. Большой шаг вперед - появление класса ToleServer с поддержкой событий. Теперь работа с существующими и создание новых OLE-серверов стала намного удо бней. Как видите, не приходится обращаться к низкоуровневым функциям. Впрочем, в Delphi 4.0 тоже существовал этот класс, только не от Borland. Отличная библиотека была создана Бином Ли (Binh Ly) в COM Nodes - это Threading COM Library. С легкой руки Алекс ея Вуколова (специальное спасибо!) я использовал ее для построения масштабируемых COM-серверов в сервисах WinNT.

Обращу ваше внимание только на параметр NewInstance. Он позволяет создать новый процесс. Я часто задаю себе вопрос - "А нужен ли NewInstance?". Одна копия процесса, все ж, требует меньше памяти. Но еще чаще я думаю - "Боже, как хорошо я сделал, когда созд ал новый процесс!". Почему? Если вы не хотите потерять уже открытые, но еще не сохраненные книги, экспериментируя даже с моими примерами, создавайте новый процесс. Печальный опыт научил меня использовать GetActiveObject только в случае полной уверенности в коде, который будет выполняться после. Поэтому, мой вам совет, тестируйте свои приложения только с NewInstance. Или закрывайте важные книги пред этим. Excel - хитрая программа, бывает, улетает в неизвестность, ни слова не сказав. Это не вина Microsoft. Это неудачное расположение звезд.

Как показать Excel, если он, разумеется, создан?

Вот здесь начинаются хитрости. Любой, читавший помощь по Excel VBA, скажет, что достаточно написать FIXLSApp.Visible := true. Не тут-то было. Я делаю так:

Delphi 4.0 / 5.0


 procedure TForm1.ShowExcel;
 begin
   if Assigned(FIXLSApp) then begin // а если он не создан?
     FIXLSApp.Visible[0] := true;
     if FIXLSApp.WindowState[0] = TOLEEnum(xlMinimized) then
       FIXLSApp.WindowState[0] := TOLEEnum(xlNormal);
     FIXLSApp.ScreenUpdating[0] := true;
   end;
 end;
 

Зачем здесь условие на минимайз и какой-то ScreenUpdating? Давайте попробуем закомментировать эти строки, остаиви только Visible, запустить проект, создать Excel (кнопка CreateExcel), показать его (кнопка ShowExcel), минимизировать, вернуться в приложение и сделать снова ShowExcel. Да-да, Visible = true переводит фокус в минимизированный Excel, не восстанавливая размеры окна. Это ситуация, с которой я борюсь условием на xlMinimized. Но ScreenUpdating зачем?

Знающие люди говорят, что это свойство отвечает за перерисовку окон Excel. Это все равно, что DisableControls у TDataSet. Добавляет скорости, если в нем false. И это правда что, если выключить его во время длительных пересчетов, то быстрее пересчитается. Но мы, ведь, не выключали его. Зачем тогда эта строка?

Делаем так: комметируем эту строку, запускаем демо, CreateExcel, ShowExcel, закрываем его (можно кнопкой с крестиком в правом верхнем углу окна, кому нравится - через меню "Файл/Выход"). Знающие люди скажут, что Excel на самом деле не закрыт. Интерфейс мы не освободили, поэтому в TaskManager мы его и увидим. Итак, Excel по-прежнему у нас в руках. Мы имеем право сделать ему снова Show.

После такого действия у меня возникает ощущение, что я переплатил за свою видеокарту. Фокус в Excel-е, но я по-прежнему наблюдаю форму демо-проекта. Видимо, программисты из MS не рассчитывали на то, что кто-то закроет Excel, вызванный через создание Excel .Application, а потом захочет увидеть его снова. Но я-то захотел?!

Свойства Visible, WindowState и ScreenUpdating вызываются с каким-то непонятным индексом массива - 0. В модуле Excel TLB во многих свойствах и методах вы можете встретить параметр или индекс lcid. Не помню, у кого я это прочитал (Калверт или Канту), но с тех пор я туда передаю всегда 0. И все работает. LCID - это что-то насчет локализации. В MSDN написано "Indicates that the parameter is a locale ID (LCID)".

Спрячем Excel от посторонних глаз!

На свой процесс я всегда создаю один экземпляр Excel.Application. Уже пару лет все отчеты у меня - это отчеты Excel. Я написал несколько классов, которые мне очень помогают в этом. Сегодня у меня целая «отчетная» подсистема, зашитая в класс и обслуживающа я непомерно большие запросы моих пользователей. В промежутках между работой с отчетами нет необходимости «мозолить глаза» лишним окном в TaskBar-е. Вот и прячу я этот Excel. Это очень просто и комментариев, думаю, не требует:

Delphi 4.0 / 5.0


 procedure TForm1.HideExcel;
 begin
   if Assigned(FIXLSApp) then begin
     FIXLSApp.Visible[0] := false;
   end;
 end;
 

Закроем Excel корректно!

Собственно говоря, при закрытии приложения Excel сам будет закрыт, если вы там не устели чего-нибудь отредактировать. И это правильно. Программисты Borland (Inprise до сих пор мне режет слух, да и некоторым в Inprise, судя по всему, тоже) позаботились об этом. Но я еще с Delphi 3 заимел дурную привычку освобождать все самостоятельно. Освобождать обычным присваиванием в nil (это касается проекта для D4). Труда это не составляет, да и проверка на Assigned удобна. Поэтому, и еще из кое-каких соображений, я д елаю так:

Delphi 4.0


 procedure TForm1.ReleaseExcel;
 begin
   if Assigned(FIXLSApp) then begin
     if (FIXLSApp.Workbooks.Count > 0) and (not FIXLSApp.Visible[0]) then begin
       FIXLSApp.WindowState[0] := TOLEEnum(xlMinimized);
       FIXLSApp.Visible[0] := true;
       Application.BringToFront;
     end;
   end;
   FIXLSApp := nil;
 end;
 

Ну вот, написал только про nil, а кода - на полстраницы. Опишу ситуацию. Вы не запускали новый процесс, вы «законнектились» к уже существовавшему. В нем была открыта книга. Попробуйте: CreateExcel, ShowExcel, HideExcel (имеем право), ReleaseExcel. Если оставить только присваивание в nil, то существовавший процесс не будет выгр ужен (он же существовал до запуска нашего демо), но будет спрятан от пользователя с его открытой книгой.

Delphi 5.0


 procedure TForm1.ReleaseExcel;
 begin
   if Assigned(IXLSApp) then begin
     if (IXLSApp.Workbooks.Count > 0) and (not IXLSApp.Visible[0]) then begin
       IXLSApp.WindowState[0] := TOLEEnum(xlMinimized);
       IXLSApp.Visible[0] := true;
       if not(csDestroying in ComponentState) then Self.SetFocus;
       Application.BringToFront;
     end;
   end;
   FreeAndNil(FIXLSApp);
 end;
 
 

Практически тот же код. Только в D5 вы работаете уже не с интерфейсом напрямую, а с экземпляром класса TexcelApplcation. Если посмотреть его предков, то можно увидеть, что это настоящий класс, освободить который просто необходимо. Поэтому вместо присваива ния в nil там написано FreeAndNil (помните такую процедуру?).

Лучшее решение - шаблоны

Excel, интегрированный с моими приложениями, хорош (для меня - программиста) только по одной причине. Я всегда создаю шаблоны и использую их потом при построении отчетов. Шаблоны позволяют мне избежать ручного (в исходном тексте) форматирования. В общем с лучае, алгоритм выглядит просто: по шаблону создается книга, каким-то образом помеченные области заполняются данными и… (а дальше все уже готово). Как я создаю книгу по шаблону:

Delphi 4.0 / 5.0


 function TForm1.AddWorkbook(const WorkbookName: string): Excel8TLB._Workbook;
 begin
   Result := nil;
   if Assigned(FIXLSApp) and (trim(WorkbookName) <> '') then begin
     Result := FIXLSApp.Workbooks.Add(WorkbookName, 0);
   end;
 end;
 
 

В этом коде нет ничего сложного. В принципе при работе с Excel я мало находил мест, где что-либо сделать было бы сложно. Чаще достаточно прочитать справку по VBA или записать макрос (благо, Microsoft встроила в Excel хороший пишущий player). После выполне ния этого метода будет добавлена книга, близнец шаблона, с именем шаблона и порядковым номером (как "Книга1.xls" или "Книга228.xls"). Правда здесь есть одна тонкость. Эти «циферки» в имя книги Excel добавляет после поиска книг с таким же названием в катал оге по умолчанию. Я несколько раз наступал на грабли (больно!), когда пытался сохранять книги в другом каталоге и создавать новую - по этому же шаблону. К сожалению, не может эта «злобная» программа держать открытыми несколько книг с одинаковыми названиям и, несмотря на то, что они лежат в разных каталогах.

Как я помечаю области, в которые необходимо разместить данные? В Excel существует возможность объединить ячейки в группу и поименовать эту группу. В терминах Microsoft это объект Range (область). Для своего проекта я создал тестовую книгу "Test.xls", в ко торой на листе "Лист1" разместил область "TestRange" (см. рисунок). Более того, для ячеек этой области я указал форматы вывода (Field4 - дата, Field3 - красный цвет шрифта). Я надеюсь, что после переноса тестовых данных форматы сохранятся.

Что есть шаблон без данных в нем?

Существует масса способов передать данные в Excel, начиная с DDE и заканчивая обычным присваиванием (типа Cell.Value := NewValue ). Конечно, максимальную скорость передачи данных можно получить, только используя DDE. Но я отказался от этого пути из-за нек оторых ограничений и давно смущающего меня флажка в настройках Excel ("Игнорировать DDE-запросы"). Поэтому здесь я опишу менее эффективный, но работоспособный, путь решения этой проблемы. Итак, после нажатия кнопки CreateExcel имеем открытый шаблон с лист ом "Лист1" и областью с именем "TestRange". Для чистоты эксперимента (скорей из лени, великая вещь - собственная лень) я описал константный массив с тестовыми данными - TestDataArray. Именно эти данные я и передаю в ячейки области:

Delphi 4.0


 procedure TForm1.btnDataToBookClick(Sender: TObject);
 var LaunchDir: string;
     IWorkbook: Excel8TLB._Workbook;
     ISheet: Excel8TLB._Worksheet;
     IRange: Excel8TLB.Range;
     NewValueArray, V: OLEVariant;
     i: integer;
 begin
   if Assigned(IXLSApp) then begin
     LaunchDir := ExtractFilePath( ParamStr(0) );
     IWorkbook := AddWorkbook( LaunchDir + 'Test.xls' );
     try
       ISheet := IWorkbook.Worksheets.Item['Лист1'] as Excel8TLB._Worksheet;
       IRange := ISheet.Range['TestRange', EmptyParam];
       NewValueArray := VarArrayCreate([0, 20, 1, 4], varVariant);
       for i := 0 to 20 do begin
         NewValueArray[i, 1] := TestDataArray[i].V1;
         NewValueArray[i, 2] := TestDataArray[i].V2;
         NewValueArray[i, 3] := TestDataArray[i].V3;
         NewValueArray[i, 4] := date + i;
       end;
       IRange.Value := NewValueArray;
     finally
       IRange := nil;
       ISheet := nil;
       IWorkbook := nil;
     end;
   end;
 end;
 
 

Delphi 5.0


 procedure TForm1.btnDataClick(Sender: TObject);
 type
 var LaunchDir: string;
     IWorkbook: Excel97.ExcelWorkbook;
     ISheet: Excel97.ExcelWorksheet;
     IRange: Excel97.Range;
     NewValueArray, V: OLEVariant;
     i: integer;
 begin
   if Assigned(IXLSApp) then begin
     LaunchDir := ExtractFilePath( ParamStr(0) );
     IWorkbook := AddWorkbook( LaunchDir + 'Test.xls' );
     try
       ISheet := IWorkbook.Worksheets.Item['Лист1'] as Excel97.ExcelWorksheet;
       IRange := ISheet.Range['TestRange', EmptyParam];
       NewValueArray := VarArrayCreate([0, 20, 1, 4], varVariant);
       for i := 0 to 20 do begin
         NewValueArray[i, 1] := TestDataArray[i].V1;
         NewValueArray[i, 2] := TestDataArray[i].V2;
         NewValueArray[i, 3] := TestDataArray[i].V3;
         NewValueArray[i, 4] := date + i;
       end;
       IRange.Value := NewValueArray;
     finally
       IRange := nil;
       ISheet := nil;
       IWorkbook := nil;
     end;
   end;
 end;
 
 

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

To be continue…

Excel - занимательная программа. Я давно с ней. Библиотека типов Excel громадна, как «Титаник» (хорошо, что не тонет). Я отдаю должное программистам, создавшим этот не менее замечательный, чем Delphi, продукт. И в одну статью все, что хочется написать, не вместишь (почему-то у меня уже шесть листов? Знаю, я слишком многословен). Поэтому ругайте меня и ждите продолжения…




Сущность ООП

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

Вот как вы можете сделать это. Забудьте об диалоговом окне хотя бы на минуту и сконцентрируйтесь на создании файла персональных данных. Скажем, вы редактируете запись человека со следующими полями: First Name, Last Name, Age и Active. Скажем, вам нужны следующие операции при работе с записью: добавление, изменение, удаление и построение списка.

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


 interface
 
 PPersonRecord = ^TPersonRecord;
 TPersonRecord = record
 
   FirstName: string;
   LastName: string;
   Age: Byte;
   Active: Boolean;
 end;
 
 TPersonFile = class(TObject)
 private
 
   FFileName: TFileName;
   FFile: file of TPersonRec;
 public
 
   constructor Create(AFileName: TFileName);
   destructor Destroy; override;
   procedure LoadRecord(Index: Integer);
   procedure SaveRecord(Index: Integer);
   procedure Add(NewPersonRecord: TPersonRecord);
   procedure Change(ChangedPersonRecord: TPersonRecord; Index: Integer);
   procedure Delete(Index: Integer);
   procedure List(AStringList: TStringList);
   property Person[Index: Integer]: TPersonRecord read LoadRecord write
     SaveRecord;
 end;
 
 implementation
 
 constructor TPersonFile.Create(AFileName: TFileName);
 begin
 
   inherited.Create;
   AssignFile(FFile, AFileName);
   Reset(FFile, SizeOf(TPersonRec));
   New(FPersonRecord);
 end;
 
 destructor TPersonFile.Destroy;
 begin
 
   CloseFile(FFile);
   Dispose(FPersonRecord);
   inherited Destroy;
 end;
 
 function TPersonFile.LoadRecord(Index: Integer): PPersonRec;
 begin
 
   { позиция файла в точке коррекции для чтения записи }
   { ... }
 end;
 
 procedure TPersonFile.SaveRecord(Index: Integer);
 begin
 
   { позиция файла в точке коррекции для записи записи }
   { ... }
 end;
 
 procedure TPersonFile.Add(NewPersonRecord: TPersonRecord);
 begin
 
   { файл позиционируется в конец для записи записи }
   { ... }
 end;
 
 procedure TPersonFile.Change(ChangedPersonRecord: TPersonRecord; Index:
   Integer);
 begin
 
   { именение TStatus ??? }
   { позиция файла в точке коррекции для записи записи }
   { ... }
 end;
 
 procedure TPersonFile.Delete(Index: Integer);
 begin
 
   { изменение TStatus ??? }
   { позиция файла в точке коррекции для записи записи }
   { ... }
 end;
 
 procedure TPersonFile.List(AStringList: TStringList);
 begin
 
   { в цикле обходим все записи, пополняя AStringList??? }
 end;
 

OK, я надеюсь вы поняли мою идею. Вышеприведенный код взят мною из головы и, вероятно, несвободен от ошибок, поскольку я не до конца понял как работает тип file (для доступа к бинарному файлу я использую TFileStream), но идея следующая: инкапсуляция ваших функций работы с файлом в невизуальный объект как показано выше.

Теперь вы можете начать думать о ваших диалогах. Вам необходимо создать диалог, у которого в обработчике события OnCreate была бы примерно такая строчка кода:


 MyPersonFile := TPersonFile.Create('c:\person.dat');
 

Естественно, вам необходим модуль, в котором вы объявляете TPersonFile в секции используемых модулей, а в классе формы необходимо поле с именем MyPersonFile. Вам также необходимо помнить об освобождении MyPersonFile в методе формы onClose. Я думаю вы сообразите как разместить в вашей программе необходимые элементы управления (менюшки, кнопки и прочие причиндалы), хотя бы для того, чтобы с помощью них можно было бы открыть файл.

Теперь вы должны разместить на форме компоненты типа Edit, CheckBox и др., отображающие и позволяющие редактировать поля записи через свойство Record. Убедитесь в том, что вы поддерживаете должный порядок, и освобождаете объект (запись) после его создания и использования. Конечно, эту работу красивой не назовешь, но от нее вас никто еще не освобождал. Вот красота ООП:

*После создания комбинации объект / форма диалога вся работа уже сделана.*

Вот другая хорошая вещь:

*Если вы изменяете ваш пользовательский интерфейс (например, при отказе от кучи диалогов или от использования Delphi (молчу-молчу)), ООП предоставляет вам простой и легкий в использовании способ переноса логики приложения, инкапсулированной в объекте TPersonFile.




Записать содержимое окна OpenGL в BMP файл

Сидят два программера в офисе. Бац - звонок телефонный, на проводе шеф:
- Hу, ребята, чем занимаетесь?
- Козла забиваем!
- В домино играете ?!
- Да неееее - в DOOM!

gr - объект, в канве которого я рисую с помощью OpenGL


 bt := TBitmap.Create;
 with bt do
 begin
   Width := gr.Width;
   Height := gr.Height;
   Canvas.CopyRect(ClientRect, gr.Canvas, gr.ClientRect);
   SaveToFile('e:\bt.bmp');
   Free;
 end;
 




Как открыть базу данных Microsoft Access .MDB в Delphi

Программирование под Майкрософт.Net - это как секс с представителем своего пола - пока этим не займешься, сама мысль об этом кажется извращением. После того, как этим займешься, понимаешь, что наверное что-то в этом есть, но друзьям признаться стыдно.

ADO

Если у Вас Delphi 5 Enterprise или Delphi 5 Professional с ADO Express, то Вы можете использовать компонент ADOTable и в его свойстве ConnectionString настроить (build) подключение как базе данных MS Access. Например:

Provider=Microsoft.Jet.OLEDB.4.0;
User ID=Admin;
Password=Password;
Data Source=D:\Path\dbname.mdb;
Mode=ReadWrite;
Extended Properties=" " ;
Persist Security Info=False;
Jet OLEDB:System database=" " ;
Jet OLEDB:Registry Path=" " ;
Jet OLEDB:Database Password=" " ;
Jet OLEDB:Engine Type=5;
Jet OLEDB:Database Locking Mode=1;
Jet OLEDB:Global Partial Bulk Ops=2;
Jet OLEDB:Global Bulk Transactions=1;
Jet OLEDB:New Database Password=" " ;
Jet OLEDB:Create System Database=False;
Jet OLEDB:Encrypt Database=False;
Jet OLEDB:Don't Copy Locale on Compact=False;
Jet OLEDB:Compact Without Replica Repair=True;
Jet OLEDB:SFP=False

При этом будет открыта база данных D:\Path\dbname.mdb, будет использован драйвер ADO для базы данных Access (Microsoft.Jet.OLEDB.4.0). Имя пользователя будет Admin без пароля (эти значения присваиваются поумолчанию при создании базы Access). Если Вы всё-таки захотите использовать пароль, то его надо будет задать в ствойстве Jet OLEDB:Database Password. Если у Вас установлен режим безопасности, то необходимо указать файл .MDW или .MDA в свойстве Jet OLEDB:System database.

BDE

Так же для открытия базы данных Access можно воспользоваться BDE которая содержит родной драйвер (MSACCESS). В компоненте Database установите следующие свойства:

 DatabaseName = any_name (или alias_name)
 DriverName   = MSACCESS
 LoginPrompt  = False
 Params       = PATH=d:\path
                DATABASE NAME=d:\path\filename.mdb
                TRACE MODE=0
                LANGDRIVER=Access General
                USER NAME=Admin
                PASSWORD=your_password
                OPEN/MODE=READ/WRITE
                SQLPASSTHRU MODE=NOT SHARED
 

Значения свойства DatabaseName объекта Database, это то, которое Вы будете использовать в свойстве DatabaseName компонентов Table и Query, которые представляют таблицы и запросы для этой базы данных (тем самым связывая их с объектом Database).

BDE+ODBC

В случае с базой данных Access, BDE предоставляет драйвер, однако существует множество других баз, для которых в BDE драйвера нет, но для которых есть драйвер ODBC. ODBC обычно используется для небольших баз данных или в приложениях, в которых присутствуют только операции импорта/экспорта...

Ниже приведён пример использования драйвера ODBC с BDE для открытия базы данных Access:

  1. Создайте DSN (Data Source Name) для Вашей базы данных (используя апплет ODBC Data Sources в панели управления).
  2. Кликните на закладку " System DSN" или " User DSN"
  3. Кликните по кнопке " Add..."
  4. Выберите " Microsoft Access Driver (*.mdb)" и нажмите ENTER. Появится диалоговое окошко " ODBC Microsoft Access Setup" .
  5. Задайте имя в текстовом окошке Data Source Name (без пробелов и без специальных символов).
  6. Кликните по кнопке " Select..." чтобы выбрать нужный файл .MDB.
  7. Если у Вас установлена схема безопасноти, то выберите радио кнопку " Database" в " System Database" , а затем кликните кнопку " System database..." , чтобы указать файл рабочей группы .MDW или .MDA.
  8. Если Вы хотите указать имя пользователя и пароль, то нажмите кнопку " Advanced..." . Данный способ защиты является низкоуровневым, так как любой, кто имеет доступ к Вашей машине может спокойно посмотреть свойства DSN. Если Вам необходим более высокий уровень защиты, то задавать имя пользователя и пароль необходимо на стадии открытия базы данных (см. ниже).
  9. В заключении нажмите " OK" , после чего Ваш DSN будет сохранён.
  10. В Delphi установите свойства компонента TDatabase:
  11. В DatabaseName задайте имя, которое указали в DSN.
  12. Если Вы хотите, чтобы пользователя спрашивали имя и пароль, то установите LoginPrompt в True.
  13. Если Вы не хотите использовать стандартный диалог имени и пароля (или если имя и пароль будут задаваться программно), то установите LoginPrompt в False и задайте свойство Params (или задайте эти свойства по ходу выполнения программы):
     USER NAME=your_username
     PASSWORD=your_password
     
  14. Свяжите компоненты TTable или TQuery с компонентом TDatabase, как рассказывалось Выше, просто указав тоже имя (которое было задано в DSN) в их соответствующих свойствах DatabaseName.



Открыть CD-ROM


Клиент:
- В стоимость мультимедийного компьютера CDROM входит?
- Входит.
- Так там нет его!
- Kак нет?.. Я его Вам поставил.
- Ну, как, мы его открываем, а там пусто!..

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

Для начала научимся открывать CD-ROM по нажатию простого "батона":

  • В uses нужно сначала объявить модуль MMSystem:

 uses
   MMSystem;
 

  • По нажатию кнопок написать:

 //Для открытия
 procedure TForm1.OpenBtnClick(Sender: TObject);
 begin
   mciSendString('Set cdaudio door open wait', nil, 0, handle);
 end;
 
 //Для закрытия
 procedure TForm1.CloseBtnClick(Sender: TObject);
 begin
   mciSendString('Set cdaudio door closed wait', nil, 0, handle);
 end;
 

Ну а если вы уж хотите, чтобы это всё происходило автоматически с периодичностью в несколько минут, тогда выносим наш любимый компонент - Timer. Устанавливаем его свойство Interval в 30000 миллисекунд - это 30 секунд, т.е. каждые полминуты глупый ламерюга будет подскакивать...И на событие OnTimer, предвкушая удовольствие, пишем: сначала в публичных объявлениях объявим переменную логического типа IsOpen для обозначения времени когда открыт CD-ROM


 public
   { Public declarations }
   IsOpen: boolean;
 

По созданию окна (OnCreate) устанавливаем эту переменную в false, т.к. изначально, когда наша прога только запускается, CD-ROM не открыт:


 procedure TForm1.FormCreate(Sender: TObject);
 begin
   IsOpen := false;
 end;
 

И наконец, по таймеру пишем:


 procedure TForm1.Timer1Timer(Sender: TObject);
 begin
   if IsOpen = false then
   begin
     mciSendString('Set cdaudio door open wait', nil, 0, handle);
     IsOpen:=true;
   end
   else
   begin
     mciSendString('Set cdaudio door closed wait', nil, 0, handle);
     IsOpen:=false;
   end;
 end;
 




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

Автор: Nomadic

В компьютер заложили множество всевозможных анекдотов, чтобы тот выдал средний. Результат начинался так: "Лежат в постели три еврея: Чапаев, Чебурашка и поручик Ржевский..."

Для dBase-таблицы встроенными средствами ты не перестроишь индекс, если его нет. Для этой цели мне пришлось написать процедуру для физического удаления признака индексации в самом dbf-файле и после её применения добавлять индексы заново.

Для этого в заголовок файла dbf по смещению 28(dec) записываешь 0.

По другому никак не выходит(я долго бился)- вот для Paradox таблиц все Ok.

С помощью BDE Callbacks. Пpимеp для Delphi 2.0, на пеpвом не пpовеpял:


 unit Callback;
 
 interface
 
 uses BDE, Classes, Forms, DB, DBTables;
 
 type
   TForm1 = class(TForm)
     Table1: TTable;
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
   private
     CBack: TBDECallback; // опpеделение BDE CallBack
     CBBuf: CBInputDesc; // пpосто буфеp
     function CBFunc(CBInfo: Pointer): CBRType; // Callback-функция
   public
   end;
 
 var
   Form1: TForm1;
 
 implementation
 
 {$R *.DFM}
 
 procedure TForm1.FormCreate(Sender: TObject);
 begin
   Session.Open; // В это вpемя сессия ещ? не откpыта
   CBack := TBDECallback.Create(Session {Hапpимеp}, nil, cbINPUTREQ, @CBRegBuf,
     SizeOf(CBBuf), CBFunc, False); // Опpеделили Callback
   Table1.Open;
   //^^^^^^^^^^^ - здесь возможна ошибка с индексом, etc.
 end;
 
 procedure TForm1.FormDestroy(Sender: TObject);
 begin
   CBack.Free; // Освобождаем CallBack
 end;
 
 function TForm1.CBFunc(CBInfo: Pointer): CBRType;
 begin
   with PCBInputDesc(CBInfo)^ do
     case eCbInputId of
       cbiMDXMissing {, cbiDBTMissing - можно ещ? и очищать BLOB-поля}:
         begin
           iSelection := 3; // Hомеp ваpианта ответа (1-й - откpыть только
           // для чтения, 2-й - не откpывать, 3-й - отсоединить индекс).
           // Возможный источник непpиятностей: а вдpуг в последующих веpсиях
           // BDE номеpа будут дpугими?
           Result := cbrCHKINPUT; // Обpабатывать введ?нный ответ
         end;
     end;
 end;
 
 end.
 

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

Вообще, pуки бы отоpвал тем, кто писал спpавку по Дельфям: я неделю мучался с сабжем, пока случайно не набpёл на Callbacks.




Как открыть Excel-евский файл

И послал он свой комп на три кнопки. [Ctrl/Alt/Del]


 procedure OpenExcelBook;
 var
   VExcel: Variant;
 begin
   try
     //проверяем, нет ли запущенного Excel
     VExcel := GetActiveOleObject('Excel.Application');
   except
     //если нет, то запускаем
     on EOLESysError do
       VExcel := CreateOleObject('Excel.Application');
   end;
   with VExcel do
   begin
     Visible := True;
     //Открывать Excel на полный экран
     WindowState := -4137;
     //не показывать предупреждающие сообщения
     VExcel.DisplayAlerts := False;
     //Открываем рабочую книгу
     WorkBooks.Open('C:\Temp\MyBook.xls');
     //Становимся на первый лист
     WorkSheets[1].Activate;
   end;
 end;
 




Открыть файл JPEG

Компьютеpщик говоpит девушке:
-Ты мне сегодня во сне пpиснилась!
-В эpотическом?
-Hет, в обычном.
-А как ты их вообще pазличаешь?
-А у эpотических pасшиpение *.JPG

В комплект поставки Delphi входит модуль JPEG. Он позволяет работать с изображениями в формате JPEG. Эта программа открывает выбранный файл и выводит изображение на форму.


 uses Jpeg;
 
 procedure TForm1.Button1Click(Sender: TObject);
 var
   JpegIm: TJpegImage;
   bm: TBitMap;
 begin
   if OpenDialog1.Execute = false then
     Exit;
   bm := TBitMap.Create;
   JpegIm := TJpegImage.Create;
   JpegIm.LoadFromFile(OpenDialog1.FileName);
   bm.Assign(JpegIm);
   Form1.Canvas.Draw(0, 0, bm);
   bm.Destroy;
   JpegIm.Destroy;
 end;
 




Открытие и закрытие нескольких приводов CD-ROM

Автор: Vadim Petrov

Глубокая ночь. Сидит юзер за компом. Вдруг на мониторе белым по черному высвечивается: "Если нажмешь 10 клавиш одновременно, покажу голую бабу". Ну юзер не долго думая продавливает 10 клавиш обоими руками. Тут на мониторе появляется: "Молодец! А если, скатина, отпустишь хоть одну клавишу - все диски форматну!!!"

Что касается вопроса "Открытие и закрытие привода CD-ROM", то при наличии более одного CD-ROMа в системе, рекомендую воспользоваться следующими функциями:


 //                  ____       _          ______            __
 //                 / __ \_____(_)   _____/_  __/___  ____  / /____
 //                / / / / ___/ / | / / _ \/ / / __ \/ __ \/ / ___/
 //               / /_/ / /  / /| |/ /  __/ / / /_/ / /_/ / (__  )
 //              /_____/_/  /_/ |___/\___/_/  \____/\____/_/____/
 //
 (*******************************************************************************
 * DriveTools 1.0                                                               *
 *                                                                              *
 *                 (c) 1999 Jan Peter Stotz                                     *
 *                                                                              *
 ********************************************************************************
 *                                                                              *
 * If you find bugs, has ideas for missing featurs, feel free to contact me     *
 *                           jpstotz@gmx.de                                     *
 *                                                                              *
 ********************************************************************************
 * Date last modified:   May 22, 1999                                           *
 *******************************************************************************)
 
 unit DriveTools;
 
 interface
 
 uses
 
   Windows, SysUtils, MMSystem;
 
 function CloseCD(Drive: Char): Boolean;
 function OpenCD(Drive: Char): Boolean;
 
 implementation
 
 function OpenCD(Drive: Char): Boolean;
 var
 
   Res: MciError;
   OpenParm: TMCI_Open_Parms;
   Flags: DWord;
   S: string;
   DeviceID: Word;
 begin
 
   Result := false;
   S := Drive + ':';
   Flags := mci_Open_Type or mci_Open_Element;
   with OpenParm do
   begin
     dwCallback := 0;
     lpstrDeviceType := 'CDAudio';
     lpstrElementName := PChar(S);
   end;
   Res := mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm));
   if Res <> 0 then
     exit;
   DeviceID := OpenParm.wDeviceID;
   try
     Res := mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_OPEN, 0);
     if Res = 0 then
       exit;
     Result := True;
   finally
     mciSendCommand(DeviceID, mci_Close, Flags, Longint(@OpenParm));
   end;
 end;
 
 function CloseCD(Drive: Char): Boolean;
 var
 
   Res: MciError;
   OpenParm: TMCI_Open_Parms;
   Flags: DWord;
   S: string;
   DeviceID: Word;
 begin
 
   Result := false;
   S := Drive + ':';
   Flags := mci_Open_Type or mci_Open_Element;
   with OpenParm do
   begin
     dwCallback := 0;
     lpstrDeviceType := 'CDAudio';
     lpstrElementName := PChar(S);
   end;
   Res := mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm));
   if Res <> 0 then
     exit;
   DeviceID := OpenParm.wDeviceID;
   try
     Res := mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0);
     if Res = 0 then
       exit;
     Result := True;
   finally
     mciSendCommand(DeviceID, mci_Close, Flags, Longint(@OpenParm));
   end;
 end;
 
 end.
 




Как открыть запароленную таблицу Paradox7 (.db)


Забрали интернетчика в армию. На границе служить. Стоит он на посту. Вдруг - шаги.
- Пароль!!! ...тишина
- Пароль!!!! ...тишина
Программер снимает с плеча автомат... короткая очередь...
- User Anonymous Access Denied.

Автор: Александр Демский

Предупрежден - значит, вооружен. Берем Парадоксовскую табличку, паролим ее самым секретным паролем, бумажку с паролем сжигаем, а сам пароль забываем. Что теперь делать? Да ничего, просто открываем нашу табличку с одним из паролей: jIGGAe, nx66ppx, cupcdvum. Один, да подойдет. Не доверяйте своих секретов буржуям!




Открытие файла только на чтение

Перед открытием или созданием файла, установите переменную FileMode. Чтобы установить ее, воспользуйтесь 'File Open Mode constants' (константы режима открытия файла). Взгляните на описание модуля Sysutils. Где-то во второй части описания находится перечень 'File Open Mode constants'. Вот они-то как раз и используются в переменной FileMode. Константы лучше связывать логическим оператором OR... например с fmOpen... или с константой fmShare... константы устанавливают режим.

Ознакомьтесь в файле помощи с описанием переменной FileMode. Если перед открытием файла вы установили ее в ноль, файл будет открыт только для чтения. По-умолчанию read/write (чтение/запись) для нетипизированных файлов.

Вы можете просто попробовать установить filemode после того, как сделаете файлу assign. Например:


 AssignFile(F, FileName);
 FileMode := 0;  { устанавливаем доступ к файлу только для чтения }
 Reset(F);
 .
 .
 .
 CloseFile(F);
 




Как открыть меню кнопки Пуск


 procedure TForm1.Button1Click(Sender: TObject);
 begin
   SendMessage(Self.Handle, WM_SYSCOMMAND, SC_TASKLIST, 0);
 end;
 




Открыть URL в новом окне, используя WEBBrowser

В семье инетчика. Ночной сеанс. Муж:
- Дорогая откройка свою WWW, и быстренько на мой сайт.


 {
   Usually when you open a URL in new window in TWebBrowser it opens
   the Internet Explorer. This tip creates a new instance of your
   browser form and opens the new site in your browser.
 }
 
 
 procedure TForm1.WebBrowser1NewWindow2(Sender: TObject;
   var ppDisp: IDispatch; var Cancel: WordBool);
 var
   NewWindow: TForm1;
 begin
   // a new instance of the form will be created 
   // Eine neue Instanz wird erstellt 
   NewWindow := TForm1.Create(self);
 
   NewWindow.Show;
   ppDisp := NewWindow.Webbrowser1.DefaultDispatch;
 end;
 




Исправление иконок выключенных пунктов меню

Автор: VS

При использовании ListImage, в недоступных пунктах Menu пиктограммы отображаются некорректно. Это можно видеть на рисунке:


Ошибка связана с получением монохромного изображения в процедуре TCustomImageList.DoDraw. Однако ее можно исправить, если воспользоваться небольшой "заплаткой" - ScrambleBitmap.


 procedure TCustomImageList.DoDraw(Index: Integer; Canvas: TCanvas;
   X, Y: Integer; Style: Cardinal; Enabled: Boolean);
 
   procedure ScrambleBitmap(var BMP: TBitmap);
   const
     RMask = $0000FF;
     RAMask = $FFFF00;
     GMask = $00FF00;
     GAMask = $FF00FF;
     BMask = $FF0000;
     BAMask = $00FFFF;
   var
     R, C: integer;
     Color: LongWord;
   begin
     with Bmp.Canvas do
     begin
       for C := 0 to Bmp.Height - 1 do
         for R := 0 to Bmp.Width - 1 do
         begin
           Color := Pixels[R, C];
           if ((Color = 0) or (Color = $FFFFFF)) then
             Continue;
           if (((Color and RMask > $7F) and (Color and RAMask > $0)) or
             ((Color and GMask > $7F00) and (Color and GAMask > $0)) or
             ((Color and BMask > $7F000) and (Color and BAMask > $0))) then
             Pixels[R, C] := $FFFFFF
           else
             Pixels[R, C] := 0;
         end;
     end;
   end;
 
 const
   ROP_DSPDxax = $00E20746;
 
 var
   R: TRect;
   DestDC, SrcDC: HDC;
 
 begin
   if HandleAllocated then
   begin
     if Enabled then
       ImageList_DrawEx(Handle, Index, Canvas.Handle, X, Y, 0, 0,
         GetRGBColor(BkColor), GetRGBColor(BlendColor), Style)
     else
     begin
       if FMonoBitmap = nil then
       begin
         FMonoBitmap := TBitmap.Create;
         with FMonoBitmap do
         begin
           // Monochrome:= True; закомментировать!!!
 
           Width := Self.Width;
           Height := Self.Height;
         end;
       end;
       { Store masked version of image temporarily in FBitmap }
       FMonoBitmap.Canvas.Brush.Color := clWhite;
       FMonoBitmap.Canvas.FillRect(Rect(0, 0, Self.Width, Self.Height));
       ImageList_DrawEx(Handle, Index, FMonoBitmap.Canvas.Handle, 0, 0, 0, 0,
         CLR_DEFAULT, 0, ILD_NORMAL);
       ScrambleBitmap(FMonoBitmap); // заплатка
       R := Rect(X, Y, X + Width, Y + Height);
       SrcDC := FMonoBitmap.Canvas.Handle;
       BitBlt(SrcDC, 0, 0, Width, Height, SrcDC, 0, 0, DSTINVERT); // добавить!!!
       { Convert Black to clBtnHighlight }
       Canvas.Brush.Color := clBtnHighlight;
       DestDC := Canvas.Handle;
       Windows.SetTextColor(DestDC, clWhite);
       Windows.SetBkColor(DestDC, clBlack);
       BitBlt(DestDC, X + 1, Y + 1, Width, Height, SrcDC, 0, 0, ROP_DSPDxax);
       { Convert Black to clBtnShadow }
       Canvas.Brush.Color := clBtnShadow;
       DestDC := Canvas.Handle;
       Windows.SetTextColor(DestDC, clWhite);
       Windows.SetBkColor(DestDC, clBlack);
       BitBlt(DestDC, X, Y, Width, Height, SrcDC, 0, 0, ROP_DSPDxax);
     end;
   end;
 end;
 

Теперь пиктограммы в Menu будут отображаться как на приведенном рисунке:

"Заплатку" можно использовать и в ToolBar, где ошибка аналогична. ToolBar без "заплатки":

ToolBar с "заплаткой":




Подключиться к Personal Oracle с помощью BDE

Доступ к Personаl Oracle (как и к любой другой версии СУБД Oracle) осуществляется следующим образом. Сначала нужно запустить сервер (в случае Personal Oracle для Windows 95 это отдельное приложение, в случае Oracle для Windows NT - набор сервисов, обслуживающих конкретную базу данных) и настроить клиентскую часть Oracle. Для этого следует запустить утилиту SQLNet Easy Configuration (в случае Oracle 8 - Oracle Net8 Easy Config) и с ее помощью создать описание псевдонима базы данных Oracle (для него, как и в BDE, используется термин alias, но это не то же самое, что псевдоним BDE). При создании этого описания важны три параметра.

Первый из них - сетевой протокол, с помощью которого осуществляется доступ к серверу Oracle (IPX/SPX, TCP/IP и др.). Второй параметр - местоположение сервера в сети. В случае Personal Oracle это обычно компьютер с IP-адресом 127.0.0.1 (это специальный адрес для доступа к локальному компьютеру, так называемый TCP Loopback Address, который обычно имеет URL http://localhost/). Третий параметр - имя базы данных. По умолчанию в случае Personal Oracle она называется ORCL. В общем случае имя может быть любым, но это должно быть имя уже существующей базы данных, с которой вы собираетесь работать.

В принципе все описания псевдонимов Oracle хранятся в текстовом файле TNSNAMES.ORA, который можно редактировать вручную.

Далее следует запустить утилиту SQL Plus и проверить соединение клиента с сервером. Обычно в качестве имени пользователя используется имя SYSTEM и пароль MANAGER (если вы сами администрируете сервер). Если же сервер был установлен раньше, узнайте у администратора базы данных, каким именем и паролем следует воспользоваться. Помимо имени пользователя и пароля, SQL Plus запросит так называемую строку связи, в которой должно содержаться имя сервиса, который был создан вами перед этим. При удачном соединении в SQL Plus появится соответствующее сообщение. Отметим, что утилита Oracle Net8 Easy Config позволяет протестировать соединение непосредственно в процессе создания описания сервиса.

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

Теперь можно, наконец, заняться настройкой BDE. В качестве Server Name следует указать имя псевдонима Oracle (его можно просто выбрать из выпадающего списка, так как BDE Administrator также обращается к файлу TNSNAMES.ORA). После этого нужно проверить соединение с сервером через BDE с помощью BDE Administrator или SQL Explorer.

Если соединение не устанавливается и появляется сообщение "Vendor initialization failed", стоит убедиться, что динамическая загружаемая библиотека, указанная в параметре Vendor Init драйвера Oracle, действительно присутствует на данном компьютере. На всякий случай стоит скопировать ее в папку Windows\System, так как некоторые ранние версии BDE в Windows 95 не находят эту библиотеку в подкаталоге Bin каталога, в котором установлен клиент Oracle, в силу ограничений, налагаемых этой операционной системой на длину переменной окружения PATH. Отметим также, что при использовании Oracle 8 нужно использовать версию не ниже 8.0.4; в случае использования более ранней версии следует обновить ее до 8.0.4.




Связь с personal Oracle

Автор: Knud Andersen

Связаться с Personal Oracle - мудреное дело, но оно оказывается очень простым, если знать как...

  1. Personal Oracle должен иметь имя сервера (servername) "2:" (два и точка с запятой)
  2. Сетевой протокол (Net Protocol) ДОЛЖЕН БЫТЬ пустым (т.е. пустым - ничего не содержать)
Если вы работаете с Personal Oracle версии 7.1, в файле конфигурации сервера должен быть определен ORA71WIN.DLL, в противном случае выберите ora7win.dll

Oracle в сети.... Если вы можете соединиться через sql*dba или sql*plus, то настройки вашего Oracle, вероятно, правильные. Кроме того, поставщик в файле конфигурации должен указывать версию базы данных.

 The server name (имя сервера):  SQL*Net V.1.x:  Protocol (протокол) : Servername (имя сервера) : Database SID
 ---> например:  T:222.122.22.32:DEMO
Помните: Protocol и SID чуствительны к регистру. Протокол T для TCP/IP. (Я не помню остальных, но я могу узнать, если они вам необходимы....). TCP/IP адрес может быть заменен псевдонимом, если правильно сконфигурирован host-файл....

SQL*Net V.2.x: Здесь все сводится к (Oracle) псевдониму. Используйте его как имя сервера (Server Name). Сетевой протокол (Network Protocol) должен отражать используемый протокол (TCP/IP, Named pipes, IPX/SPX и др.)




Oracle - экспорт

export.cmd


 D:\Oracle\Ora81\BIN\exp.exe -parfile=D:\Temp\OraExport\export.txt
 

export.txt


 USERID=SYSTEM/manager@BILLING
 FILE=D:\Temp\OraExport\billing.dmp
 GRANTS=Y
 INDEXES=Y
 CONSTRAINTS=Y
 LOG=D:\Temp\OraExport\export.log
 

export.log


 




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

Автор: Nomadic

Перевод документации:

Что такое ORACLE Database?

Это данные которые будут обрабатываться как единое целое. Database состоит из файлов операционной системы. Физически существуют database files и redo log files. Логически database files содержат словари, таблицы пользователей и redo log файлы. Дополнительно database требует одну или более копий control file.

Что такое ORACLE Instance?

ORACLE Instance обеспечивает программные механизмы доступа и управления database. Instance может быть запущен независимо от любой database (без монтирования или открытия любой database). Один instance может открыть только одну database. В то время как одна database может быть открыта несколькими Instance.

Instance состоит из:

SGA (System Global Area), которая обеспечивает коммуникацию между процессами;
до пяти (в последних версиях больше) бэкграундовых процессов.

От себя добавлю - database включает в себя tablespace, tablespace включает в себя segments (в одном файле данных может быть один или несколько сегментов, сегменты не могут быть разделены на несколько файлов). segments включают в себя extents.




Доступ к объекту Oracle


Для этого можно воспользоваться компонентами от AllRoundAutomations Direct Oracle Access. Если кому надо могу поделиться. При помощи этих компонент можно не только производить простые запросы/вставки, но и выполнять DDL-скрипты, и иметь доступ к объектам Oracle 8, примет смотри ниже...


 var
   Address: TOracleObject;
 begin
   Query.SQL.Text := 'select Name, Address from Persons';
   Query.Execute;
   while not Query.Eof do
   begin
     Address := Query.ObjField('Address');
     if not Address.IsNull then
       ShowMessage(Query.Field('Name') + ' lives in ' + Address.GetAttr('City'));
     Query.Next;
   end;
 end;
 




Переход с Oracle на Interbase

Автор: Shawn Wu

Я пытаюсь преобразовать мою базу данных на Oracle в базу данных local Interbase server. Все таблицы Oracle ссылаются на имя схемы. Interbase поддерживает такого типа имена схем?

Нет, Interbase не использует понятие классификатора таблицы (владельца), как это делают другие сервера, например, Oracle или Sybase. Наилучшее решение в этом случае - использование директив компиляции, позволяющее контролировать соглашение о стиле имен Oracle или Interbase, используемое в генерируемом .exe-файле.

Также, Delphi читает все атрибуты Oracle типа Number и конвертирует их в FloatField. Interbase при этом использует тип SmallIntField. Так, для преобразования необходимо пройтись по всем таблицам, удалить поля и затем снова их добавить. Можно это сделать как-то по-человечески?

Если я правильно понял то, что вы хотели сказать, то этот вопрос относится к специфике Interbase. Например, Interbase использует короткое поле (short field) с масштабированием вместо реального типа, если заданная при создании таблицы точность не превышает 10. [например, CREATE TABLE xxx (FLOATFIELD NUMERIC (5, 2)) обычно означает реальный тип с точностью 5 цифр с 2-мя цифрами после запятой. Но Interbase знает, что сможет поместить 5 цифр в короткое поле, поэтому она создаст короткое поле и запись и смасштабирует его с коэффициентом 2.] Проблема в следующем: BDE "спрашивает" Interbase о полях таблицы и их типах, Interbase честно рапортует, что поля имеют тип short, т.е. они "короткие". Но BDE ничего не знает о масштабировании.

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

Могу ли я менять один тип SQL на другой, или это - несбыточная мечта?

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

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

Как я уже говорил выше: директивы компилятора.




Определение операционной системы

- В кого бы вы выстрелили, если бы оказались в одном лифте с Садамом Хусейном, Гитлером, Сталиным и Билл Гейтсом и у вас был бы только один револьвер с двумя патронами? - В Билл Гейтса два раза, чтобы наверняка…


 const
   { operating system constants }
   cOsUnknown = -1;
   cOsWin95 = 0;
   cOsWin98 = 1;
   cOsWin98SE = 2;
   cOsWinME = 3;
   cOsWinNT = 4;
   cOsWin2000 = 5;
   cOsWhistler = 6;
 
 function GetOperatingSystem : integer;
 var
   osVerInfo: TOSVersionInfo;
   majorVer, minorVer: Integer;
 begin
   result := cOsUnknown;
   { set operating system type flag }
   osVerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
   if GetVersionEx(osVerInfo) then
   begin
     majorVer := osVerInfo.dwMajorVersion;
     minorVer := osVerInfo.dwMinorVersion;
     case osVerInfo.dwPlatformId of
       VER_PLATFORM_WIN32_NT : { Windows NT/2000 }
       begin
         if majorVer <= 4 then
           result := cOsWinNT
         else
         if (majorVer = 5) and (minorVer= 0) then
           result := cOsWin2000
         else
         if (majorVer = 5) and (minorVer = 1) then
           result := cOsWhistler
         else
           result := cOsUnknown;
       end;
       VER_PLATFORM_WIN32_WINDOWS : { Windows 9x/ME }
       begin
         if (majorVer = 4) and (minorVer = 0) then
           result := cOsWin95
         else
         if (majorVer = 4) and (minorVer = 10) then
         begin
           if osVerInfo.szCSDVersion[1] = 'A' then
             result := cOsWin98SE
           else
             result := cOsWin98;
         end
         else
         if (majorVer = 4) and (minorVer = 90) then
           result := cOsWinME
         else
           result := cOsUnknown;
       end;
       else
         result := cOsUnknown;
     end;
   end
   else
     result := cOsUnknown;
 end;
 
 procedure TForm1.Button1Click(Sender: TObject);
 begin
   ShowMessage(IntToStr(GetOperatingSystem));
 end;
 




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



 procedure TMyForm.CreateParams(var Params :TCreateParams); {override;}
 begin
   inherited CreateParams(Params); {CreateWindowEx}
   Params.ExStyle := Params.ExStyle or WS_Ex_AppWindow;
 end;
 




Получение адреса из входящего сообщения в MS Outlook

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


 Function GetEAddr(InputMailItem : Variant {mailitem}) : String;
   Var
    MapiFile: TextFile;
    FirstLine, MailAddress : String;
    StrLength, Index : Integer;
   begin
    MailAddress := '';
    // Сохраняем сообщение в текстовом файле... 
    InputMailItem.SaveAs(WideString(ExtractFilePath(Application.EXEName)
    + 'mailitem.txt'), $00000000);
 
   // Если рассмотреть структуру созданного файла, то в первой строке
   // кроме всего прочего, содержится электронный адрес отправителя.
   // Задача состоит в том, чтобы прочитать его... 
 
    AssignFile(MapiFile, ExtractFilePath(Application.EXEName) + 'mailitem.txt');
    Reset(MapiFile);
    Readln(MapiFile, FirstLine);
    CloseFile(MapiFile);
    If Pos('@', Trim(FirstLine)) >  0 Then
      Begin
       StrLength := Length(Trim(FirstLine));
       Index := StrLength;
       While FirstLine[Index] < >  ' ' Do Dec(Index);
       MailAddress := Copy(FirstLine, Index + 1, StrLength - Index);
       For Index := 1 To Length(Trim(MailAddress)) Do
          If (MailAddress[Index] = '[') Or (MailAddress[Index] = ']')
    Then MailAddress[Index] := ' ';
       MailAddress := Trim(MailAddress);
      End
    Else
     MailAddress := Trim(InputMailItem.SenderName);
    Result := MailAddress;
   // В том случае, если адрес все же не определен, возвращаем известный нам 
   SenderName...    
 end;
 




Как прочитать адресную книгу Outlook MSOffice из Delphi


Hе откладывайте покупку М$ Office 97 на завтpа...Лучше отложите ее HАВСЕГДА!


 uses
   ComObj, Outlook_TLB;
 
 procedure TForm1.Button1Click(Sender: TObject);
 var
   MSOutlook, MyNameSpace, MyFolder, MyItem: Variant;
   s: string;
   i: Integer;
 begin
   try
     MSOutlook := CreateOleObject('Outlook.Application');
     MyNameSpace := MSOutlook.GetNameSpace('MAPI');
     MyFolder := MyNamespace.GetDefaultFolder(olFolderContacts);
     for i := 1 to MyFolder.Items.Count do
     begin
       s := s + #13#13'Contact No: ' + IntToStr(i) + #13#13;
       MyItem := MyFolder.Items[i];
       s := s + 'BillingInformation: ' + MyItem.BillingInformation + #13;
       s := s + 'Body: ' + MyItem.Body + #13;
       s := s + 'Categories: ' + MyItem.Categories + #13;
       s := s + 'Companies: ' + MyItem.Companies + #13;
       s := s + 'CreationTime: ' + DateTimeToStr(MyItem.CreationTime) + #13;
       s := s + 'EntryID: ' + MyItem.EntryID + #13;
       s := s + 'Importance: ' + IntToStr(MyItem.Importance) + #13;
       s := s + 'LastModificationTime: ' + DateTimeToStr(MyItem.LastModificationTime) + #13;
       s := s + 'MessageClass: ' + MyItem.MessageClass + #13;
       s := s + 'Mileage: ' + MyItem.Mileage + #13;
       s := s + 'NoAging: ' + IntToStr(MyItem.NoAging) + #13;
       s := s + 'OutlookVersion: ' + MyItem.OutlookVersion + #13;
       s := s + 'Saved: ' + IntToStr(MyItem.Saved) + #13;
       s := s + 'Sensitivity: ' + IntToStr(MyItem.Sensitivity) + #13;
       s := s + 'Size: ' + IntToStr(MyItem.Size) + #13;
       s := s + 'Subject: ' + MyItem.Subject + #13;
       s := s + 'UnRead: ' + IntToStr(MyItem.UnRead) + #13;
       s := s + 'Account: ' + MyItem.Account + #13;
       s := s + 'Anniversary: ' + DateTimeToStr(MyItem.Anniversary) + #13;
       s := s + 'AssistantName: ' + MyItem.AssistantName + #13;
       s := s + 'AssistantTelephoneNumber: ' + MyItem.AssistantTelephoneNumber + #13;
       s := s + 'Birthday: ' + DateTimeToStr(MyItem.Birthday) + #13;
       s := s + 'Business2TelephoneNumber: ' + MyItem.Business2TelephoneNumber + #13;
       s := s + 'BusinessAddress: ' + MyItem.BusinessAddress + #13;
       s := s + 'BusinessAddressCity: ' + MyItem.BusinessAddressCity + #13;
       s := s + 'BusinessAddressCountry: ' + MyItem.BusinessAddressCountry + #13;
       s := s + 'BusinessAddressPostalCode: ' + MyItem.BusinessAddressPostalCode + #13;
       s := s + 'BusinessAddressPostOfficeBox: ' + MyItem.BusinessAddressPostOfficeBox + #13;
       s := s + 'BusinessAddressState: ' + MyItem.BusinessAddressState + #13;
       s := s + 'BusinessAddressStreet: ' + MyItem.BusinessAddressStreet + #13;
       s := s + 'BusinessFaxNumber: ' + MyItem.BusinessFaxNumber + #13;
       s := s + 'BusinessHomePage: ' + MyItem.BusinessHomePage + #13;
       s := s + 'BusinessTelephoneNumber: ' + MyItem.BusinessTelephoneNumber + #13;
       s := s + 'CallbackTelephoneNumber: ' + MyItem.CallbackTelephoneNumber + #13;
       s := s + 'CarTelephoneNumber: ' + MyItem.CarTelephoneNumber + #13;
       s := s + 'Children: ' + MyItem.Children + #13;
       s := s + 'CompanyAndFullName: ' + MyItem.CompanyAndFullName + #13;
       s := s + 'CompanyMainTelephoneNumber: ' + MyItem.CompanyMainTelephoneNumber + #13;
       s := s + 'CompanyName: ' + MyItem.CompanyName + #13;
       s := s + 'ComputerNetworkName: ' + MyItem.ComputerNetworkName + #13;
       s := s + 'CustomerID: ' + MyItem.CustomerID + #13;
       s := s + 'Department: ' + MyItem.Department + #13;
       s := s + 'Email1Address: ' + MyItem.Email1Address + #13;
       s := s + 'Email1AddressType: ' + MyItem.Email1AddressType + #13;
       s := s + 'Email1DisplayName: ' + MyItem.Email1DisplayName + #13;
       s := s + 'Email1EntryID: ' + MyItem.Email1EntryID + #13;
       s := s + 'Email2Address: ' + MyItem.Email2Address + #13;
       s := s + 'Email2AddressType: ' + MyItem.Email2AddressType + #13;
       s := s + 'Email2DisplayName: ' + MyItem.Email2DisplayName + #13;
       s := s + 'Email2EntryID: ' + MyItem.Email2EntryID + #13;
       s := s + 'Email3Address: ' + MyItem.Email3Address + #13;
       s := s + 'Email3AddressType: ' + MyItem.Email3AddressType + #13;
       s := s + 'Email3DisplayName: ' + MyItem.Email3DisplayName + #13;
       s := s + 'Email3EntryID: ' + MyItem.Email3EntryID + #13;
       s := s + 'FileAs: ' + MyItem.FileAs + #13;
       s := s + 'FirstName: ' + MyItem.FirstName + #13;
       s := s + 'FTPSite: ' + MyItem.FTPSite + #13;
       s := s + 'FullName: ' + MyItem.FullName + #13;
       s := s + 'FullNameAndCompany: ' + MyItem.FullNameAndCompany + #13;
       s := s + 'Gender: ' + IntToStr(MyItem.Gender) + #13;
       s := s + 'GovernmentIDNumber: ' + MyItem.GovernmentIDNumber + #13;
       s := s + 'Hobby: ' + MyItem.Hobby + #13;
       s := s + 'Home2TelephoneNumber: ' + MyItem.Home2TelephoneNumber + #13;
       s := s + 'HomeAddress: ' + MyItem.HomeAddress + #13;
       s := s + 'HomeAddressCity: ' + MyItem.HomeAddressCity + #13;
       s := s + 'HomeAddressCountry: ' + MyItem.HomeAddressCountry + #13;
       s := s + 'HomeAddressPostalCode: ' + MyItem.HomeAddressPostalCode + #13;
       s := s + 'HomeAddressPostOfficeBox: ' + MyItem.HomeAddressPostOfficeBox + #13;
       s := s + 'HomeAddressState: ' + MyItem.HomeAddressState + #13;
       s := s + 'HomeAddressStreet: ' + MyItem.HomeAddressStreet + #13;
       s := s + 'HomeFaxNumber: ' + MyItem.HomeFaxNumber + #13;
       s := s + 'HomeTelephoneNumber: ' + MyItem.HomeTelephoneNumber + #13;
       s := s + 'Initials: ' + MyItem.Initials + #13;
       s := s + 'ISDNNumber: ' + MyItem.ISDNNumber + #13;
       s := s + 'JobTitle: ' + MyItem.JobTitle + #13;
       s := s + 'Journal: ' + IntToStr(MyItem.Journal) + #13;
       s := s + 'Language: ' + MyItem.Language + #13;
       s := s + 'LastName: ' + MyItem.LastName + #13;
       s := s + 'LastNameAndFirstName: ' + MyItem.LastNameAndFirstName + #13;
       s := s + 'MailingAddress: ' + MyItem.MailingAddress + #13;
       s := s + 'MailingAddressCity: ' + MyItem.MailingAddressCity + #13;
       s := s + 'MailingAddressCountry: ' + MyItem.MailingAddressCountry + #13;
       s := s + 'MailingAddressPostalCode: ' + MyItem.MailingAddressPostalCode + #13;
       s := s + 'MailingAddressPostOfficeBox: ' + MyItem.MailingAddressPostOfficeBox + #13;
       s := s + 'MailingAddressState: ' + MyItem.MailingAddressState + #13;
       s := s + 'MailingAddressStreet: ' + MyItem.MailingAddressStreet + #13;
       s := s + 'ManagerName: ' + MyItem.ManagerName + #13;
       s := s + 'MiddleName: ' + MyItem.MiddleName + #13;
       s := s + 'MobileTelephoneNumber: ' + MyItem.MobileTelephoneNumber + #13;
       s := s + 'NickName: ' + MyItem.NickName + #13;
       s := s + 'OfficeLocation: ' + MyItem.OfficeLocation + #13;
       s := s + 'OrganizationalIDNumber: ' + MyItem.OrganizationalIDNumber + #13;
       s := s + 'OtherAddress: ' + MyItem.OtherAddress + #13;
       s := s + 'OtherAddressCity: ' + MyItem.OtherAddressCity + #13;
       s := s + 'OtherAddressCountry: ' + MyItem.OtherAddressCountry + #13;
       s := s + 'OtherAddressPostalCode: ' + MyItem.OtherAddressPostalCode + #13;
       s := s + 'OtherAddressPostOfficeBox: ' + MyItem.OtherAddressPostOfficeBox + #13;
       s := s + 'OtherAddressState: ' + MyItem.OtherAddressState + #13;
       s := s + 'OtherAddressStreet: ' + MyItem.OtherAddressStreet + #13;
       s := s + 'OtherFaxNumber: ' + MyItem.OtherFaxNumber + #13;
       s := s + 'OtherTelephoneNumber: ' + MyItem.OtherTelephoneNumber + #13;
       s := s + 'PagerNumber: ' + MyItem.PagerNumber + #13;
       s := s + 'PersonalHomePage: ' + MyItem.PersonalHomePage + #13;
       s := s + 'PrimaryTelephoneNumber: ' + MyItem.PrimaryTelephoneNumber + #13;
       s := s + 'Profession: ' + MyItem.Profession + #13;
       s := s + 'RadioTelephoneNumber: ' + MyItem.RadioTelephoneNumber + #13;
       s := s + 'ReferredBy: ' + MyItem.ReferredBy + #13;
       s := s + 'SelectedMailingAddress: ' + IntToStr(MyItem.SelectedMailingAddress) + #13;
       s := s + 'Spouse: ' + MyItem.Spouse + #13;
       s := s + 'Suffix: ' + MyItem.Suffix + #13;
       s := s + 'TelexNumber: ' + MyItem.TelexNumber + #13;
       s := s + 'Title: ' + MyItem.Title + #13;
       s := s + 'TTYTDDTelephoneNumber: ' + MyItem.TTYTDDTelephoneNumber + #13;
       s := s + 'User1: ' + MyItem.User1 + #13;
       s := s + 'User2: ' + MyItem.User2 + #13;
       s := s + 'User3: ' + MyItem.User3 + #13;
       s := s + 'User4: ' + MyItem.User4 + #13;
       s := s + 'UserCertificate: ' + MyItem.UserCertificate + #13;
       s := s + 'WebPage: ' + MyItem.WebPage + #13;
     end;
     Memo1.Lines.Text := s;
   except
   on E: Exception do
     MessageDlg(E.message + #13 + s, mtError, [mbOk], 0);
   end;
   MSOutlook.Quit;
 end;
 




Перекрытие виртуальных методов

Кто-нибудь знает, в чем разница между перекрытием (OVERRIDING) виртуального метода и заменой (REPLACING) его? Я немного запутался.

Допустим у вас есть класс:


 TMyObject = class (TObject)
 

и его наследник:


 TOverrideObject = class (TMyObject)
 

К примеру, TMyObject имеет метод Wiggle:


 procedure Wiggle; virtual;
 

а TOverrideObject перекрывает Wiggle:


 procedure Wiggle; override;
 

и, естественно, вы реализовали оба метода.

Теперь вы создаете TList, содержащий целую кучу MyObjects и OverrideObjects в свойстве TList.Items[n]. Свойство Items является указателем, поэтому для вызова метода Wiggle вам достаточно вызвать необходимый элемент списка. Например так:


 if TObject(Items[1]) is TMyObject then
   TMyObject(Items[1]).Wiggle
 else
 if TObject(Items[1]) is TOverrideObject then
   TOverrideObject(Items[1]).Wiggle;
 

но возможности полиморфизма и директива override позволяют вам сделать так:


 TMyObject(Items[1]).Wiggle;
 

Ваше приложение посмотрит на экземпляр специфического объекта, ссылка на который содержится в Items[1] и скажет: "Да, это - TMyObject, но, точнее говоря, это TOverrideObject; но поскольку метод Wiggle является виртуальным методом и TOverrideObject переопределил метод Wiggle, я собираюсь выполнить метод TOverrideObject.Wiggle, а не метод TMyObject.Wiggle."

Теперь представьте себе, что при декларации метода вы пропустили директиву override, попробуйте это выполнить теперь:


 TMyObject(Items[1]).Wiggle;
 

Приложение и в этом случае должно "видеть" данный метод, даже если Items[1] - TOverrideObject; но у него отсутствует перекрытая версия метода Wiggle, поэтому приложение выполнит TMyObject.Wiggle, а не TOverrideObject.Wiggle (поведение, которое вы можете как хотеть, так и избегать).

Так, перекрытый метод функционально может отличаться от декларированного метода, содержащего директиву virtual (или dynamic) в базовом классе, и объявленный с директивой override в классе-наследнике. Для замены метода необходимо объявить его в классе-наследнике без директивы override. Перекрытые методы могут выполняться даже тогда, когда специфический экземпляр класса-предка является точной копией базового класса. "Замененные" методы могут выполняться только тогда, когда специфический экземпляр является "слепком" только этого класса.




Собственные курсоры в программе


Компьютерный магазин в каком-то городе. Заходит старушка, подходит к прилавку и говорит:
- Извините, я у вас коврик для мыши купила, так вот он не работает!
Продавцы в совершенном ох#ении смотрят на бабулю:
- Это как?
А бабуля и отвечает:
- Как как, сколько я его в сарай не клала, ни одной мыши не попалось. Может, его ядом посыпать, или приманку какую?

В этой статье вы найдёте несколько способов использования собственных курсоров, в том числе и анимированных.[это файлы с расширением .ani]

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


 Screen.Cursors[5] := LoadCursorFromFile('File.ani');
 Screen.Cursor := 5;
 

Здесь используется свойство Cursors глобального объекта Screen. В нём содержится список курсоров, доступных приложению. По индексу в нужную позицию мы загружаем курсор из файла. А затем с помощью свойства Cursor задействуем его.

Если же вы имеете файл ресурсов, тогда дела будут обстоять иначе:

Помещаете этот файл в тот же каталог, что и exe. Затем в модуле объявляем глобальную константу, например после


 var
   Form1: TForm1;
 

Выглядеть это будет примерно так:


 var
   Form1: TForm1;
 const
   MyConst = 100;
 

С помощью этой константы мы зарезервируем новую позицию в свойстве Cursors глобального объекта Screen.

После чего подключаем файл ресурсов, т.е. если он у нас называется Cursors.res, тогда после


 {$R *.DFM}
 

напишем:


 {$R Cursors.res}
 

Затем, допустим, по нажатию на кнопку пишем код:


 Screen.Cursors[MyConst] := LoadCursor(hInstance,'MYCURSOR');
 Screen.Cursor := MyConst;
 

Здесь 'MYCURSOR' - это имя курсора, который нам необходимо загрузить. Обратите внимание, если вы создаёте файл ресурсов самостоятельно, а сделать это можно с помощью утилиты "ImageEditor", вам необходимо в именах курсоров использовать только прописные буквы.




Как использовать свой диалог ввода пароля BDE

Если вы забыли напрочь свой парль для входа в UNIX То попробовать вам нужно подобрать его по буквам Если он не очень длинный, символов на 6, не больше То успеете наверно подобрать его при жизни....


 //  .....
 //  .....
   public
     { Public declarations }
     procedure Password(Sender: TObject; var Continue: Boolean);
 //    ...
   end;
 
 var
   FormMain: TFormMain;
 
 implementation
 {$R *.dfm}
 
 procedure TFormMain.Password(Sender: TObject; var Continue: Boolean);
 var
   Passwd: String[15];
 begin
   Passwd := '';
 
   FormPasswd := TFormPasswd.Create(Application);  // Creating dialog
   try
     if (FormPasswd.ShowModal = ID_OK) then begin  // If OK is pressed then get password from edit "edPassword"
       Passwd := FormPasswd.edPasswd.Text
     end
       else begin                                  // If Cancel is pressed then terminate application
         Application.ShowMainForm := False;
         Application.Terminate;
         Exit;
       end;
   finally
     FormPasswd.Free;                              // finally free password form
   end;
 
   Continue := (Passwd > '');
   Session.AddPassword(Passwd);                    // Add password typed to session
 end;
 
 procedure TFormMain.FormCreate(Sender: TObject);
 begin
   ClientDatabase.Session.RemoveAllPasswords;  // Remove all typed passwords from session, so user need type password again in app start
 //  Undocument next row in debug mode. This is for debugging and testing only, so we don't need typing password again and again ...
 //  ClientDatabase.Session.AddPassword('YOUR-PASSWORD');
   ClientDatabase.Session.OnPassword := Password;  // Set OnPassword Event
 end;
 




Как создать отдельную подсказку Hint для каждой ячейки StringGrid

В приведенном примере отслеживается движение курсора мыши - при перемещении между ячейками StringGrid'а - появляется окно подсказки(hint), показывающее номер текущей строки и колонки.


 TForm1 = class(TForm)
   StringGrid1: TStringGrid;
   procedure StringGrid1MouseMove(Sender: TObject;Shift: TShiftState; X, Y: Integer);
   procedure FormCreate(Sender: TObject);
 private
   {Private declarations}
   Col : integer;
   Row : integer;
 public
   {Public declarations}
 end;
 
 var
   Form1: TForm1;
 
 implementation
 {$R *.DFM}
 
 procedure TForm1.FormCreate(Sender: TObject);
 begin
   StringGrid1.Hint := '0 0';
   StringGrid1.ShowHint := True;
 end;
 
 procedure TForm1.StringGrid1MouseMove(Sender: TObject;
 Shift: TShiftState; X, Y: Integer);
 var
   r: integer;
   c: integer;
 begin
   StringGrid1.MouseToCell(X, Y, C, R);
   with StringGrid1 do
   begin
     if ((Row <> r) or(Col <> c)) then
     begin
       Row := r;
       Col := c;
       Application.CancelHint;
       StringGrid1.Hint :=IntToStr(r)+#32+IntToStr(c);
     end;
   end;
 end;
 




Своя кнопка в Internet Explorer

  • ButtonText = Всплывающая подсказка к кнопке
  • MenuText = Текст, который будет использован для пункта в меню "Сервис"
  • MenuStatusbar = *Ignore*
  • CLSID = Ваш уникальный classID. Для создания нового CLSID (для каждой кнопки) можно использовать GUIDTOSTRING.
  • Default Visible := Показать ей.
  • Exec := Путь к Вашей программе.
  • Hoticon := иконка из shell32.dll когда мышка находится над кнопкой
  • Icon := иконка из shell32.dll

 procedure CreateExplorerButton;
 const
   TagID = '\{10954C80-4F0F-11d3-B17C-00C0DFE39736}\';
 var
   Reg: TRegistry;
   ProgramPath: string;
   RegKeyPath: string;
 begin
   ProgramPath := 'c:\folder\exename.exe';
   Reg := TRegistry.Create;
   try
     with Reg do
     begin
       RootKey := HKEY_LOCAL_MACHINE;
       RegKeyPath := 'Software\Microsoft\Internet Explorer\Extensions';
       OpenKey(RegKeyPath + TagID, True);
       WriteString('ButtonText', 'Your program Button text');
       WriteString('MenuText', 'Your program Menu text');
       WriteString('MenuStatusBar', 'Run Script');
       WriteString('ClSid', '{1FBA04EE-3024-11d2-8F1F-0000F87ABD16}');
       WriteString('Default Visible', 'Yes');
       WriteString('Exec', ProgramPath);
       WriteString('HotIcon', ',4');
       WriteString('Icon', ',4');
     end
   finally
     Reg.CloseKey;
     Reg.Free;
   end;
 end;
 

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




Реализация собственного потока

Автор: Mike Scott

Я хотел бы создать конструктор Load, загружающий список из потока...

Новые потоки в Delphi более разносторонние, чем в BP7. Поскольку вы знаете как пользоваться потоками в BP7, а размер статьи ограничен, то я думаю, что для начала вам необходимо попробовать в действии описанный ниже модуль, инкапсулирующий класс для работы с потоками в стиле BP7. Класс является наследником TComponent, но в нашем случае не было бы никакой разницы, если бы он был наследником TObject. К примеру, вы могли бы адаптировать данный код к своему наследнику TList.

Более важен тот факт, что вы можете использовать поток так, как вам это необходимо, исходя из вашей задачи и специфики. Я сделал работу потока похожую по стилю на BP7, где вначале идет ID класса. В каком-нибудь месте вам необходимо вызвать RegisterType( TYourClass, UniqueIDLikeBP7 ), после чего TYourClass готов к работе с потоками.

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

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


 unit CompStrm;
 
 interface
 
 uses Classes;
 
 type
   TCompatibleStream = class;
 
   { TStreamObject }
 
   TStreamObject = class(TComponent)
     constructor Load(S: TCompatibleStream); virtual; abstract;
     procedure Store(S: TCompatibleStream); virtual; abstract;
     function GetObjectType: word; virtual; abstract;
   end;
 
   TStreamObjectClass = class of TStreamObject;
 
   { TCompatibleStream }
 
   TCompatibleStream = class(TFileStream)
     function ReadString: string;
     procedure WriteString(var S: string);
     function StrRead: PChar;
     procedure StrWrite(P: PChar);
     function Get: TStreamObject; virtual;
     procedure Put(AnObject: TStreamObject); virtual;
   end;
 
   { Register Type : используйте это для регистрации ваших объектов для
   работы с потоками с тем же ID, который они имели в OWL }
 
 procedure RegisterType(AClass: TStreamObjectClass;
   AnID: word);
 
 implementation
 
 uses SysUtils, Controls;
 
 var
   Registry: TList; { хранение ID объекта и информации о классе }
 
   { TClassInfo }
 
 type
   TClassInfo = class(TObject)
     ClassType: TStreamObjectClass;
     ClassID: word;
     constructor Create(AClassType: TStreamObjectClass;
       AClassID: word); virtual;
   end;
 
 constructor TClassInfo.Create(AClassType: TStreamObjectClass;
   AClassID: word);
 
 var
   AnObject: TStreamObject;
 
 begin
   if not Assigned(AClassType) then
     raise EInvalidOperation.Create('Класс не инициализирован'
       );
 
   if not AClassType.InheritsFrom(TStreamObject) then
     raise EInvalidOperation.Create('Класс ' + AClassType.ClassName +
       ' не является потомком TStreamObject'
       );
 
   ClassType := AClassType;
   ClassID := AClassID;
 end;
 
 { функции поиска информации о классе }
 
 function FindClassInfo(AClass: TClass): TClassInfo;
 
 var
   i: integer;
 
 begin
   for i := Registry.Count - 1 downto 0 do
   begin
     Result := TClassInfo(Registry.Items[i]);
     if Result.ClassType = AClass then
       exit;
   end;
   raise EInvalidOperation.Create('Класс ' + AClass.ClassName +
     ' не зарегистрирован для работы с потоком');
 end;
 
 function FindClassInfoByID(AClassID: word): TClassInfo;
 
 var
   i: integer;
   AName: string[31];
 
 begin
   for i := Registry.Count - 1 downto 0 do
   begin
     Result := TClassInfo(Registry.Items[i]);
     AName := TClassInfo(Registry.Items[i]).ClassType.ClassName;
     if Result.ClassID = AClassID then
       exit;
   end;
   raise EInvalidOperation.Create('ID класса ' + IntToStr(AClassID) +
     ' отсутствует в регистраторе
     классов' ) ;
 
 end;
 
 procedure RegisterType(AClass: TStreamObjectClass;
   AnID: word);
 
 var
   i: integer;
 
 begin
   { смотрим, был ли класс уже зарегистрирован }
   for i := Registry.Count - 1 downto 0 do
     with TClassInfo(Registry[i]) do
       if ClassType = AClass then
       begin
         if ClassID <> AnID then
           raise EInvalidOperation.Create('Класс ' + AClass.ClassName +
             ' уже зарегистрирован с ID ' +
             IntToStr(ClassID));
         exit;
       end;
   Registry.Add(TClassInfo.Create(AClass, AnID));
 end;
 
 { TCompatibleStream }
 
 function TCompatibleStream.ReadString: string;
 
 begin
   ReadBuffer(Result[0], 1);
   if byte(Result[0]) > 0 then
     ReadBuffer(Result[1], byte(Result[0
       ]));
 
 end;
 
 procedure TCompatibleStream.WriteString(var S: string);
 
 begin
   WriteBuffer(S[0], 1);
   if Length(S) > 0 then
     WriteBuffer(S[1], Length(S));
 end;
 
 function TCompatibleStream.StrRead: PChar;
 
 var
   L: Word;
   P: PChar;
 
 begin
   ReadBuffer(L, SizeOf(Word));
   if L = 0 then
     StrRead := nil
   else
   begin
     P := StrAlloc(L + 1);
     ReadBuffer(P[0], L);
     P[L] := #0;
     StrRead := P;
   end;
 end;
 
 procedure TCompatibleStream.StrWrite(P: PChar);
 
 var
   L: Word;
 
 begin
   if P = nil then
     L := 0
   else
     L := StrLen(P);
   WriteBuffer(L, SizeOf(Word));
   if L > 0 then
     WriteBuffer(P[0], L);
 end;
 
 function TCompatibleStream.Get: TStreamObject;
 
 var
   AClassID: word;
 
 begin
   { читаем ID объекта, находим это в регистраторе и загружаем объект }
   ReadBuffer(AClassID, sizeof(AClassID));
   Result := FindClassInfoByID(AClassID).ClassType.Load(Self);
 end;
 
 procedure TCompatibleStream.Put(AnObject: TStreamObject);
 
 var
   AClassInfo: TClassInfo;
   ANotedPosition: longint;
   DoTruncate: boolean;
 
 begin
   { получает объект из регистратора }
   AClassInfo := FindClassInfo(AnObject.ClassType);
 
   { запоминаем позицию в случае проблемы }
   ANotedPosition := Position;
   try
     { пишем id класса и вызываем метод store }
     WriteBuffer(AClassInfo.ClassID, sizeof(AClassInfo.ClassID));
     AnObject.Store(Self);
   except
     { откатываемся в предыдущую позицию и, если EOF, тогда truncate }
     DoTruncate := Position = Size;
     Position := ANotedPosition;
     if DoTruncate then
       Write(ANotedPosition, 0);
     raise;
   end;
 end;
 
 { выход из обработки, очистка регистратора }
 
 procedure DoneCompStrm; far;
 
 var
   i: integer;
 
 begin
   { освобождаем регистратор }
   for i := Registry.Count - 1 downto 0 do
     TObject(Registry.Items[i]
       ).Free;
 
   Registry.Free;
 end;
 
 begin
   Registry := TList.Create;
   AddExitProc(DoneCompStrm);
 end.
 




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

Автор: OAmiry (Borland)

Упакуй, Господи, душу его...

Для упаковки таблицы dBASE убедитель в том, что таблица открыта в монопольном (exclusive) режиме и вызывайте DbiPackTable. Пример:


 Table1.Close ;
 Table1.Exclusive := TRUE ;
 Table1.Open ;
 DbiPackTable( Table1.DBHandle, Table1.Handle, nil, nil, TRUE ) ;
 

Убедитесь, что DBITYPES, DBIPROCS, DBIERRS включены в секцию USES вашего модуля и, в случае запуска из-под IDE, в режиме проектирования таблица не активна.




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

Упаковка таблиц dBASE требует вызова BDE функции DbiPackTable. Пример ее использования показан ниже, включая проверку на ошибки. Чтобы воспользоваться функцией DbiPackTable, вызывающий модуль должен в своей секции uses иметь модули-обертки BDE DbiTypes, DbiErrs и DbiProcs.

При неудачном вызове DbiPackTable, сообщение об ошибке не генерится. Для того, чтобы понять как функция сработала, вам необходимо проверить возвращаемое ею значение. В случае успешного выполнения возвращаемое значение равно DBIERR_NONE. Любое другое значение указывает на ошибку, а с помощью него можно определить саму ошибку, ее причину, и наметить действия, необходимые для ее устранения.

Вот сам пример:


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




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

Для упаковки таблицы dBASE, открытой с помощью TTable, воспользуйтесь функцией BDE DbiPackTable. Для этого достаточно сделать две операции:

  1. Добавьте в секцию uses следующие модули:

    { Для Delphi 1.0: } DBITYPES, DBIPROCS и DBIERRS;
    { Для Delphi 2.0: } BDE;

  2. Затем вызовите BDE функцию DbiPackTable следующим образом:

 Check(DbiPackTable(Table1.DbHandle, Table1.Handle, Nil, szDBASE, TRUE));
 

Примечания:

  • Таблица должна быть открыта в эксклюзивном режиме.
  • При вызове функций API BDE используйте процедуру Check. Check в случае ошибки при вызове BDE генерирует исключительную ситуацию.



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

Nomadic

Для dBase:


 uses
   DbiProcs;
 
 with Table do
 begin
   OldState := Active;
   Close;
   Exclusive := True;
   Open;
 
   DbiPackTable(DBHandle, Handle, nil, nil, True);
   {^ здесь можно добавить check()}
 
   Close;
   Exclusive := False;
   Active := OldState;
   { при желании можно сохранить закладку }
 end;
 

Автор: Pavel Kulchenko

Пpимеp для Paradox:


 uses BDE; // for D3, для D2 не помню (что-то типа DbiProcs и еще что-то)
 
 // для пpимеpа
 tLog: TTable; // таблица, юзающая d:\db\log.db
 
 var
   TblDesc: CRTblDesc;
   rslt: DBIResult;
   Dir: string; //имеется в виду huge string т.е. {$H+}
   hDb: hDbiDb;
 
 begin
   tLog.Active := False; //деактивиpуем TTable
 
   SetLength(Dir, dbiMaxNameLen + 1);
   DbiGetDirectory(tLog.DBHandle, False, PChar(Dir));
   SetLength(Dir, StrLen(PChar(Dir)));
 
   DbiOpenDatabase(nil, nil, dbiReadWrite, dbiOpenExcl, nil, 0, nil, nil, hDb);
 
   DbiSetDirectory(hDb, PChar(Dir));
 
   FillChar(TblDesc, sizeof(CRTblDesc), 0);
   StrPCopy(TblDesc.szTblName, 'd:\db\log.db');
   // здесь должно быть полное имя файла
   //котоpое можно: а) ввести pуками;
   //б) вытащить из пpопеpтей таблицы;
   //в) вытащить из алиаса;
   //г) см. FAQ
   StrCopy(TblDesc.szTblType, szParadox);
   //BTW тут может и szDBase стоять
 
   TblDesc.bPack := TRUE;
 
   DbiDoRestructure(hDb, 1, @TblDesc, nil, nil, nil, False);
   DbiCloseDatabase(hDb);
 
 end;
 
 // можно еще чеки ввести, но облом :-)
 




Как программно паковать таблицы Paradox или восстанавливать индексы

Автор: Сергей А.


 unit repair_u;
 
 interface
 
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   Db, DBTables, BDE, StdCtrls;
 
 type
   TForm1 = class(TForm)
     tb: TTable;
     te: TTable;
     Button1: TButton;
     Label1: TLabel;
     procedure Button1Click(Sender: TObject);
   private
     { Private declarations }
   public
     { Public declarations }
   end;
 
 var
   Form1: TForm1;
 
 implementation
 // Pack a Paradox or dBASE table
 // The table must be opened execlusively before calling this function…
 
 procedure PackTable(Table: TTable);
 var
   Props: CURProps;
   hDb: hDBIDb;
   TableDesc: CRTblDesc;
 begin
   // Make sure the table is open exclusively so we can get the db handle…
   if not Table.Active then
     raise EDatabaseError.Create('Table must be opened to pack');
   if not Table.Exclusive then
     raise EDatabaseError.Create('Table must be opened exclusively to pack');
   // Get the table properties to determine table type…
   Check(DbiGetCursorProps(Table.Handle, Props));
   // If the table is a Paradox table, you must call DbiDoRestructure…
   if (Props.szTableType = szPARADOX) then
   begin
     // Blank out the structure…
     FillChar(TableDesc, sizeof(TableDesc), 0);
     // Get the database handle from the table's cursor handle…
     Check(DbiGetObjFromObj(hDBIObj(Table.Handle), objDATABASE, hDBIObj(hDb)));
     // Put the table name in the table descriptor…
     StrPCopy(TableDesc.szTblName, Table.TableName);
     // Put the table type in the table descriptor…
     StrPCopy(TableDesc.szTblType, Props.szTableType);
     // Set the Pack option in the table descriptor to TRUE…
     TableDesc.bPack := True;
     // Close the table so the restructure can complete…
     Table.Close;
     // Call DbiDoRestructure…
     Check(DbiDoRestructure(hDb, 1, @TableDesc, nil, nil, nil, False));
   end
   else
     {// If the table is a dBASE table, simply call DbiPackTable…} if
       (Props.szTableType = szDBASE) then
       Check(DbiPackTable(Table.DBHandle, Table.Handle, nil, szDBASE, True))
     else
       // Pack only works on PAradox or dBASE; nothing else…
       raise EDatabaseError.Create('Table must be either of Paradox or dBASE ' +
         'type to pack');
   Table.Open;
 end;
 {$R *.DFM}
 
 procedure TForm1.Button1Click(Sender: TObject);
 begin
   tb.open;
   PackTable(tb);
   tb.close;
   te.open;
   PackTable(te);
   te.close;
 end;
 
 end.
 




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

Автор: Mike Orriss

Возвожно ли перестраивать и паковать таблицы Paradox из программ, написанных на Delphi, если да то как и где найти документацию по этому вопросу?

Попробуйте приведенную ниже функцию, она пакует таблицы Paradox и dBase (требуется компонент TDatabase, указывающий на ту же директорию, где хранятся таблицы):


 uses DBIProcs, DBITypes, DBIErrs;
 
 function PackTable(tbl: TTable; db: TDatabase): DBIResult;
 var
   crtd: CRTblDesc;
 begin
   Result := DBIERR_NA;
   with tbl do
     if Active then
       Active := False;
   with db do
     if not Connected then
       Connected := True;
   FillChar(crtd, SizeOf(CRTblDesc), 0);
   StrPCopy(crtd.szTblName, tbl.TableName);
   crtd.bPack := True;
   Result := DbiDoRestructure(db.Handle, 1, @crtd, nil, nil, nil, FALSE);
 end;
 

Пример использования:


 procedure TForm1.Button1Click(Sender: TObject);
 begin
   if PackTable(Table1,DataBase1) = DBIERR_NONE then
     .....
   else
     MessageBeep(0);
 end;
 




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

- Христос воскрес! - Fixed.


 function dgPackParadoxTable(Tbl: TTable; Db: TDatabase): DBIResult;
 { Packs a Paradox table by calling the BDE DbiDoRestructure
 function. The TTable passed as the first parameter must
 be closed. The TDatabase passed as the second parameter
 must be connected. }
 var
   TblDesc: CRTblDesc;
 begin
   Result := DBIERR_NA;
   FillChar(TblDesc, SizeOf(CRTblDesc), 0);
   StrPCopy(TblDesc.szTblName, Tbl.TableName);
   TblDesc.bPack := True;
   Result        := DbiDoRestructure(Db.Handle, 1, @TblDesc, nil, nil, nil, False);
 end;
 
 function dgPackDbaseTable(Tbl: TTable): DBIResult;
 { Pack a dBASE table by calling DbiPackTable. The table
 passed as a parameter will be opened if it isn't open. }
 begin
   Result := DBIERR_NA;
   if Tbl.Active = False then
     Tbl.Open;
   Result := DbiPackTable(Tbl.DBHandle, Tbl.Handle,
     nil, nil, True);
 end;
 




Назначение палитры Bitmap

Если вы рисуете на TImage....

Во-первых, вам нужно использовать Image1.Picture.bitmap, а не Image.Canvas. Причина кроется в том, что Image1.Picture.Bitmap имеет палитру, в Timage нет. Затем палитру необходимо назначить. Вот пример:


 // Устанавливаем Width и Height перед использованием
 // Image1.Picture c Bitmap Canvasvar
 
 Bitmap: TBitmap;
 begin
   Bitmap:=TBitmap.Create;
   Bitmap.LoadfromFile({'Whatever.bmp'});
 
   With Image2.Picture.bitmap do
   Begin
     Width:=Bitmap.Width;
     height:=Bitmap.Height;
     Palette:=Bitmap.Palette;
     Canvas.draw(0,0,bitmap);
     Refresh;
   end;
 end;
 

Если вы рисуете на канве формы...


 Canvas.Draw(0,0,Bitmap);
 SelectPalette(Form1.Canvas.handle,Bitmap.Palette,True);
 RealizePalette(Form1.Canvas.Handle);
 




Перемещение мышью панели на форме во время выполнения программы

Автор: Aleksey


 {Так можно таскать мышкой TPanel по форме в run-time'е.
 Поместите на форму TPanel и напишите обработчик события OnMauseDown,
 запустите программу и задвинте эту панель подальше.}
 
 procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
   Shift: TShiftState; X, Y: Integer);
 const
   SC_DRAGMOVE = $F012;
 begin
   ReleaseCapture;
   {а если сюда написать Form1, то можно таскать форму по экрану}
   Panel1.Perform(WM_SYSCOMMAND, SC_DRAGMOVE, 0);
 end;
 

на самом деле таким образом можно таскать по форме любые визуальные компоненты.




Paradox и неверные индексы Windows

Автор: David W. Husch

Сообщение об ошибке: В файловой системе win95 существует ошибка, "микширующая" блокировку записи Paradox и механизм обновления. В хост-файлах Paradox в Windows 95 для работы нескольких пользователей измените следующие значения:

Select Control Panel
 System (icon)
 Performance (Tab)
 File System (Button)
 Troubleshooting (Tab)
 "Disable New File Sharing and Locking Semantics" (щелкните) (нажмите OK)
 (Выключить общий доступ к новым файлам и семантику блокировки)



Byte-поля Paradox

Автор: Mark Edington

Что за магия при записи в поле Paradox Byte? По этому поводу в документации ничего не сказано.

Есть 2 пути получить доступ к данным в TBytesField.

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

  2.  procedure SetCheckBoxStates;
     var
       CBStates: array[1..13] of Byte;
     begin
       CBStateField.GetData(CBStates);
       { Здесь обрабатываем данные... }
     end;
     

    Для записи значений вы должны использовать SetData.

  3. Используйте свойство Value, возвращающее вариантный массив байт (variant array of bytes):

  4.  procedure SetCheckBoxStates;
     var
       CBStates: Variant;
     begin
       CBStates := CBStateField.Value;
       { Здесь обрабатываем данные... }
     end;
     

Первый метод, вероятно, для вас будет легче, поскольку вы сразу докапываетесь до уровня байт. Запись данных также получится сложнее, поскольку вам нужно будет работать с variant-методами типа VarArrayCreate и др.




После работы программы не сохраняются изменения в базе Paradox

Где-нибудь при закрытии главной формы выполните нижеследующие куски кода:

Для Delphi3 (при открытой таблице):


 Table.FlushBuffers;
 

Для прочих:


 Table.Open;
 Check(dbiSaveChanges(Table.Handle));
 Table.Close;
 

Чтобы сбросить кэш, можно еще после этого сделать:


 asm
   mov ah, $0D
   int $21
 end;
 




Размеры полей таблицы Paradox

Автор: John B Moore

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

Требования к предельным размерам типов полей таблицы Paradox

Данный список указывает количество байт каждого типа поля таблицы Paradox, занимаемое в структуре записи. Имейте в виду, что указанный размер занимает каждое поля в самом файле .DB, не во вспомогательных файлах типа .MB.

    Тип данных           Байт
    -----------------------------------------------------------
    Alphanumeric          1 байт на символ, до 255
    AutoIncrement         4 байта
    Binary (BLOB)        10 байт + 1 на символ. В пределе
                            (0 - 240) [1]
    Bytes                 1 на символ, максимально до 255.
    BCD                  17
    Currency (Денежный)   8
    Date                  4
    Formatted Memo       10 байт + 1 на символ. В пределе
                            (0 - 240)
    Graphic              10 байт + 1 на символ. В пределе
                            (0 - 240)
    Memo                 10 байт + 1 на символ. В пределе
                            (1 - 240) [2]
    Logical               1
    LongInt               4
    Numeric (Числовой)    8
    OLE                  10 байт + 1 на символ. В пределе
                            (0 - 240)
    SmallInt              2
    Time                  4
    TimeStamp             8
 
 Пределы:
    Maximum Field Count      :  255 полей
    (максимальное количество
     полей)
    Maximum Blocks per table :  64К
    (максимальное количество
     блоков в таблице)
    Maximum Block Size       :  32К символов
    (максимальный размер
     блока)
    Max Record Size, unkeyed :  Текущий размер блока - 6 байта [3]
    (максимальный размер
     записи, неключевой)
    Max Record Size, keyed   :  (BlockSize - 6) / 3, округляется в меньшую сторону
    (максимальный размер        до ближайшего размера блока. [4]
     записи, ключевой)
Сноски:

[1] Все blob-поля содержат 10-байтовые указатели на .MB-файл, которые указывают где могут быть найдены "остальные" значения поля.

[2] В отличие от данных "blob"-типа, Memo-поле требует по крайней мере один "Memo"-символ, сохраненный в .DB-файле, для обеспечения совместимости с Paradox for DOS.

[3] Размер блока по умолчанию хранится в IDAPI.CFG. Для изменения значения по умолчанию, запустите Configuration Utility и измените установку Tables, Paradox, Block Size. Значение по умолчанию 2048 и может изменяться в диапазоне от 1024 до 32К. 6 байтов в данном значении резервируются для внутренних указателей.

[4] Это следствие наличия значений ключа записей Paradox, которые передаются в .PX файл, очень похожий на табличный файл. Размер ключа не может превышать 1/3 размера блока таблицы; в противном случае Paradox будет пытаться увеличить размер блока. При выполнении вычислений не забывайте брать в расчет 6-байтные указатели.




Paradox в сети

Автор: James Presley

Я пришел к тебе с дискетой, рассказать что сеть упала.

Может мне кто-нибудь помочь? Я получаю следующую ошибку приложения....Not initialized for accessing network files (не инициализировано для доступа к сетевым файлам).

Программа Borland BDE Install НЕ включает в себя автоматически драйвер для работы в сети для таблиц Paradox, если целевой компьютер подключен к сети. Ваш пользователь получит сообщение об ошибке, если путь никем не установлен. Программы третьих фирм, устанавливающие BDE, поступают точно так же (я использую WISE). Настройка сетевого каталога возможна программным путем из самой программы, или с помощью пользователя и утилиты BDEconfig.

При запуске приложения я разворачиваю предусмотренную Borland DLL "netdir.dll" (58K), загруженную из форума PdoxWin, получаю доступ к idapi.cfg и считываю значение сетевого каталога (netdir). Следующий код проверяет был ли установлен сетевой каталог, и, если не был, то он временно устанавливается для текущего сеанса пользователя.


 {объявляем DLL функцию}
 function getCFGNetDir: pchar; far; external 'netdir' index 4;
 
 {проверяем и при необходимости восстанавливаем сетевой каталог}
 procedure TmySplashForm.FormCreate(Sender: TObject);
 var
   theNetDir: pchar;
   theChar: char;
 begin
   theChar := ':'
     theNetDir := getCFGNetDir;
   if (strscan(theNetDir, theChar) = nil) then
     session.netfiledir := 'C:\';
 end;
 




Ограничения Paradox

Автор: Eryk

Какой предел IDAPI для подключенных пользователей и размера файла для таблиц Paradox?

255 пользователей, максимальный размер таблицы по умолчанию от 128Мб до 4Гб, в зависимости от установки BLOCKSIZE в IDAPI.CFG во время создания таблицы. (максимальный размер = BLOCKSIZE x 64Mb).




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

Пришёл программер как-то раз в ресторан, заказал себе отбивную. Берётся, значит, за дело, бац, а вилка с ножиком, аж соскальзывают с отбивной:
- Read only... - подумал программер.

Данный совет поможет вам разобраться в таком вопросе, как доступ к таблицам Paradox, расположенным на CD-ROM или диске, имеющем флаг "только для чтения".

Механиз блокирования файлов Paradox требует наличие файла PDOXUSRS.LCK, осуществляющий логику работы блокировки. Данный файл обычно создается во время выполнения приложения и располагается в том же каталоге, где и таблицы. Тем не менее, в случае с CD-ROM, во время выполнения программы нет никакой возможности создать на нем описанный выше файл. Решение простое: мы создаем этот файл и помещаем его на CD-ROM во время его (CD) создания. Следующая простейшая программка позволит создать вам файл PDOXUSRS.LCK и поместить его в образ компакта для его последующего копирования на CD-ROM:

  1. Стартуйте пустой проект и добавьте на форму следующие компоненты: TEdit, TButton и TDatabase.
  2. В обработчике кнопки OnClick используйте следующий код:

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

  4. Функция ChkPath является методом, определенным пользователем для формы. Она просто проверяет путь, введенный пользователем в поле редактирования и убеждается, что он существует. Вот функция:

  5.  function TForm1.ChkPath : Boolean;
     var
     s : array[0..100] of char;
     begin
     If DirectoryExists(Edit1.Text) then begin
     DataBase1.DatabaseName:= 'TempDB';
     DataBase1.DriverName:= 'Standard';
     DataBase1.LoginPrompt:= false;
     DataBase1.Connected := False;
     DataBase1.Params.Add('Path=' + Edit1.Text);
     DataBase1.Connected := TRUE;
     Result := TRUE;
     end
     else begin
     StrPCopy(s,'Каталог : ' + Edit1.text + ' не найден');
     Application.MessageBox(s, 'Ошибка!', MB_ICONSTOP);
     Result := FALSE;
     end;
     end;
     
     { Примечание: Не забудьте добавить объявление
       функции в секцию public формы. }
     

  6. Перед компиляцией необходимо вспомнить еще об одной вещи: в список Uses нужно добавить следующие модули:
      Delphi 1.0: FileCtrl, DbiProcs, DbiTypes, DbiErrs.
       Delphi 2.0: FileCtrl , BDE
    После компиляции и выполнения, программа создаст два файла в определенном вами каталоге. Создаваемые два файла: PDOXUSRS.LCK и PARADOX.LCK.

    Примечание: Файл PARADOX.LCK необходим только для доступа к таблицам Paradox for DOS, так что вы можете его удалить.

  7. Вам осталась сделать только одну последнюю вещь: скопировать оставшийся файл (PDOXUSRS.LCK) в образ CD-ROM. Естественно, ваши таблицы будут только для чтения.

    Примечание: Если вы собираетесь довольно часто пользоваться данной утилитой, то для удобства вы можете изменить свойство Text компонента Edit на ваш "любимый" каталог, а свойство Caption кнопки поменять на что-нибудь более "интеллектуальное".

    Вот окончательная версия кода:


  8.  unit Unit1;
     
     interface
     
     uses
       Windows, Messages, SysUtils, Classes, Graphics, Controls,
       Forms, Dialogs, DB, StdCtrls, FileCtrl,
     
     {$IFDEF WIN32}
       BDE;
     {$ELSE}
       DbiProcs, DbiTypes, DbiErrs;
     {$ENDIF }
     
     type
       TForm1 = class(TForm)
         Edit1: TEdit;
         Button1: TButton;
         Database1: TDatabase;
         procedure Button1Click(Sender: TObject);
       private
         { Private declarations }
       public
         { Public declarations }
         function ChkPath: Boolean;
       end;
     
     var
       Form1: TForm1;
     
     implementation
     
     {$R *.DFM}
     
     function TForm1.ChkPath: Boolean;
     var
       s: array[0..100] of char;
     begin
       if DirectoryExists(Edit1.Text) then
       begin
         DataBase1.DatabaseName := 'TempDB';
         DataBase1.DriverName := 'Standard';
         DataBase1.LoginPrompt := false;
         DataBase1.Connected := False;
         DataBase1.Params.Add('Path=' + Edit1.Text);
         DataBase1.Connected := TRUE;
         Result := TRUE;
       end
       else
       begin
         StrPCopy(s, 'Каталог : ' + Edit1.text + ' не найден');
         Application.MessageBox(s, 'Ошибка!', MB_ICONSTOP);
         Result := FALSE;
       end;
     end;
     
     procedure TForm1.Button1Click(Sender: TObject);
     begin
       if ChkPath then
         Check(DbiAcqPersistTableLock(Database1.Handle,
           'PARADOX.DRO', 'PARADOX'));
     end;
     
     end.
     




Из Paradox в Access при помощи ADO

В данной статье мы обратим внимание на компонент TADOCommand и использование языка SQL DDL (Data Definition Language), с целью помочь Вам с проблемой переноса данных BDE/Paradox в ADO/Access.

Язык определения данных (Data Definition Language)

Не многие программисты создают базу данных программным путём, большинство из нас для этого используют некую визуальную среду наподобие MS Access для построения файла MDB. Но иногда нам всё таки приходится создавать и удалять базу данных, а так же объекты базы данных программным путём. Для этого используется наиболее распространённая на сегодняшний день технология Structured Query Language Data Definition Language (SQL DDL). Выраджения языка определения данных (DDL) - это SQL выражения, которые поддерживают определения или объявления объектов базы данных (например, CREATE TABLE, DROP TABLE, CREATE INDEX либо подобные им).

В рамки данной статьи не входит детальное ознакомление с языком DDL. Если Вы знакомы с языком SQL DML (Data Manipulation Language - это выражения типа SELECT, UPDATE и DELETE), то DDL не будет для Вас серьёзным барьером. Обратите внимание, что работа с DDL может быть весьма ухищрённой, так как каждый производитель базы данных може включать в неё собственные расширения для SQL.

Давайте взглянем на простейший пример выражения CREATE TABLE:


 CREATE TABLE PhoneBook(
 Name TEXT(50)
 Tel TEXT(50));
 

Данное DDL выражение (для MS Access) в время выполнения создаст новую таблицу с названием PhoneBook. Таблица PhoneBook будет иметь два поля: Name и Tel. Оба поля имеют строковый тип (TEXT) и размер поля 50 символов.

TFieldDef.DataType

Очевидно, что в Access тип данных, представленный строкой это TEXT. В Paradox это STRING. Чтобы передать таблицы Paradox в Access, нам необходимо знать какие типы данных присутствуют и, соответственно их имена. При работе в BDE с таблицами Paradox, TFieldDef.DataType определяет тип физического поля в (dataset) таблице. Поэтому для успешного перенесения данных из таблиц Paradox в Access Вам необходимо создать функцию, которая бы преобразовывала соотвествующие типы полей Paradox в типы Access.

Давайте посмотрим на пример функции, которая проверяет тип поля (fd) и возвращает соответствующий тип Access, а заоодно и размер поля, который необходим для выражения CREATE TABLE DDL.


 function AccessType(fd:TFieldDef):string;
 begin
   case fd.DataType of
     ftString:   Result:='TEXT('+IntToStr(fd.Size)+')';
     ftSmallint: Result:='SMALLINT';
     ftInteger:  Result:='INTEGER';
     ftWord:     Result:='WORD';
     ftBoolean:  Result:='YESNO';
     ftFloat :   Result:='FLOAT';
     ...
     else
       Result:='TEXT(50)';
   end;
 end;
 

ADOX

ADOX - это расширения ADO для Data Definition Language а так же для модели защиты (ADOX). ADOX предоставляет разработчикам богатый набор инструментов для получения доступа к структуре, модели защиты, а так же процедурам, хранимым в базе данных.

Для использования ADOX в Delphi, Вам необходимы установить библиотеку типа ADOX.

  1. Select Project | Import Type Library
  2. Выберите "Microsoft ADO Ext 2.x for DDL and Security (Version 2.x)"
  3. Измените "TTable" на "TADOXTable"
  4. Измените "TColumn" на "TADOXColumn"
  5. Измените "TIndex" на "TADOXIndex"
  6. Нажмите кнопку Install (перекомпиляция пакетов (packages))
  7. Нажмите один раз OK и дважды Yes
  8. File | Close All | Yes

На вершине объектной модели ADOX находится объект Catalog. Он обеспечивает доступ к набору Таблиц (Tables), Видов (Views) и Процедур, который используется для работы со структурой базы данных, а так же к набору Пользователей (Users) и рупп (Groups), которые используются для авторизации доступа. Каждый объект Catalog связан только с одним подключением к источнику данных.

Давайте оставим ADOX (пока) и перейдём к ADOExpress.

TADOCommand

В ADOExpress компонент TADOCommand - это VCL представление объекта ADO Command. Объект Command представляет команду (запрос или выражение), которая может быть обработана источником данных. Команды могут быть выполнены методом Execute, используемым в ADOCommand. TADOCommand чаще всего используется для исполнения команд языка определения данных (DDL) SQL. Свойство CommandText содержит в себе саму команду. Свойство CommandType используется для того, как интерпретировать свойство CommandText. Тип cmdText используется для указания инструкции DDL. Впринципе, использовать компонент ADOCommand для получения данных из таблицы, запросов или хранимых процедур не имеет смысла, но никто не запрещает Вам пользоваться данным компонентов и в таких целях.

Итак, самое время приступить к реальному программированию...

Приведённый ниже проект демонстрирует следующее:

Получение списка всех таблиц из BDE, использование TFieldDefs чтобы получить определения (имя, тип данных, размер, и т.д.) полей в таблице, создание инструкции CREATE TABLE и копирование данных из таблицы BDE/Paradox в таблицу ADO/Access.

Давайте решим эту задачу по шагам:

GUI

Запускаем Delphi - получаем новый проект с пустой формой. Добавляем две кнопки, один ComboBox и один компонент Memo. Далее добавляем компоненты TTable, TADOTable, TADOConnection и TADOCommand. Чтобы установить следующие свойства, используем Object Inspector (оставьте все другие свойства как есть - например, Memo будет иметь имя по умолчанию: Memo1):


 Button1.Caption = 'Construct Create command'
 Button2.Caption = 'Create Table and copy data'
 ComboBox.name = cboBDETblNames;
 
 ADOConnection1.ConnectionString = ...
 TADOTable.name = ADOTable
 ADOTable.Connection = ADOConnection1
 TADOCommand.name = ADOCommand
 ADOCommand.Connection = ADOConnection1
 TTable.name = BDETable
 BDETable.DatabaseName = 'DBDEMOS'
 

Пример:

Для получения списка таблиц, связанных с данной базо данных (DBDEMOS) мы воспользуемся следующим кодом (OnCreate для формы):


 procedure TForm1.FormCreate(Sender: TObject);
 begin
   Session.GetTableNames('DBDEMOS', '*.db', False,
   False, cboBDETblNames.Items);
 end;
 

В самом начале ComboBox содержит имена таблиц (Paradox) в базе данных DBDEMOS. В нижеприведённом коде мы выберем таблицу Country.

Следующая наша задача - это создание инструкции CREATE TABLE DDL. Это делается в процедуре OnClick кнопки 'Construct Create command':


 //Кнопка 'Construct Create command'
 procedure TForm1.Button1Click(Sender: TObject);
 var
   i: integer;
   s: string;
 begin
   BDETable.TableName:=cboBDETblNames.Text;
   BDETable.FieldDefs.Update;
 
   s:='CREATE TABLE ' + BDETable.TableName + ' (';
   with BDETable.FieldDefs do
   begin
     for i:=0 to Count-1 do
     begin
       s:=s + ' ' + Items[i].name;
       s:=s + ' ' + AccessType(Items[i]);
       s:=s + ',';
     end;
     s[Length(s)]:=')';
   end;
 
   Memo1.Clear;
   Memo1.lines.Add (s);
 end;
 

Вышеприведённый код просто анализирует определения полей для выбранной таблицы (cboBDETblNames) и генерирует строку, которая будет использоваться свойством CommandText компоненты TADOCommand.

Например, когда Вы выбираете таблицу Country, то Memo будет заполнен следующей строкой:


 CREATE TABLE country(
 Name TEXT(24),
 Capital TEXT(24),
 Continent TEXT(24),
 Area FLOAT,
 Population FLOAT)
 

И в заключении, пример для кнопки 'Create Table and copy data' , которая удаляет таблицу (DROP..EXECUTE), создаёт таблицу (CREATE..EXECUTE), и затем копирует данные в новую таблицу (INSERT...POST). Так же присутствует некоторая обработка ошибок, но код будет выходить на ошибку, если, например, (новая) таблица ещё не существует (в случае удаления).


 //Кнопка 'Create Table and copy data'
 procedure TForm1.Button2Click(Sender: TObject);
 var
   i: integer;
   tblName: string;
 begin
   tblName:=cboBDETblNames.Text;
 
   //обновляем
   Button1Click(Sender);
 
   //удаление & создание таблицы
   ADOCommand.CommandText:='DROP TABLE ' + tblName;
   ADOCommand.Execute;
 
   ADOCommand.CommandText:=Memo1.Text;
   ADOCommand.Execute;
 
   ADOTable.TableName:=tblName;
 
   //копируем данные
   BDETable.Open;
   ADOTable.Open;
   try
     while not BDETable.Eof do
     begin
       ADOTable.Insert;
       for i:=0 to BDETable.Fields.Count-1 do
       begin
         ADOTable.FieldByName
         (BDETable.FieldDefs[i].name).Value :=
         BDETable.Fields[i].Value;
       end;
       ADOTable.Post;
       BDETable.Next
     end;
   finally
     BDETable.Close;
     ADOTable.Close;
   end;
 end;
 

Вот и всё. Теперь проверьте Вашу базу данных Access...вуаля :) теперь в ней находится таблица Country со всеми данными из DBDEMOS.

Однако некоторые вопросы остались без ответа, например: как добавлять индексы в таблицу (CREATE INDEX ON ...), или как создавать пустую базу данных Access.




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



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



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


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