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

ВИДЕОКУРС ВЗЛОМ
выпущен 2 июля!


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

БОЛЬШОЙ FAQ ПО DELPHI



Автоматический формат даты в компоненте Edit

Маугли подходит к компьютеру:
- Мы с тобой одного формата, ты и я!


 procedure TForm1.Edit1Exit(Sender: TObject);
 begin
   if Edit1.Text <> '' then
   begin
     try
       StrToDate(Edit1.Text);
     except
       Edit1.SetFocus;
       MessageBeep(0);
       raise Exception.Create('"' + Edit1.Text
         + '" - некорректная дата');
     end {try};
     Edit1.Text := DateToStr(StrToDate(Edit1.Text));
   end {if};
 end;
 




Дни недели


 unit datefunc;
 
 interface
 function checkdate(date: string): boolean;
 function Date2julian(date: string): longint;
 function Julian2date(julian: longint): string;
 function DayOfTheWeek(date: string): string;
 function idag: string;
 
 implementation
 uses
 
   sysutils;
 
 function idag(): string;
 {Получает текущую дату и возвращает ее в формате YYYYMMDD для использования
 другими функциями данного молуля.}
 var
 
   Year, Month, Day: Word;
 begin
   DecodeDate(Now, Year, Month, Day);
   result := IntToStr(year) + IntToStr(Month) + IntToStr(day);
 end;
 
 function Date2julian(date: string): longint;
 {Получает дату в формате YYYYMMDD.
 Если у вас другой формат,
 в первую очередь преобразуйте его.}
 var
 
   month, day, year: integer;
   ta, tb, tc: longint;
 begin
 
   month := strtoint(copy(date, 5, 2));
   day := strtoint(copy(date, 7, 2));
   year := strtoint(copy(date, 1, 4));
   if month > 2 then
     month := month - 3
   else
   begin
     month := month + 9;
     year := year - 1;
   end;
   ta := 146097 * (year div 100) div 4;
   tb := 1461 * (year mod 100) div 4;
   tc := (153 * month + 2) div 5 + day + 1721119;
   result := ta + tb + tc
 end;
 
 function mdy2date(month, day, year: integer): string;
 var
 
   y, m, d: string;
 begin
 
   y := '000' + inttostr(year);
   y := copy(y, length(y) - 3, 4);
   m := '0' + inttostr(month);
   m := copy(m, length(m) - 1, 2);
   d := '0' + inttostr(day);
   d := copy(d, length(d) - 1, 2);
   result := y + m + d;
 
 end;
 
 function Julian2date(julian: longint): string;
 {Получает значение и возвращает дату в формате YYYYMMDD}
 var
 
   x, y, d, m: longint;
   month, day, year: integer;
 begin
 
   x := 4 * julian - 6884477;
   y := (x div 146097) * 100;
   d := (x mod 146097) div 4;
   x := 4 * d + 3;
   y := (x div 1461) + y;
   d := (x mod 1461) div 4 + 1;
   x := 5 * d - 3;
   m := x div 153 + 1;
   d := (x mod 153) div 5 + 1;
   if m < 11 then
     month := m + 2
   else
     month := m - 10;
   day := d;
   year := y + m div 11;
   result := mdy2date(month, day, year);
 end;
 
 function checkdate(date: string): boolean;
 {Дата должна быть в формате YYYYMMDD.}
 var
 
   julian: longint;
   test: string;
 begin
   {Сначала преобразовываем строку в юлианский формат даты.
   Это позволит получить необходимое значение.}
   julian := Date2julian(date);
   {Затем преобразовываем полученную величину в дату.
   Это всегда будет правильной датой. Для проверки делаем обратное преобразование.
   Результат проверки передаем как выходной параметр функции.}
   test := Julian2date(julian);
 
   if date = test then
 
     result := true
   else
 
     result := false;
 end;
 
 function DayOfTheWeek(date: string): string;
 {Получаем дату в формате YYYYMMDD
 и возвращаем день недели.}
 var
 
   julian: longint;
 begin
   julian := (Date2julian(date)) mod 7;
 
   case julian of
     0: result := 'Понедельник';
     1: result := 'Вторник';
     2: result := 'Среда';
     3: result := 'Четверг';
     4: result := 'Пятница';
     5: result := 'Суббота';
     6: result := 'Воскресенье';
   end;
 end;
 
 end.
 

Тем не менее, начиная со второй версии, Delphi содержат в своем арсенале замечательную функцию DayOfWeek, возвращающую целочисленный результат в диапазоне от 1 до 7. Вот пример кода, присланный Андреем Ивановым:


 uses SysUtils;
 ...
 
 function TForm1.DayOfWeekRus(S: TDateTime): string;
 begin
   case DayOfWeek(S) of
     1: Result := 'Воскресенье';
     2: Result := 'Понедельник';
     3: Result := 'Вторник';
     4: Result := 'Среда';
     5: Result := 'Четверг';
     6: Result := 'Пятница';
     7: Result := 'Суббота';
   end;
 end;
 




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

Автор: Nomadic

Приходит программер в магазин:
- У ваз майонезз езззь?
- Езььь.
- Рулезззь!

Я тут писал по поводу того, что у меня не pаботали тpиггеpы. Все дело оказалось в пpавиле написания команды "create trigger". Если все остальные команды коppектно воспpинимаются на любом pегистpе, то эта - только набpанная одними большими буквами.




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

Автор: Nomadic

Подождите, идет подготовка к зависанию компьютера...

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

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

Возможны два варианта доступа:

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

Замечание: Проверялся доступ через сервера NW 3.11 и 3.12. Для 4.х нужно еще разобраться.

1.1.1. DB2 Сервер

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

1.2.1. DB2 Сервер

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



DBase и особые случаи BDE

Ну и запросы у вас - сказала база данных и повисла.

Dbase является причиной бОльшего количества 'special case' в BDE, чем таблицы SQL и Paradox из-за поддержки "Выражений в Индексах" (Expressions in indexes) и т.д., и т.п..

  1. Создание/пересоздание индекса
    • DbiRegenIndexes( Table1.Handle ); { Регенерация всех индексов }
    • create index (зависит от существования выражения)

 if (( Pos('(',cTagExp) + Pos('+',cTagExp) ) > 0 ) then
   Table1.AddIndex( cTagName, cTagExp, [ixExpression])  // <- ixExpression - _литерал_
 else
   Table1.AddIndex( cTagName, cTagExp, []);
 

  1. Мастер/Деталь связан с выражением дочернего индекса
    • вызов BDE процедуры DbiLinkDetailToExp() вместо обычной DbiLinkDetail()
  2. Упаковка таблиц

 with Table1 do
   StrPCopy( TName, TableName );
 Result := DBIPackTable( DbHandle, Handle, TName, szDBASE, TRUE );
 

  1. Установка видимости удаленных записей, on/off (т.е. dBase SET DELETED ON/OFF)

 DbiSetProp( hDBIObj(Table1.Handle), curSOFTDELETEON, LongInt(bValue));
 

  1. Установка символа частичного/точного соответствия, on/off (т.е. dBase SET EXACT ON/OFF)

 DbiSetProp( hDBIObj(Table1.Handle), curINEXACTON, LongInt(bValue));
 




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


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




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

Для начала вы должны включить SoftDeletes, после чего вы сможете просматривать записи, помеченные к удалению. В противном случае, вы их не увидите. По умолчанию, для файлов DBF, SoftDeletes установлен в False. Вот логика работы:


 procedure TForm1.Button1Click(Sender: TObject);
 var
   B: BOOL;
   W: Word;
 begin
   Check(DbiSetProp(hDBIObj(Table1.Handle), curSOFTDELETEON,
     longint(True)));
   { Проверяем, что это работает }
   Check(DbiGetProp(hDBIObj(Table1.Handle), curSOFTDELETEON, @B,
     sizeof(B), W));
   if B = False then
     Label2.Caption := 'Не помечена'
   else
     Label2.Caption := 'Помечена';
 end;
 

Когда указатель на запись указывает на запись, которую вы хотите удалить, используйте следующую логику:


 Table1.UpdateCursorPos;
 Check(DbiUndeleteRecord(Table1.Handle));
 

Метод UpdateCursorPos устанавливает основной курсор BDE на позицию курсора текущей записи, который существуют только для того, чтобы все работало правильно. Вам нужно только вызвать этот метод прямым вызовом одной из BDE API функций (такой как, например, DbiUndeleteRecord).

Ну и, наконец, чтобы все работало, поместите модули DBIPROCS и DBITYPES с список USES.




DBASE - Индексы выражений

Введение

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

В конце данного совета включены два небольших раздела, описывающих механику создания индексов выражений dBASE, один относится к утилите Database Desktop, другой - к приложениям Delphi.

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

Функции dBASE доступны для применения в Delphi или Database Desktop для ускоренного использования в выражениях индекса, и затем только в связи с индексами dBASE. То есть, вы не сможете использовать функции dBASE или синтаксис для создания выражения индекса для таблицы Paradox или Local InterBase Server (LIBS). Функции dBASE не могут использоваться при программировании в Delphi. Они доступны только для выражений индесов dBASE. Синтаксис и функции dBASE, которые могут быть использованы для выражений индексов, "расположены" в библиотечном файле Borland Database Engine (BDE) IDDBAS01.DLL.

При создании индекса dBASE, который должен базироваться на двух или более полях таблицы, для которой он создается, два или более поля конкатенируются (связываются вместе) в величине, которая в некоторой степени похожа на Delphi тип String, с использованием синтакса Delphi: оператор "+". Например, выражению необходимо создать индекс, который должен базироваться в первую очередь на основе поля LastName, а затем на основе поля FirstName:

LastName + FirstName
В отличие от самого dBASE, такие индексы, основанные на нескольких полях, ограничены использованием таких же полей в таблице. dBASE допускает создание индексов, основанных на нескольких полях, содержищихся в другой таблице. Это позволяет во время создания индекса иметь открытую только "другую" таблицу или использовать таблицу, содержащую индекс.

У индексов с несколькими полями для других типов таблиц (например, Paradox и InterBase), используемые поля должны быть разделены точкой с запятой (;), как показано ниже:

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

LastName + FirstName
При создании индексных выражений, которые конкатенируют два и более поля, все включенные поля должны иметь одинаковый тип. К тому же, если они должны конкатенироваться, вместо складывания, то все поля должны иметь тип String. Например, для двух целочисленных полей, Value1 и Value2, выражение индекса...

Value1 + Value2
...не вызовет ошибку. Но в этом случае произойдет конкатенация двух значений полей и они суммируются. Таким образом, если Value1 для данной записи содержало 4, а Value2 - 5, результирующий индексный узел будет целой величиной 9, а не строковой конкантенацией "45".

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

STR( [, [, ]])
Преобразовывает dBASE-тип Float или Numeric в Character (String)
DTOS()
Преобразовывает значение Date к Character, формат YYYYMMDD
MLINE(, )
Извлекает отдельную строку из Memo-поля как значение Character

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

Индексные выражения на основе модификации значений полей

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

Создание индексов на основе модификации значений полей требует, по крайней мере, практическое знание функций dBASE и синтаксиса, поскольку данная технология использует dBASE, а не функции и синтаксис Delphi. Функция dBASE SUBSTR() извлекает подстроку из поля типа String. Delphi-эквивалент данной dBASE-функции - Copy. Но только dBASE функция SUBSTR() может применяться при создании индексного выражения dBASE.

Использование фунций dBASE в индексных выражениях dBASE заключается в простом включении в индексное выражение функции, использование в функциях dBASE-синтаксиса и имени (имен) поля (полей), использующихся в функциях. Например, индексное выражение на основе трех последних символов значения поля типа String с именем Code, имеющим длину 20 символов выглядит так:

RIGHT(Code, 3)
Важно соблюдение следующего правила: конструкции индексных выражений dBASE, модифицирующих значения полей, должны возвращать величину с "последовательной длиной" для каждой записи таблицы, т.е. результат не должен содержать граничных пробелов. Например, функция dBASE TRIM() удаляет граничные пробелы (ASCII код 32) из значения поля типа String. Если это было использовано вместе с конкантенацией двух полей, имеющих тип String, где поле не имеет постоянной длины для разных записей, длина результирующего значения будет различная для всех записей. В свете этого рассмотрим следующий пример: построим индексное выражение на основе конкантенации полей LastName и FirstName field, где функция TRIM() применена к полю LastName:

TRIM(LastName) + FirstName
Данное выражение не возратит значения "последовательной длины" для всех записей. Если поля LastName и FirstName содержали значения...

  LastName  FirstName
   --------  ---------
   Smith     Jonas
   Wesson    Nancy
...то результат использования индексного выражения может быть таким:

  SmithJonas
   WessonNancy
 
Как вы можете наблюдать, длина значения первого поля равна 10 символов, тогда как второго - 11 символов. Узлы индекса для данного индексного выражения должны базироваться на значении поля первой ненумерованной записи. Следовательно, результат выражения индекса для каждого узла должен быть равен 10 символов. В нашем примере результат вычисления для второй записи округляется до "WessonNanc". Все это приводит к тому, что поиск, основанный на поиске полных значений в полях, окончится неудачей.

Решение это дилеммы кроется в не использовании функции TRIM(), а в использовании полной длины значений поля LastName, включая граничные пробелы. В индексах, которые используют функции IIF() для установления порядка одного поля или другого, основанных на сравнении логических выражений в IIF(), если два поля имеют различную длину, более короткое поле должно быть заполнено пробелами до длины большей области. Для примера, создавая индекс с использованием функции IIF(), и индексируя поля Company или Name, базирующийся на поле Category, и где поле Company длиной 40 символов, а поле Name длиной 25 симловов, поле Name необходимо дополнять 15-ю пробелами; например, с помощью dBASE-функции SPACE(). Выражение индекса в этом случае будет таким:

IIF(Category = "B", Company, Name + SPACE(15))
Поиск и выражения индексов dBASE

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

Это вынуждает вынести dBASE-индексы в отдельный класс. Обработка таких индексов в Delphi и BDE отличается от обработки индексов для других типов таблиц. Одно из самых существенных различий заключается в том, что не все поисковые инструменты, основанные на индексах и использующие синтаксис Delphi, могут использовать выражения индексов dBASE. FindKey, FindNearest и GotoKey методы компонента TTable не годятся для работы с выражениями индексов. При попытке использования FindKey вы получите сообщение об ошибке: "Field index out of range." (Индекс поля за границами диапазона). При попытке использования метода GotoKey может произойти та же ошибка, или табличный курсор может остаться на месте (визуально искомая величина не найдена). С выражениями индексов может использоваться только метод GotoNearest. Но даже GotoNearest может не работать с некоторыми индексными выражениями. Только с помощью эксперимента можно установить - работает ли метод GotoNearest с данным индексным выражением.

Фильтрация индексных выражений dBASE

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

С активным индексным выражением метод SetRange компонента TTable приводит к следующей ошибке: "Field index out of range." (Индекс поля за границами диапазона). Тем не менее, с тем же активным индексным выражением методы SetRangeStart и SetRangeEnd успешно фильтруют набор данных.

Например, выражение индекса с конкантенацией поля LastName и активного FirstName, в приведенном ниже коде, использующем метод FindKey (предполагающий фильтрацию тех записей, где первый символ поля LastName содержит "S"), "вылетит" с ошибкой:


 begin
   Table1.SetRange(['S'], ['Szzz'])
 end;
 

Код, приведенный ниже, использует то же активное выражение индекса, но используемый фильтр поля LastName правильно отфильтрует данные, и не вызовет ошибки:


 begin
   with Table1 do
   begin
     SetRangeStart;
     FieldByName('LastName').AsString := 'S';
     SetRangeEnd;
     FieldByName('LastName').AsString := 'Szzz';
     ApplyRange;
   end;
 end;
 

И, так же, как и в случае основанного на индексах поиска, успех применения фильтра целиком и полностью зависит от самого индексного выражения. Использование методов SetRangeStart и SetRangeEnd в приведенном примере работало бы с индексом, построенным на основе простой конкантенации двух полей, имеющих тип String. Но если вместо этого выражение было основано на одном или нескольких полях с использованием функции IIF(), тот же самый процесс фильтрации потерпел бы неудачу (хотя и без ошибки).

Несколько полезных советов при создании индексных выражений dBASE

Вот некоторые "удобные" индексные выражения dBASE. Некоторые интуитивно-понятные в достижении своей цели, другие немного "заумные".

Сортировка поля типа Character символов по-возрастающей, поля Date - по-убывающей

С полем типа Character и именем Name, и полем типа Date и именем OrdDate:

Name + STR(OrdDate - {12/31/3099}, 10, 0)
Сортировка поля типа Character по-возрастающей и поля типа Numeric (или Float) по-убывающей

