Прокрутка таблицы — хитрость PeekMessage

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

На днях я решил поиграть с API-функцией PeekMessage(). Функция работает, но ловить ее нужно следующим образом.

Я прокручиваю таблицу, связанную с набором данных. «Поиск» в наборе данных замедляет процесс скролирования (условимся называть «поиском» синхронное перемещение табличного курсора в процессе скроллирования, при котором текущей записью становится запись, ближайшая к нажимаемой кнопке полосы прокрутки). Возникла задача: необходимо отменить «поиск» (процесс слежения) и переместить указатель на необходимую запись только в случае остановки пользователем процесса скроллирования, другими словами — пока пользователь осуществляет скроллирование, «поиск» необходимо отменить. Итак, ко мне в голову пришла мысль, что с помощью PeekMessage() можно выловить определенное сообщение и тем самым отменить поиск во время прокрутки. Звучит просто, но на самом деле все оказалось наоборот.

Я установил фильтр поиска сообщений на WM_MOUSEFIRST/LAST. Ситуация: пользователь непрерывно прокручивает DBGrid вниз, т.е. держит нажатой нижнюю кнопку скроллирования. В результате PeekMessage() возвращает False — нас это не устраивает, это не то, что мы хотим. Положительный результат можно получить только в случае сверхскоростных манипуляций мышью.

Если в фильтре использовать 0 и 0, чтобы поймать любое сообщение, результат всегда будет True. Причина, очевидно в том, что любой щелчок мыши в области DBGrid никак не обойдется без последствий, генерация системой сообщения PAINT яркий тому пример, поэтому PeekMessage может возвратить True в любое время, что тоже не может нам помочь.

Было бы хорошо, если бы дескриптор DBGrid получал событие OnMouseUp() во время его скроллирования. Обидно, но OnMouseUp() работает только с DBGrid, а не с полосами прокрутки. OnMouseUp() с TForm при KeyPreview:=true не работает, я проверял.

После пришла идея опросить состояние кнопок мыши с помощью функции GetKeyState(). Пока кнопка нажата (DOWN), «поиск» запрещен, и наоборот. UP (кнопка отжата) свидетельствует об окончании процесса скроллирования. Данный способ работы с окном во время манипуляций с его полосой прокрутки заработал без проблем. Теперь все в порядке: поиска во время прокрутки не происходит и табличный курсор также никуда не перемещается.

Рассмотренная тема имеет отношение к полосам прокрутки, а события OnKeyUp() и OnMouseUp() могут применяться где-нибудь еще.

{/codecitation}

Проиграть звук из таблицы

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Xavier Pacheco

unit Main;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

ExtCtrls, DBCtrls, DB, DBTables, StdCtrls, Mask, Buttons, ComCtrls;

type

TMainForm = class(TForm)

tblSounds: TTable;

dsSounds: TDataSource;

tblSoundsWaveTitle: TStringField;

tblSoundsWave: TBlobField;

edTitle: TDBEdit;

edFileName: TDBEdit;

Label1: TLabel;

Label2: TLabel;

OpenDialog: TOpenDialog;

tblSoundsFileName: TStringField;

SaveDialog: TSaveDialog;

pnlToobar: TPanel;

sbPlay: TSpeedButton;

sbAdd: TSpeedButton;

sbSave: TSpeedButton;

sbExit: TSpeedButton;

Bevel1: TBevel;

dbnNavigator: TDBNavigator;

stbStatus: TStatusBar;

procedure sbPlayClick(Sender: TObject);

procedure sbAddClick(Sender: TObject);

procedure sbSaveClick(Sender: TObject);

procedure sbExitClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

procedure OnAppHint(Sender: TObject);

end;

var

MainForm: TMainForm;

implementation

{$R *.DFM}

uses MMSystem;

procedure TMainForm.sbPlayClick(Sender: TObject);

var

B: TBlobStream;

M: TMemoryStream;

begin

B := TBlobStream.Create(tblSoundsWave, bmRead); // create blob stream

Screen.Cursor := crHourGlass; // wait hourglass

try

M := TMemoryStream.Create; // create memory stream

try

M.CopyFrom(B, B.Size); // copy from blob to memory stream

// Attempt to play sound. Raise exception if something goes wrong

Win32Check(PlaySound(M.Memory, 0, SND_SYNC or SND_MEMORY));

finally

M.Free;

end;

finally

Screen.Cursor := crDefault;

B.Free; // clean up

end;

end;

procedure TMainForm.sbAddClick(Sender: TObject);

begin

if OpenDialog.Execute then

begin

tblSounds.Append;

tblSounds[‘FileName’] := ExtractFileName(OpenDialog.FileName);

tblSoundsWave.LoadFromFile(OpenDialog.FileName);

edTitle.SetFocus;

end;

end;

procedure TMainForm.sbSaveClick(Sender: TObject);

begin

with SaveDialog do

begin

FileName := tblSounds[‘FileName’]; // initialize file name

