Programming: Delphi


Советы программистов (Часть 3)





  1. Часть 1
  2. Часть 2
  3. Часть 4
  1. DBFSeek и DBFLocate
  2. Ошибка при добавлении или изменении записей
  3. Простой пример работы с базой данных из DLL
  4. Сохранение в базе данных файла формата JPEG
  5. Загрузка изображений в поля BLOB
  6. Извлечение изображения из поля BLOB
  7. Информация о псевдонимах BDE
  8. Получение пути псевдонима и таблицы
  9. Задание псевдонима программным путем
  10. Запись буфера BDE на диск
  11. Работа с BDE в сети
  12. Форматирование носителя
  13. Определение свободного места на диске
  14. Управление дисководом
  15. Блокирование ввода информации
  16. Индикация статуса клавиш
  17. Отключение клавиш <Ctrl>+<Alt>+<Del>, <Alt>+<Tab>, <Ctrl>+<Esc> из приложения
  18. Управление индикаторами на клавиатуре
  19. Переключение языка
  20. Откуда инсталлировалась Windows
  21. Пиктограмма приложения в панели задач
  22. Пиктограмма приложения в окне Tray
  23. Перемещение формы не за заголовок
  24. Использование собственных курсоров в приложении
  25. Добавление своих пунктов меню в системное меню окна




DBFSeek и DBFLocate

 Как выполнить поиск в таблице?

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

Пример:

{ 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 - поиск величины, не связанный с ключевым полем; замена теперь принимает FieldName, величина может быть частичной } function DBFLocate(const Table1: TTable; const sFld, sValue: string): boolean; var bmPos: TBookMark; bFound: boolean; len: integer; begin Result := False; if (sValue <> '') and (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; procedure TForm1.Button1Click(Sender: TObject); begin Table1.UpdateCursorPos; if DBFSeek(Table1, xVal1) then begin ... /// делаем все, что необходимо if DBFLocate(Table1, 'CUSTNAME', xVal2) then begin ... /// делаем все, что необходимо end;



Ошибка при добавлении или изменении записей

 Почему при добавлении или изменении записей в некоторых запросах возникает ошибка «Cannot modify a read-only dataset»?

Во-первых, свойство RequestLive должно быть установлено в True.

Во-вторых, чтобы запрос был редактируемым, он должен удовлетворять требованиям, изложенным в помощи при поиске по «result set, editing».

[Nomadic]



Простой пример работы с базой данных из DLL

 Это простейшая DLL, экспортирующая единственную функцию. Вызывающий ее оператор передает функции значение ключа и строку со значением. Функция открывает демонстрационную базу данных BIOLIFE, находит по ключу запись и добавляет строку после всех записей в поле Notes:

library Mydll; uses DBTables; function Modify(Key: Double; const Info: String): Boolean; export; var Table: TTable; Stream: TBlobStream; begin Table := TTable.Create(nil); Table.DatabaseName := 'D:\'; Table.TableName := 'BIOLIFE'; Table.TableType := ttParadox; Table.Open; if Table.FindKey([Key]) then begin Result := True; Table.Edit; Stream := TBlobStream.Create(TMemoField(Table.FieldByName('Notes')), bmReadWrite); Stream.Seek(0, 2); Stream.Write(Info[1], Length(Info)); Stream.Free; Table.Post; end else Result := False; Table.Free; end; exports Modify; begin end. Пример вызова из приложения:

function Modify(Key: Double; const Info: String): Boolean; far; external 'MYDLL'; ... Modify(90200, 'Васек Трубачев');



Сохранение в базе данных файла формата JPEG

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

Можно сделать, например, так:

if Picture.Graphic is TJPegImage then begin bs := TBlobStream.Create(TBlobField(Field), bmWrite); Picture.Graphic.SaveToStream(bs); bs.Free; end else if Picture.Graphic is TBitmap then begin Jpg := TJPegImage.Create; Jpg.CompressionQuality := ...; Jpg.PixelFormat := ...; Jpg.Assign(Picture.Graphic); Jpg.JPEGNeeded; bs := TBlobStream.Create(TBlobField(Field), bmWrite); Jpg.SaveToStream(bs); bs.Free; Jpg.Free; end else Field.Clear; [Nomadic]

Примечание
Вы не забыли объявить переменную bs как TBlobStream?



Загрузка изображений в поля BLOB

 Как загрузить изображение в BLOB-поле?

Имеется несколько способов загрузки изображения в BLOB-поле таблицы dBASE или Paradox. Перечислим три самых простых метода:

  • копирование данных из буфера обмена Windows в компонент TDBImage, связанный с полем BLOB;
  • применение метода LoadFromFile компонента TBlobField;
  • использование метода Assign для копирования объекта типа TBitmap в значение свойства Picture компонента TBDBImage. Первый способ, в соответствии с которым происходит копирование изображения из буфера обмена, наиболее удобен, если требуется добавить изображение в таблицу, и с приложением работает конечный пользователь. В этом случае компонент TDBImage выступает в роли интерфейса между BLOB-полем таблицы и изображением, хранящимся в буфере обмена. Метод PasteFromClipboard компонента TDBImage как раз и занимается тем, что копирует изображение из буфера обмена в TDBImage. При сохранении записи изображение записывается в BLOB-поле таблицы.

    Поскольку буфер обмена Windows может содержать данные различных форматов, то желательно перед вызовом метода CopyFromClipboard осуществлять проверку формата хранящихся в нем данных. Для этого необходимо создать объект TClipboard и использовать его метод HasFormat, позволяющий определить формат хранящихся в буфере данных. Имейте в виду, что для создания объекта TClipboard необходимо добавить модуль Clipbrd в секцию uses того модуля, в котором будет создаваться экземпляр объекта.

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

    procedure TForm1.Button1Click(Sender: TObject); var C: TClipboard; begin C := TClipboard.Create; try if Clipboard.HasFormat(CF_BITMAP) then DBImage1.PasteFromClipboard else ShowMessage('Буфер обмена не содержит изображения!'); finally C.Free; end; end; Второй способ заполнения BLOB-поля заключается в загрузке изображения непосредственно из файла. Данный способ одинаково хорош как при создании приложения (формирование данных), так и при его использовании.

    Этот способ использует метод LoadFromFile компонента TBlobField, который применяется в Delphi для работы с dBASE-таблицами и двоичными Windows-полями или таблицами Paradox и графическими Windows-полями; в обоих случаях с помощью данного метода можно загрузить изображение и сохранить его в таблице.

    Методу LoadFromFile компонента TBlobField необходим единственный параметр типа String: имя загружаемого файла с изображением. Значение данного параметра может быть получено при выборе файла пользователем с помощью компонента TOpenDialog и его свойства FileName.

    Пример, демонстрирующий работу метода LoadFromFile компонента TBlobField с именем Table1Bitmap (поле с именем Bitmap связано с таблицей TTable, которой присвоено имя Table1):

    procedure TForm1.Button2Click(Sender: TObject); begin Table1Bitmap.LoadFromFile('c:\delphi\images\splash\16color\construc.bmp'); end; Третий способ для копирования содержимого объекта типа TBitmap в свойство Picture компонента TDBImage использует метод Assign. Объект типа TBitmap может быть как свойством Bitmap свойства объекта Picture компонента TImage, так и отдельного объекта TBitmap. Как и в методе, копирующем данные из буфера обмена в компонент TDBImage, данные изображения компонента TDBImage сохраняются в BLOB-поле после успешного сохранения записи.

    Ниже приведен пример, в котором задействован метод Assign. В нашем случае используется отдельный объект TBitmap. Для помещения изображения в компонент TBitmap был вызван его метод LoadFromFile.

    procedure TForm1.Button3Click(Sender: TObject); var B: TBitmap; begin B := TBitmap.Create; try B.LoadFromFile('c:\delphi\images\splashh\16color\athena.bmp'); DBImage1.Picture.Assign(B); finally B.Free; end; end;



    Извлечение изображения из поля BLOB

     Простейший способ – применение метода Assign для сохранения содержимого BLOB-поля в объекте, имеющем тип TBitmap. Отдельный объект TBitmap или свойство Bitmap объекта Picture, в свою очередь являющегося свойством компонента TImage, могут служить примером совместимой цели для данной операции.

    Пример кода, демонстрирующего использование метода Assign для копирования изображения из BLOB-поля в компонент TImage.

    procedure TForm1.Button1Click(Sender: TObject); begin Image1.Picture.Bitmap.Assign(Table1Bitmap); end;
    В этом примере объект Table1Bitmap типа TBlobField представляет собой BLOB-поле таблицы dBASE. Данный TblobField-объект был создан с помощью редактора полей (Fields Editor). Если для создания полей таблицы Fields Editor не используется, то получить к ним доступ можно с помощью метода FieldByName или свойства Fields, оба они являются членами компонентов TTable или TQuery. В случае ссылки на BLOB-поле таблицы с помощью одного из приведенных членов, перед использованием метода Assign указатель на поле должен быть прежде приведен к типу объекта TBlobField.
    Пример:
    procedure TForm1.Button1Click(Sender: TObject); begin Image1.Picture.Bitmap.Assign(TBLOBField(Table1.Fields[1])); end; Изображение, хранящееся в BLOB-поле, может быть скопировано непосредственно в отдельный объект TBitmap. Ниже приведен пример, демонстрирующий создание объекта TBitmap и сохранения в нем изображения из BLOB-поля.

    procedure TForm1.Button2Click(Sender: TObject); var B: TBitmap; begin B := TBitmap.Create; try B.Assign(Table1Bitmap); Image1.Picture.Bitmap.Assign(B); finally B.Free; end; end;



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

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

    Обратите внимание на метод GetAliasParams класса TSession. Возвращенная строка будет содержать искомый путь.

    Воспользуемся следующей функцией:

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



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

     Как получить псевдоним или путь к таблице?

    Решение 1:
    Есть три способа сделать это:

  • Первый годится только для постоянных псевдонимов BDE.
  • Второй работает с BDE и локальными псевдонимами.
  • Третий работает с BDE и локальными псевдонимами, используя «тяжелый» путь, через вызовы DBI. function GetDBPath1(AliasName: string): TFileName; var ParamList: TStringList; begin ParamList := TStringList.Create; with Session do try GetAliasParams(AliasName, ParamList); Result := UpperCase(ParamList.Values['PATH']) + '\'; finally Paramlist.Free; end; end; function GetDBPath2(AliasName: string): TFileName; var ParamList: TStringList; i: integer; begin ParamList := TStringList.Create; with Session do try try GetAliasParams(AliasName, ParamList); except for i:=0 to pred(DatabaseCount) do if (Databases[i].DatabaseName = AliasName) then ParamList.Assign(Databases[i].Params); end; Result := UpperCase(ParamList.Values['PATH']) + '\'; finally Paramlist.Free; end; end; function GetDBPath3(ATable: TTable): TFileName; var TblProps: CURProps; pTblName, pFullName: DBITblName; begin with ATable do begin AnsiToNative(Locale, TableName, pTblName, 255); Check(DBIGetCursorProps(Handle, TblProps)); Check(DBIFormFullName(DBHandle, pTblName, TblProps.szTableType, pFullName)); Result := ExtractFilePath(StrPas(pFullName)); end; end;
    Решение 2:
    По таблице (фактически по Database) получить физическое местонахождение.

    Примечание
    Database можно создать явно, если нет, Delphi сама его создаст. Доступ к ней осуществляется по Table(Query).Database.

    uses DbiProcs; function GetDirByDatabase(Database: TDataBase): string; var pszDir: PChar; begin pszDir := StrAlloc(255); try DbiGetDirectory(Database.Handle, True, pszDir); Result := StrPas(pszDir); finally StrDispose(pszDir); end; end; По псевдониму:

    function GetPhNameByAlias(sAlias: string): string; var Database: TDataBase; pszDir: PChar; begin Database := TDataBase.Create(nil); pszDir := StrAlloc(255); try Database.AliasName := sAlias; Database.DatabaseName := 'TEMP'; Database.Connected := True; DbiGetDirectory(Database.Handle, True, pszDir); Database.Connected := False; Result := StrPas(pszDir); finally Database.Free; StrDispose(pszDir); end; end; [Nomadic]



    Задание псевдонима программным путем

     Эта информация поможет разобраться в вопросе создания и использования псевдонимов баз данных в приложениях.

    Вне Delphi создание и конфигурирование псевдонимов осуществляется утилитой BDECFG.EXE. Тем не менее, применяя компонент TDataBase, в приложении можно создать и использовать псевдоним, не определенный в IDAPI.CFG.

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

    • Решение 1. Создает и конфигурирует псевдоним для базы данных STANDARD (.DB, .DBF). Псевдоним затем используется компонентом TTable.
    • Решение 2. Создает и конфигурирует псевдоним для базы данных INTERBASE (.GDB). Псевдоним затем используется компонентом TQuery для подключения к двум таблицам базы данных.
    • Решение 3. Создает и конфигурирует псевдоним для базы данных STANDARD (.DB, .DBF). Демонстрация ввода псевдонима пользователем и его конфигурация во время выполнения программы.
    Решение 1:
    Используем базу данных .DB или .DBF (STANDARD)
    1. Создаем новый проект.
    2. Располагаем на форме следующие компоненты: TDataBase, TTable, TDataSource, TDBGrid и TButton.
    3. Дважды щелкаем по компоненту TDataBase или через контекстное меню (правая кнопка мыши) вызываем редактор базы данных.
    4. Присваиваем базе данных имя «MyNewAlias». Это имя будет выполнять роль псевдонима в свойстве DatabaseName для компонентов типа TTable, TQuery, TStoredProc.
    5. Выбираем в поле Driver Name (Имя драйвера) пункт STANDARD.
    6. Нажимаем кнопку Defaults. Это автоматически добавляет путь (PATH=) в секцию перекрытых параметров (окно Parameter Overrides).
    7. Устанавливаем переменную PATH (PATH=С:\Program Files\Common Files\Borland Shared\Data).
    8. Нажимаем кнопку OK и закрываем окно редактора.
    9. В компоненте TTable свойству DatabaseName присваиваем значение «MyNewAlias».
    10. В компоненте TDataSource свойству DataSet присваиваем значение «Table1».
    11. В компоненте DBGrid свойству DataSource присваиваем значение «DataSource1».
    12. Создаем в компоненте TButton обработчик события OnClick. procedure TForm1.Button1Click(Sender: TObject); begin Table1.Tablename:= 'CUSTOMER'; Table1.Active:= True; end;
    13. Запускаем приложение.

      Примечание
      В качестве альтернативы шагам 3–11 можно включить все эти действия в сам обработчик:

      procedure TForm1.Button1Click(Sender: TObject); begin Database1.DatabaseName := 'MyNewAlias'; Database1.DriverName := 'STANDARD'; Database1.Params.Clear; Database1.Params.Add('PATH=С:\Program Files\Common Files\ Borland Shared\Data'); Table1.DatabaseName := 'MyNewAlias'; Table1.TableName := 'CUSTOMER'; Table1.Active := True; DataSource1.DataSet := Table1; DBGrid1.DataSource := DataSource1; end;
    Решение 2
    Используем базу данных INTERBASE
    1. Создаем новый проект.
    2. Располагаем на форме следующие компоненты: - TDataBase, TQuery, TDataSource, TDBGrid и TButton.
    3. Посредством двойного щелчка по компоненту TDataBase или через контекстное меню (правая кнопка мыши) вызываем редактор базы данных.
    4. Присваиваем базе данных имя «MyNewAlias». Оно будет выполнять роль псевдонима в свойстве DatabaseName для компонентов типа TTable, TQuery, TStoredProc.
    5. Выбираем в поле Driver Name (имя драйвера) пункт INTRBASE.
    6. Нажимаем кнопку Defaults. Это автоматически добавляет путь (PATH=) в секцию перекрытых параметров (окно Parameter Overrides). SERVER NAME=IB_SERVER:/PATH/DATABASE.GDB USER NAME=MYNAME OPEN MODE=READ/WRITE SCHEMA CACHE SIZE=8 LANGDRIVER= SQLQRYMODE= SQLPASSTHRU MODE=SHARED AUTOCOMMIT SCHEMA CACHE TIME=-1 MAX ROWS=-1 BATCH COUNT=200 ENABLE SCHEMA CACHE=FALSE SCHEMA CACHE DIR= ENABLE BCD=FALSE BLOBS TO CACHE=64 BLOB SIZE=32 PASSWORD= Устанавливаем следующие параметры:

      SERVER NAME=C:\Program Files\Common Files\Borland Shared\Data\EMPLOYEE.GDB USER NAME=SYSDBA OPEN MODE=READ/WRITE SCHEMA CACHE SIZE=8 LANGDRIVER= SQLQRYMODE= SQLPASSTHRU MODE=NOT SHARED SCHEMA CACHE TIME=-1 PASSWORD=masterkey
    1. В компоненте TDataBase свойство LoginPrompt устанавливаем в False. Если в секции перекрытых параметров (окно Parameter Overrides) задан пароль (ключ PASSWORD) и свойство LoginPrompt установлено в False, при соединении с базой данный пароль запрашиваться не будет. Предупреждение: при неправильно указанном пароле в секции перекрытых параметров и неактивном свойстве LoginPrompt вы не сможете получить доступ к базе данных, поскольку нет возможности ввести правильный пароль – диалоговое окно Ввод пароля отключено свойством LoginPrompt.
    2. Нажимаем кнопку OK и закрываем окно редактора.
    3. В компоненте TQuery свойству DatabaseName присваиваем значение «MyNewAlias».
    4. В компоненте TDataSource свойству DataSet присваиваем значение «Query1».
    5. В компоненте DBGrid свойству DataSource присваиваем значение «DataSource1».
    6. Создаем в компоненте TButton обработчик события OnClick. procedure TForm1.Button1Click(Sender: TObject); begin Query1.SQL.Clear; Query1.SQL.ADD('SELECT DISTINCT * FROM CUSTOMER C, SALES S' + ' WHERE (S.CUST_NO = C.CUST_NO)' + ' ORDER BY C.CUST_NO, C.CUSTOMER'); Query1.Active := True; end;
    7. Запускаем приложение.
    Решение 3
    Ввод псевдонима пользователем

    В этом решении выводится диалоговое окно и на основе информации, введенной пользователем, создается псевдоним.

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

    1. Выполняем шаги 1–11 из Решения 1.
    2. Пишем следующий обработчик события OnClick компонента TButton: procedure TForm1.Button1Click(Sender: TObject); var NewString: string; ClickedOK: Boolean; begin NewString := 'C:\'; ClickedOK := InputQuery('Database Path', 'Path:', NewString); if ClickedOK then begin Database1.DatabaseName := 'MyNewAlias'; Database1.DriverName := 'STANDARD'; Database1.Params.Clear; Database1.Params.Add('Path=' + NewString); Table1.DatabaseName := 'MyNewAlias'; Table1.TableName := 'CUSTOMER'; Table1.Active := True; DataSource1.DataSet := Table1; DBGrid1.DataSource := DataSource1; end; end;
    3. Запускаем приложение.




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

     Сделанные в таблице изменения непосредственно на диск не записываются до тех пор, пока таблица не закрыта. Потеря питания или сбой в системе могут привести к утрате данных и прочим неприятностям. Чтобы избежать этого, существует два прямых вызова Database Engine, приводящих к одному и тому же результату. Эти функции – DbiUseIdleTime и DbiSaveChanges.

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

    procedure TForm1.Table1AfterPost(DataSet: TDataSet); begin DbiSaveChanges(Table1.Handle); end; При таком способе можно не опасаться порчи данных в случае потери питания или сбоя системы, которая может произойти после обновления записи.

    При помощи функции DBISaveChanges также можно сделать постоянной временную таблицу (созданную с помощью DBICreateTempTable).

    Эта функция не применима к таблицам SQL.

    DBIUseIdleTime может быть вызвана, если очередь запросов Windows (Windows Message Queue) пуста. Это позволяет Database Engine сохранить на диске «грязные буферы». Другими словами, выполняется операция DBISaveChanges, но применительно ко ВСЕМ измененным таблицам. Тем не менее, данная операция не обязательно должна выполняться после каждого обновления записи, ее нужно приберечь для «холостого» периода (период простоя, idle).

    В Delphi этому можно найти такое применение (добавьте BDE в список используемых модулей):

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

    В случае если в таблице выполняется не слишком много изменений, клиент может использовать вызов DBISaveChanges после каждого постинга (обновления записи) или же «прикрепить» к таймеру вызов DBIUseIdleTime.



    Работа с BDE в сети

     Может ли мое приложение иметь доступ к файлам, расположенным на сетевых дисках?

    Да.

    Когда я попытался это сделать, программа выдала сообщение об ошибке «Not initialized for accessing network files» (не инициализирована для доступа к сетевым файлам).

    Необходимо задать правильный путь к каталогу в поле NET DIR файла IDAPI.CFG. Директория должна быть одна и к ней должен быть открыт доступ всем пользователям приложения с применением одинаковых подключенных сетевых дисков. Если NET DIR указывает на «F:\PUBLIC\NETDIR», то пользователи с подключенным сетевым диском «G:\NETDIR» доступа не получат.

    Можно ли запустить приложение, относящееся к описываемой категории, с сетевого диска без установленного на локальной машине BDE (за исключением возможных ссылок в локальном файле WIN.INI на копии элементов программы BDE/IDAPI, расположенных на сетевом диске)?

    Установите BDE в сети, затем добавьте следующие секции в файл WIN.INI каждой рабочей станции:

    [IDAPI] CONFIGFILE01=F:\IDAPI\IDAPI.CFG DLLPATH=F:\IDAPI [Borland Language Drivers] LDPath=F:\IDAPI\LANGDRV Пути должны отражать текущее месторасположение каталога IDAPI.

    Для установки NET DIR мне нужно запустить BDECFG на каждой рабочей станции или просто сделать это на сервере?

    C помощью утилиты BDECFG отредактируйте файл IDAPI.CFG и сохраните его в сетевом каталоге IDAPI. Следовательно, данную операцию необходимо проделать всего лишь один раз.

    Если мне нужно сделать это только на сервере, то как все рабочие станции узнают о месторасположении сетевых файлов (NET DIR)?

    Рабочая станция открывает файл IDAPI.CFG из каталога, указанного в WIN.INI, и уже оттуда читает настройки NET DIR.

    [News Group]



    Форматирование носителя

     Как отформатировать носитель под Win32?

    Используйте ShFormatDrive:

    function SHFormatDrive(hWnd: HWND; Drive: Word; fmtID: Word; Options: Word): Longint; stdcall; external 'Shell32.dll' name 'SHFormatDrive'; const SHFMT_DRV_A = 0; SHFMT_DRV_B = 1; SHFMT_ID_DEFAULT = $FFFF; SHFMT_OPT_QUICKFORMAT = 0; SHFMT_OPT_FULLFORMAT = 1; SHFMT_OPT_SYSONLY = 2; SHFMT_ERROR = -1; SHFMT_CANCEL = -2; SHFMT_NOFORMAT = -3; procedure TForm1.Button1Click(Sender: TObject); var FmtRes: longint; begin try FmtRes := ShFormatDrive(Handle, SHFMT_DRV_A, SHFMT_ID_DEFAULT, SHFMT_OPT_QUICKFORMAT); case FmtRes of SHFMT_ERROR: ShowMessage('Error formatting the drive'); SHFMT_CANCEL: ShowMessage('User canceled formatting the drive'); SHFMT_NOFORMAT: ShowMessage('No Format') else ShowMessage('Disk has been formatted'); end; except end; end;



    Определение свободного места на диске

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

    Для этого потребуется использовать GetDiskFreeSpaceEx() с последующим преобразованием целочисленных значений к типу Double.

    GetDiskFreeSpaceEx: function (Directory: PChar; var FreeAvailable, TotalSpace: TLargeInteger; TotalFree: PLargeInteger): Bool stdcall = nil; procedure GetDiskSizeAvail(TheDrive: PChar; var TotalBytes: double; var TotalFree: double); var AvailToCall, TheSize: TLargeInteger; FreeAvail: PLargeInteger; begin GetDiskFreeSpaceEx(TheDrive, AvailToCall, TheSize, FreeAvail); {$IFOPT Q+} {$DEFINE TURNOVERFLOWON} {$Q-} {$ENDIF} if TheSize >= 0 then TotalBytes := TheSize else if TheSize = -1 then begin TotalBytes := $7FFFFFFF; TotalBytes := TotalBytes * 2; TotalBytes := TotalBytes + 1; end else begin TotalBytes := $7FFFFFFF; TotalBytes := TotalBytes + abs($7FFFFFFF - TheSize); end; if AvailToCall >= 0 then TotalFree := AvailToCall else if AvailToCall = -1 then begin TotalFree := $7FFFFFFF; TotalFree := TotalFree * 2; TotalFree := TotalFree + 1; end else begin TotalFree := $7FFFFFFF; TotalFree := TotalFree + abs($7FFFFFFF - AvailToCall); end; end; procedure TForm1.Button1Click(Sender: TObject); var TotalBytes: double; TotalFree: double; begin GetDiskSizeAvail('C:\', TotalBytes, TotalFree); ShowMessage('Total bytes: ' + FloatToStr(TotalBytes)); ShowMessage('Total bytes free: ' + FloatToStr(TotalFree)); end; Примечание
    Функция GetDiskFreeSpaceEx описана в SysUtils.



    Управление дисководом

     Как проверить готовность диска A:?

    function DiskInDrive(const Drive: char): Boolean; var DrvNum: byte; EMode: Word; begin Result := false; DrvNum := Ord(Drive) - Ord('A') + 1; EMode := SetErrorMode(SEM_FAILCRITICALERRORS); try if DiskSize(DrvNum) = -1 then Result := true else MessageBeep(0); finally SetErrorMode(EMode); end; end;



    Блокирование ввода информации

     Как заблокировать ввод?

    Недокументированная функция из User32.dll, которая блокирует ввод (мышь, клавиатуру кроме <Ctrl>+<Alt>+<Del>). При нажатии <Ctrl>+<Alt>+<Del> все разблокируется.

    procedure BlockInput; external 'user32.dll'; Передаем параметры в стек вручную через push (1 – заблокировать; 0 – разблокировать):

    procedure Block; asm push 1 call BlockInput end; procedure UnBlock; asm push 0 call BlockInput end; [Pastushenko Andrew]



    Индикация статуса клавиш

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

    Событие OnIdle происходит каждый раз, когда приложение "не работает". С помощью обработчика данного события можно сделать так, чтобы во время «простоя» приложение могло выполнять второстепенные задачи. В это время оно находится в ожидании какого-то события, например, ввода пользователем новой команды.

    TIdleEvent – процедурный тип, имеющий логический параметр Done со значением по умолчанию True. Если Done равен True, после обработки события OnIdle вызывается функция Windows API WaitMessage, передающая управление другим приложениям до тех пор, пока в очереди сообщений вашего приложения не появится новое сообщение. Если Done равно False, WaitMessage не вызывается.

    Как же решить нашу задачу в свете вышесказанного?

    Добавьте четыре компонента CheckBox к вашему компоненту StatusBar и включите следующее объявление в секцию Private вашей формы:

    procedure AppOnIdle(Sender: TObject; var Done: Boolean); Добавьте в секцию реализации: procedure TForm1.AppOnIdle(Sender: TObject; var Done: Boolean); begin CheckBox1.Checked := Odd(GetKeyState(VK_CAPITAL)); CheckBox2.Checked := Odd(GetKeyState(VK_SHIFT)); CheckBox3.Checked := Odd(GetKeyState(VK_NUMLOCK)); CheckBox4.Checked := Odd(GetKeyState(VK_SCROLL)); Done := False; end; procedure TForm1.FormCreate(Sender: TObject); begin Application.OnIdle := AppOnIdle; end;



    Отключение клавиш <Ctrl>+<Alt>+<Del>, <Alt>+<Tab>, <Ctrl>+<Esc> из приложения

     Как подавить реакцию Windows на <Ctrl>+<Alt>+<Del>, <Alt>+<Tab>, <Ctrl>+<Esc>?

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

    // Включение режима SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, 0, 0); // Выключение режима SystemParametersInfo(SPI_SCREENSAVERRUNNING, 0, 0, 0);



    Управление индикаторами на клавиатуре

     Как включать/выключать индикаторы NumLock, CapsLock и т. д.?

    Решение:

    procedure SetNumLock(bState: Boolean); var KeyState: TKeyboardState; begin GetKeyboardState(KeyState); if ((bState) and (not ((KeyState[VK_NUMLOCK] and 1) = 1)) or ((not (bState)) and ((KeyState[VK_NUMLOCK] and 1) = 1))) then // имитация нажатия клавиши keybd_event(VK_NUMLOCK, $45, (KEYEVENTF_EXTENDEDKEY or 0), 0); // имитация отпускания клавиши keybd_event(VK_NUMLOCK, $45, (KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP), 0); SetKeyboardState(KeyState); end; Для других клавиш заменяйте VK_NUMLOCK.

    [News Group]



    Переключение языка

     Для переключения языка применяется вызов LoadKeyboardLayout:

    var russian, latin: HKL; ... russian := LoadKeyboardLayout('00000419', 0); latin := LoadKeyboardLayout('00000409', 0); Где-то в программе:

    SetActiveKeyboardLayout(russian); [Nikolaev Igor]

    Примечание
    Для переключения надо использовать функцию API ActivateKeyboardLayout(russian, 0), где russian – см. выше. Для вызова SetActiveKeyboardLayout(russian) необходимо определить такую функцию и передать ей в качестве параметра russian. Второй параметр – 0 (можно не передавать).



    Откуда инсталлировалась Windows

     Как узнать, откуда инсталлировалась Windows?

    Решение:

    procedure TForm1.Button1Click(Sender: TObject); var reg: TRegistry; begin reg := TRegistry.Create; reg.RootKey := HKEY_LOCAL_MACHINE; reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\SETUP', false); ShowMessage(reg.ReadString('SourcePath')); reg.CloseKey; reg.Free; end; Примечание
    Добавьте в uses модуль Registry.



    Пиктограмма приложения в панели задач

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

    Application.CreateHandle; ShowWindow(Application.Handle, SW_HIDE); Application.ShowMainForm := False; При нормальном поведении TApplication создает дескриптор и показывает окно прежде, чем что-то начнет «происходить». Чтобы избежать этого, необходимо создать модуль, содержащий единственную строчку в секции initialization:

    IsLibrary := True; Поместите этот модуль первым в .DPR-файле в списке используемых модулей. Так мы обманываем TApplication. Оно «думает», что оно запущено из DLL, тем самым изменяя свое обычное поведение.

    [News Group]



    Пиктограмма приложения в окне Tray

     Как поместить пиктограмму в Tray?

    Решение:

    function TaskBarAddIcon(hWindow: THandle; ID: Cardinal; ICON: hicon; CallbackMessage: Cardinal; Tip: String): boolean; var NID: TNotifyIconData; begin FillChar(NID, SizeOf(TNotifyIconData), 0); with NID do begin cbSize := SizeOf(TNotifyIconData); Wnd := hWindow; uID := ID; uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP; uCallbackMessage := CallbackMessage; hIcon := Icon; if Length(Tip) > 63 then SetLength(Tip, 63); StrPCopy(szTip, Tip); end; Result := Shell_NotifyIcon(NIM_ADD, @NID); end; [News Group]

    Примечание
    В uses необходимо добавить ShellAPI.



    Перемещение формы не за заголовок

     Решение:

    TForm1 = class(TForm) private procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest; end; { реализация обработчика события } procedure TForm1.WMNCHitTest(var M: TWMNCHitTest); begin inherited; { вызвали унаследованный обработчик сообщения, } if M.Result = htClient then { щелкнув в клиентской области окна? } M.Result := htCaption; { если так, то мы заставили Windows думать, } { что щелчок был произведен по заголовку окна. } end; Это заставляет Windows думать, что курсор мыши находится в области заголовка окна. Но это может повлечь за собой другую проблему, поскольку предполагается, что мышь будет считаться расположенной в области заголовка при любом ее нахождении в области клиента. Тем не менее, это решение элегантно, поскольку при перетаскивании формы ее границы изменяются на «резиновые». Если описаный способ не помогает, попробуйте работать с другим сообщением, которое может дать тот же результат.

  • Выключите все BorderIcons формы.
  • Убедитесь в том, что заголовок является пустой строкой.
  • BorderStyle = bsNone
  • Перекройте процедуру формы CreateParams, как показано ниже: type TForm1 = class(TForm) ... protected procedure CreateParams(var Params: TCreateParams); override; ... end; implementation procedure TForm1.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); with Params do Style := Style or ws_Border or ws_ThickFrame; end; end. Использование обработчиков событий мыши:

    var Moving: Boolean; OldX, OldY: Integer; ... procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Button = mbLeft then begin { нас интересует только левая кнопка } OldLeft := X; { сохраняем текущую позицию } OldTop := Y; Moving := True; end; end; procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin { Если необходимо переместить окно относительно своей оригинальной позиции } if Moving then Self.SetBounds(Self.Left + X - OldLeft, Self.Top + Y - OldTop, Self.Width, Self.Height); end; procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Button = mbLeft then Moving := False; { Останавливаем перемещение } end; Не забудьте назначить эти методы каждому элементу управления вашей формы:

    Self.Panel1.OnMouseDown := Self.OnMouseDown;



    Использование собственных курсоров в приложении

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

    С помощью программы Image Editor упакуйте курсор в RES-файл. В следующем примере подразумевается, что курсор под именем cursor_1 сохранен в файле MYFILE.RES.

    {$R c:\programs\delphi\MyFile.res} { Это ваш RES файл } const PutTheCursorHere_Dude = 1; { произвольное положительное число } procedure stuff; begin Screen.Cursors[PutTheCursorHere_Dude] := LoadCursor(hInstance, PChar('cursor_1')); Screen.Cursor := PutTheCursorHere_Dude; end;



    Добавление своих пунктов меню в системное меню окна

     Поместите:

    const My_MenuItem = $4000; Константу можете назвать по-своему и дать ей другой номер, но есть некоторые номера, которые зарезервированы Windows для собственных пунктов меню – не попадите на них.

    Обязательно поместите в секцию private строку:

    procedure HookSysCommand(var message: TwmSysCommand); message WM_SysCommand; procedure TForm1.HookSysCommand(var message: TwmSysCommand); begin inherited; case Message.CmdType of My_MenuItem: ShowMessage('Пункт активизирован'); end; end; procedure TForm1.FormCreate(Sender: TObject); var SysMenu: THandle; begin SysMenu := GetSystemMenu(Handle, False); AppendMenu(SysMenu, mf_SEPARATOR, 0, #0); AppendMenu(SysMenu, mf_BYPOSITION, My_MenuItem, 'Новый пункт'); { AppendMenu добавляет новый пункт в конец, а для вставки своего пункта в другую порядковую позицию воспользуйтесь InsertMenu. Пример: InsertMenu(SMenu, 1, mf_BYPOSITION, My_MenuItem, 'Новый пункт'); } end; [Алексей]


    Часть 4


    При перепечатке любого материала с сайта, видимая ссылка на источник www.warayg.narod.ru и все имена, ссылки авторов обязательны.

    © 2005