C полем типа Character и именем Company, и полем типа Numeric и именем Amount (поле Amount имеет длину 9 цифр с двумя цифрами после десятичной запятой):

Company + STR(Amount - 999999.99, 9, 2)
Сортировка логического поля

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

IIF(Paid, "A", "Z")
Два поля с типом Numeric (или Float)

Предположим, у нас имеется два поля типа Numeric с пятью и двумя десятичными разрядами, первое поле с именем Price, второе - Quantity:

STR(Price, 5, 2) + STR(Quantity, 5, 2)
Сортировка одного из двух полей в зависимости от выполнения логического условия

Сортировка имен месяцев в поле, имеющим тип Character

Предположим, поле содержит имена месяцев на английском языке ("Jan," "Feb" и т.д.), и его необходимо расположить в соответствующем порядке (имя поля M):

  IIF(M="Jan", 1, IIF(M="Feb", 2, IIF(M="Mar", 3, IIF(M="Apr", 4,
   IIF(M="May", 5, IIF(M="Jun", 6, IIF(M="Jul", 7, IIF(M="Aug", 8,
   IIF(M="Sep", 9, IIF(M="Oct", 10, IIF(M="Nov", 11, 12)))))))))))
 
(Вышеприведенный код - единственная строка кода, разбирая на несколько из-за ограничений ширины страницы.)

Сортировка по первой строке Memo-поля

Для Memo-поля с именем Notes:

MLINE(Notes, 1)
Сортировка по средним трем символам в девятисимвольном поле типа long

Для девятисимвольного поля типа long с именем StockNo:

SUBSTR(StockNo, 4, 3)
Создание индексных выражений dBASE в Database Desktop

В утилите Database Desktop, индексы могут создаваться как для новой таблицы (во время ее создания), так и для существующей, путем ее реструктуризации. В обоих случаях используется диалог "Define Index", использующийся для создания одного или более индексов таблицы.

Для вывода диалога создания индекса ("Create Index") во время создания новой таблицы, в диалоге создания dBASE таблицы ("Create dBASE Table") (показ структуры), выберите в списке "Table Properties" (свойства таблицы) пункт "Indexes" (индексы) и нажмите на кнопку "Define".

Чтобы вывести диалог создания индекса ("Create Index") при создании индекса для существующей таблицы, выберите Utilities|Restructure, выберите файл с таблицей в диалоге выбора файла ("Select File"), и в диалоге реструктуризации таблицы dBASE ("Restructure dBASE Table") (показ структуры таблицы) выберите в списке "Table Properties" (свойства таблицы) пункт "Indexes" (индексы) и нажмите на кнопку "Define".

Только в диалоге создания индекса ("Create Index"), выражения индекса могут создаваться щелчком на кнопке "Expression Index" (индеск выражения) и вводом выражения в поле редактирования "Expression Index". Для ассистирования данного процесса, вы можете дважды щелкнуть на имени поля с списке полей, после чего имя поля будет помещено в область редактирования "Index Expression" в текущей точке ввода (позиция курсора).

Как только нужное выражение составлено, нажмите кнопку OK. Введите имя нового индексного тэга в поле редактирования "Index Tag Name" (имя индексного тэга") в диалоге "Save Index As" (сохранить индекс как...) и нажмите "OK". (Помните, имена тэгов индексов dBASE не могут превышать десяти символов и должны соблюдать соглашения об именах dBASE.)

Создание индексных выражений dBASE в приложениях Delphi

dBASE-индексы могут создаваться программным путем в Delphi-приложениях как для новой таблицы (метод CreateTable компонента TTable), так и для существующей.

Для создания индекса как части новой таблицы, необходимо вызваться метод Add свойства IndexDefs компонента TTable. В нашем случае необходимо включить в набор флажков индекса флажок ixExpression. Данный флажок уникален для индексов таблиц dBASE, и может использоваться только с индексными выражениями dBASE. Для примера:


 with Table1 do
 begin
   Active := False;
   DatabaseName := 'Delphi_Demos';
   TableName := 'CustInfo';
   TableType := ttdBASE;
   with FieldDefs do
   begin
     Clear;
     Add('LastName', ftString, 30, False);
     Add('FirstName', ftString, 20, False);
   end;
   with IndexDefs do
   begin
     Clear;
     Add('FullName', 'LastName + FirstName', [ixExpression]);
   end;
   CreateTable;
 end;
 

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


 Table1.AddIndex('FullName', 'LastName + FirstName', [ixExpression]);
 

Изучение функций и синтаксиса dBASE

Для создания индексных выражений dBASE могут использоваться только функции и синтакс, относящиеся к обработке данных. Тем не менее, полный список и описание данных функций выходит за рамки данного совета. Для получения дополнительной информации о dBASE-функциях обработки данных, обратитесь к руководству "dBASE Language Reference" или книгам и справочникам по dBASE третьих фирм.




Формат и размер dBase-поля

Автор: Eryk Bottomley

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

Следующий код иллюстрирует необходимые вызовы BDE:


 procedure GetdBaseFieldTypes(t: TTable; var l: TStringList);
 var
   pF: pFLDDesc;
   cProps: CURProps;
   p: pFLDDesc;
   i: Byte;
   w: Word;
   s: string;
   oldmode: LongInt;
 begin
   Check(DbiGetCursorProps(t.Handle, cProps));
   Check(DbiGetProp(hDBIObj(t.Handle), curXLTMODE, oldmode, SizeOf(LongInt), w));
   Check(DbiSetProp(hDBIObj(t.Handle), curXLTMODE, LongInt(xltNONE)));
   try
     if MaxAvail < (cProps.iFields * SizeOf(FLDDesc)) then
       raise EOutofMemory.Create('Недостаточно памяти для процесса');
     GetMem(pF, (cProps.iFields * SizeOf(FLDDesc)));
     Check(DbiGetFieldDescs(t.Handle, pF));
     p := pF;
     for i := 1 to cProps.iFields do
     begin
       with p^ do
       begin
         s := IntToStr(iFldNum) + ' : ' + StrPas(szName) + ' : ';
         case iFldType of
           fldDBCHAR:
             begin { Char string, строка символов }
               s := s + 'CHARACTER(' + IntToStr(iUnits1) + ')';
             end;
           fldDBNUM:
             begin { Number, число }
               s := s + 'NUMBER(' + IntToStr(iUnits1) + ',' + InttoStr(iUnits2) +
                 ')';
             end;
           fldDBMEMO:
             begin { Memo (blob), МEMO-BLOB-поле }
               s := s + 'MEMO';
             end;
           fldDBBOOL:
             begin { Logical, лочическая величина }
               s := s + 'LOGICAL';
             end;
           fldDBDATE:
             begin { Date, поле даты }
               s := s + 'DATE';
             end;
           fldDBFLOAT:
             begin { Float, числа с плавающей точкой }
               s := s + 'FLOAT(' + IntToStr(iUnits1) + ',' + InttoStr(iUnits2) +
                 ')';
             end;
           fldDBLOCK:
             begin { Логический тип LOCKINFO }
               s := s + 'LOCKINFO';
             end;
           fldDBOLEBLOB:
             begin { OLE object (blob), OLE-объект, BLOB-поле }
               s := s + 'OLE';
             end;
           fldDBBINARY:
             begin { Binary data (blob), двоичные данные, BLOB-поле }
               s := s + 'BINARY';
             end;
         else
           s := s + 'НЕИЗВЕСТНО';
         end;
       end;
       l.Add(s);
       Inc(p);
     end;
   finally
     Check(DbiSetProp(hDBIObj(t.Handle), curXLTMODE, oldmode));
     FreeMem(pF, (cProps.iFields * SizeOf(FLDDesc)));
   end;
 end;
 




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

Таблицы dBASE применяют довольно статическую систему нумерации записей. Номер записи для данной записи (извините за тавтологию) отражает физическую позицию в табличном файле. Эти номера записей не изменяются вследствие фильтрации, упорядочивания данных или сортировки. К примеру, первая запись, хранящаяся в .DBF файле, будет иметь номер записи 1. Возможно, после некоторого упорядочивания индекса, запись будет последней из 100 записей. В этом случае запись должна оставаться с тем же номером, а не номером 100, отражающим новую позицию в сортированном наборе данных. Это противоречит таблицам Paradox, где соблюдается последовательная нумерация. Последовательная нумерация Paradox похожа на нумерацию записей dBASE, за исключением большей гибкости и отражению в номере записи ее текущей позиции в наборе данных. То есть, запись может не всегда иметь номер, установленный для нее фильтром набора данных, уменьшившим общее число записей, или при активном индексе, из-за чего может измениться отображаемый порядок записи.

В приложениях для работы с базами данных, созданных с помощью Delphi и Borland Database Engine (BDE), DB-компонентами не предусмотрено извлечение и определение записи таблицы dBASE. Такая операция, тем не менее, возможна с помощью вызова из вашего приложения функций BDE.

Существует несколько функций BDE, возвращающих информацию о текущей записи dBASE, например, ее номер. На самом деле, любая функция, заполняющая структуру BDE pRECProps, вполне достаточна. Например, функции BDE DbiGetRecord, DbiGetNextRecord и DbiGetPriorRecord. Естественно, только первая из них реально позволяет получить информацию о текущей записи. Две других перемещают при вводе указатель на запись, подобно методам Next и Prior компонентов TTable и TQuery.

Структура pRECProps состоит из следующих полей:

iSeqNum: тип LongInt; определяет текущий номер записи (относительно набора данных, включая фильтрацию и сортировку индекса); используется, если тип таблицы поддерживает последовательную нумерацию (только Paradox).

iPhyRecNum: тип LongInt; определяет номер записи; используется, если тип таблицы поддерживает физические номера записи (только dBASE).

bRecChanged: тип Boolean; в настоящее время не используется.

bSeqNumChanged: тип Boolean; в настоящее время не используется.

bDeleteFlag: тип Boolean; указывает на удаленную запись; используется, если тип таблицы поддерживает "мягкое" удаление (только dBASE).

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


 function RecNo(ATable: TTable): LongInt;
 var
   R: RECProps;
   rslt: DbiResult;
   Error: array[0..255] of Char;
 begin
   ATable.UpdateCursorPos;
   rslt := DbiGetRecord(ATable.Handle, dbiNoLock, nil, @R);
   if rslt = DBIERR_NONE then
     Result := R.iPhyRecNum
   else
   begin
     DbiGetErrorString(rslt, Error);
     ShowMessage(StrPas(Error));
     Result := -1;
   end;
 end;
 

Для вызова любой BDE-функции из приложения Delphi, модули-обертки BDE DbiTypes, DbiErrs и DbiProcs должны быть включены в секцию Uses модуля, из которого они будут вызываться (секция Uses здесь не показана). Для того, чтобы сделать функции более транспортабельными, они не имеют прямой ссылки на компонент TTable, но указатель на TTable передается как параметр. Если эта функция используется в модуле, который не ссылается на модули Delphi DB и DBTables, они должны быть добавлены, иначе ссылки на компонент TTable будут недействительными.

Метод TTable UpdateCursorPos вызывается для гарантии синхронизации номера текущей записи в компоненте TTable и связанной с ним таблицы.

В случае ошибок BDE функций, исключительная ситуация ими не генерируется. Вместо этого они возвращают значение BDE-типа DbiResult, указывающее на успешное завершение или ошибку операции. Возвращаемое значение должно быть получено и обработано внешним приложением, с выполнением соответствующих действий. Любой результат, кроме DBIERR_NONE, указывает на неудачное выполнение функции. В этом случае может быть осуществлено дополнительное действие (как в примере выше), где с помощью BDE функции DbiGetErrorString код ошибки переводится в удобночитаемое сообщение. В этом примере возвращаемое в DbiGetRecord значение сохраняется в переменной rslt, а затем для определения успешности вызова функции сравнивается с DBIERR_NONE.

Если вызов DbiGetRecord был успешным, физический номер записи из поля iPhyRecNum структуры pRECProps сохраняется в переменной Result, которая является возвращаемой функцией величиной. Чтобы указать на то, что функция потерпела неудачу (т.е., вызов фунции DbiGetRecord окончился неудачно), вместо номера записи возвращается отрицательная величина. Значение ее может быть произвольным (отрицательная величина совместимого типа) и отдается на усмотрение программисту.




Восстановление записи dBase

Автор: Loren Scott

После удаления записи из таблицы (dBase), возможно ли ее восстановить? Какие идеи?


 function GetTableCursor(oTable: TTable): hDBICur;
 var
   szTable: array[0..78] of Char;
 begin
   StrPCopy(szTable, oTable.TableName);
   DbiGetCursorForTable(oTable.DBHandle, szTable, nil, Result);
 end;
 
 function dbRecall(oTable: TTable): DBIResult;
 begin
   Result := DbiUndeleteRecord(GetTableCursor(oTable)));
 end;
 

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

Предположим, у вас на форме имеется кнопка (с именем 'butRecall'), восстанавливающая текущую отображаемую (или позиционируемую курсором) запись, данный код, будучи расположенный в обработчике события кнопки OnClick (вместе с опубликованным выше кодом), это демонстрирует (продвигаясь в наших предположених дальше, имя вашего объекта TTable - Table1 и имя текущей формы - Form1):


 procedure TForm1.butRecallClick(Sender : TObject);
 begin
   if dbRecall( Table1 ) <> DBIERR_NONE then
     ShowMessage( 'Не могу восстановить запись!' );
 end;
 




Различные цвета строк в DBCtrlGrid

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

Используйте событие drawColumnCell. И не забудьте выставить defautlDrawing в False


 procedure TMain.ProjectGridDrawColumnCell(Sender: TObject;
   const Rect: TRect; DataCol: Integer; Column: TColumn;
   State: TGridDrawState);
 begin
   projectGrid.canvas.brush.color := clWindow;
   projectGrid.canvas.fillRect(rect);
   if gdSelected in state then
   begin
     projectGrid.canvas.brush.color := clHighlight;
     if fsBold in projectGrid.canvas.font.style then
     begin
       projectGrid.canvas.font.color := clHighlightText;
       projectGrid.canvas.font.style := [fsBold];
     end
     else
       projectGrid.canvas.font.color := clHighlightText;
   end
   else if gdFocused in state then
   begin
     projectGrid.canvas.brush.color := clWindow;
     if fsBold in projectGrid.canvas.font.style then
     begin
       projectGrid.canvas.font.color := clWindowText;
       projectGrid.canvas.font.style := [fsBold];
     end
     else
       projectGrid.canvas.font.color := clWindowText;
   end
   else if gdFixed in state then
   begin
     projectGrid.canvas.brush.color := clHighlight;
     if fsBold in projectGrid.canvas.font.style then
     begin
       projectGrid.canvas.font.color := clHighlightText;
       projectGrid.canvas.font.style := [fsBold];
     end
     else
       projectGrid.canvas.font.color := clHighlightText;
   end;
   with globalDataModule.qProjects do
   begin
     // тестовая запись. Устанавливаем свойства для перекрытия заданных по умолчанию;
     if fieldByName('EST_COMPL_DATE').asDateTime < date then
       projectgrid.Canvas.font.color := clRed;
     if compareStr(fieldByName('STAT_CODE').asString, 'HD') = 0 then
       projectgrid.Canvas.font.color := clOlive;
     if (compareStr(fieldByName('CHANGED').asString, 'Y') = 0) and
       (fieldByName('ASSIGN_EMP_ID').asInteger = userRecord.UserId) then
       projectgrid.Canvas.font.style := [fsBold];
   end;
   projectGrid.canvas.textOut(rect.left + 2, rect.top + 2, column.field.text);
 end;
 




Insert и Override с помощью DBEdit

Автор: Denis Sarrazin

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

Сама Windows не позволяет это сделать, но я нашел как это обойти с помощью одной хитрости, и, похоже, это классно работает (надеюсь вы получите даже больше, чем вы хотите :).

Сначала я добавляю к моей форме свойство (и соответствующие переменные и процедуры), наподобие этому:


 private
 FinsertMode: boolean;
 procedure SetInsertMode(value: boolean);
 public
 property insertMode: boolean read FinsertMode write SetInsertMode;
 

В обработчике создания события формы я инициализирую его:


 procedure TForm1.FormCreate(Sender: TObject);
 begin
 {инициализация}
 insertMode := True;
 end;
 

Также для этого свойства я создаю процедуру SetInsertMode, которая с помощью TPanel с именем Panel1 извещает пользователя о текущем режиме работы:


 procedure TForm1.SetInsertMode(value: boolean);
 begin
 FinsertMode := value;
 if FinsertMode then
 Panel1.Caption := 'ВСТАВКА'
 else
 Panel1.Caption := 'ПЕРЕЗАПИСЬ';
 end;
 