if Execute then // execute dialog

tblSoundsWave.SaveToFile(FileName); // save blob to file

end;

end;

procedure TMainForm.sbExitClick(Sender: TObject);

begin

Close;

end;

procedure TMainForm.FormCreate(Sender: TObject);

begin

Application.OnHint := OnAppHint;

end;

procedure TMainForm.OnAppHint(Sender: TObject);

begin

stbStatus.SimpleText := Application.Hint;

end;

end.

{/codecitation}

Проверка изменения данных таблицы

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

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

if Table1.State in dsEditModes then

if MessageDlg( ‘Сохранить изменения?’, mtInformation, [mbYes, mbNo], 0 ) = mrYes then

Table1.Post

else

Table1.Cancel ;

{/codecitation}

Предохранить от потери данных

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Оформил: DeeCo

Автор: http://www.swissdelphicenter.ch

{

Wenn eine Datenbank bzw. eine Tabelle (Paradox oder DBase)

lokal auf einem PC installiert ist und BDE-Einstellung

«LOCAL SHARE» FALSE ist, dann werden Anderungen des Tabelleninhalts

durch die BDE zwischengespeichert.

Diese Daten sind bei einem Chrash weg.

Daher kann es sich empfehlen die Zwischenspeicherung zu umgehen:

If a database or a table is local on a PC installed (Paradox or Dbase)

and the BDE-setting «LOCAL SHARE» is FALSE, then changings are not

stored immediatly but are kept in the memory.

This changings are gone after a chrash.

So it might be better after changing to store the data physically on the disk:

}

uses

BDE;

procedure TForm1.Table1AfterPost(DataSet: TDataSet);

begin

DbiSaveChanges(Table1.Handle);

end;

{/codecitation}

Получить версию таблицы

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Оформил: DeeCo

Автор: http://www.swissdelphicenter.ch

function GetTableVersion(Table: TTable): Longint;

var

hCursor: hDBICur;

DT: TBLFullDesc;

begin

Check(DbiOpenTableList(Table.DBHandle, True, False,

PChar(Table.TableName), hCursor));

Check(DbiGetNextRecord(hCursor, dbiNOLOCK, @DT, nil));

Result := DT.tblExt.iRestrVersion;

Check(DbiCloseCursor(hCursor));

end;

{/codecitation}

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

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Xavier Pacheco

Если ссылка на таблицу получена через псевдоним, получить физический путь к ней не так просто. Для получения этого пути необходимо использовать функцию BDE DbiGetDatabaseDesc. Данной функции в качестве параметров передаются имя псевдонима и указатель на структуру DBDesc. Структура DBDesc будет заполнена информацией, относящейся к этому псевдониму. Определение структуры:

pDBDesc = ^DBDesc;

DBDesc = packed record { Описание данной базы данных }

szName : DBINAME; { Логическое имя (или псевдоним) }

szText : DBINAME; { Описательный текст }

szPhyName : DBIPATH; { Физическое имя/путь }

szDbType : DBINAME; { Тип базы данных }

end;

Физическое имя/путь будет содержаться в поле szPhyName структуры DBDesc.

Возможные значения, возвращаемые функцией DBIGetDatbaseDesc:

DBIERR_NONE Описание базы данных для pszName было успешно извлечено.

DBIERR_OBJNOTFOUND База данных, указанная в pszName, не была обнаружена.

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

var

vDBDesc: DBDesc;

DirTable: String;

begin

Check(DbiGetDatabaseDesc(PChar(Table1.DatabaseName), @vDBDesc));

DirTable := Format(‘%s\%s’, [vDBDesc.szPhyName, Table1.TableName]);

ShowMessage(DirTable);

end;

{/codecitation}

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

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Вам нужно воспользоваться свойством FieldDefs. В следующем примере список полей и их соответствующий размер передается компоненту TMemo (расположенному на форме) с именем Memo1:

procedure TForm1.ShowFields;

var

i: Word;

begin

Memo1.Lines.Clear;

Table1.FieldDefs.Update;

{ должно быть вызвано, если Table1 не активна }

for i := 0 to Table1.FieldDefs.Count — 1 do

With Table1.FieldDefs.Items[i] do

Memo1.Lines.Add(Name ‘ — ‘ IntToStr(Size));

end;

Если вам просто нужны имена полей (FieldNames), то используйте метода TTable GetFieldNames:

GetIndexNames для получения имен индексов:

var

FldNames, IdxNames : TStringList;

begin

FldNames := TStringList.Create;

IdxNames := TStringList.Create;

If Table1.State = dsInactive then

Table1.Open;

Table1.GetFieldNames(FldNames);

Table1.GetIndexNames(IdxNames);

{…… используем полученную информацию ……}

FldNames.Free; {освобождаем stringlist}

IdxNames.Free;

end;

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

{/codecitation}