Затем я добавляю три обработчика событий (OnKeyDown, OnKeyPress, OnEnter) для каждого моего DBEdit (можно при наличии нескольких компонентов создать один общий обработчик для всех):


 procedure TForm1.DBEditKeyDown(Sender: TObject; var Key: Word; Shift:
   TShiftState);
 begin
   if (Key = VK_INSERT) then
     insertMode := not insertMode;
 end;
 
 procedure TForm1.DBEditKeyPress(Sender: TObject; var Key: Char);
 begin
   if (not insertMode) and (Sender is TDBEdit) then
     (Sender as TDBEdit).SelLength := 1
   else
     (Sender as TDBEdit).SelLength := 0;
 end;
 
 procedure TForm1.DBEditEnter(Sender: TObject);
 begin
   insertMode := True;
 end;
 

Банзай! Похоже это работает, хотя я и не имел достаточного времени протестировать это. Естественно, вы можете изменить это по просьбе вашего заказчика (например, я всегда сбрасывал режим во вставку при перемещении к другому компоненту DBEedit). Все вышесказанное должно также работать без проблем и с компонентами Edit.




Исправление DBEdit MaxLength

Автор: Reinhard Kalinke

Аксиомы:
1. Купи Pentium IV и увидишь, что REBOOT там намного быстрее.
2. У программ нет глюков. Они просто содержат неизвестные тебе функции.
3. Лучший метод сжатия файлов: DEL *.* - 100% сжатие.
4. Пентиум III - это такая новая модель процессоров, делающая ошибки в 10 раз быстрее.
5. Секрет Windows: Запусти на Пентиуме эмулятор PC XT.
6. Компьютер - это устройство, созданное для скоростного создания и автоматизации ошибок.
7. E-mail, возвращенный отправителю, означает несоответствие напряжений в Сети.
8. Компьютеры делают очень быстро и аккуратно стандартные ошибки.

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

По-моему, это является следствием этого кода в TDBEdit.DataChange (DBCTRLS.PAS):


 if FDataLink.Field <> nil then
 begin
 ...
   if FDataLink.Field.DataType = ftString then
     MaxLength := FDataLink.Field.Size
   else
     MaxLength := 0;
   ...
   end else
   begin
   ...
     MaxLength := 0;
   ...
 end;
 

т.к. иногда значение устанавливается на ноль...

Похоже все будет работать, если вы измените строку


 MaxLength := 0;
 

на


 MaxLength := inherited MaxLength;
 

Для того, чтобы изменения вступили в силу, вам необходимо перекомпилировать ваш complib с измененным DBCTRLS.PAS, находящимся в пути lib.

Если вы хотите использовать MaxLength с StringField, изменений необходимо сделать немного больше:


 ...
 if (FDataLink.Field.DataType = ftString)
   and (inherited MaxLength = 0) then
     MaxLength := FDataLink.Field.Size
   else
     MaxLength := inherited MaxLength;
 ...
 

Или использовать что-то типа EditMask...




Особенности использования BLOB полей в dbExpress на примере MySQL

Автор: Андрей Пащенко
Специально для Королевства Delphi

Использовать новые компоненты dbExpress удобно. Однако прилагательное «новые» приносит не только радость… Решение возникающих проблем бывает затягивается на долгие часы и дни. На помощь Internet увы надеяться не приходится, т.к. информации по dbExpress там ни так много. Одна из этих проблем – работа с BLOB полями. Использовать нативный SQL для работы с BLOB не всегда возможно, поэтому нужно применять другие, альтернативные способы.

Для работы с BLOB полями в Delphi имеется несколько классов:

  • TBlobStream;
  • TClientBlobStream;
  • TBlobField;
  • TGraphicField;
  • TMemoField;

Также сюда можно отнести функцию TCustomClientDataSet.CreateBlobStream, но она реализована посредством класса TClientBlobStream. Классы TGraphicField и TMemoField являются производными от TBlobField. TBlobStream не подходит для работы с dbExpress, а применяется только при манипулировании данным через BDE.

Таким образом для работы с BLOB-полями через dbExpress остаются два ключевых класса: TBlobField и TClientBlobStream. Следовательно возможно два, принципиально различных, варианта доступа к BLOB-полям: через потоки и через свойства объекта. Как указано в справочной системе при работе с BLOB-полями вообще и dbExpress в частности достаточно удобными оказываются переменные типа String.

Действительно, максимальный размер данных хранимых в переменных данного типа составляет 2 Гб, что равняется максимальному размеру BLOB-поля в MySQL (3.23.47). Строки достаточно удобны для работы с потоками, а также существует достаточно много функций для работы с ними. Проблем при работе с BLOB-полями также существует две: чтение данных и их запись. Рассмотрим каждый из возможных вариантов.

Проблема №1. Чтение данных из BLOB-поля

Для работы с BLOB-полями необходимо присвоить свойству TCustomClientDataSet.FetchOnDemand значение True, а также необходимо внимательно изучить свойство Options параметр poFetchBlobsOnDemand. Данные настройки нужны для того, чтобы получать данные из BLOB-поля в клиентское приложение. Загрузить данные можно используя метод FetchBlobs.

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


 {описание типов переменных}
 qrProba: TSQLClientDataSet; {поле BLOBF – является BLOB-полем}
 Image: TImage;
 Stream: TStream;
 Memo: TMemo;
 {--------------------------------------}
 begin
   {делаем нужную запись активной, например, методом Locate.}
   Stream := qrProba.CreateBlobStream(qrProba.FieldByName('BlobF'), bmRead);
   try
     Image.Picture.Bitmap.LoadFromStream(Stream); {если это картинка}
     {Memo.Lines.LoadFromStream(Stream); - если это текст}
   finally
     Stream.Free;
   end;
 end;
 

Использование свойства TDataSet.FieldValues


 {описание типов переменных}
 qrProba: TSQLClientDataSet; {поле BLOBF – является BLOB-полем}
 Image: TImage;
 Stream: TStream;
 Memo: TMemo;
 {----------------------------------}
 begin
   {делаем нужную запись активной, например, методом Locate.}
   Memo.Lines.Text := qrProba['BLOBF'];
 end;
 

Использование свойства TBlobField.Value


 {описание типов переменных}
 Memo: TMemo;
 BLOBField: TBlobField;
 {----------------------------------}
 begin
   {делаем нужную запись активной, например, методом Locate.}
   Memo.Lines.Text := BlobField.Value; { можно так}
   Memo.Lines.Text := BlobField.AsString; { а можно и так}
   Memo.Lines.Text := BlobField.AsVariant;   { это третий способ}
 end;
 

Проблема №2. Запись данных в BLOB-поле.

При записи данных в BLOB-поле необходимо учитывать, что для внесения изменений одного метода Post недостаточно. Для пересылки данных в таблицу после метода Post необходимо вызывать метод TCustomClientDataSet.ApplyUpdates. Вместе с данным методом полезно использовать свойство TCustomClientDataSet.ChangeCount, которое содержит количество изменений внесенных пользователем. В справочной системе Delphi содержится пример как совместно использовать это свойство и метод ApplyUpdates.

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

Перед созданием потока необходимо обязательно вызывать метод FetchBlobs для загрузки данных из BLOB-поля, иначе возникает ошибка. При работе с полем используя поток, необходимо следовать правилу:

Одна запись – один поток.

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


 { описание типов переменных}
 qrProba: TSQLClientDataSet; {поле BLOBF – является BLOB-полем}
 Image: TImage;
 Stream: TClientBlobStream;
 Memo: TMemo;
 {--------------------------------------}
 begin
   {делаем нужную запись активной, например, методом Locate.}
   qrProba.Edit;
   qrProba.FetchBlobs;
   Stream := TClientBlobStream.Create(TBlobField(qrProba.FieldByName('BlobF')),
     bmReadWrite);
   Stream.Position := 0;
   Stream.Clear;
   Image.Picture.Bitmap.SaveToStream(Stream);
   qrProba.Post;
   qrProba.ApplyUpdates(0);
   Stream.Free;
 end;
 

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


 BLOBField: TBlobField;
 Stream1: TMemoryStream;
 d: Char;
 i: Integer;
 s: string;
 {------------------}
 begin
   Stream1 := TMemoryStream.Create;
   Stream.Clear;
   Image.Picture.Bitmap.SaveToStream(Stream1);
   Stream1.Position := 0;
   for i := 1 to Stream1.Size do
   begin
     Stream1.Read(d, 1);
     s := s + d;
   end;
   BlobField.DataSet.Edit;
   BlobField.AsString := s;
   BlobField.DataSet.Post;
   TSQLClientDataSet(BlobField.DataSet).ApplyUpdates(0);
   Stream1.Free;
 end;
 

Использование свойства TDataSet.FieldValues


 {описание типов переменных}
 qrProba: TSQLClientDataSet; {поле BLOBF – является BLOB-полем}
 Image: TImage;
 Stream: TStream;
 Memo: TMemo;
 {----------------------------------}
 begin
   {делаем нужную запись активной, например, методом Locate.}
   qrProba.Edit;
   qrProba['BLOBF'] := Memo.Lines.Text;
   qrProba.Post;
   qrProba.ApplyUpdates(0);
 end;
 

Использование свойства TBlobField.Value


 {описание типов переменных}
 Memo: TMemo;
 BLOBField: TBlobField;
 {----------------------------------}
 begin
   {делаем нужную запись активной, например, методом Locate.}
   BlobDield.DataSet.Edit;
   BlobField.Value := Memo.Lines.Text;
   BlobField.DataSet.Post;
   TSQLClientDataSet(BlobField.DataSet).ApplyUpdates(0);
 end;
 

Вместо заключения

«И зачем все это!?», – спросит внимательный читатель, – «Ведь в начале статьи написано, что данные BLOB-поля неплохо представляются в виде String. Почему просто не записать SQL запрос UPDATE mytable SET blobf=’s’ WHERE id=1, где s – строковая переменная, которая может содержать, какие угодно данные?». Действительно, в определенных ситуациях такое решение пригодно, но предположим, что в данной переменной содержится символ { ? } , тогда сервер посчитает ее концом присваемого значения и возникнет ошибка. При использовании вышеописанных способов такого не происходит. Конечно, для исключения подобных ситуаций можно проводить предварительную обработку переменной для замены «запрещенных» символов на другие, но это дополнительная работа. В любом случае, главное: «ВОЗМОЖНОСТЬ ВЫБОРА. Выбора решения поставленной задачи».




Создание DBExpress-Connection в Run-Time


 procedure TVCLScanner.PostUser(const Email, FirstName, LastName: WideString);
 var
   Connection: TSQLConnection;
   DataSet: TSQLDataSet;
 begin
   Connection := TSQLConnection.Create(nil);
   with Connection do
   begin
     ConnectionName := 'VCLScanner';
     DriverName := 'INTERBASE';
     LibraryName := 'dbexpint.dll';
     VendorLib := 'GDS32.DLL';
     GetDriverFunc := 'getSQLDriverINTERBASE';
     Params.Add('User_Name=SYSDBA');
     Params.Add('Password=masterkey');
     Params.Add('Database=milo2:D:\frank\webservices\umlbank.gdb');
     LoginPrompt := False;
     Open;
   end;
   DataSet := TSQLDataSet.Create(nil);
   with DataSet do
   begin
     SQLConnection := Connection;
     CommandText := Format('INSERT INTO kings VALUES("%s","%s","%s")',
       [Email, FirstN, LastN]);
     try
       ExecSQL;
     except
     end;
   end;
   Connection.Close;
   DataSet.Free;
   Connection.Free;
 end;
 




DBFSeek и DBFLocate

Автор: Tom

Надежней и намного быстрее (если вы ищите отдельные записи) выполнить поиск строки с помощью Seek (если найдена первая запись), или выполнить Locate (индекс не требуется)

например


 Table1.UpdateCursorPos;
 if DBFSeek( Table1, xVal1 ) then {_не_ delphi-функция - смотри ниже}
 begin
   if DBFLocate( Table1, 'CUSTNAME', xVal2  ) then {_не_ delphi-функция - модификация из faq}
   begin
     //... делаем все, что необходимо
   end;
 end;
 

P.S.

  1. DBFLocate - модифицированная из faq фунция fieldname
  2. DBFSeek - функция, найденная методом проб и ошибок! - значительно лучшая (IMHO) чем setkey...fieldbyname1...fieldbyname2...gotokey, используемые для выражений индексов dBase за первым полем. Вы можете использовать FindKey для dBase индексов, состоящих из одного поля, вопреки мнению других участников форума.

 {============================================================
 { DBFSeek
 { поиск величины с использованием индекса - простой путь
 {============================================================}
 
 function DBFSeek(const Table1: TTable; const sValue: string): boolean;
 var
 
   sExpValue: DBIKEYEXP;
   bmPos: TBookMark;
   nOrder: integer;
 
 begin
 
   Result := False;
 
   with Table1 do
   begin
     if (Active) and (Length(IndexName) > 0) then
     begin
       bmPos := GetBookMark;
       DisableControls;
 
       StrPCopy(sExpValue, sValue);
       if (DbiGetRecordForKey(Handle, True, 0, strlen(sExpValue), @sExpValue, nil)
         = DBIERR_NONE) then
         Result := True
       else
         GotoBookMark(bmPos);
 
       FreeBookMark(bmPos);
       EnableControls;
     end;
   end;
 end;
 
 {==================================================================================
 { DBFLocate
 { поиск величины, не связанный с ключевым полем
 { замена из faq, теперь акцептует fieldname, величина может быть частичной
 {================================================================================}
 
 function DBFLocate(const Table1: TTable; const sFld, sValue: string): boolean;
 var
 
   bmPos: TBookMark;
   bFound: boolean;
   len: integer;
 begin
 
   Result := False;
   if (not StrEmpty(sValue)) and (not StrEmpty(sFld)) then
   begin
     with Table1 do
     begin
       DisableControls;
       bFound := False;
       bmPos := GetBookMark;
       len := Length(sValue);
       First;
 
       while not EOF do
       begin
         if FieldByName(sFld).AsString <> sValue then
           Next
         else
         begin
           Result := True;
           bFound := True;
           Break;
         end;
       end;
 
       if (not bFound) then
         GotoBookMark(bmPos);
 
       FreeBookMark(bmPos);
       EnableControls;
     end;
   end;
 end;
 




Индекс в другом каталоге

Автор: Serg

Подскажите как работать c dbf под Delphi, когда индексы расположены в другом каталоге?


 Vnhead_Cdx := TStringList.Create;
 Vnhead_Cdx.Add('c:\parus\bumi1\idx\vnhead.cdx');
 Vnhead.IndexFiles := Vnhead_Cdx;
 // при это сам dbf находится в c:\parus\bumi1\dbf
 




Как перекинуть все данные из DBF в DB

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




DBGrid и Memo-поля

Если ваш холодильник управляется системой windows95/98, то вам следует быть внимательным:
1)Установка и удаление новых продуктов не всегда происходит корректно, для безопасности следует отформатировать морозилку перед инсталяцией ещё не замороженных продуктов!
2)Несанкционированный доступ ваших соседей к вашему холодильнику может быть пресечён установкой пароля. В случае, если вы забыли пароль рекомендуется вызвать слесаря-сантехника для удаленного доступа через заднюю стенку аппарата...
3)Вообще, причин, по которым вы не сможете насладиться вкусом ваших продуктов очень много! (Заметьте, холодильних WinFroze позволяет наслаждаться ВИДОМ продукта в любое время, имея прозрачную дверцу).

В обработчик события GetText TMemoField поместите следующую строку:


 Text := GrabMemoAsString(TMemoField(Sender));
 

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


 function GrabMemoAsString(TheField: TMemoField): string;
 begin
   if TheField.IsNull then
     Result := ''
   else
     with TBlobStream.Create(TheField, bmRead) do
     begin
       if Size >= 255 then
       begin
         Read(Result[1], 255);
         Result[0] := #255;
       end
       else
       begin
         Read(Result[1], Size);
         Result[0] := Chr(Size);
       end;
       Free;
       while Pos(#10, Result) > 0 do
         Result[Pos(#10, Result)] := ' ';
       while Pos(#13, Result) > 0 do
         Result[Pos(#13, Result)] := ' ';
     end;
 end;
 




Шапка в TDBGrid

Автор: Andre

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

Уже реализовано в виде вот этого компонента


 unit bdbgrid;
 
 interface
 
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
     Grids, DBGrids, Math;
 
 type
   TOnDrawTitleEvent = procedure(ACol: integer; ARect: TRect; var TitleText:
     string) of object;
 
   TBitDBGrid = class(TDBGrid)
   private
     FBitmapBrowse: TBitmap;
     FBitmapEdit: TBitmap;
     FBitmapInsert: TBitmap;
     FBitmapFill: TBitmap;
     FRealTitleFont: TFont;
     FOnDrawTitle: TOnDrawTitleEvent;
     FResizeFlag: boolean;
     { Private declarations }
     procedure SetRealTitleFont(Value: TFont);
     procedure UpdateTitlesHeight;
   protected
     procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState:
       TGridDrawState); override;
     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
       override;
     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
       override;
     { Protected declarations }
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     { Public declarations }
   published
     property OnDrawTitle: TOnDrawTitleEvent read FOnDrawTitle write
       FOnDrawTitle;
     property RealTitleFont: TFont read FRealTitleFont write SetRealTitleFont;
     { Published declarations }
   end;
 
 procedure Register;
 
 implementation
 
 var
   DrawBitmap: TBitmap;
 
 function Max(X, Y: Integer): Integer;
 begin
   Result := Y;
   if X > Y then
     Result := X;
 end;
 
 procedure WriteText(ACanvas: TCanvas; ARect: TRect; DX, DY: Integer; const Text:
   string; Alignment: TAlignment);
 // © Borland function :)
 const
   AlignFlags: array[TAlignment] of Integer =
   (DT_LEFT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
     DT_RIGHT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
     DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX);
 var
   B, R: TRect;
   I, Left: Integer;
 begin
   with DrawBitmap, ARect do { Use offscreen bitmap to eliminate flicker and }
   begin { brush origin tics in painting / scrolling. }
     Width := Max(Width, Right - Left);
     Height := Max(Height, Bottom - Top);
     R := Rect(DX, DY, Right - Left - 1, Bottom - Top - 1);
     B := Rect(0, 0, Right - Left, Bottom - Top);
   end;
   with DrawBitmap.Canvas do
   begin
     DrawBitmap.Canvas.CopyRect(B, ACanvas, ARect);
     Font := ACanvas.Font;
     Font.Color := ACanvas.Font.Color;
     Brush := ACanvas.Brush;
     SetBkMode(Handle, TRANSPARENT);
     DrawText(Handle, PChar(Text), Length(Text), R,
       AlignFlags[Alignment]);
   end;
   ACanvas.CopyRect(ARect, DrawBitmap.Canvas, B);
 end;
 
 constructor TBitDBGrid.Create(AOwner: TComponent);
 begin
   inherited Create(Aowner);
   FRealTitleFont := TFont.Create;
   FResizeFlag := false;
 end;
 
 destructor TBitDBGrid.Destroy;
 begin
   FRealTitleFont.Free;
   inherited Destroy;
 end;
 
 procedure TBitDBGrid.UpdateTitlesHeight;
 var
   Loop: integer;
   MaxTextHeight: integer;
   RRect: TRect;
 begin
   MaxTextHeight := 0;
   for loop := 0 to Columns.Count - 1 do
   begin
     RRect := CellRect(0, 0);
     RRect.Right := Columns[Loop].Width;
     RRect.Left := 0;
     Canvas.Font := RealTitleFont;
     MaxTextHeight := Max(MaxTextHeight, DrawText(Canvas.Handle,
       PChar(Columns[Loop].Title.Caption),
       Length(Columns[Loop].Title.Caption), RRect,
       DT_CALCRECT + DT_WORDBREAK)
       );
   end;
   if TitleFont.Height <> -MaxTextHeight then
     TitleFont.Height := -MaxTextHeight;
 end;
 
 procedure TBitDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y:
   Integer);
 begin
   if MouseCoord(X, Y).Y = 0 then
     FResizeFlag := true;
   inherited MouseDown(Button, Shift, X, Y);
 end;
 
 procedure TBitDBGrid.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y:
   Integer);
 begin
   inherited MouseUp(Button, Shift, X, Y);
   if FResizeFlag then
   begin
     FResizeFlag := false;
     UpdateTitlesHeight;
   end;
 end;
 
 procedure TBitDBGrid.DrawCell(ACol, ARow: Longint; ARect: TRect; AState:
   TGridDrawState);
 var
   Indicator: TBitmap;
   TitleText: string;
   Al: TAlignment;
 begin
   if not ((gdFixed in AState) and ((ARow = 0) and (dgTitles in Options) and (ACol
     <> 0))) then
     inherited DrawCell(ACol, ARow, ARect, AState)
   else
   begin
     if DefaultDrawing then
     begin
       DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_BOTTOMLEFT);
       DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_TOPRIGHT);
       InflateRect(ARect, -1, -1);
       Canvas.Brush.Color := FixedColor;
       Canvas.FillRect(ARect);
     end;
     TitleText := Columns[ACol - 1].Title.Caption;
     if Assigned(OnDrawTitle) then
       OnDrawTitle(ACol, ARect, TitleText);
     if DefaultDrawing and (TitleText <> '') then
     begin
       Canvas.Brush.Style := bsClear;
       Canvas.Font := RealTitleFont;
       if ACol > 0 then
         Al := Columns[ACol - 1].Title.Alignment
       else
         Al := Columns[0].Title.DefaultAlignment;
       WriteText(Canvas, ARect, 2, 2, TitleText, Al);
     end;
   end;
 end;
 
 procedure TBitDBGrid.SetRealTitleFont(Value: TFont);
 begin
   FRealTitleFont.Assign(Value);
   Repaint;
 end;
 
 procedure Register;
 begin
   RegisterComponents('Andre VCL', [TBitDBGrid]);
 end;
 
 initialization
   DrawBitmap := TBitmap.Create;
 
 finalization
   DrawBitmap.Free;
 
 end.
 




Позиция ячейки в TDBGrid

В 8 классе я впервые сконектился с девушкой на 9600бод. В 11 классе я сконектился с девушкой стандарта V90-60-90 на 56700, но стоило мне это 200 долларов за ночной анлимитед. На 2 курсе института я решил завести себе выделенную девушку. На 3 курсе я узнал от друзей, что пропускная способность моей девушки 2Мб/с, и к ней подключен не только я. На 5 курсе я хакнул многих девушек нашего курса. На 6-ом меня поймали два грузина, после этого я стал сисопом. После того как я стал сисопом, я попал на зону, где меня сделали администратором и меня хакали все кому не лень. После этого я не смог конектиться с девушкой даже на 2400. В 30 лет я пристрастился к ИЕ4, через него поймал win95CIH и нашел успокоение 26 апреля 1999г.

В TCustomGrid определен метод CellRect, который, к сожалению, защищен. Это означает, что даный метод доступен только для TCustomGrid и его наследников. Но все-таки существует немного мудреное решение вызова данного метода:


 type
   TMyDBGrid = class(TDBGrid)
     public
       function CellRect(ACol, ARow: Longint): TRect;
   end;
 
 function TMyDBGrid.CellRect(ACol, ARow: Longint): TRect;
 begin
   Result := inherited CellRect(ACol, ARow);
 end;
 

Вы можете сделать приведение типа вашего DBGrid к TMyDBGrid (это возможно, поскольку CellRect статический метод) и вызвать CellRect:


 Rectangle := TMyDBGrid(SomeDBGrid).CellRect(SomeColumn, SomeRow);
 
 procedure TfmLoadIn.DBGrid1DrawColumnCell(Sender: TObject;
   const Rect: TRect; DataCol: Integer; Column: TColumn;
   State: TGridDrawState);
 const
   Disp = 2; //Правильно выравниваем компонент
 begin
   inherited;
   if (gdFocused in State) then
   begin
     if (Column.FieldName = 'TYPEDescription') then
     begin
       dlTYPEDescription.Left := Rect.Left + DBGrid1.Left + Disp;
       dlTYPEDescription.Top := Rect.Top + DBGrid1.top + Disp;
       dlTYPEDescription.Width := Rect.Right - Rect.Left;
       dlTYPEDescription.Height := Rect.Bottom - Rect.Top;
       dlTYPEDescription.Visible := True;
     end;
   end;
 end;
 




Как сделать, чтобы необходимая ячейка DBGrid получила фокус ввода

Автор: MsGuns

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

Для установки в ПОЛЕ, связанное с гридом, используется метод TField.FocusControl




DBGrid с цветными ячейками

Один кибернетик создал машину для предсказания будущего. Задал ей простой вопрос:
- Что я буду делать через час?
Машина работала трое суток и выдала:
- Будешь сидеть у монитора и ждать моего ответа.

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

Я создал форму, поместил на ней компонент TTable и указал ему на таблицу EMPLOYEE.DB в базе данных DBDEMOS. Затем я разместил на форме Datasource и DBGrid, "соединил" их и получил живые данные.

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

Единственный код расположился в обработчике события OnDrawColumnCell компонента DBGrid и выглядел он так:


 procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect:
   TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
 var
   holdColor: TColor;
 begin
   holdColor := DBGrid1.Canvas.Brush.Color; {сохраняем оригинальный цвет}
   {"раскрашиваем" ячейки только для поля EmpNo}
   if Column.FieldName = 'EmpNo' then
     if (Column.Field.AsInteger mod 2 <> 0) then
     begin
       DBGrid1.Canvas.Brush.Color := clGreen;
       DBGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, State);
       DBGrid1.Canvas.Brush.Color := holdColor;
     end;
 end;
 

В данном случае мы использовали метод DefaultDrawColumnCell компонента TCustomDBGrid, являющегося родителем для TDBGrid. Он раскрасил зеленым цветом нечетные ячейки поля EmpNo.




DBGrid с цветными ячейками 2

- А чё UNIX, чё UNIX? - возмущался Вывоуз, - Малыш Билли ещё на Васике лопал, когда она уже была. Старушенция дряхлая!
- Ты бабушку не трогай! - серьёзно обиделся товарищ Команд ком, - Она тебе, глюкало переросток, ещё фору даст!!! - но, подумав, товарищ Ком помрачнел и добавил:
- Вот только какого демона она на мою территрию лезет!
И сплюнул:
- Оболочка дешевая.

Есть ли какой-либо способ придать ячейке DBGrid другой цвет? Мне хотелось бы выделить отдельные ячейки строки по определенному признаку. Типа флага, который, если если счет просрочен свыше 90 дней, делает строчку красной. Буду благодарен за любую помощь.

Обработайте событие OnDrawDataCell. Вот пример, который использует демонстрационную таблицу COUNTRY и рисует текст красным цветом во всех строках, содержащих страны с населением свыше 10 миллионов человек:


 begin
   if Table1.FieldByName('Population').AsFloat < 10000000 then
     DBGrid1.Canvas.Font.Color := clRed;
   dbGrid1.DefaultDrawDataCell(Rect,Field,State);
 end;
 




DBGrid с цветными ячейками 3

Автор: Neil Rubenking

Hа боpту самолета:
- Здpавствуйте, дамы и господа, - говоpит командиp экипажа. - Мы благодаpим вас за то, что вы выбpали нашу авиакомпанию для пеpвого полета в пеpвый день нового 2000 года. Мы находимся на высоте 3 тыс. футов, наша скоpость... вау!... ох, блин!... вот фак!... Извините за неудобства, котоpые вы испытываете, находясь вниз головой, надеюсь, все были пpистегнуты. Есть ли сpеди пассажиpов на боpту пpогpаммист?

C цветом ячейки DBGrid не так все просто, ведь в Delphi 1.0 разукрасить ячейку можно в обработчике события OnDrawDataCell, тогда как в Delphi 2.0 вам придется прибегнуть к событию OnDrawColumnCell. Для того чтобы создать код, который бы работал в ОБОИХ версих Delphi, вам необходимо прибегнуть к механизму условной компиляции, с помощью которого вы можете СКРЫТЬ обработчик OnDrawColumnCell в Delphi 1.0 и ВКЛЮЧИТЬ его в Delphi 2.0. Вот пример, в котором все ячейки строки рисуются красным, если колонка 'Preferred' содержит 'True':


 ...
 private
 { Private declarations }
 {$IFDEF Win32}
 
 procedure DBGrid1DrawColumnCell(Sender: TObject;
   const Rect: TRect; DataCol: Integer; Column: TColumn;
   State: TGridDrawState);
 {$ENDIF}
   procedure DrawField(const Value: string; const Rect: TRect;
     vCanvas: TCanvas; vFont: TFont; vAlignment: TAlignment);
     ...
       procedure TForm1.DrawField(const Value: string; const Rect: TRect;
       vCanvas: TCanvas; vFont: TFont; vAlignment: TAlignment);
     var
       X: Integer;
     begin
       vCanvas.Font := vFont;
       vCanvas.Font.Color := clRed;
       vCanvas.Font.Style := vCanvas.Font.Style + [fsUnderline];
       case vAlignment of
         taRightJustify:
           begin
             SetTextAlign(vCanvas.Handle, TA_RIGHT);
             X := Rect.Right - 2;
           end;
         taLeftJustify:
           begin
             SetTextAlign(vCanvas.Handle, TA_LEFT);
             X := Rect.Left + 2;
           end;
         taCenter:
           begin
             SetTextAlign(vCanvas.Handle, TA_CENTER);
             X := (Rect.Right + Rect.Left) div 2;
           end;
       end;
       vCanvas.TextRect(Rect, X, Rect.Top + 2, Value);
       SetTextAlign(vCanvas.Handle, TA_LEFT);
     end;
 
     procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect:
       TRect; Field: TField; State: TGridDrawState);
     begin
       with Sender as TDBGrid, DataSource.DataSet do
       begin
         if FieldByName('Preferred').AsString <> 'True' then
           Exit;
         DrawField(Field.DisplayText, Rect, Canvas, Canvas.Font,
           Field.Alignment);
       end;
     end;
 
   {$IFDEF Win32}
     procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject;
       const Rect: TRect; DataCol: Integer; Column: TColumn;
       State: TGridDrawState);
     begin
       with Sender as TDBGrid, DataSource.DataSet do
       begin
         if FieldByName('Preferred').AsString <> 'True' then
           Exit;
         DrawField(Column.Field.DisplayText, Rect, Canvas,
           Column.Font, Column.Alignment);
       end;
     end;
   {$ENDIF}
 
     procedure TForm1.FormCreate(Sender: TObject);
     begin
   {$IFDEF Win32}
       DBGrid1.OnDrawDataCell := nil;
       DBGrid1.OnDrawColumnCell := DBGrid1DrawColumnCell;
   {$ENDIF}
     end;
 
 




Как заставить DBGrid сортировать данные по щелчку на заголовке столбца

Автор: Nomadic

Песня о зависшем Windows: Кликну, а в ответ - тишина.

Кyсочек кода, чтобы повесить на clickable столбец RxGrid, показывающий RxQuery с опpеделенным макpосом %Order. Работать не бyдет (без модyлей), но в качестве идеи может быть полезен.


 unit vgRXutil;
 
 interface
 
 uses
   SysUtils, Classes, DB, DBTables, rxLookup, RxQuery;
 
 { TrxDBLookup }
 procedure RefreshRXLookup(Lookup: TrxLookupControl);
 procedure RefreshRXLookupLookupSource(Lookup: TrxLookupControl);
 
 function RxLookupValueInteger(Lookup: TrxLookupControl): Integer;
 
 { TRxQuery }
 
 { Applicatable to SQL's without SELECT * syntax }
 
 { Inserts FieldName into first position in '%Order' macro and refreshes query }
 procedure HandleOrderMacro(Query: TRxQuery; Field: TField);
 
 { Sets '%Order' macro, if defined, and refreshes query }
 procedure InsertOrderBy(Query: TRxQuery; NewOrder: string);
 
 { Converts list of order fields if defined and refreshes query }
 procedure UpdateOrderFields(Query: TQuery; OrderFields: TStrings);
 
 implementation
 uses
   vgUtils, vgDBUtl, vgBDEUtl;
 
 { TrxDBLookup refresh }
 
 type
   TRXLookupControlHack = class(TrxLookupControl)
     property DataSource;
     property LookupSource;
     property Value;
     property EmptyValue;
   end;
 
 procedure RefreshRXLookup(Lookup: TrxLookupControl);
 var
   SaveField: string;
 begin
   with TRXLookupControlHack(Lookup) do
   begin
     SaveField := DataField;
     DataField := '';
     DataField := SaveField;
   end;
 end;
 
 procedure RefreshRXLookupLookupSource(Lookup: TrxLookupControl);
 var
   SaveField: string;
 begin
   with TRXLookupControlHack(Lookup) do
   begin
     SaveField := LookupDisplay;
     LookupDisplay := '';
     LookupDisplay := SaveField;
   end;
 end;
 
 function RxLookupValueInteger(Lookup: TrxLookupControl): Integer;
 begin
   with TRXLookupControlHack(Lookup) do
   try
     if Value <> EmptyValue then
       Result := StrToInt(Value)
     else
       Result := 0;
   except
     Result := 0;
   end;
 end;
 
 procedure InsertOrderBy(Query: TRxQuery; NewOrder: string);
 var
   Param: TParam;
   OldActive: Boolean;
   OldOrder: string;
   Bmk: TPKBookMark;
 begin
   Param := FindParam(Query.Macros, 'Order');
   if not Assigned(Param) then
     Exit;
 
   OldOrder := Param.AsString;
 
   if OldOrder <> NewOrder then
   begin
     OldActive := Query.Active;
     if OldActive then
       Bmk := GetPKBookmark(Query, '');
     try
       Query.Close;
       Param.AsString := NewOrder;
       try
         Query.Prepare;
       except
         Param.AsString := OldOrder;
       end;
       Query.Active := OldActive;
       if OldActive then
         SetToPKBookMark(Query, Bmk);
     finally
       if OldActive then
         FreePKBookmark(Bmk);
     end;
   end;
 end;
 
 procedure UpdateOrderFields(Query: TQuery; OrderFields: TStrings);
 var
   NewOrderFields: TStrings;
 
   procedure AddOrderField(S: string);
   begin
     if NewOrderFields.IndexOf(S) < 0 then
       NewOrderFields.Add(S);
   end;
 
 var
   I, J: Integer;
   Field: TField;
   FieldDef: TFieldDef;
   S: string;
 begin
   NewOrderFields := TStringList.Create;
   with Query do
   try
     for I := 0 to OrderFields.Count - 1 do
     begin
       S := OrderFields[I];
       Field := FindField(S);
       if Assigned(Field) and (Field.FieldNo > 0) then
         AddOrderField(IntToStr(Field.FieldNo))
       else
       try
         J := StrToInt(S);
         if J < FieldDefs.Count then
           AddOrderField(IntToStr(J));
       except
       end;
     end;
     OrderFields.Assign(NewOrderFields);
   finally
     NewOrderFields.Free;
   end;
 end;
 
 procedure HandleOrderMacro(Query: TRxQuery; Field: TField);
 var
   Param: TParam;
   Tmp, OldOrder, NewOrder: string;
   I: Integer;
   C: Char;
   TmpField: TField;
   OrderFields: TStrings;
 begin
   Param := FindParam(Query.Macros, 'Order');
   if not Assigned(Param) or Field.Calculated or Field.Lookup then
     Exit;
   OldOrder := Param.AsString;
   I := 0;
   Tmp := '';
   OrderFields := TStringList.Create;
   try
     OrderFields.Ad(Field.FieldName);
     while I < Length(OldOrder) do
     begin
       Inc(I);
       C := OldOrder[I];
       if C in FieldNameChars then
         Tmp := Tmp + C;
 
       if (not (C in FieldNameChars) or (I = Length(OldOrder))) and (Tmp <> '')
         then
       begin
         TmpField := Field.DataSet.FindField(Tmp);
         if OrderFields.IndexOf(Tmp) < 0 then
           OrderFields.Add(Tmp);
         Tmp := '';
       end;
     end;
 
     UpdateOrderFields(Query, OrderFields);
     NewOrder := OrderFields[0];
     for I := 1 to OrderFields.Count - 1 do
       NewOrder := NewOrder + ', ' + OrderFields[1];
   finally
     OrderFields.Free;
   end;
   InsertOrderBy(Query, NewOrder);
 end;
 
 end.
 




DbGrid со свойствами Col и Row

Идет Иванушка-дурачек по полю и видит коровью морду. RC5-64 подумал Иванушка. Идет дальше и дедка-пастуха видит - Daniel Baker - подумал Иванушка. Увидел частокол с кольями на равном растоянии друг от друга... не успел ничего подумать, как пастух пробурчал:
- Ага OGR has started!!


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




Как выделить цветом текущую строку в TDBGrid

Люди в мире делятся на две группы: те, кто не знают Билла Гейтса и те, кто его ненавидят!


  procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect:
  TRect;
    Field: TField; State: TGridDrawState);
  begin
    if gdFocused in State then
    with (Sender as TDBGrid).Canvas do
    begin
      Brush.Color := clRed;
      FillRect(Rect);
      TextOut(Rect.Left, Rect.Top, Field.AsString);
    end;
  end;
 




DBGrid CutToClipboard

Автор: Kurt Barthelmess

После смерти Моисей, Эйнштейн и Билл Гейтс каждый в свое время попали в рай. Бог каждого спрашивает:
- Что бы Вы хотели меня спросить?
Моисей:
- Я бы хотел узнать, как правильно исполнять Твою волю.
Эйнштейн:
- Я бы хотел узнать законы, по которым Ты построил мир.
Билл Гейтс:
- Какого фига ты расселся на моем месте?

Внутри TDBGrid "зашит" защищенный (protected) элемент управления типа TInPlaceEdit, потомок TCustomMaskEdit. Данный элемент управляется комбинацией клавиш [Shift]+[Ins] и [Shift]+[Del]. Но для нас не существует способа оперировать элементом, поскольку он является защищенным членом.

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


 procedure TForm1.Paste1Click(Sender: TObject);
 begin
   SendMessage(GetFocus, WM_PASTE, 0, 0);
 end;
 
 procedure TForm1.Copy1Click(Sender: TObject);
 begin
   SendMessage(GetFocus, WM_COPY, 0, 0);
 end;
 

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




DBGrid DefaultDrawDataCell

Корреспондент:
- Билл Гейтс, Почему Вы решили оставить ТАКОЙ пост и начать новую трудовую деятельность?
- А надоело руководить, пора начать такой вид деятельности, который бы смог и меня прокормить и мою семью!

TDBGrid имеет недокументированный в электронной справке метод DefaultDrawDataCell.

Вот пример его использования:


 procedure TForm1.DBGrid1DrawDataCell(Sender: TObject;
 const Rect: TRect; Field: TField; State: TGridDrawState);
 begin
   with Sender as TDBGrid do
   begin
     Canvas.Font.Color := clRed;
     DefaultDrawDataCell(Rect, Field, State);
   end;
 end;
 




Как программно перевести DBGrid в режим редактирования

Решили Винду под банкомат поставить. Поставили - работает. Вставили кредитку. Появилось сообщение:
Введите Ваш пин-код.
Ввели. Дальше сообщение:
Сохранить пароль при следующих входах? - Да/Нет (Не предлагать больше сохранять никакие пароли)

Как программно перевести DBgrid в реим редактирования и установить курсор в окошке редактирования в требуемую позицию?

Ответ:

Переведите таблицу в режим редактирования, затем получите дескриптор (handle) окна редактирования и перешлите ей сообщение EM_SETSEL. В качестве параметров вы должны переслать начальную позицию курсора, и конечную позицию, определяющую конец выделения текста цветом. В приведенном примере курсор помещается во вторую позицию, текст внутри ячейки не выделяется.

Пример:


 procedure TForm1.Button1Click(Sender: TObject);
 var
        h : THandle;
 begin
        Application.ProcessMessages;
        DbGrid1.SetFocus;
        DbGrid1.EditorMode := true;
        Application.ProcessMessages;
        h:= Windows.GetFocus;
        SendMessage(h, EM_SETSEL, 2, 2);
 end;
 




Как экспортировать содержимое DBGrid в Excel или ClipBoard

КОГДА при виде трупа ваша первая мысля - обыскать. Когда вас ВСЕГДА окружают пять верных рузей. Когда вы ВЕЗДЕ таскаете за собой пыльный мешок с надписью "инвентарь". И наконец когда вы ВСЮДУ ищите неприятности - значит вам ДАВНО пора бросать играть в БАЛДУРС ГЕЙТ!


 // ЗАМЕЧАНИЕ: этот метод должен включать COMObj, Excel97 units
 
 // ОБНОВЛЕНИЕ: если Вы используете Delphi 4, то замените xlWBatWorkSheet на 1 (один)
 
 //-----------------------------------------------------------
 // если toExcel = false, то экспортируем содержимое dbgrid в Clipboard
 // если toExcel = true, то экспортируем содержимое dbgrid в Microsoft Excel
 //-----------------------------------------------------------
 
 procedure ExportDBGrid(toExcel: Boolean);
 var
   bm: TBookmark;
   col, row: Integer;
   sline: string;
   mem: TMemo;
   ExcelApp: Variant;
 begin
   Screen.Cursor := crHourglass;
   DBGrid1.DataSource.DataSet.DisableControls;
   bm := DBGrid1.DataSource.DataSet.GetBookmark;
   DBGrid1.DataSource.DataSet.First;
 
   // создаём объект Excel
   if toExcel then
   begin
     ExcelApp := CreateOleObject('Excel.Application');
     ExcelApp.WorkBooks.Add(xlWBatWorkSheet);
     ExcelApp.WorkBooks[1].WorkSheets[1].name := 'Grid Data';
   end;
 
   // Сперва отправляем данные в memo
   // работает быстрее, чем отправлять их напрямую в Excel
   mem := TMemo.Create(Self);
   mem.Visible := false;
   mem.Parent := MainForm;
   mem.Clear;
   sline := '';
 
   // добавляем информацию для имён колонок
   for col := 0 to DBGrid1.FieldCount-1 do
     sline := sline + DBGrid1.Fields[col].DisplayLabel + #9;
   mem.Lines.Add(sline);
 
   // получаем данные из memo
   for row := 0 to DBGrid1.DataSource.DataSet.RecordCount-1 do
   begin
     sline := '';
     for col := 0 to DBGrid1.FieldCount-1 do
       sline := sline + DBGrid1.Fields[col].AsString + #9;
     mem.Lines.Add(sline);
     DBGrid1.DataSource.DataSet.Next;
   end;
 
   // копируем данные в clipboard
   mem.SelectAll;
   mem.CopyToClipboard;
 
   // если необходимо, то отправляем их в Excel
   // если нет, то они уже в буфере обмена
   if toExcel then
   begin
     ExcelApp.Workbooks[1].WorkSheets['Grid Data'].Paste;
     ExcelApp.Visible := true;
   end;
 
   FreeAndNil(ExcelApp);
   DBGrid1.DataSource.DataSet.GotoBookmark(bm);
   DBGrid1.DataSource.DataSet.FreeBookmark(bm);
   DBGrid1.DataSource.DataSet.EnableControls;
   Screen.Cursor := crDefault;
 end;
 




DbGrid и множественный выбор

Разговор ламера (Л) с программером (П):
П: - Ну как, в этом чате дырок много?
Л: - Да, я уже с двумя познакомился!

При включении флажка [dgMultiSelect] в свойстве-наборе Options компонента DBGrid, вы добавляете к табличной сетке возможность множественного выбора записей.

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

Свойство SelectedRows является объектом, имеющим тип TBookmarkList. Его свойства и методы описаны ниже.


 // property SelectedRows: TBookmarkList read FBookmarks;
 
 //   TBookmarkList = class
 //   public
 
 {* Метод Clear освобождает все выбранные в DBGrid записи *}
 // procedure Clear;
 
 {* Метод Delete удаляет все выбранные строки из набора данных *}
 // procedure Delete;
 
 {* Метод Find определяет наличие закладки в выбранном списке. *}
 // function  Find(const Item: TBookmarkStr;
 //      var Index: Integer): Boolean;
 
 {* Метод IndexOf возвращает индекс закладки, расположенной в свойстве Items. *}
 // function IndexOf(const Item: TBookmarkStr): Integer;
 
 {* Метод Refresh возвращает логическую величину, уведомляющую о том, ч
 то в то время, пока в табличной сетке была выбрана запись, были добавлены
 (удалены) какие-то данные. Метод Refresh может быть использован для
 обновления списка выбранных записей для уменьшения возможности получения
 удаленной записи. *}
 // function Refresh: Boolean;  True = orphans found
 
 {* Свойство Count возвращает количество выбранных в настоящий
 момент элементов в DBGrid *}
 // property Count: Integer read GetCount;
 
 {* Свойство CurrentRowSelected содержит логическую величину,
 зависящую от того, выбрана текущая строка или нет. *}
 // property CurrentRowSelected: Boolean
 //      read GetCurrentRowSelected
 //      write SetCurrentRowSelected;
 
 {* Свойство Items - TStringList TBookmarkStr *}
 // property Items[Index: Integer]: TBookmarkStr
 //      read GetItem; default;
 
 //  end;
 
 unit Unit1;
 
 interface
 
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   StdCtrls, Grids, DBGrids, DB, DBTables;
 
 type
   TForm1 = class(TForm)
     Table1: TTable;
     DBGrid1: TDBGrid;
     Count: TButton;
     Selected: TButton;
     Clear: TButton;
     Delete: TButton;
     Select: TButton;
     GetBookMark: TButton;
     Find: TButton;
     FreeBookmark: TButton;
     DataSource1: TDataSource;
     procedure CountClick(Sender: TObject);
     procedure SelectedClick(Sender: TObject);
     procedure ClearClick(Sender: TObject);
     procedure DeleteClick(Sender: TObject);
     procedure SelectClick(Sender: TObject);
     procedure GetBookMarkClick(Sender: TObject);
     procedure FindClick(Sender: TObject);
     procedure FreeBookmarkClick(Sender: TObject);
   private
     { Private declarations }
   public
     { Public declarations }
   end;
 
 var
   Form1: TForm1;
   Bookmark1: TBookmark;
   z: Integer;
 
 implementation
 
 {$R *.DFM}
 
 //Пример использования свойства Count
 
 procedure TForm1.CountClick(Sender: TObject);
 begin
   if DBgrid1.SelectedRows.Count > 0 then
   begin
     showmessage(inttostr(DBgrid1.SelectedRows.Count));
   end;
 end;
 
 //Пример использования свойства CurrentRowSelected
 
 procedure TForm1.SelectedClick(Sender: TObject);
 begin
   if DBgrid1.SelectedRows.CurrentRowSelected then
     showmessage('Выбрана');
 end;
 
 //Пример использования метода Clear
 
 procedure TForm1.ClearClick(Sender: TObject);
 begin
   dbgrid1.SelectedRows.Clear;
 end;
 
 //Пример использования метода Delete
 
 procedure TForm1.DeleteClick(Sender: TObject);
 begin
   DBgrid1.SelectedRows.Delete;
 end;
 
 {*
 Данные пример проходит в цикле все выбранные
 записи табличной сетки и отображает второе
 поле набора данных.
 
 Метод DisableControls используется в случае,
 когда необходимо запретить обновление DBGrid
 при изменении набора данных. Последняя позиция
 набора данных сохраняется как TBookmark.
 
 Метод IndexOf вызывается при необходимости
 проверить существование закладки.
 Решение использовать метод IndexOf, а не
 Refresh, должно приниматься исходя из
 специфики приложения.
 *}
 
 procedure TForm1.SelectClick(Sender: TObject);
 var
   x: word;
   TempBookmark: TBookMark;
 begin
   DBGrid1.Datasource.Dataset.DisableControls;
   with DBgrid1.SelectedRows do
     if Count > 0 then
     begin
       TempBookmark := DBGrid1.Datasource.Dataset.GetBookmark;
       for x := 0 to Count - 1 do
       begin
         if IndexOf(Items[x]) > -1 then
         begin
           DBGrid1.Datasource.Dataset.Bookmark := Items[x];
           showmessage(DBGrid1.Datasource.Dataset.Fields[1].AsString);
         end;
       end;
     end;
   DBGrid1.Datasource.Dataset.GotoBookmark(TempBookmark);
   DBGrid1.Datasource.Dataset.FreeBookmark(TempBookmark);
   DBGrid1.Datasource.Dataset.EnableControls;
 end;
 
 {*
 Данный пример позволит вам установить закладку и
 затем найти ее в списке выбранных записей
 компонента DBGrid.
 *}
 
 //Устанавливаем закдадку
 
 procedure TForm1.GetBookMarkClick(Sender: TObject);
 begin
   Bookmark1 := DBGrid1.Datasource.Dataset.GetBookmark;
 end;
 
 //Освобождаем закладку
 
 procedure TForm1.FreeBookmarkClick(Sender: TObject);
 begin
   if assigned(Bookmark1) then
   begin
     DBGrid1.Datasource.Dataset.FreeBookmark(Bookmark1);
     Bookmark1 := nil;
   end;
 end;
 
 //Испольуем метод Find для установления позиции
 //записи-закладки в списке выбранных записей компонента DBGrid
 
 procedure TForm1.FindClick(Sender: TObject);
 begin
   if assigned(Bookmark1) then
   begin
     if DBGrid1.SelectedRows.Find(TBookMarkStr(Bookmark1), z) then
       showmessage(inttostr(z));
   end;
 end;
 
 end.
 




Как в TDBGrid узнать над каким полем висит мышь

Автор: Бурундук

Лежат как то системщик с подругою в постели, вот только что у них всё закончилось ... Она его ласково так спрашивает:
- Милый, Save of changes, Yes or Not?


 var
   ScrPt, GrdPt: TPoint;
   Cell: TGridCoord;
 begin
   ScrPt := Mouse.CursorPos;
   GrdPt := DBGrid.ScreenToClient(ScrPt);
   Cell := DBGrid.MouseCoord(GrdPt.X, GrdPt.Y);
   // Col := Cell.X;
   // Row := Cell.Y;
 end;
 


  ...
  FieldText: string;
  DLink: TDataLink;
  OldActiveRec: Integer;
  ...
  Cell := DBGrid.MouseCoord(GrdPt.X, GrdPt.Y);
  FieldText := '';
  DLink := THackDBGrid(DBGrid).DataLink;
  if Assigned(DLink) then
  begin
    if (Cell.X < = 0)or(Cell.Y < = 0) then Exit;
    OldActiveRec := DLink.ActiveRecord;
    try
      DLink.ActiveRecord := Cell.Y-1{TitleOffset};
      FieldText := DBGrid.Columns[Cell.X-1{IndicatorOffset}].Field.Text;
    finally
      DLink.ActiveRecord := OldActiveRec;
    end;
  end;
 




Использование опции MultiSelect в DBGRID

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

Есть пример в Delphi Technical Information... Его можно посмотреть здесь


 {*
 Данный пример позволяет производить множественный выбор записей
 в табличной сетке и отображать второе поле
 набора данных.
 
 Метод DisableControls применяется для того, чтобы
 DBGrid не обновлялся во время изменения набора данных.
 Последняя позиция набора данных сохраняется как
 TBookmark.
 
 Метод IndexOf вызывается для проверки
 существования закладки.
 Решение использовать метод IndexOf, а не метод
 Refresh должно определяться
 спецификой приложения.
 *}
 
 procedure TForm1.SelectClick(Sender: TObject);
 var
   x: word;
   TempBookmark: TBookMark;
 begin
   DBGrid1.Datasource.Dataset.DisableControls;
   with DBgrid1.SelectedRows do
     if Count <> 0 then
     begin
       TempBookmark := DBGrid1.Datasource.Dataset.GetBookmark;
       for x := 0 to Count - 1 do
       begin
         if IndexOf(Items[x]) > -1 then
         begin
           DBGrid1.Datasource.Dataset.Bookmark := Items[x];
           showmessage(DBGrid1.Datasource.Dataset.Fields[1].AsString);
         end;
       end;
     end;
   DBGrid1.Datasource.Dataset.GotoBookmark(TempBookmark);
   DBGrid1.Datasource.Dataset.FreeBookmark(TempBookmark);
   DBGrid1.Datasource.Dataset.EnableControls;
 end;
 




Как отучить TDBGrid от автодобавления новой записи

Внимание! Осторожно - вирус! Если вы получите по почте мессадж, где в качестве subject стоит "повестка", а отправителем числится "военкомат", ни в коем случае не открывайте его. Немедленно делетируйте его вместе с конвертом. Внутри него может оказаться опаснейший вирус, полностью лишающий вас возможности работать на вашем компьютере. Форвардируйте это сообщение всем, с кем вы ведете переписку.

Добавьте в обработчик события вашего TTable "BeforeInsert" следующую строку:


 procedure TForm1.Tbable1BeforeInsert(DataSet: TDataset);
 begin
   Abort;  // <<---эту строчку
 end;
 

Осуществляем перехват нажатия клавиши и проверку на конец файла (end-of-file):


 procedure TForm8.DBGrid1KeyDown(Sender: TObject;
   var Key: Word; Shift: TShiftState);
 begin
   if (Key = VK_DOWN) then
   begin
     TTable1.DisableControls;
     TTable1Next;
     if TTable1.EOF then
       Key := 0
     else
       TTable1.Prior;
     TTable1.EnableControls;
   end;
 end;
 




Как в TDBGrid pазpешить только опеpации UPDATE записей

Автор: Nomadic

Когда я выключаю комп я постоянно думаю над вопросом computer шут или даун?...

А я делаю так. На DataSource, к которому прицеплен Grid, вешаю обработчик на событие OnStateChange. Ниже текст типичного обратчика


 if DBGrid1.DataSource.DataSet.State in [dsEdit, dsInsert] then
   DBGrid1.Options := DBGrid1.Options + goRowSelect
 else
   DBGrid1.Options := DBGrid1.Options - goRowSelect;
 

Дело в том, что если у Grid'а стоит опция goRowSelect, то из Grid'а невозможно добавить запись. Ну а когда програмно вызываешь редактирование или вставку, то курсор принимает обычный вид и все Ok.

Лучше использовать конструкцию "State in dsEditModes"




Замечательные возможности DBGrid

Стоят старая и молодая проститутки на боевом посту. Старая все объясняет: к кому подходить, к кому не надо... На рассвете вдруг из дверей офиса нетвердой походкой выходит мужик, волосы взъерошены, глаза красные... Молодая:
- Ой, что это с ним?
Старая:
- Не обращай внимания. Это свой, программист. Тоже всю ночь тр@хался.

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

Как изменить цвет строки в TDBGrid

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

Рассмотрим простейшее приложение с TDBGrid, содержащее один компонент TTable, один компонент TDataSource и один компонент TDBGrid: Установим значения их свойств в соответствии с приведенной ниже таблицей:

Компонент Свойство Значение
Table1 DatabaseName BCDEMOS (или DBDEMOS)
TableName events.db
Active true
DataSource1 DataSet Table1
DBGrid1 DataSource DataSource1
     

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

Его параметр Rect – структура, описывающая занимаемый ячейкой прямоугольник; параметр Column - колонка DBGrid, в которой следует изменить способ рисования изображения. Для вывода текста используется метод TextOut свойства Canvas компонента TDBGrid.

Предположим, нам нужно изменить цвет текста и фона строки в зависимости от значения какого-либо поля (например, VenueNo). Создадим обработчик события OnDrawColumnCell компонента DBGrid1.

В случае Delphi соответствующий код имеет вид:


 procedure TForm1.DBGridDrawColumnCell(Sender: TObject; const Rect: TRect;
 DataCol: Integer; Column: TColumn; State: TGridDrawState);
 begin
   if Table1.FieldByName('VenueNo').Value = 1 then
     with DBGrid1.Canvas do
     begin
       Brush.Color := clGreen;
       Font.Color := clWhite;
       FillRect(Rect);
       TectOut(Rect.Left + 2, Rect.Top + 2, Column.Field.Text);
     end;
 end;
 

В результате на этапе выполнения при отображении строк, в которых значение поля VenueNo равно 1, фон ячеек будет окрашен в зеленый цвет, а текст выведен белым цветом.

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

Соответствующий код для Delphi имеет вид:


 procedure TForm1.DBGridDrawColumnCell(Sender: TObject; const Rect: TRect;
 DataCol: Integer; Column: TColumn; State: TGridDrawState);
 begin
   if Table1.FieldByName('VenueNo').Value = 1 then
     with DBGrid1.Canvas do
     begin
       Brush.Color := clGreen;
       Font.Color := clWhite;
       FillRect(Rect);
       if Column.Alignment = taRightJustify then
         TectOut(Rect.Right - 2 - TectWidth(Column.Field.Text),
         Rect.Top+2, Column.Field.Text)
       else
         TectOut(Rect.Left + 2, Rect.Top + 2, Column.Field.Text);
     end;
 end;
 

В этом случае выравнивание текста в колонках совпадает с выравниванием столбцов.

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

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

Соответствующий код для Delphi имеет вид:


 procedure TForm1.DBGridDrawColumnCell(Sender: TObject; const Rect: TRect;
 DataCol: Integer; Column: TColumn;  State: TGridDrawState);
 begin
   if (Table1.FieldByName('VenueNo').Value = 1) and (Column.FieldName = 'VenueNo') then
     with DBGrid1.Canvas do
     begin
       Brush.Color := clGreen;
       Font.Color := clWhite;
       FillRect(Rect);
       if Column.Alignment = taRightJustify then
         TectOut(Rect.Right - 2 - TectWidth(Column.Field.Text),
         Rect.Top + 2, Column.Field.Text)
       else
         TectOut(Rect.Left + 2, Rect.Top + 2, Column.Field.Text);
     end;
 end;
 

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

Как заменить данные в столбце компонента TDBGrid

Нередко в колонке DBGrid нужно вывести не реальное значение, хранящееся в поле соответствующей таблицы, а другие данные, соответствующие имеющимся (например, символьную строку вместо ее числового кода). В этом случае также используется метод TextOut свойства Canvas компонента TDBGrid:

Соответствующий код для Delphi имеет вид:


 procedure TForm1.DBGridDrawColumnCell(Sender: TObject; const Rect: TRect;
 DataCol: Integer; Column: TColumn;  State: TGridDrawState);
 begin
   if Column.FieldName = 'VenueNo' then
     with DBGrid1.Canvas do
     begin
       Brush.Color := clWhite;
       FillRect(Rect);
       if Table.FieldByName('VanueNo').Value = 1 then
       begin
         Font.Color := clRed;
         TextOut(Rect.Right - 2 - DBGrid1.Canvas.TextWidth('our vanue'),
         Rect.Top + 2, 'our vanue');
       end
       else
         TextOut(Rect.Right - 2 - DBGrid1.Canvas.TextWidth('other vanue'),
         Rect.Top + 2, 'other vanue');
     end;
 end;
 

Еще один пример – использование значков из шрифтов Windings или Webdings в качестве подставляемой строки.

Соответствующий код для Delphi имеет вид:


 procedure TForm1.DBGridDrawColumnCell(Sender: TObject; const Rect: TRect;
 DataCol: Integer; Column: TColumn;  State: TGridDrawState);
 begin
   if Column.FieldName = 'VenueNo' then
     with DBGrid1.Canvas do
     begin
       Brush.Color := clWhite;
       FillRect(Rect);
       Font.name := 'Windings';
       Font.Size := -14;
       if Table.FieldByName('VanueNo').Value = 1 then
       begin
         Font.Color := clRed;
         TextOut(Rect.Right - 2 - DBGrid1.Canvas.TextWidth('J'),
         Rect.Top + 2, 'J');
       end
       else
         TextOut(Rect.Right - 2 - DBGrid1.Canvas.TextWidth('F'),
         Rect.Top + 2, 'F');
     end;
 end;
 

Как поместить графическое изображение в TDBGrid

Использование свойства Canvas компонента TDBGrid в методе OnDrawColumnCell позволяет не только выводить в ячейке текст методом TextOut, но и размещать в ячейках графические изображения. В этом случае используется метод Draw свойства Canvas.

Модифицируем наш пример, добавив в форму компонент TImageList и поместив в него несколько изображений.

Модифицируем код нашего приложения:

Соответствующий код для Delphi имеет вид:


 procedure TForm1.DBGridDrawColumnCell(Sender: TObject; const Rect: TRect;
 DataCol: Integer; Column: TColumn;  State: TGridDrawState);
 var
   Im1: TBitmap;
 begin
   Im1 := TBitmap.Create;
   if Column.FieldName = 'VenueNo' then
     with DBGrid1.Canvas do
     begin
       Brush.Color := clWhite;
       FillRect(Rect);
       if Table.FieldByName('VanueNo').Value = 1 then
         ImageList1.GetBitmap(0, Im1)
       else
         ImageList1.GetBitmap(2, Im1);
       Draw(round((Rect.Left + Rect.Right - Im1.Width) / 2), Rect.Top, Im1);
     end;
 end;
 

Теперь в TDBGrid в колонке VenueNo находятся графические изображения.




Как определить изменение фокуса строки в TDBGrid

CPU not found. Press any key to continue

Используйте событие OnDataChange объекта Datasource, соединенного с DBGrid. Если параметр State в обработчике событие равен dsBrowse, значит вы перешли в новую строку (или только что открыли таблицу).

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

Я не уверен в том, что проблему можно решить, обрабатывая событие одинарного щелчка, для отслеживания события изменения строк я рекомендую использовать событие TDatasource.OnDataChange, а для колонок - TDBGrid.OnColEnter/Exit.

Лично я пользуюсь следующей рабочей технологией:

  1. Для того, чтобы обнаружить изменения текущей строки, воспользуйтесь событием TDataSource OnDataChange. OnDataChange возникает при прокрутке или щелчке на другой строке. Обработчик события может выглядеть приблизительно так:

  2.  procedure Form1.DSrc1DataChange(Sender: TObject; Field: TField);
     

    где Field является колонкой, где произошло изменение.

    Поля TTable могут использоваться для сравнения текущих выбранных строк полей (ключ) с вашими требованиями. С той же целью может быть использовано и свойство TDBGrid Fields. Для примера:


     if tbl1.Fields[0].AsString = 'BlaBlaBla' then ...
     

    или


     if dbGrid1.Fields[I].IsNull then ...
     

  3. Для отслеживания изменения колонки, используйте события TDBGrid OnColExit & OnColEnter. Для определения выбранной к настоящему времени колонки воспользуйтесь свойствами TDBGrid SelectedField и SelectedIndex.

    Когда выбирается другая колонка другой строки, вы получаете события OnColExit, OnColEnter и OnDataChange.

  4. Можно пойти и "кривым" путем, взявшись за обработку события TDBGrid OnDrawDataCell, которое возникает когда ячейка выбирается, или когда сетка скроллируется. Обработчик события может выглядеть примерно так:

  5.  procedure Form1.dbGrid1DrawDataCell(Sender: TObject; Rect: TRect;
     Field: TField; State: TGridDrawState);
     

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

  6. Если у вас нет проблем в создании "101 изменения" стандартных компонентов - что является проблемой для меня 8-), то попробуйте это. Это легко.
  7. Чтобы иметь доступ к индексу строки или колонки выбранной ячейки, вы должны унаследовать ваш класс от TCustomGrid и опубликать свойства времени выполнения Row и Col (текущие строка и колонка сетки, не таблицы!!):


     type
     TSampleDBGrid = class(TCustomGrid)
     public
     property Col;
     property Row;
     end;
     

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


     var
     G: TSampleDBGrid;
     begin
     G := TSampleDBGrid(myDBGrid1);
     if G.Row = I then ...
     if G.Col = J then ...
     

    Дело в том, что TDBGrid является потомком TCustomGrid, который имеет несколько свойств, содержащих координаты сетки, но это не опубликовано в TDBGrid.

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


 grid.colcount := dbGrid.fieldcount;
 table.first;
 row := 0;
 while not table.eof do begin
 grid.rowcount := row + 1;
 for i := 0 to grid.colcount-1 do
 grid.cells[i,row] := dbGrid.fields[i].asString;
 table.next;
 inc (row);
 end;
 

Могут быть ошибки, но это должно помочь.

Посмотрите на следующий код, он может вам помочь. Он берет у элемента управления свойсто 'Name' и помещает его в свойство 'Caption' метки.


 unit Unit1;
 
 interface
 
 uses
   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
   Forms, Dialogs, StdCtrls;
 
 type
   TForm1 = class(TForm)
     Label1: TLabel;
     Edit1: TEdit;
     Edit2: TEdit;
     Button1: TButton;
     procedure Button1Click(Sender: TObject);
     procedure Edit1MouseDown(Sender: TObject; Button: TMouseButton;
       Shift: TShiftState; X, Y: Integer);
     procedure Edit2MouseDown(Sender: TObject; Button: TMouseButton;
       Shift: TShiftState; X, Y: Integer);
   private
     { Private declarations }
   public
     { Public declarations }
   end;
 
 var
   Form1: TForm1;
 
 implementation
 
 {$R *.DFM}
 
 procedure TForm1.Button1Click(Sender: TObject);
 begin
   close;
 end;
 
 procedure TForm1.Edit1MouseDown(Sender: TObject; Button: TMouseButton;
   Shift: TShiftState; X, Y: Integer);
 begin
   Label1.Caption := TEdit(Sender).Name;
 end;
 
 procedure TForm1.Edit2MouseDown(Sender: TObject; Button: TMouseButton;
   Shift: TShiftState; X, Y: Integer);
 begin
   Label1.Caption := TEdit(Sender).Name;
 end;
 
 end.
 




DBGrid - сохранение конфигурации

Заходит програмер в свой темный подъезд и слышит, что в темноте кто-то шебуршится.
- Бї@дь надо-было сохраниться! - запоздало подумал он.

Нижеописанный код создает, сохраняет и загружает конфигурационный файл и изменяет размеры столбцов таблицы DBGRID


 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
   Dialogs, Grids, DBGrids, Db, DBTables, StdCtrls, IniFiles;
 ...
 
 procedure TMainForm.NewIni(const NomeIni: string);
 var
   F: System.Text;
   i: Byte;
 begin
   System.Assign(F, NomeIni);
   System.ReWrite(F);
   System.WriteLn(F, '[Campi_Ordine]');
   for i:=1 to Table1.FieldCount do
     System.WriteLn(F, 'Campo',i,'=',Table1.Fields[i-1].FieldName);
   System.WriteLn(F, '');
   System.WriteLn(F, '[Campi_Size]');
   for i:=1 to Table1.FieldCount do
     System.WriteLn(F, 'Campo',i,'=',Table1.Fields[i-1].DisplayWidth);
   System.Close(F);
 end;
 
 procedure TMainForm.SaveIni(const FN: string);
 var
   Ini: TIniFile;
   i: Integer;
   S : string;
 begin
   NewIni(FN);
   Ini := TIniFile.Create(FN);
   with Ini do begin
     for i:=1 to Table1.FieldCount do
     begin
       S:= Table1.Fields[i-1].FieldName;
       WriteString('Campi_Ordine', 'Campo'+IntToStr(i),
       Table1.Fields[i-1].FieldName);
       WriteInteger('Campi_Size', 'Campo'+IntToStr(i),
       Table1.Fields[i-1].DisplayWidth);
     end;
   end;
   Ini.Free;
 end;
 
 procedure TMainForm.LoadIni(const FN: string);
 var
   Ini: TIniFile;
   i: Integer;
   j: Longint;
   S: string;
 
   function MyReadInteger(const Section, Ident: string): Longint;
   begin
     result := Ini.ReadInteger(Section, Ident, -1);
     if result=-1 then
       raise Exception.Create('Errore nel file di configurazione.');
   end;
 
   function MyReadString(const Section, Ident: string): string;
   begin
     result := Ini.ReadString(Section, Ident, '');
     if result='' then
       raise Exception.Create('Errore nel file di configurazione.');
   end;
 
 begin
   Ini := TIniFile.Create(FN);
   try
     with Ini do
     begin
       for i:=1 to Table1.FieldCount do
       begin
         S:= MyReadString('Campi_Ordine', 'Campo'+IntToStr(i));
         j:= MyReadInteger('Campi_Size', 'Campo'+IntToStr(i));
         Table1.FieldByName(S).index := i-1;
         Table1.FieldByName(S).DisplayWidth := j;
       end;
     end;
   finally
     Ini.Free;
   end;
 end;
 




DBGrid - выбранные строки

Автор: Nancy Reid

На собрании перед выпуском Windows'98 в компании Micro$oft участникам был задан странный вопрос:
- Если вы зашли на авиaлайнер и узнали, что ваша группа программистов была ответственна за составление программы, управляющей полетом вашего авиалайнера, сколько бы из вас немедленно выскочило из самолета?
Все подняли руки, кроме одного программиста. Когда его спросили, что бы он сделал, тот ответил, что он бы с удовольствием остался на борту. Когда его спросили почему, он ответил:
- А чего мне бояться полета? С нашей программой этот самолет даже не доехал бы до взлетной полосы.

Существует одно свойство, не упомянутое в файлах помощи (оплошность, господа программисты из Borland), имеющее имя SelectedRows, и вот как его можно использовать:


 procedure TfrmGrid.Button1Click(Sender: TObject);
 var
   i: integer;
 begin
   For i := 0 to DBGrid1.SelectedRows.Count - 1 do
   begin
     Table1.GoToBookmark(TBookmark(DBGrid1.SelectedRows[i]));
     Table1.Delete;
   end;
 end;
 




Выделить все строки в DBGrid

Мужик заходит в лавочку, торгующую легальным софтом. Подходит к одному из продавцов и тихо-тихо говорит:
- Мне Windows'2000, пожалуйста. Тут все, и покупатели и продавцы, замирают и пристально смотрят на мужика. Мужик не выдерживает такой паузы, оборачивается ко всем и кричит:
- Да! Да! Тр@хаться я иду!


 function GridSelectAll(Grid: TDBGrid): Longint;
 begin
   Result := 0;
   Grid.SelectedRows.Clear;
   with Grid.Datasource.DataSet do
   begin
     First;
     DisableControls;
     try
       while not EOF do
       begin
         Grid.SelectedRows.CurrentRowSelected := True;
         inc(Result);
         Next;
       end;
     finally
       EnableControls;
     end;
   end;
 end;
 
 procedure TForm1.Button1Click(Sender: TObject);
 begin
   GridSelectAll(DBGrid1);
 end;
 




Решение проблемы передачи фокуса TDBGrid

- Что для геймера Жизнь?
- Два компакта с "Half-life"!

В данном документе содержится решение проблемы невозможности получения DBGrid-ом фокуса после щелчка на каком-либо элементе управления родительской формы, в то время, как DBGrid находится на ее дочерней MDI-форме.

Относится ко всем версиям Delphi

Очевидно, DBGrid имеет некоторые проблемы с управлением фокусом, если он находится на дочерней MDI-форме. Эта проблема решена в приведенном ниже наследнике TDBGrid, в котором обрабатываются мышиные сообщения и выясняется когда фокус должен быть передан сетке. Наследник создан в виде компонента, который легко устанавливается в Палитру Компонентов. Примечание: код адаптирован для всех версий Delphi. Проблемы могут быть в Delphi 2 и 3, если вы забудете заменить устаревшие в этих версиях модули "winprocs" и "wintypes" на "windows."


 unit FixedDBGrid;
 
 interface
 
 uses
 
   Winprocs, wintypes, Messages, SysUtils, Classes, Graphics,
   Controls, Forms, Dialogs, Grids, DBGrids;
 
 type
 
   TFixedDBGrid = class(TDBGrid)
   private
     { Private declarations }
   protected
     { Protected declarations }
   public
     { Public declarations }
     procedure WMRButtonDown(var Message: TWMRButtonDown); message
       WM_RBUTTONDOWN;
     procedure WMLButtonDown(var Message: TWMLButtonDown); message
       WM_LBUTTONDOWN;
   published
     { Published declarations }
   end;
 
 procedure Register;
 
 implementation
 
 procedure TFixedDBGrid.WMRButtonDown(var Message: TWMRButtonDown);
 begin
 
   winprocs.SetFocus(handle); {помните, что winprocs относится только к Delphi 1!}
   inherited;
 end;
 
 procedure TFixedDBGrid.WMLButtonDown(var Message: TWMLButtonDown);
 begin
 
   winprocs.SetFocus(handle); {помните, что winprocs относится только к Delphi 1!}
   inherited;
 end;
 
 procedure Register;
 begin
 
   RegisterComponents('Samples', [TFixedDBGrid]);
 end;
 
 end.
 




Сортировка колонок в DBGrid

Звонок Пользователя в службу поддержки.
- Алло, это служба поддержки???
- Да.
- У меня проблема, мой модем не хочет работать!!!
- Давайте пропишем Вам строчку инициализации.
- Давайте.
- AT&F1&M5
- Спасибо!!!Через 5 минут.
- У меня все еще не работает!!!
- Да??? Ну давайте запишите другую
- Я слушаю
- ATS10=100
- Спасибо!
Проходит еще 5 минут...
- У меня Модем все еще плохо работает!!!
- Ну что, пишите еще одну строчку...
- Слушаю.
- AT&F&B1&A0&S0=90
- Спасибо. Прошло еще 5 минут...
- Алло!!! У меня сгорел модем!!!
- Жаль, а то у меня еще столько в запасе строчек инициализаций осталось...

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

Главное препятствие в решении задачи - сам DBGrid. Проблема в отсутствии событий OnClick или OnMouseDown, позволяющие реагировать на элементарные манипуляции с заголовком. Правда, существует событие OnDoubleClick, но для данной цели оно не слишком изящно. Все что нам нужно - сделать заголовок, реагирующий на однократный щелчок мышью. Обратимся к компоненту THeaderControl.

THeaderControl - компонент, введенный в палитру еще в Delphi 2.0 и обеспечивающий необходимые нам функции. Главное достоинство - реакция компонента при щелчке на отдельных панелях, панели также обеспечивают визульное отображение подобно кнопке (могут вдавливаться и отжиматься). Нам необходимо "прикрутить" THeaderControl к DBGrid. Вот как это сделать:

Во-первых, создайте новое приложение. Положите THeaderControl на форму. Он автоматически выровняется по верхнему краю формы. Затем поместите на форму DBGrid и присвойте свойству Align значение alClient. Затем добавьте компоненты TTable и TDataSource. В компоненте TTable присвойте свойству DatabaseName значение DBDEMOS, а свойству TableName значение EVENTS.DB. В TDataSource укажите в свойстве DataSet на компонент Table1, а в TDBGrid в свойстве DataSource на DataSource1. Если свойство Active компонента TTable было неактивно, включите его (значение True). Теперь немного поколдуем!

Сделаем так, чтобы компонент THeaderControl выглядел похожим на заголовок компонента DBGrid. Произведем необходимые манипулиции в момент создания формы. Дважды щелкните на событии OnCreate формы и введите следующий код:


 procedure TForm1.FormCreate(Sender: TObject);
 var
   TheCap: string;
   TheWidth, a: Integer;
 begin
   DBGrid1.Options := DBGrid1.Options - [dgTitles];
   HeaderControl1.Sections.Add;
   HeaderControl1.Sections.Items[0].Width := 12;
   Table1.Exclusive := True;
   Table1.Active := True;
   for a := 1 to DBGrid1.Columns.Count do
   begin
     with DBGrid1.Columns.Items[a - 1] do
     begin
       TheCap := Title.Caption;
       TheWidth := Width;
     end;
     with HeaderControl1.Sections do
     begin
       Add;
       Items[a].Text := TheCap;
       Items[a].Width := TheWidth + 1;
       Items[a].MinWidth := TheWidth + 1;
       Items[a].MaxWidth := TheWidth + 1;
     end;
     try
       Table1.AddIndex(TheCap, TheCap, []);
     except
       HeaderControl1.Sections.Items[a].AllowClick := False;
     end;
   end;
   Table1.Active := False;
   Table1.Exclusive := False;
   Table1.Active := True;
 end;
 

После того как THeaderControl заменил стандартный заголовок DBGrid, в первую очередь мы сбрасываем (устанавливаем в False) флаг dgTitles в свойстве Options компонента DBGrid. Затем мы добавляем колонку в HeaderControl и устанавливаем ее ширину, равную 12. Это будет пустой колонкой, которая имеет ту же ширину, что и левая колонка статуса в DBGrid.

Затем нужно убедиться что таблица открыта для эксклюзивного доступа (никакие другие пользователи использовать ее не смогут). Причину я объясню немного позже.

Теперь добавляем секции в HeaderControl. Для каждой добавленной колонки мы создаем в заголовке тот же текст, что и в соответствующей колонке DBGrid. В цикле мы проходим по всем колонкам DBGrid и повторяем текст заголовка колонки и его высоту. Мы также устанавливаем для HeaderControl значения свойств MinWidth и MaxWidth, равными ширине соответствующей колонки в DBGrid. Это предохранит колонки от изменения их ширины. Для изменяющих размер колонок нужно дополнительное кодирование, и я решил не лишать Вас этого удовольствия.

Теперь самое интересное. Мы собираемся создать индекс для каждой колонки в DBGrid. Имя индекса будет таким же, как и название колонки. Данный код мы должны заключить в конструкцию try..finally, поскольку существуют некоторые поля, которые не могут быть проиндексированы (например, Blob- и Memo-поля). При попытке индексации этих полей генерится исключительная ситуация. Мы перехватываем это исключение и недопускаем возможности щелчка на данной колонке. Это означает, что колонки, содержащие неиндексированные поля, не будут реагировать на щелчок мышью. Создание этих индексов служит объяснением тому, почему таблица должна быть открыта в режиме эксклюзивного доступа. И в заключение мы закрываем таблицу, сбрасываем флаг эксклюзивности и снова делаем таблицу активной.

Последний шаг. При щелчке на HeaderControl нам необходимо включить правильный индекс таблицы. Создадим обработчик события OnSectionClick компонента HeaderControl как показано ниже:


 procedure TForm1.HeaderControl1SectionClick(
 HeaderControl: THeaderControl; Section: THeaderSection);
 begin
   Table1.IndexName := Section.Text;
 end;
 

Это все! После щелчка на заголовке колонки значение свойства таблицы IndexName становится равным заголовку компонента HeaderControl.

Просто и красиво, да? Тем не менее есть масса мест, требующих улучшения. К примеру, вторичный щелчок должен возобновлять порядок сортировки. Или возможность изменения размера самих колонок. Попробуйте сами, это не сложно!

Улучшения

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

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


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

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


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




Копирование информации из DBGrid-а в Clipboard

Автор: Беличенко Б.

Утро. 7.30. Звонит будильник. Программер медленно отрывает голову от подушки. Кидает будильник об стену и нервно шепчет:
- I'm is bypassing my startup files!
И опять засыпает.

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


 unit UnGridToClb;
 
 interface
 
 uses
   Windows, SysUtils, Classes, Dialogs,
   Grids, DBGrids, Db, DBTables, ClipBrd;
 
 procedure CopyGRDToClb(dbg: TDBGrid);
 
 // Копирует DBGrid в буфер обмена,
 // после чего данные отлично переносятся
 // как в простой текстовый редактор, так и в Excell
 
 implementation
 
 procedure CopyGRDToClb(dbg: TDBGrid);
 var
   bm: TBookMark;
   pch, pch1: PChar;
   s, s2: string;
   i, j: integer;
 begin
   s := '';
   for j := 0 to dbg.Columns.Count - 1 do
     s := s + dbg.Columns.Items[j].Title.Caption + #9;
   s := s + #13 + #10;
   if not dbg.DataSource.DataSet.active then
   begin
     ShowMessage('Нет выборки!!!');
     Exit;
   end;
   try
     dbg.Visible := False; //Делаем грид невидимым, чтобы не тратилось время
     //на его перерисовку при прокрутке DataSet - просто и
     //эффективно
     bm := dbg.DataSource.DataSet.GetBookmark; // для того чтобы не
     // потерять текущую запись
     dbg.DataSource.DataSet.First;
     while not dbg.DataSource.DataSet.EOF do
     begin
       s2 := '';
       for j := 0 to dbg.Columns.Count - 1 do
       begin
         s2 := s2 + dbg.Columns.Items[j].Field.AsString + #9;
       end;
       s := s + s2 + #13 + #10;
       dbg.DataSource.DataSet.Next;
     end;
     //Переключаем клавиатуру "в русский режим",
     //иначе - проблемы с кодировкой
     GetMem(pch, 100);
     GetMem(pch1, 100);
     GetKeyboardLayoutName(pch);
     StrCopy(pch1, pch);
     while pch <> '00000419' do
     begin
       ActivateKeyboardLayout(HKL_NEXT, 0);
       GetKeyboardLayoutName(pch);
       if strComp(pch, pch1) = 0 then
         //Круг замкнулся - нет такого языка '00000419'
         StrCopy(pch, '00000419');
     end;
 
     clipboard.AsText := s; //Данные - в буфер!!!
 
     //Возвращаем режим клавиатуры
     while strComp(pch, pch1) <> 0 do
     begin
       ActivateKeyboardLayout(HKL_NEXT, 0);
       GetKeyboardLayoutName(pch);
     end;
 
     FreeMem(pch);
     FreeMem(pch1);
 
     dbg.DataSource.DataSet.GotoBookmark(bm);
     //ShowMessage('Данные успешно скопированы в буфер обмена.');
   finally
     dbg.Visible := True;
   end;
 end;
 
 end.
 




Как из DBGrid перенести данные в существующий Excel файл

Автор: xUSSR

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


 //Если не обезательно из DBGrid-а... то вот пример из Query ...
 // Если есть вопросы то ¹ ACQ 134087719
 
 // имя файла шаблона и откуда (можно TTable)
 Procedure SendtoExcel(ShFile: String; Querys: TQuery);
 Var
    ExcelApp, Workbook, Range, Cell1, Cell2, ArrayData: Variant;
    BeginCol, BeginRow, j: integer;
    RowCount, ColCount: Integer;
 Begin
    BeginCol := 1;
    BeginRow := 3;
 
  // Размеры выводимого массива данных
    RowCount := Querys.RecordCount;
    ColCount := Querys.FieldDefs.Count;
 
  // Создание Excel
    ExcelApp := CreateOleObject('Excel.Application');
 
  // Отключаем реакцию Excel на события, чтобы ускорить вывод информации
    ExcelApp.Application.EnableEvents := false;
 
  //  Создаем Книгу (Workbook)
  //  Если заполняем шаблон, то
    Workbook := ExcelApp.WorkBooks.Add(ShFile);
    ArrayData := VarArrayCreate([1, RowCount, 1, ColCount], varVariant);
 
  // Заполняем массив
    Querys.DisableControls;
    Querys.First;
    While Not Querys.eof Do
    Begin
        For J := 1 To Querys.FieldDefs.Count Do
        Begin
            ArrayData[Querys.RecNo, J] :=
             Querys.FieldbyName(Querys.FieldDefs.Items[j - 1].DisplayName).value;
        End;
        Querys.Next;
    End;
 
    Querys.EnableControls;
 
 //     Левая верхняя ячейка области, в которую будем выводить данные
    Cell1 := WorkBook.WorkSheets[1].Cells[BeginRow, BeginCol];
  // Правая нижняя ячейка области, в которую будем выводить данные
    Cell2 := WorkBook.WorkSheets[1].Cells[BeginRow + RowCount - 1,
     BeginCol + ColCount - 1];
 
  // Область, в которую будем выводить данные
    Range := WorkBook.WorkSheets[1].Range[Cell1, Cell2];
 
  // А вот и сам вывод данных
  // Намного быстрее поячеечного присвоения
    Range.Value := ArrayData;
 
  // Делаем Excel видимым
    ExcelApp.Visible := True;
 End;
 




Экспортировать DBGrid в HTML

Автор: Тенцер А.Л.

Звонит юзеp oпеpатоpу АТС:
- Девушка! Мне тут какой-то совеpшенно дикий счет пpишел за услуги связи...
- Ваш номеp?
- 555-55-55
- Так... Все веpно. Это счет за секс-услуги по телефону.
- Да ты че! Я такой гадостью сpоду не занимался!
- Как? А неделю назад вы звонили Васе Пупкину по телефону 444-44-44 и пытались настpоить полуось?


 type
  TGridToHTMLOption = (ghWithHeaders);
  TGridToHTMLOptions = set of TGridToHTMLOption;
 
 function DBGridToHTML(Grid : TDBGrid;
   ExportOptions: TGridToHTMLOptions): String;
 const
   HTMLStart =
    '< !DOCTYPE HTML PUBLIC " -//W3C//DTD HTML 4.0 Transitional//EN" > '#13
 +
    '< HTML> '#13 +
    '< HEAD> < META http-equiv=Content-Type content=" text/html;
 charset=windows-1251" > '#13 +
    '< STYLE> '#13 +
    'BODY {'#13 +
    ' BACKGROUND: white;'#13 +
    ' COLOR: black;'#13 +
    ' FONT-FAMILY: arial;'#13 +
    ' FONT-SIZE: 8pt;'#13 +
    ' VERTICAL-ALIGN: top'#13 +
    '}'#13 +
    'TABLE {'#13 +
    ' BACKGROUND: white;'#13 +
    ' BORDER-BOTTOM: silver 0px solid;'#13 +
    ' BORDER-LEFT: silver 1px solid;'#13 +
    ' BORDER-RIGHT: silver 0px solid;'#13 +
    ' BORDER-TOP: silver 1px solid;'#13 +
    ' FONT-FAMILY: arial;'#13 +
    ' FONT-SIZE: 8pt;'#13 +
    ' FONT-WEIGHT: normal;'#13 +
    '}'#13 +
    'TD {'#13 +
    ' BORDER-BOTTOM: silver 1px solid;'#13 +
    ' BORDER-LEFT: silver 0px solid;'#13 +
    ' BORDER-RIGHT: silver 1px solid;'#13 +
    ' BORDER-TOP: silver 0px solid;'#13 +
    ' VERTICAL-ALIGN: top;'#13 +
    ' TEXT-ALIGN: left;'#13 +
    '}'#13 +
    'TD.grid {'#13 +
    ' TEXT-ALIGN: left;'#13 +
    '}'#13 +
    'TD.gridr {'#13 +
    ' TEXT-ALIGN: right;'#13 +
    '}'#13 +
    'TD.gridc {'#13 +
    ' TEXT-ALIGN: center;'#13 +
    '}'#13 +
    'TH {'#13 +
    ' BACKGROUND: silver;'#13 +
    ' BORDER-BOTTOM: gray 1px solid;'#13 +
    ' BORDER-LEFT: gray 0px solid;'#13 +
    ' BORDER-RIGHT: gray 1px solid;'#13 +
    ' BORDER-TOP: gray 0px solid;'#13 +
    ' FONT-WEIGHT: bold;'#13 +
    '}'#13 +
    'TH.grid {'#13 +
    ' TEXT-ALIGN: left;'#13 +
    '}'#13 +
    'TH.gridr {'#13 +
    ' TEXT-ALIGN: right;'#13 +
    '}'#13 +
    'TH.gridc {'#13 +
    ' TEXT-ALIGN: center;'#13 +
    '}'#13 +
    '< /STYLE> '#13 +
    '< TITLE> Печать таблицы< /TITLE> '#13 +
    '< /HEAD> '#13 +
    '< BODY> '#13;
   HTMLEnd = '< /BODY> < /HTML> ';
   TableStart = '< TABLE WIDTH=" 100%"  CELLSPACING=0 CELLPADDING=1> '#13;
   TableEnd = '< /TABLE> '#13;
   HeaderRowStart = '< TR> '#13;
   HeaderRowEnd = '< /TR> '#13;
   BodyRowStart = '< TR> '#13;
   BodyRowEnd = '< /TR> '#13;
 
 const
   StyleNames: array [TAlignment] of String = ('grid', 'gridr',
 'gridc');
 
   function TD(Column: TColumn; IsTitle: Boolean; Widht: Integer):
 String;
   var
     S: String;
     Align: TAlignment;
     Tag: String;
   begin
     if IsTitle then begin
       Tag := 'TH';
       Align := Column.Title.Alignment;
       S := StyleNames[Align];
     end else begin
       Tag := 'TD';
       Align := Column.Alignment;
       if Align = taLeftJustify then begin
         if (Column.Field is TBCDField) or
            (Column.Field is TCurrencyField) then
           Align := taRightJustify;
         if (Column.Field is TBooleanField) then
           Align := taCenter;
       end;
       S := StyleNames[Align];
       if (Column.Field is TBCDField) or (Column.Field is
 TIntegerField) then
         S := S + ' NOWRAP'
     end;
     if Widht >  0 then
       S := S + Format(' WIDTH=" %d%%" ', [Widht]);
     Result := '< ' + Tag + ' class=' + S + '> ';
     if IsTitle then begin
       S := Column.Title.Caption
     end else begin
       if Column.Field is TBooleanField then
       with TBooleanField(Column.Field) do begin
         if Length(DisplayValues) = 0 then begin
           if AsBoolean then
             S := 'да'
           else
             S := 'нет';
         end else
           S := Column.Field.DisplayText;
       end else
         S := Column.Field.DisplayText;
     end;
     if Length(Trim(S)) = 0 then
       S := ' ';
     Result := Result + S + '< /' + Tag + '> '#13;
   end;
 
 var
  BM : String;
  I : Integer;
  Widhts: array of Integer;
  TotalWidht: Integer;
 begin
   Result := '';
   with Grid  do begin
     if Assigned(DataSource) and
        Assigned(DataSource.DataSet) and
        DataSource.DataSet.Active then
     with DataSource.DataSet do begin
       DisableControls;
       BM := BookMark;
       SetLength(Widhts, Columns.Count);
       TotalWidht := 0;
       for I := 0 to Pred(Columns.Count) do begin
         if Assigned(Columns[I].Field) then begin
           Widhts[I] := Columns[I].Width;
           Inc(TotalWidht, Widhts[I]);
         end;
       end;
       for I := 0 to High(Widhts) do begin
         Widhts[I] := Widhts[I] * 100 div TotalWidht;
       end;
       Result := HTMLStart;
       Result := Result + TableStart;
       if (ghWithHeaders in ExportOptions) then begin
         Result := Result + HeaderRowStart;
         for I := 0 to Pred(Columns.Count) do begin
           if Assigned(Columns.Items[I].Field) then begin
             Result := Result + TD(Columns.Items[I], TRUE, Widhts[I]);
           end;
         end;
         Result := Result + HeaderRowEnd;
       end;
       First;
       while not Eof do begin
         Result := Result + BodyRowStart;
         for I := 0 to Pred( Columns.Count ) do begin
           if Assigned(Columns.Items[I].Field) then begin
             Result := Result + TD(Columns.Items[I], FALSE,
 -1{Integer(Widhts[Index]});
           end;
         end;
         Result := Result + BodyRowEnd;
         Next;
       end;
       Result := Result + TableEnd + HTMLEnd;
       BookMark := BM;
       EnableControls;
     end;
   end;
 end;
 




Перемещение по таблице с помощью вертикальной полосы прокрутки

Автор: Reinhard Kalinke

Компьютерный магазин. Заходит покупатель - толстый упакованный армянин.
АРМЯНИН: День добрый!
ПРОДАВЕЦ: Здравствуйте!
А: Компьютеры есть хорошие?
П: Есть, вот модель - Аквариус.
А: А сколько у него памяти?
П: 4,3 гига винт, 32 метра димм, 4 метра видео, 512 килов кэш.
А: И сколько это вместе?

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

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

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


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

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

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




DBGrid компонент отображающий разными цветами удалённые, обновлённые и добавленные записи



"...Для продолжения установки Win'2000 вставьте 45234-ю дискету..."


 unit atcDBGrid;
 (*
 (c) Aveen Tech
 2001 - 2002
 
 FileName: atcDBGrid.pas
 
 Version Date Author Comment
 1.0 13/06/2000 Majid Vafai Jahan Create.
 
 OVERVIEW
 - This grid is inherited from DBGrid and add some required functionality to it.
 
 Functionality:
 - Record type are all records that may be modified, unmodified, inserted, deleted.
 - Coloring according to Record type.
 - show selected Record Type.
 
 *)
 
 interface
 
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   Grids, DBGrids, dbTables, db;
 
 const
   AlignFlags : array [TAlignment] of Integer =
   ( DT_LEFT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
   DT_RIGHT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
   DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX );
   RTL: array [Boolean] of Integer = (0, DT_RTLREADING);
 
 type
   TCachedShow = (csModify, csUnModify, csRemoved, csInserted, csAll, csNormal);
   TatcDBGrid = class(TDBGrid)
 
 private
   FCachedShow: TCachedShow;
   FModifiedColor: TColor;
   FInsertedColor: TColor;
   FDeletedColor: TColor;
   procedure SetCachedShow(const Value: TCachedShow);
 
 protected
   procedure DrawDataCell(const Rect: TRect; Field: TField; State: TGridDrawState); override;
   procedure DrawColumnCell(const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); override;
 
 public
   constructor Create(AOwner: TComponent); override;
 
 published
   property atcCachedShow: TCachedShow read FCachedShow write SetCachedShow;
   property atcDeletedColor: TColor read FDeletedColor write FDeletedColor;
   property atcInsertedColor: TColor read FInsertedColor write FInsertedColor;
   property atcModifiedColor: TColor read FModifiedColor write FModifiedColor;
 
 end;
 
 procedure register;
 
 implementation
 
 procedure register;
 begin
   RegisterComponents('ATC DB Compo', [TatcDBGrid]);
 end;
 
 constructor TatcDBGrid.Create(AOwner: TComponent);
 (*
 Description: Record Type Showing is All except Deletes.
 *)
 begin
   inherited;
   FCachedShow := csNormal;
   FDeletedColor := clGray;
   FInsertedColor := clAqua;
   FModifiedColor := clRed;
 end;
 
 procedure TatcDBGrid.DrawColumnCell(const Rect: TRect; DataCol: Integer;
 Column: TColumn; State: TGridDrawState);
 (*
 Description: On Drawing Column Color Updated Records.
 *)
 var
   ARect: TRect;
 begin
   inherited;
   if not Assigned(Column.Field) then
     exit;
   // Copy Rect into Variable.
   CopyRect(ARect, Rect);
   if Assigned(DataLink) and (DataLink.Active) and (DataLink.DataSet <> nil) then
   begin
     // если текущая запись изменена
     if DataLink.DataSet.UpdateStatus = usModified then
     begin
       Canvas.Brush.Color := atcModifiedColor;
       Canvas.Font.Color := clBlack;
       Canvas.FillRect(Rect);
       DrawText(Canvas.Handle, PChar(Column.Field.Text), Length(Column.Field.Text), ARect,
       AlignFlags[Column.Alignment] or RTL[UseRightToLeftAlignmentForField(Column.Field, Column.Alignment)]);
     end
     // если текущая запись добавлена.
     else
     if DataLink.DataSet.UpdateStatus = usInserted then
     begin
       Canvas.Brush.Color := atcInsertedColor;
       Canvas.Font.Color := clBlack;
       Canvas.FillRect(Rect);
       DrawText(Canvas.Handle, PChar(Column.Field.Text), Length(Column.Field.Text), ARect,
       AlignFlags[Column.Alignment] or RTL[UseRightToLeftAlignmentForField(Column.Field, Column.Alignment)]);
     end
     // если текущая запись удалена.
     else
     if DataLink.DataSet.UpdateStatus = usDeleted then
     begin
       Canvas.Brush.Color := atcDeletedColor;
       Canvas.Font.Color := clWhite;
       Canvas.FillRect(Rect);
       DrawText(Canvas.Handle, PChar(Column.Field.Text), Length(Column.Field.Text), ARect,
       AlignFlags[Column.Alignment] or RTL[UseRightToLeftAlignmentForField(Column.Field, Column.Alignment)]);
     end;
   end;
 end;
 
 
 procedure TatcDBGrid.DrawDataCell(const Rect: TRect; Field: TField;
 State: TGridDrawState);
 (*
 Описание: Рисуем ячейки
 *)
 var
   ARect: TRect;
 begin
   inherited;
   CopyRect(ARect, Rect);
 
   if Assigned(DataLink) and (DataLink.Active) and (DataLink.DataSet <> nil) then
   begin
     // если текущая запись изменена
     if DataLink.DataSet.UpdateStatus = usModified then
     begin
       Canvas.Brush.Color := clRed;
       Canvas.Font.Color := clBlack;
       Canvas.FillRect(Rect);
       DrawText(Canvas.Handle, PChar(Field.Text), Length(Field.Text), ARect,
       AlignFlags[Field.Alignment] or RTL[UseRightToLeftAlignmentForField(Field, Field.Alignment)]);
     end
     // если текущая запись добавлена.
     else
     if DataLink.DataSet.UpdateStatus = usInserted then
     begin
       Canvas.Brush.Color := clAqua;
       Canvas.Font.Color := clBlack;
       Canvas.FillRect(Rect);
       DrawText(Canvas.Handle, PChar(Field.Text), Length(Field.Text), ARect,
       AlignFlags[Field.Alignment] or RTL[UseRightToLeftAlignmentForField(Field, Field.Alignment)]);
     end
     // если текущая запись удалена.
     else
     if DataLink.DataSet.UpdateStatus = usDeleted then
     begin
       Canvas.Brush.Color := clGray;
       Canvas.Font.Color := clWhite;
       Canvas.FillRect(Rect);
       DrawText(Canvas.Handle, PChar(Field.Text), Length(Field.Text), ARect,
       AlignFlags[Field.Alignment] or RTL[UseRightToLeftAlignmentForField(Field, Field.Alignment)]);
     end;
   end;
 end;
 
 
 procedure TatcDBGrid.SetCachedShow(const Value: TCachedShow);
 (*
 Description: Record type for showing in grid.
 Parameters: Value cached record show.
 *)
 begin
   FCachedShow := Value;
   if ComponentState = [csDesigning] then
     exit;
   if not Assigned(DataSource) or not Assigned(DataSource.DataSet) then
     exit;
   // для показа только выбранного типа записей.
   if Assigned(DataLink) and Assigned(DataLink.DataSet) and (DataLink.Active) then
   begin
     case FCachedShow of
       csAll:
         TBDEDataSet(DataSource.DataSet).UpdateRecordTypes := [rtModified, rtInserted, rtDeleted, rtUnmodified];
       csModify:
         TBDEDataSet(DataSource.DataSet).UpdateRecordTypes := [rtModified];
       csUnModify:
         TBDEDataSet(DataSource.DataSet).UpdateRecordTypes := [rtUnmodified];
       csInserted:
         TBDEDataSet(DataSource.DataSet).UpdateRecordTypes := [rtInserted];
       csRemoved:
         TBDEDataSet(DataSource.DataSet).UpdateRecordTypes := [rtDeleted];
       csNormal:
         TBDEDataSet(DataSource.DataSet).UpdateRecordTypes := [rtModified, rtInserted, rtUnmodified];
     end;
   end;
 end;
 
 end.
 




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



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



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


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