Перемещение таблиц

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Здесь я привожу примеры программ, которые я использую для копирования и удаления таблиц. Необходимые для работы модули: DB, DBTables, DbiProcs,DbiErrs, и DbiTypes. Вам всего лишь необходимо указать каталог расположения, исходное имя таблицы, каталог назначения и имя таблицы, куда будет скопирована исходная таблица и BDE скопирует таблицу целиком со всеми индексами. Процедура удаления в качестве входных параметров использует каталог расположения и имя таблицы, при этом BDE удаляет как саму таблицу, так и все файлы, связанные с ней (индексы и т.п.). Для тестирования данные процедуры были помещены в новое приложение и мне пришлось их немного отредактировать, чтобы удалить некоторые зависимости, которые были связаны с главной формой приложения. Теперь процедуры являются полностью автономными и могут быть помещены в отдельный модуль. (Не забудьте включить его в список используемых модулей). Пользуйтесь на здоровье!

procedure TConvertForm.CopyTable(FromDir, SrcTblName, ToDir, DestTblName:

string);

var

DBHandle: HDBIDB;

ResultCode: DBIResult;

Src, Dest, Err: array[0..255] of Char;

SrcTbl, DestTbl: TTable;

begin

SrcTbl := TTable.Create(Application);

DestTbl := TTable.Create(Application);

try

SrcTbl.DatabaseName := FromDir;

SrcTbl.TableName := SrcTblName;

SrcTbl.Open;

DBHandle := SrcTbl.DBHandle;

SrcTbl.Close;

ResultCode := DbiCopyTable(DBHandle, false,

StrPCopy(Src, FromDir ‘\’ SrcTblName), nil,

StrPCopy(Dest, ToDir ‘\’ DestTblName));

if (ResultCode DBIERR_NONE) then

begin

DbiGetErrorString(ResultCode, Err);

raise EDatabaseError.Create(‘При копировании ‘

FromDir ‘\’ SrcTblName ‘ в ‘

ToDir ‘\’ DestTblName ‘ ,’

‘BDE сгенерировал ошибку »’

StrPas(Err) »»);

end;

finally

SrcTbl.Free;

DestTbl.Free;

end;

end;

procedure TConvertForm.DeleteTable(Dir, TblName: string);

var

DBHandle: HDBIDB;

ResultCode: DBIResult;

tbl, Err: array[0..255] of Char;

SrcTbl, DestTbl: TTable;

SrcTbl := TTable.Create(Application);

begin

try

SrcTbl.DatabaseName := Dir;

SrcTbl.TableName := TblName;

SrcTbl.Open;

DBHandle := SrcTbl.DBHandle;

SrcTbl.Close;

ResultCode := DbiDeleteTable(DBHandle,

StrPCopy(Tbl, Dir ‘\’ TblName), nil);

if (ResultCode DBIERR_NONE) then

begin

DbiGetErrorString(ResultCode, Err);

raise EDatabaseError.Create(‘Удаляя ‘

Dir ‘\’ TblName ‘, BDE ‘

‘сгенерировал ошибку »’

StrPas(Err) »»);

end;

finally

SrcTbl.Free;

end;

end;

{/codecitation}

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

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

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

function dgPackParadoxTable(Tbl: TTable; Db: TDatabase): DBIResult;

{ Packs a Paradox table by calling the BDE DbiDoRestructure

function. The TTable passed as the first parameter must

be closed. The TDatabase passed as the second parameter

must be connected. }

var

TblDesc: CRTblDesc;

begin

Result := DBIERR_NA;

FillChar(TblDesc, SizeOf(CRTblDesc), 0);

StrPCopy(TblDesc.szTblName, Tbl.TableName);

TblDesc.bPack := True;

Result := DbiDoRestructure(Db.Handle, 1, @TblDesc, nil, nil, nil, False);

end;

function dgPackDbaseTable(Tbl: TTable): DBIResult;

{ Pack a dBASE table by calling DbiPackTable. The table

passed as a parameter will be opened if it isn’t open. }

begin

Result := DBIERR_NA;

if Tbl.Active = False then

Tbl.Open;

Result := DbiPackTable(Tbl.DBHandle, Tbl.Handle,

nil, nil, True);

end;

{/codecitation}

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

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Mike Orriss

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

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

uses DBIProcs, DBITypes, DBIErrs;

function PackTable(tbl: TTable; db: TDatabase): DBIResult;

var

crtd: CRTblDesc;

begin

Result := DBIERR_NA;

with tbl do

if Active then

Active := False;

with db do

if not Connected then

Connected := True;

FillChar(crtd, SizeOf(CRTblDesc), 0);

StrPCopy(crtd.szTblName, tbl.TableName);

crtd.bPack := True;

Result := DbiDoRestructure(db.Handle, 1, @crtd, nil, nil, nil, FALSE);

end;

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

procedure TForm1.Button1Click(Sender: TObject);

begin

if PackTable(Table1,DataBase1) = DBIERR_NONE then

…..

else

MessageBeep(0);

end;

{/codecitation}