Перехват ошибок DBEngine

Перехват ошибок DBEngine

Автор: Eryk

Ошибки общего характера, типа Key Violation или конфликты блокировки лучше всего обрабатывать в обработчике события Application.OnException ...например:

{СекцияInterface}
procedure HandleException(Sender: TObject; E: Exception);
...

{Секция Implementation}
procedure TForm1.HandleException(Sender: TObject; E: Exception);
var
  err: DBIResult;
begin
  if E is EDBEngineError then
  begin
    err := (E as EDBEngineError).errors[(E as EDBEngineError).errorcount -
      1].errorcode;
    if (err = DBIERR_KEYVIOL) then
      showMessage('Ошибка Key violation!')
    else if (err = DBIERR_LOCKED) then
      showmessage('Запись блокирована другим пользователем')
    else if (err = DBIERR_FILELOCKED) then
      showmessage('Таблица блокирована кем-то еще')
    else
      showmessage('Другая ошибка DB')
  end
  else
    showmessage('Упс!: ' + E.Message);
end;

...'инсталлировать' обработчик исключений можно так:

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.onException:=HandleException;
end;

Для использования предопределенных констант ошибок ('DBIERR_etc.'), вам необходимо включить DBIERRS в список используемых модулей. Полный список кодов ошибок при работе с базами данных вы можете найти в файле DBIERRS.INT, расположенном в каталоге :\DELPHI\DOC.

Взято из

Перехватчики событий, сигналы и слоты

Перехватчики событий, сигналы и слоты

Автор: Андрей Боровский ()


Перехватчики событий

В предыдущей статье была рассмотрена обработка событий Qt в обработчике события OnEvent Kylix класса TApplication. В этой статье будет показан другой метод обработки событий Qt - использование перехватчиков событий (event hooks). Перехватчики событий подобны обработчику события OnEvent, с той разницей, что перехватчики событий позволяют подойти к обработке событий более дифференцировано. Перехватчики назначаются для отдельных объектов Qt, причем каждому объекту может быть назначено несколько перехватчиков для обработки разных типов событий.

Перехватчик может быть процедурой или функцией, являющейся методом объекта Object Pascal и использующей формат вызова cdecl. Для того, чтобы назначить перехватчик какому-либо экземпляру класса Qt, необходимо создать экземпляр класса перехватчика для данного объекта Qt и связать его с методом-обработчиком. Функции, позволяющие сделать это, как и другие функции CLXDisplay API, декларируются в модуле Qt (файл Qt.pas).

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


TForm1= class(TForm)
    Label1: TLabel;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure Label1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
    DropHook : QEvent_hookH;
    function EventHandler(Handle : QObjectH; e : QEventH) : Boolean; cdecl;
 end;
 ...
 procedure TForm1.FormCreate(Sender: TObject);
 var
   M : TMethod;
 begin
   DropHook:=QEvent_hook_create(Label1.Handle);
   EventFunc(M):=EventHandler;
   Qt_hook_hook_events(DropHook, M);
 end;


DropHook - переменная типа QEvent_hookH, ссылка на объект-перехватчик событий. Не путайте этот объект с объектом, события которого перехватываются. В CLXDisplay API определено несколько объектов перехватчиков различных типов, и для создания каждого из них используется специальная функция. В данном примере мы создаем наиболее общий объект-перехватчик, перехватывающий события разных типов. Функция QEvent_hook_create создает экземпляр такого объекта и связывает его с экземпляром класса, события которого необходимо обрабатывать (в нашем случае - экземпляр QLabel).

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

EventFunc = function(Handle : QObjectH; e : QEventH) : Boolean of object; cdecl; 

декларация которой в точности соответствует декларации метода-перехватчика.

Связывание метода перехватчика с объектом-перехватчиком выполняется функцией Qt_hook_hook_events. Первый параметр функции - указатель на объект-перехватчик, второй параметр - указатель на метод. Учтите, что для каждой пары "объект-перехватчик / тип перехватываемых событий" в модуле Qt определена своя функция, связывающая объекты и методы перехватчики.

Сам метод перехватчик похож на метод обработки событий из предыдущего примера. Ссылка на объект события передается в переменной e, а значение, указывающее на то, следует ли вызывать обработчик события, назначенный объекту по умолчанию, возвращается в качестве результата функции. Обратите внимание на то, что в новом примере мы не проверяем, с каким Qt объектом связано обрабатываемое событие. В этом нет необходимости, так как метод перехватчик связан лишь с одним экземпляром Qt класса. Однако мы могли бы связать этот метод с несколькими объектами, и тогда параметр Handle позволил бы нам определить, каким Qt объектом вызван перехватчик.

Уничтожение объекта-перехватчика выполняется в деструкторе формы. Для этого служит функция QEvent_hook_destroy.

Исходный текст демонстрационного приложения находится здесь. Как и пример из предыдущей статьи, это приложение может быть скомпилировано и в Kylix (для Linux), и в Delphi 6 (для Windows). Для того, чтобы это приложение выполнялось корректно, Вам возможно придется исправить ошибку в модуле Qt (см. предыдущую статью).

Еще один пример использования перехватчиков - приложение, отслеживающее состояние буфера обмена Qt. Это приложение отображает информацию о mime-типах данных, скопированных в буфер обмена. Кроме того, если в буфере обмена присутствуют данные в текстовом формате, приложение отображает и сами данные. Информация обновляется при изменении содержимого буфера обмена. Для того, чтобы контролировать состояние буфера обмена, мы создаем объект-перехватчик QClipboard_hook и связываем его с методом перехватчиком, имеющим тип QClipboard_dataChanged_Event. Этот метод вызывается всякий раз при изменении содержимого буфера обмена. Ниже приводится исходный текст метода перехватчика.


procedure TForm1.ClipboardDataChanged;
var
  QMS : QMimeSourceH;
  S : WideString;
  S1 : String;
  i : Integer;
begin
  QMS:=QClipboard_data(CB);
  Memo1.Lines.Clear;
  (* enumerating clipboard data formats *)
  i:=0;
  S1:=QMimeSource_format(QMS, i);
  while S1<>'' do
  begin
    Memo1.Lines.Add(S1);
    Inc(i);
    S1:=QMimeSource_format(QMS, i);
  end;
  Label3.Caption:='';
  (* if text data is available, we retrieve it *)
  if QTextDrag_canDecode(QMS) then
  begin
    QTextDrag_Decode(QMS, @S);
    Label3.Caption:=S;
  end;
end;



Переменная CB указывает на объект буфера обмена. При помощи функции QClipboard_data мы получаем ссылку на объект QMimeSourceH, являющийся контейнером данных, содержащихся в буфере обмена. Этот объект позволяет также получить информацию о типах данных, для чего используется функция QMimeSource_format. Эта функция возвращает строку с именем типа данных. Первый параметр функции - указатель на объект-контейнер, второй параметр - номер типа данных. Типы нумеруются с нуля. Если значение этого параметра превышает номер последнего типа, возвращается пустая строка. В нашем примере мы добавляем строки с именами типов в объект Memo1. Далее с помощью функции QTextDrag_canDecode мы проверяем, содержит ли объект-контейнер данные в текстовом формате и если содержит, извлекаем эти данные при помощи функции QTextDrag_Decode.

Полный исходный текст демонстрационного приложения находится здесь. Отслеживание содержимого буфера обмена работает корректно только для приложений, использующих Qt буфер. С учетом этих ограничений демонстрационное приложение работает и в Windows (будучи скомпилировано в Delphi 6). Для демонстрации его работы Вы можете воспользоваться либо Qt приложениями (в Linux) либо примерами использования CLXDisplay API, поставляемыми с Delphi 6 (в Windows).

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

Сигналы и слоты
В приложениях, построенных на основе иерархии объектов часто бывает необходимо, чтобы в ответ на событие, связанное с одним из объектов, вызывался метод другого объекта. Рассмотрим такой пример: пусть в нашем приложении требуется ввести обработку события SomeEvent, связанного с каким-либо объектом VCL. В объекте определено свойство OnSomeEvent процедурного типа TSomeEvent. Когда мы назначаем обработчик событию, мы инициализируем свойство OnSomeEvent значением указателя на метод, список параметров которого соответствует типу TSomeEvent. Как правило метод-обработчик не является методом того объекта, которому принадлежит свойство OnSomeEvent. Таким образом мы устанавливаем связь между двумя объектами. Когда в системе происходит событие SomeEvent, в объекте, с которым связано это событие, выполняется проверка содержимого свойства OnSomeEvent, и если это свойство инициализировано, вызывается соответствующий метод-обработчик.

В Qt library взаимодействие между объектами осуществляется при помощи механизма сигналов и слотов. Объект Qt генерирует (в терминологии Qt "эмитирует") сигнал в ответ на событие. Для приема и обработки сигналов служат слоты. Также как и сигналы, слоты являются частью объектов Qt. Каждому слоту в данном объекте сопоставлен какой-либо метод этого объекта. Для того, чтобы объект реагировал на некоторый сигнал, необходимо связать этот сигнал с одним из слотов объекта. В этом случае после генерации сигнала будет вызван метод, соответствующий данному слоту. Если сигнал несет какие-либо данные о событии, эти данные могут быть переданы методу обработчику через его параметры. Связывание сигналов и слотов похоже на назначение обработчиков событий объектов Object Pascal, однако между реализацией взаимодействия объектов в Object Pascal и Qt есть существенные различия. Многие объекты библиотеки Qt library уже имеют слоты для обработки определенных сигналов и для связывания их друг с другом не требуется перекрывать их методы в объектах-потомках. Во-вторых механизм взаимодействия сигналов и слотов позволяет связывать сигналы и слоты разных типов, не заботясь о соответствии списков параметров. Если список параметров сигнала не соответствует списку параметров обработчика, при вызове обработчик получает значения параметров, установленные по умолчанию. Третье отличие заключается в возможности связывать один сигнал с несколькими слотами и один слот с несколькими сигналами. Это означает, что событию может быть сопоставлено несколько обработчиков, являющихся методами разных объектов, и в ответ на событие будут вызываться все назначенные ему обработчики.

CLXDisplay API предоставляет средства для работы с сигналами и слотами Qt. Для связывания сигналов и слотов служит функция QObject_connect. Функции передается четыре параметра. Первый параметр - указатель на объект-источник сигнала. Второй параметр - строка типа PChar. В этой строке передается имя сигнала, соответствующее синтаксису языка C++. Имя сигнала должно предваряться символом "2". Третий параметр функции QObject_connect - указатель на метод-приемник. Четвертый параметр - строка типа PChar, содержащая имя слота, соответствующее синтаксису C++ и предваряемое символом "1".

Рассмотрим пример:
В Qt классе QLineEdit, лежащем в основе компонента VisualCLX TEdit, определен сигнал textChanged, который эмитируется при изменении строки в окне компонента. В классе QLabel, на котором основан компонент TLabel, определен слот setText, который позволяет задать строку в компоненте Label. Если связать сигнал textChanged экземпляра класса QLineEdit со слотом setText экземпляра класса QLabel, изменения в строке ввода будут немедленно отображаться в строке QLabel. Для того, чтобы связать указанные сигнал и слот, необходимо вызвать функцию QObject_connect со следующими значениями:

QObject_connect(Edit1.Handle, PChar('2textChanged ( const QString & )'), Label2.Handle, PChar('1setText( const QString & )'));

Первый параметр - указатель на объект-источник сигнала, в данном случае QEdit. Второй параметр - имя сигнала, определенное в заголовочном файле C++ qlineedit.h, с прибавлением двойки, указывающей на то, что это сигнал. Третий параметр - ссылка на объект-приемник сигнала (QLabel). Четвертый параметр - имя слота из файла qlabel.h с прибавлением единицы. Обратите внимание на то, что в данном случае списки параметров сигнала и слота совпадают, так что в ответ на сигнал слоту будет передана строка измененного текста. Приложение, демонстрирующее связывание сигналов и слотов в Object Pascal, можно скачать здесь. Следует отметить, что в Delphi 6 это приложение работает не совсем корректно.

Для разрыва связи между сигналом и слотом используется функция QObject_disconnect. Обычно в обращении к этой функции нет необходимости, так как при уничтожении экземпляра Qt объекта все связи с его сигналами и слотами разрываются автоматически. Функцию QObject_disconnect следует использовать если необходимо разорвать связь между сигналом и слотом до уничтожения соответствующих объектов. Список параметров у функции QObject_disconnect такой же, как и у функции QObject_connect. Значение nil, переданное функции QObject_connect в том или ином параметре (сигнал, слот, объект приемник), интерпретируется функцией как "групповой символ" и позволяет выполнять операцию разрыва связи сразу над множеством элементов. Например, вызов

QObject_disconnect(SomeControl.Handle, PChar('2SomeSignal ()'), nil, nil); 

отсоединяет все слоты, связанные с сигналом SomeSignal Qt объекта, соответствующего SomeControl.

В рамках CLXDisplay API определено большое количество сигналов и слотов. Если же Вы захотите добавить свои сигналы и слоты, Вам придется объединить фрагменты программ, написанные на Object Pascal и C++.

Взято с Исходников.Ru

Переключение консольного приложения в полный экран

Переключение консольного приложения в полный экран

{
   There is no documented way to make a console application fullscreen. 
   The following code works for both NT and Win9x. 
   For win NT I used the undocumented SetConsoleDisplayMode and 
   GetConsoleDisplayMode functions. 
} 

{ 
 function GetConsoleDisplayMode(var lpdwMode: DWORD): BOOL; stdcall; 
   external 'kernel32.dll'; 
  // lpdwMode: address of variable for current value of display mode 
} 

function NT_GetConsoleDisplayMode(var lpdwMode: DWORD): Boolean; 
type 
  TGetConsoleDisplayMode = function(var lpdwMode: DWORD): BOOL; 
  stdcall; 
var 
  hKernel: THandle; 
  GetConsoleDisplayMode: TGetConsoleDisplayMode; 
begin 
  Result := False; 
  hKernel := GetModuleHandle('kernel32.dll'); 
  if (hKernel > 0) then 
  begin @GetConsoleDisplayMode := 
      GetProcAddress(hKernel, 'GetConsoleDisplayMode'); 
    if Assigned(GetConsoleDisplayMode) then 
    begin 
      Result := GetConsoleDisplayMode(lpdwMode); 
    end; 
  end; 
end; 

{ 
  function SetConsoleDisplayMode(hOut: THandle; // standard output handle 
  dwNewMode: DWORD;         // specifies the display mode 
  var lpdwOldMode: DWORD    // address of variable for previous value of display mode 
  ): BOOL; stdcall; external 'kernel32.dll'; 
} 

function NT_SetConsoleDisplayMode(hOut: THandle; dwNewMode: DWORD; 
  var lpdwOldMode: DWORD): Boolean; 
type 
  TSetConsoleDisplayMode = function(hOut: THandle; dwNewMode: DWORD; 
  var lpdwOldMode: DWORD): BOOL; 
  stdcall; 
var 
  hKernel: THandle; 
  SetConsoleDisplayMode: TSetConsoleDisplayMode; 
begin 
  Result := False; 
  hKernel := GetModuleHandle('kernel32.dll'); 
  if (hKernel > 0) then 
  begin @SetConsoleDisplayMode := 
      GetProcAddress(hKernel, 'SetConsoleDisplayMode'); 
    if Assigned(SetConsoleDisplayMode) then 
    begin 
      Result := SetConsoleDisplayMode(hOut, dwNewMode, lpdwOldMode); 
    end; 
  end; 
end; 

function GetConsoleWindow: THandle; 
var 
  S: AnsiString; 
  C: Char; 
begin 
  Result := 0; 
  Setlength(S, MAX_PATH + 1); 
  if GetConsoleTitle(PChar(S), MAX_PATH) <> 0 then 
  begin 
    C := S[1]; 
    S[1] := '$'; 
    SetConsoleTitle(PChar(S)); 
    Result := FindWindow(nil, PChar(S)); 
    S[1] := C; 
    SetConsoleTitle(PChar(S)); 
  end; 
end; 

function SetConsoleFullScreen(bFullScreen: Boolean): Boolean; 
const 
  MAGIC_CONSOLE_TOGGLE = 57359; 
var 
  dwOldMode: DWORD; 
  dwNewMode: DWORD; 
  hOut: THandle; 
  hConsole: THandle; 
begin 
  if Win32Platform = VER_PLATFORM_WIN32_NT then 
  begin 
    dwNewMode := Ord(bFullScreen); 
    NT_GetConsoleDisplayMode(dwOldMode); 
    hOut := GetStdHandle(STD_OUTPUT_HANDLE); 
    Result := NT_SetConsoleDisplayMode(hOut, dwNewMode, dwOldMode); 
  end 
  else 
  begin 
    hConsole := GetConsoleWindow; 
    Result := hConsole <> 0; 
    if Result then 
    begin 
      if bFullScreen then 
      begin 
        SendMessage(GetConsoleWindow, WM_COMMAND, MAGIC_CONSOLE_TOGGLE, 0); 
      end 
      else 
      begin 
        // Better solution than keybd_event under Win9X ? 
        keybd_event(VK_MENU, MapVirtualKey(VK_MENU, 0), 0, 0); 
        keybd_event(VK_RETURN, MapVirtualKey(VK_RETURN, 0), 0, 0); 
        keybd_event(VK_RETURN, MapVirtualKey(VK_RETURN, 0), KEYEVENTF_KEYUP, 0); 
        keybd_event(VK_MENU, MapVirtualKey(VK_MENU, 0), KEYEVENTF_KEYUP, 0); 
      end; 
    end; 
  end; 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
var 
  s: string; 
begin 
  AllocConsole; 
  try 
    SetConsoleFullScreen(True); 
    Write('Hi, you are in full screen mode now. Type something [Return]: '); 
    Readln(s); 
    SetConsoleFullScreen(False); 
    // ShowMessage(Format('You typed: "%s"', [s])); 
  finally 
    FreeConsole; 
  end; 
end;

Взято с

Перекодирование

Перекодирование

Этот алгоритм позволяет перекодировать текст.
Реализованы кодировки Windows-1251, KOI8-R, ISO-8859-5 и DOS.
Кодировка ? это таблица, в которой указано,
например, что символ под номером 160 - это русская буква "а", а под номером 150 ? "Ц" и т. д.
Кодировки различаются номерами русских букв
(как располагать английские буквы договорились).
Разные компьютеры в Интернете используют разные кодировки.
И поэтому, когда русский текст идет по Интернету, его многократно перекодируют.

Этот алгоритм обеспечивает высокую скорость перекодирования больших объемов данных.


procedure TForm1.Button1Click(Sender: TObject);
var
  code1, code2: TCode;
  s: string;
  c: char;
  i: integer;
  chars: array [char] of char;
  str: array [TCode] of string;
begin
  case ComboBox1.ItemIndex of
    1: code1 := koi;
    2: code1 := iso;
    3: code1 := dos;
    else code1 := win;
  end;
  case ComboBox2.ItemIndex of
    1: code2 := koi;
    2: code2 := iso;
    3: code2 := dos;
    else code2 := win;
  end;
  s := Memo1.Text;

  Str[win] := 'АаБбВвГгДдЕеЖжЗзИиЙйКкЛлМмНнОоПпРрСсТтУуФфХхЦцЧчШшЩщЪъЫыЬьЭэЮюЯя';
  Str[koi] := 'юЮаАбБцЦдДеЕфФгГхХиИйЙкКлЛмМнНоОпПяЯрРсСтТуУжЖвВьЬыЫзЗшШэЭщЩчЧъЪ';
  Str[iso] := 'РрСсТтУуФфХхЦцЧчШшЩщЪъЫыЬьЭэЮюЯяа№бёвђгѓдєеѕжізїијйљкњлћмќн§оўпџ';
  Str[dos] := 'Ђ ЃЎ‚ўѓЈ„¤…Ґ†¦‡§€Ё‰©ЉЄ‹"Њ¬Ќ­Ћ®ЏЇђа'б'в"г"де?ж?з˜и™йљк›лњмќнћоџп';

  for c := #0 to #255 do
    Chars[c] := c;

  for i := 1 to Length(Str[win]) do
    Chars[Str[code2][i]] := Str[code1][i];

  for i := 1 to Length(s) do
    s[i] := Chars[s[i]];

  Memo2.Text := s;
end;


Взято с сайта

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

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

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

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

TMyObject= class (TObject) 

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

TOverrideObject = class (TMyObject) 

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

procedure Wiggle; virtual;  

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

procedure Wiggle; override;  

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

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

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

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

TMyObject(Items[1]).Wiggle; 

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

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

TMyObject(Items[1]).Wiggle; 

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

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

Взято из

Советов по Delphi от

Сборник Kuliba

Переменные окружения

Переменные окружения

Cодержание раздела:

Перемещать объект на сложном фоне

Перемещать объект на сложном фоне

Написать графический редактор, как Paint Brush, в Delphi очень просто. Но встает одна проблема. Чтобы нарисовать линию, пользователь нажимает мышью на поле, двигает ее, и отпускает кнопку. Во время движения мыши линия все время перерисовывается. Причем фон, после того, как линия переместилась, должен восстановиться. Для этого можно использовать логическую операцию XOR. Важное свойство этой операции заключается в том, что при любых A и B, A XOR B XOR B = A. Это означает, что если воспользоваться этой операцией для рисования линии, то при повторном ее рисовании на этом месте этим же цветом она сотрется, оставив за собой прежний фон.

procedureTForm1.XORLine;
begin
  Form1.Canvas.MoveTo(xo, yo);
  Form1.Canvas.LineTo(lx, ly);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Form1.Color := clWhite;
  Form1.Canvas.Pen.Color := clRed;
  Form1.Canvas.Pen.Width := 3;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
  Form1.Tag := 1;
  xo := X;
  yo := Y;
  lx := X;
  ly := Y;
  Form1.Canvas.Pen.Mode := pmNotXor;
  XORLine;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
  if ssLeft in Shift then
  begin
    XORLine;
    lx := X;
    ly := Y;
    XORLine;
  end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
  Form1.Canvas.Pen.Mode := pmCopy;
  Form1.Canvas.MoveTo(xo, yo);
  Form1.Canvas.LineTo(X, Y);
end;

Взято из

Перемещение формы

Перемещение формы

Cодержание раздела:










См. также статьи в других разделах:

Перемещение контролов мышкой во время выполнения приложения?

Перемещение контролов мышкой во время выполнения приложения?

Для этого необходимо перехватить событие OnMouseDown, запомнив координаты x и y и захватить мышку. После этого можно будет отслеживать движение мышки при помощи события OnMouseMove, перемещая контрол пока срабатывает событие OnMouseUp. Затем надо поместить контрол на своё окончательное место и снять захват мышки.

Следующий пример показывает как мышкой двигать компонент TButton по форме.

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Button1MouseUp(Sender: TObject; Button: 
      TMouseButton; Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
    MouseDownSpot : TPoint;
    Capturing : bool;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if ssCtrl in Shift then begin
    SetCapture(Button1.Handle);
    Capturing := true;
    MouseDownSpot.X := x;
    MouseDownSpot.Y := Y;
  end;
end;

procedure TForm1.Button1MouseMove(Sender: TObject;
Shift: TShiftState; X,  Y: Integer);
begin
  if Capturing then begin
    Button1.Left := Button1.Left - (MouseDownSpot.x - x);
    Button1.Top := Button1.Top - (MouseDownSpot.y - y);
  end;
end;

procedure TForm1.Button1MouseUp(Sender: TObject; Button: 
    TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Capturing then begin
    ReleaseCapture;
    Capturing := false;
    Button1.Left := Button1.Left - (MouseDownSpot.x - x);
    Button1.Top := Button1.Top - (MouseDownSpot.y - y);
  end;
end;

Взято с Исходников.ru

Переназначения объектов

Переназначения объектов

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

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

var
PropInfo: PPropInfo;
begin
  PropInfo := GetPropInfo(PTypeInfo(ActiveControl.ClassInfo), 'DataSource');
  if (PropInfo <> nil)
    and (PropInfo^.PropType^.Kind = tkClass)
    and (GetTypeData(PropInfo^.PropType)^.ClassType = TDataSource) then
    DBNavigator1.DataSource := TDataSource(GetOrdProp(ActiveControl, PropInfo));
end;

Некоторая избыточность в проверках гарантирует вам, что вам не попадется некий странный объект (от сторонних производителей компонентов, например), имеющий свойство DataSource, но не типа TDataSource.

Взято из

Советов по Delphi от

Сборник Kuliba

Перестроить вкладки TPageControl с помощью Drag and Drop

Перестроить вкладки TPageControl с помощью Drag and Drop

//In the PageControl's OnMouseDown event handler: 

procedure TForm1.PageControl1MouseDown(Sender: TObject; 
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 
begin 
  PageControl1.BeginDrag(False); 
end; 


// In the PageControl's OnDragDrop event handler: 

procedure TForm1.PageControl1DragDrop(Sender, Source: TObject; X, Y: Integer); 
const 
  TCM_GETITEMRECT = $130A; 
var 
  i: Integer; 
  r: TRect; 
begin 
  if not (Sender is TPageControl) then Exit; 
  with PageControl1 do 
  begin 
    for i := 0 to PageCount - 1 do 
    begin 
      Perform(TCM_GETITEMRECT, i, lParam(@r)); 
      if PtInRect(r, Point(X, Y)) then 
      begin 
        if i <> ActivePage.PageIndex then 
          ActivePage.PageIndex := i; 
        Exit; 
      end; 
    end; 
  end; 
end; 

// In the PageControl's OnDragOver event handler: 

procedure TForm1.PageControl1DragOver(Sender, Source: TObject; X, 
  Y: Integer; State: TDragState; var Accept: Boolean); 
begin 
  if Sender is TPageControl then 
    Accept := True; 
end;

Взято с

Перетаскивание файлов в приложение

Перетаскивание файлов в приложение

Взято из FAQ:
Иногда очень полезно избавить пользователя от лишних операций при открытии файла.
Он должен нажать на кнопку " Открыть" , затем найти интересующий каталог, выбрать файл.
Проще перетащить мышкой файл сразу в окно приложения.
Рассмотрим пример перетаскивания Drag & Drop в окно произвольного текстового файла,
который сразу же открывается в компоненте Memo1. Для начала в разделе Uses необходимо подключить модуль ShellAPI. В private области окна нужно вставить следующую строку:

 procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;//получение сообщений о переносе файла в окно приложения    


Процедура обработки этого сообщения будет выглядеть следующим образом:

procedure TForm1.WMDropFiles(var Msg: TWMDropFiles);
var
  CFileName: array[0..MAX_PATH] of Char; // переменная, хранящая имя файла
begin
try  
If DragQueryFile(Msg.Drop, 0, CFileName, MAX_PATH)> 0 then  
// полу?ение пути файла  
begin  
  Form1.Caption:=CFileName; // имя файла в заголовок окна  
  Memo1.Lines.LoadFromFile(CFileName); // открываем файл  
  Msg.Result := 0;  
end;  
finally  
  DragFinish(Msg.Drop); // отпустить файл  
end;  
end; 


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

procedure TForm1.FormCreate(Sender: TObject);
begin
  DragAcceptFiles(Handle, True); 
end;

Автор ответа Vit
Взято с Vingrad.ru

Перетаскивание объектов, Drag and Drop, Docking

Перетаскивание объектов, Drag and Drop, Docking

Cодержание раздела:










См. также статьи в других разделах:

Перетасовка экрана в Delphi

Перетасовка экрана в Delphi

(Перевод одноимённой статьи с сайта delphi.about.com )

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

Уверен, что каждый из Вас уже хоть раз видел что-то подобное в действии. При запуске, программа берёт изображение десктопа и разделяет его на определённое количество прямоугольных частей (одинакового размера). После этого часть блоков случайным образом перемещается со своего первоначального места.

Как это всё осуществить
Создайте новый проект Delphi с чистой формой. Установите свойство Name в 'Shuffler'. Добавьте на форму компоненты Image (Image1) и Timer (Timer1). Image будет содержать в себе изображение десктопа (разобранное), а Timer будет вызывать процедуру рисования. Свойство Interval компонента Timer определяет, как часто будет происходить перемешивание (значение 1000 эквивалентно одной секунде, 2000 - двум секундам).
Так же для проекта потребуется несколько глобальных переменных. Поместите следующий код перед секцией implementation в модуле формы:

var
  Shuffler: TShuffler; //это было добавлено самой Delphi

  DesktopBitmap   : TBitmap; 
  gx, gy          : Integer; 
  redRect         : TBitmap; 

  rW, rH          : Integer; 

const
  DELTA = 8; //должно быть 2^n

Значение константы (integer) DELTA определяет, на сколько частей будет разбит экран (строк и колонок). Число DELTA должно быть в виде 2^n, где n - целое (integer) число со знаком. Большое значение DELTA приводит к маленьким размерам блоков. Например, если DELTA равна 16 и разрешение экрана 1024 x 768, то экран будет поделён на 256 частей размером 64x48.
DesktopBitmap - это битмап, который хранит в себе захваченное текущее изображение десктопа - мы будем получать это изображение делая скриншот.
redRect это битмап картинка, которая заменяет перемещённую часть картинки. redRect создаётся в событии формы OnCreate.
gx, gy содержат текущие координаты x и y (Left, Top) redRect внутри разобранного изображения.
rW, rH это ширина и высота прямоугольного блока. Для 1024x768 и DELTA=16, rW будет равно 64 а rH = 48.

Проект начинает выполняться с обработчика события OnCreate:

procedure TShuffler.FormCreate(Sender: TObject);
begin
  rW := Screen.Width div DELTA;
  rH := Screen.Height div DELTA;

  redRect:=TBitmap.Create;
  with redRect do begin
    Width := rW;
    Height := rH;
    Canvas.Brush.Color := clRed;
    Canvas.Brush.Style := bssolid;
    Canvas.Rectangle(0,0,rW,rH);
    Canvas.Font.Color := clNavy;
    Canvas.Font.Style := Canvas.Font.Style + [fsBold];
    Canvas.TextOut(2,2,'About');
    Canvas.Font.Style := Canvas.Font.Style - [fsBold];
    Canvas.TextOut(2,17,'Delphi');
    Canvas.TextOut(2,32,'Programming');
  end;

  Timer1.Enabled := False;
  Image1.Align := alClient;
  Visible := False;
  BorderStyle := bsNone;
  Top := 0;
  Left := 0;
  Width := Screen.Width;
  Height := Screen.Height;
  InitScreen;
//  SetWindowPos(Handle,HWND_TOPMOST,0,0,0,0,
                 SWP_NOSIZE + SWP_NOMOVE);
  Visible := True;
  Timer1.Interval := 10; // меньше := быстрее
  Timer1.Enabled  := True; // Запускаем вызов DrawScreen
end;

Во-первых, значения rW и rH определяются значением DELTA. Как уже объяснялось, если разрешение экрана 800x600 и DELTA равна 8, изображение экрана будет разделено на 8x8 частей размером 100x75 (rW = 100, rH = 75).

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

Наконец, устанавливается ширина и высота формы как у экрана. Вызов (закомментированный) API функции SetWindowPos можно использовать, чтобы установить форму всегда на переднем плане (OnTop), не перемещаемую и не изменяемую. Вызывается процедура InitScreen. Устанавливает интервал таймера и начинает выполняться обработчик события OnTimer, запуская процедуру DrawScreen.

InitScreen - Скриншот
Процедура InitScreen, вызываемая из обработчика события OnCreate, используется для получения скриншота текущего изображения десктопа, устанавливая начальную позицию redRect и рисуя сетку. Код, который будет рисовать сетку необязателен.

Чтобы получить скриншот десктопа, используется GetDC для GetDesktopWindow. API функция BitBt используется для передачи картинки десктопа в DesktopBitmap. GetDC(GetDesktopWindow) получает дескриптор контекста устройства дисплея для указанного окна - окна возвращённого функцией GetDesktopWindow. В заключении DesktopBitmap ассоциируется с компонентой Image1. Если что-то не ясно, то советую заглянуть справичные файлы по Delphi.

Начальная позиция redRect выбирается случайным образом. Trunc(Random * DELTA) возвращает целое число от 0 до DELTA. Далее, redRect рисуется в точке gx, gy, используя функцию CopyRect объекта Canvas. Опять же, если Вы не знакомы с алгоритмом рисования Delphi, то советую порыться в справке.



В конце, при помощи MoveTo и LineTo рисуется сетка. Сетка необязательна и используется только для того, чтобы лучше различать границы блоков.

procedure InitScreen;
var i,j:integer;
begin
  //получаем битмап десктопа
  DesktopBitmap := TBitmap.Create;
  with DesktopBitmap do begin
    Width := Screen.Width;
    Height := Screen.Height;
  end;
  BitBlt(DesktopBitmap.Canvas.Handle,
         0,0,Screen.Width,Screen.Height,
         GetDC(GetDesktopWindow),0,0,SrcCopy);

  Shuffler.Image1.Picture.Bitmap := DesktopBitmap;

  //изначальные координаты redRect
  Randomize;
  gx := Trunc(Random * DELTA);
  gy := Trunc(Random * DELTA);

  Shuffler.Image1.Canvas.CopyRect(
    Rect(rW * gx, rH * gy, rW * gx + rW, rH * gy + rH),
    redRect.Canvas,
    Rect(0,0,rW,rH));

  //рисуем сетку
  for i:=0 to DELTA-1 do begin
    Shuffler.Image1.Canvas.MoveTo(rW * i,0);
    Shuffler.Image1.Canvas.LineTo(rW * i,Screen.Height);

    Shuffler.Image1.Canvas.MoveTo(0, rH * i);
    Shuffler.Image1.Canvas.LineTo(Screen.Width, rH * i);
  end;
end;


Draw Screen
Основной код находится в процедуре DrawScreen. Эта процедура вызывается внутри события OnTimer компонента Timer.

procedure DrawScreen;
var
  r1,r2:TRect;
  Direction:integer;
begin
  r1:=Rect(rW * gx , rH * gy,  rW * gx + rW  , rH * gy + rH);

  Direction := Trunc(Random*4);
  case Direction of
   0: gx := Abs((gx + 1) MOD DELTA);    //право
   1: gx := Abs((gx - 1) MOD DELTA);    //лево
   2: gy := Abs((gy + 1) MOD DELTA);    //низ
   3: gy := Abs((gy - 1) MOD DELTA);    //верх
  end; //case

  r2 := Rect(rW * gx , rH * gy,  rW * gx + rW  , rH * gy + rH);

  with Shuffler.Image1.Canvas do begin
    CopyRect(r1, Shuffler.Image1.Canvas, r2);
    CopyRect(r2, redRect.Canvas, redRect.Canvas.ClipRect);
  end;
end;


Несмотря на кажущуюся сложность кода, он очень прост в использовании. Менять местами можно только части смежные с redRect, поэтому доступны только 4 возможных направления. Прямоугольник r1 содержит текущию позицию redRect, r2 указывает на прямоугольник с блоком, который был перемещён. CopyRect используется для перемещения выбранного блока на место redRect и рисования redRect его в новом месте - таким образом осуществляется обмен этих двух блоков.
Было бы приятней наблюдать анимированный обмен блоков, но я оставлю эту задачу для самостоятельного решения.

А так выглядит мой десктоп 640x480, после нескольких событий OnTimer, с DELTA=4. Обычно у меня разрешение 1024x768, но для того, чтобы картинка получилась лучше, я изменил свойства дисплея. Обратите внимание, что Вы можете в любой момент прервать выполнение программы нажатием ALT+F4. Здесь можно посмотреть код проекта.

В заключении
Вероятно вы встречались с подобными эффектами в виде скринсейвера. Если возникнет желание создать что-то подобное, то дополнительную информацию можно посмотреть в статье "Пишем Screensaver в Delphi".

Так же данный код может послужить отправной точкой для создания популярной игры "Пятнашки" или "Ppuzzle". Всё, что необходимо для этого изменить в коде, это остановить через какое-то время подпрограмму DrawScreen, чтобы получить картинку паззла. Идея игры заключается в том, чтобы сделать возможным перемещение блоков обратно. В общих чертах, необходимо добавить код, который бы получал и обрабатывал клики пользователя на разобранной картинке. Клик по блоку, следующему за redRect должен заменить блок на redRect.

Взято с Исходников.ru

Первая программа с базами данных?

Первая программа с базами данных?

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

Открываем новый проект. Открываем форму. Кладём на форму компонент TTable (с закладки "Data Access" или "BDE" - у кого какая версия Дельфей). Оп! Не ожидали - вроде бы и таблица, а компонт не визуальный! Итак компонент TTable - это пока основной компонент для нашей базы - всё обращение к таблице идёт только через него. Теперь давай-те его подсоединим к базе данных.

К Дельфи прилогается учебная база данных, её мы и будем пользовать. Найдите свойство DatabaseName и из выпадающего списка выберите "DBDEMOS" - это и есть учебная база данных. Теперь берём свойство TableName и в выпадающем списке обнаруживаем список имён всех таблиц в базе данных "DBDEMOS", выбираем например "biolife.db" - это таблица так называется (а в данном случае и название файла)

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

Но все визуальные компоненты могут подсоединится к TTable только через вспомогательный компонент TDataSource - находящийся на той же закладке. Ставим и его на форму. Находим свойство DataSet у этого компонента и в выпадающем списке указываем на Table1. Теперь визуальные компоенты будут "видеть" инфу в таблице через TDataSource.

Переходим на другую закладку компонентов - "Data Controls" и ставим компоент TDBGrid. В его свойстве DataSource указываем на DataSource1. Что видим? Пока ничего! Таблица то не открыта - кликаем на Table1 и устанавливаем свойство Active в True. Работает!

Можно программу откомпиллировать и поиграться со своим первым приложением для баз данных. Неправда ли очень просто!

Первые впечатления

Первые впечатления

Первые впечатления

Автор: Андрей Боровский ()


Наверное каждый программист, хотя бы время от времени работающий с Delphi, слышал о том, что Kylix ? это Delphi для Linux. Более строго, Kylix ? это средство разработки на основе ObjectPascal и VCL для платформы Linux/QT. Данная серия статей предназначена прежде всего для программистов, ранее писавших на Delphi, и желающих теперь освоить программирование для Linux. Я сам пишу программы как на Delphi под Windows, так и на QT под Linux. Надеюсь, мои впечатления и наблюдения покажутся Вам полезными.


Первый взгляд на Kylix

Разработчики из Borland постарались сделать Kylix максимально похожим на Delphi, и это касается не только языка программирования и структуры VCL. Пользовательский интерфейс Kylix полностью воспроизводит интерфейс своего "старшего брата". Даже диалоги открытия и сохранения файлов практически одинаковы в обеих версиях. У программистов, привыкших к интерфейсу Delphi, работа в Kylix не вызовет проблем. Для тех, кто имеет опыт программирования для Linux, отмечу, что интегрированная среда разработки Kylix отличается стабильностью графического интерфейса, развитым набором функций редактирования текста и прекрасной встроенной справочной системой. Кроме того, Kylix снабжен отличной печатной документацией (на компакт-диске имеются ее электронные версии): руководством по языку ObjectPascal, справочником по библиотеке VCL (Библиотека визуальных компонентов) и руководством для быстрого освоения пакета.

Преимущества Kylix ? те же, что и у Delphi: ускорение цикла разработки приложений, готовые компоненты для работы с базами данных, Web-интерфейсами и Интернет. К этому следует добавить возможность переноса дополнительных компонентов, написанных для Delphi. Тут надо отдать должное разработчикам: для переноса модулей, написанных исключительно средствами ObjectPascal и VCL, достаточно просто перекомпилировать исходные тексты в новой среде. Естественно, многие компании и программисты, занимающиеся разработкой компонентов для Delphi, уже выпустили их версии и для Kylix. Некоторые из этих компонентов можно найти на втором диске дистрибутива.

Немного соли и желчи

Традиционными недостатками Delphi считаются медлительность и громоздкость результирующего кода. К сожалению, в этом вопросе Kylix также копирует своего "старшего брата". Для того, чтобы приложение, написанное в Kylix, могло работать отдельно от среды разработки, ему требуются некоторые разделяемые модули времени выполнения (runtime packages). Список модулей, которые могут понадобиться Kylix приложению, а также правила их распространения и установки приводятся в файле DEPLOY, расположенном на первом диске дистрибутива. Размеры самих исполнимых модулей примерно такие же, как и в случае с Delphi, простейшее приложение занимает на диске ~ 400 килобайт. Плюс несколько сотен килобайт дополнительных модулей, которые в Delphi не нужны. Для сравнения: простое приложение, написанное на Delphi без использования модулей SysUtils, Classes, Forms и т. п. (т. е. используя только Windows API) занимает 20-40 килобайт. Такой же размер имеет и аналогичное Linux приложение, написанное на C++ с использованием QT library.

Очевидно, что Kylix ? не лучший выбор в ситуации, когда компактность кода и быстрота являются критическими параметрами.

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

P.S. Для тех, кто не знает, kylix - это античная винная чаша, обычно покрытая росписью с внешней и с внутренней стороны.

Статья и примеры программ © 2001 Андрей Наумович Боровский.

Взято с Исходников.

Ru

Pipeline Components.

Pipeline Components.

Эта область разработки возникла в моем текущем проекте. Pipeline components - это COM-объекты, которые выполняются в pipeline, который в свою очередь вызывается на выполнение обычно через ASP. Pipeline представляет собой цепочку pipeline component, выполняющихся последовательно один за одним. На вход pipeline передается объект IDictionary, который передается всем компонентам в цепочке. Результатом работы этих компонент может быть видоизмененный IDictionary, либо еще чего-нибудь.


Описание.

Pipeline компоненты должны поддерживать интерфейс IPipelineComponent, а также несколько других. Обо всех будет рассказано поподробнее ниже.

Представим себе, что мы хотим создать компонент, который сбрасывает содержимое IDictionary в xml-файл на диск. Причем мы хотим иметь возможность задавать имя этого файла в Properties Page внутри Pipeline Editor. Для ознакомления с Pipeline Editor советую обратиться на сайт Microsoft.

В первую очередь, для создания компонента в Delphi необходимо создать ActiveX Library. Для этого выполним команду File|New -> Activex tabsheet -> ActiveX Library. Затем там добавим Automation Object. Назовем объект DumpOrderToXml. Добавим методы SetXmlFilename и GetXmlFilename. Результатом должны быть следующие объявления:

function SetXmlFilename(XmlFileName: WideString): HResult [dispid $00000001]; stdcall;

function GetXmlFileName(retval XmlFileName: WideString): HResult [dispid $00000002]; stdcall;

Для дальнейшей успешной работы Вы должны иметь на диске следующие файлы: COMMERCELib_TLB.pas, MSCSAspHelpLib_TLB.pas, MSCSCoreLib_TLB.pas, PIPELINELib_TLB.pas. Их можно сгенерировать с помощью tipe library editor, предоставляемого Delphi, либо скачать у меня. Также необходимо иметь на диске ComPUtil.pas и PipeConsts.pas файлы, которые есть у меня.

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

type
  TDumpOrderToXml = class(TAutoObject, IDumpOrderToXml, IPipelineComponent, ISpecifyPropertyPages, IPersistStreamInit)
  private
    FXmlFileName: WideString;
  protected
{ IDumpOrderToXml methods }
    function GetXmlFileName(out XmlFileName: WideString): HResult; stdcall;
    function SetXmlFilename(const XmlFileName: WideString): HResult; stdcall;
{ IPipelineComponent methods }
    function EnableDesign(fEnable: Integer): HResult; stdcall;
    function Execute(const pdispOrder, pdispContext: IDispatch;
      lFlags: Integer; out plErrorLevel: Integer): HResult; stdcall;
{ ISpecifyPropertyPages methods }
    function GetPages(out pages: TCAGUID): HResult; stdcall;
{ IPersistStreamInit methods }
    function GetClassID(out classID: TCLSID): HResult; stdcall;
    function IsDirty: HResult; stdcall;
    function Load(const stm: IStream): HResult; stdcall;
    function Save(const stm: IStream; fClearDirty: BOOL): HResult; stdcall;
    function GetSizeMax(out cbSize: Largeint): HResult; stdcall;
    function InitNew: HResult; stdcall;
  end;

Интерфейс IDumpOrderToXml предоставляет нам возможность задавать и получать имя xml-файла для хранения на диске. Интерфейс IPipelineComponent - стержневой для класса, он позволяет запустить компонент на выполнение с помощью метода Execute. Интерфейс ISpecifyPropertyPage позволяет задать classid для Property Page нашего нового класса. Интерфейс IPersistStreamInit позволяет хранить введеные параметры с помощью Pipeline Editor в файле .pcf.

Приступим к реализации этих методов. Методы GetXmlFilename и SetXmlFilename достаточно просты - они просто читают (пишут) значение из (в) поле FXmlFileName. Метод EnableDesing вызывается для уведомления класса, что редактор переводит его в режим дизайна. В принципе крутые компоненты могут что-либо делать в этот момент. Нам это не нужно, поэтому просто вернем S_OK. Точно также поступим с методами InitNew и IsDirty. Это несущественные методы, которые в принципе можно реализовать более детально, но не для нас.

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

function TDumpOrderToXml.Save(const stm: IStream;
  fClearDirty: BOOL): HResult;
var OleStream: TOleStream;
  FileNameLen: Byte;
begin
  OleStream := TOleStream.Create(stm);
  try
    FileNameLen := Length(FXmlFileName);
    OleStream.Write(FileNameLen, 1);
    OleStream.Write(FXmlFileName[1], FileNameLen * Sizeof(WideChar));
  finally
    OleStream.Free;
  end;
  Result := S_OK;
end;

function TDumpOrderToXml.Load(const stm: IStream): HResult;
var OleStream: TOleStream;
  FileNameLen: Byte;
begin
  OleStream := TOleStream.Create(stm);
  try
    OleStream.Read(FileNameLen, 1);
    SetLength(FXmlFileName, FileNameLen);
    OleStream.Read(FXmlFileName[1], FileNameLen * Sizeof(WideChar));
  finally
    OleStream.Free;
  end;
  Result := S_OK;
end;

Метод GetClassID позволяет вернуть наш classid для внешнего потребителя. Ниже приведенное решение в принципе универсальное для любого класса.

function TDumpOrderToXml.GetClassID(out classID: TCLSID): HResult;
begin
  classID := Factory.ClassID;
  Result := S_OK;
end;



Метод GetSizeMax возвращает размер, который наш класс хочет занять в потоке. Пусть это будет 255 widechar-ов.

function TDumpOrderToXml.GetSizeMax(out cbSize: Largeint): HResult;
begin
  cbSize := 255 * sizeof(WideChar) + 1;
  Result := S_OK;
end;

Теперь приступим к реализации метода Execute. В первую очередь нам необходимо получить ссылку на IDictionary из параметров метода. Для этого воcпользуемся функцией GetDictFromDispatch из модуля ComPUtil.pas. Затем вызовем функцию ExportDictionaryToXml, сохраним результат во временной строке, представляющей собой xml-текст и запишем эту строку в файл на диске.

function TDumpOrderToXml.Execute(const pdispOrder, pdispContext: IDispatch;
  lFlags: Integer; out plErrorLevel: Integer): HResult;
var
  hFile: Integer;
  tmpXML: WideString;
  Order: IDictionary;
  tmpOutXml: string;
begin
  try
    tmpXML := '';
    if GetDictFromDispatch(pdispOrder, Order) = S_OK then
      begin
        ExportDictionaryToXML(Order, tmpXML);
        tmpXML := '<SO>' + tmpXML + '</SO>';
      end;
    tmpOutXml := tmpXML;
    hFile := FileCreate(string(FXmlFileName));
    FileWrite(hFile, tmpOutXml[1], Length(tmpOutXML));
    FileClose(hFile);
  finally
    Result := S_OK;
    Order := nil;
  end;
end;

Как видим, метод довольно несложный - вся нагрузка ложится на метод ExportDictionaryToXml. Рассмотрим его поподробнее. Как известно, dictionary представляет собой список именованных вариантов. Вариант сам по себе может быть IDictionary, ISimpleList или другой интерфейс. Для перечисления своих элементов dictionary поддерживает интерфейс IEnumVARIANT. Соотвественно, наша задача - взять IEnumVARIANT, пробежаться по его элементам и сохранить их имена и значение в строке.

Result := E_FAIL;
hr := InitKeyEnumInDict(Dict, Enum);
if hr = S_OK then
  begin

    repeat
      hr := GetNextKeyInDict(Enum, Key);
      if hr <> S_OK then Break;
      hr := GetDictValueVariant(Dict, LPCWSTR(Key), ItemValue);
      if hr <> S_OK then Break;

      case VarType(ItemValue) of
        ...
      else
        Break;
      end;

    until hr <> S_OK;
  end;

XmlStr := Res;
Result := S_OK;


Основное место в теле метода занимает оператор case. В нем определяются обычные значения варианта и сложные, такие как интерфейсы. Для обычных типов обработка будет такая:

Res := Res + Format('<%s>%s</%s>', [string(Key), string(ItemValue), string(Key)]);


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

Res := Res + Format('<%s>IUnknown</%s>',[string(Key), string(Key)]);

Наиболее сложная обработка для типа varDispatch. Здесь нам необходимо убедится, что элемент является либо IDictionary, либо ISimpleList. Для других случаев используем тоже самое, как для varUnknown:

if GetDictFromDispatch(ItemValue, NewDict) = S_OK then
  begin
    if ExportDictionaryToXML(NewDict, NewXml) = S_OK then
      begin
        Res := Res + Format('<%s type="Dictionary">%s</%s>',
          [string(Key), string(NewXml), string(Key)]);
      end
    else
      begin
        Exit;
      end;
  end
else if GetSimpleListFromDispatch(ItemValue, NewList) = S_OK then
  begin
    if ExportSimpleListToXML(NewList, NewXml) = S_OK then
      begin
        Res := Res + Format('<%s type="SimpleList">%s</%s>',
          [string(Key), string(NewXml), string(Key)]);
      end
    else
      begin
        Exit;
      end;
  end
else
  begin
    Res := Res + Format('<%s>IDispatch</%s>',
      [string(Key), string(Key)]);
  end;


Поскольку вариант может быть другим IDictionary, то в результате получим рекурсивный алгоритм. Замечу, что в случае ISimpleList вызывается еще один метод - ExportSimpleListToXml. Его реализация достаточно проста. Необходимо пробежаться по элементам списка, каждый из которых IDictionary, и вызывать ExportDictioanryToXml:

Result := E_FAIL;
hr := GetNumItems(List, Count);
if hr <> S_OK then Exit;

for I := 0 to Count - 1 do
  begin
    if GetNthItem(List, I, NewDict) = S_OK then
      begin
        if ExportDictionaryToXML(NewDict, NewXml) = S_OK then
          begin
            Res := Res + Format('<LISTITEM%d>'#13#10'%s</LISTITEM%d>'#13#10,
              [I, string(NewXml), I]);
          end
        else
          begin
            Exit;
          end;
      end;
  end;

XmlStr := Res;
Result := S_OK;


Вот собственно и вся реализация метода Execute. Для полной красоты картины, нам необходимо научиться редактировать поле FXmlFilename в Pipeline редакторе. Для этого добавим в проект Property Page. На форму добавим из палитры Textbox, Label, Button и SaveDialog.


В обработчик нажатия кнопки добавим код по вызову SaveDialog:

if SaveDialog1.Execute then
  begin
    Edit1.Text := SaveDialog1.FileName;
  end;


Для реализации поведения Property Page, мы должны реализовать два метода UpdatePropertyPage и UpdateObject. Первый метод восстанавливает значение из объекта в textbox. Второй, наоборот, записывает значение из textbox в объект.

procedure TDumpToXMLPropertyPage.UpdatePropertyPage;
var StrXmlFilename: WideString;
begin
{ Update your controls from OleObject }
  (OleObjects.First as IDumpOrderToXml).GetXmlFileName(StrXmlFilename);
  Edit1.Text := StrXmlFilename;
end;

procedure TDumpToXMLPropertyPage.UpdateObject;
var StrXmlFilename: WideString;
begin
{ Update OleObject from your controls }
  StrXmlFilename := Edit1.Text;
  (OleObjects.First as IDumpOrderToXml).SetXmlFileName(StrXmlFilename);
end;

Для того, чтобы Pipeline Editor знал, что у компонента есть дополнительные property-странички, необходимо реализовать метод GetPages у нашего класса.

function TDumpOrderToXml.GetPages(out pages: TCAGUID): HResult;
begin
  pages.cElems := 1;
  pages.pElems := CoTaskMemAlloc(sizeof(TGUID));
  if pages.pElems = nil then
    begin
      Result := E_OUTOFMEMORY;
    end
  else
    begin
      pages.pElems^[0] := Class_DumpToXMLPropertyPage;
      Result := S_OK;
    end;
end;


Этот метод занимается тем, что наполняет структуру, в которой хранятся все guid-ы наших property-страничек. В нашем случае это одна страничка - Class_DumpToXmlPropertyPage. Этот guid генерируется автоматически средой, когда мы создаем новую property page.

Теперь подошел черед модифицировать .dpr файл. В нем указывается экспортная функция DllRegisterServer, которую надо переделать:

function DllRegisterServer: HResult;
begin
  Result := ComServ.DllRegisterServer;
  if Result = S_OK then
    begin

{ Register DumpOrderToXml class }
      Result := RegisterCATID(CLASS_DumpOrderToXml, CATID_MSCSPIPELINE_COMPONENT);
      if Result >= 0 then
        begin
          Result := RegisterCATID(CLASS_DumpOrderToXml, CATID_MSCSPIPELINE_ANYSTAGE);
        end;

{ Here you should register others pipeline components }
    end;
end;



В этой функции указывается, что надо зарегистрировать в системе pipeline component, и что этот компонент может принадлежать любому pipeline stage.

На этом разработка закончена. Осталось откомпилировать и зарегистриовать dll. Это можно сделать через командную строку: regsvr32 testpipelines.dll

Взято с Исходников.ru

Пишем Screensaver в Delphi

Пишем Screensaver в Delphi

Автор: Dave Murray

В примере описывается создание простейшего скринсейвера, а так же его установка и запуск.

Совместимость: Delphi (все версии)

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

FormShow - скрыть курсор, установка обработки сообщений, начало отображения скринсейвера
FormHide - окончание отображения скринсейвера, отображение курсора
DeactivateScrSaver - обработка сообщений, деактивирование, если нажата мышка или клавиатура

Типичный код для этих процедур показан ниже.

Вы должны быть уверены, что Ваша форма создана со стилем fsStayOnTop. Вы так же должны быть уверены, что только один экземпляр Вашей программы будет запущен в системе. И в заключении Вам необходимо включить директиву компилятора {$D "Programname Screensaver"} в Ваш проект (*.dpr).

После того, как Вы скомпилируете программу, измените расширение файла на SCR и скопируйте его в Вашу системную папку \WINDOWS\SYSTEM .

var 
  crs : TPoint;  {первоначально расположение курсора мышки} 

procedure TScrForm.FormShow(Sender: TObject); 
{starts the screensaver} 
begin 
  WindowState := wsMaximized; {окошко будет на полный экран} 
  GetCursorPos(crs); {получаем позицию курсора} 
  Application.OnMessage := DeactivateScrSaver; {проверяем мышку/клавиатуру} 
  ShowCursor(false); {скрываем курсор} 
  {начинаем отображение скринсейвера...} 
  // 
end; {процедура TScrForm.FormShow} 

procedure TScrForm.FormHide(Sender: TObject); 
{возвращаем управление пользователю} 
begin 
  Application.OnMessage := nil; {запрещаем сообщения} 
  {останавливаем скринсейвер...} 
  // 
  ShowCursor(true); {возвращаем курсор назад} 
end; {procedure TScrForm.FormHide} 

procedure TScrForm.DeactivateScrSaver(var Msg : TMsg; var Handled : boolean); 
{определение движения мышки или нажатия на клавиатуре} 
var 
  done : boolean; 
begin 
  if Msg.message = WM_MOUSEMOVE then {сдвинулась мышка} 
    done := (Abs(LOWORD(Msg.lParam) - crs.x) > 5) or 
            (Abs(HIWORD(Msg.lParam) - crs.y) > 5) 
  else {key / mouse нажаты?} 
    done := (Msg.message = WM_KEYDOWN)     or (Msg.message = WM_KEYUP)       or 
            (Msg.message = WM_SYSKEYDOWN)  or (Msg.message = WM_SYSKEYUP)    or 
            (Msg.message = WM_ACTIVATE)    or (Msg.message = WM_NCACTIVATE)  or 
            (Msg.message = WM_ACTIVATEAPP) or (Msg.message = WM_LBUTTONDOWN) or 
            (Msg.message = WM_RBUTTONDOWN) or (Msg.message = WM_MBUTTONDOWN); 
  if done then 
    Close; 
end; {procedure TScrForm.DeactivateScrSaver} 

Взято с Исходников.ru  

Пишем свой текст в Меню

Пишем свой текст в Меню

Автор: Ido Kanner

Когда играешь во встроенную в Windows игру freecell, то справа в меню постоянно пишется сколько осталось карт. Давайте посмотрим, как это делается.

Перво наперво положим компонент главного меню на форму.
Теперь установим свойство OwnerDraw в true.

Далее создайте, то что Вы хотите вырисовывать в меню и создайте OnDrawItem.
И добавьте в него следующую строку:

... 
ACanvas.TextOut(1,ARect.Top+1,'I am in the MainMenuDrawbar'); 
... 


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

Если Вы используете Delphi 2,3 пользуйтесь сообщениями WM_MESUREITEM и WM_DRAWITEM, чтобы сделать данный эффект.


Взято с Исходников.ru

Питание, завершение работы

Питание, завершение работы

Cодержание раздела:














См. также статьи в других разделах:

Плавно превратить один рисунок в другой

Плавно превратить один рисунок в другой

procedureTForm1.Button1Click(Sender: TObject);
const
  count = 100;
var
  i: integer;
  x, y: integer;
  bm, bm1, bm2: TBitMap;
  p1, p2, p: PByteArray;
  c: integer;
  k: integer;
begin
  bm := TBitMap.Create;
  bm1 := TBitMap.Create;
  bm2 := TBitMap.Create;
  bm1.LoadFromFile('Bitmap1.bmp');
  bm2.LoadFromFile('Bitmap2.bmp');
  if bm1.Height < bm2.Height then
  begin
    bm.Height := bm1.Height;
    bm2.Height := bm1.Height;
  end
  else
  begin
    bm.Height := bm2.Height;
    bm1.Height := bm2.Height;
  end;
  if bm1.Width < bm2.Width then
  begin
    bm.Width := bm1.Width;
    bm2.Width := bm1.Width;
  end
  else
  begin
    bm.Width := bm2.Width;
    bm1.Width := bm2.Width;
  end;
  bm.PixelFormat := pf24bit;
  bm1.PixelFormat := pf24bit;
  bm2.PixelFormat := pf24bit;

  Form1.Canvas.Draw(0, 0, bm1);
  for i := 1 to count - 1 do
  begin
    for y := 0 to bm.Height - 1 do
    begin
      p := bm.ScanLine[y];
      p1 := bm1.ScanLine[y];
      p2 := bm2.ScanLine[y];
      for x := 0 to bm.Width * 3 - 1 do
        p^[x] := round((p1^[x] * (count - i) + p2^[x] * i) / count);
    end;
    Form1.Canvas.Draw(0, 0, bm);
    Form1.Caption := IntToStr(round(i / count * 100)) + '%';
    Application.ProcessMessages;
    if Application.Terminated then
      break;
  end;
  Form1.Canvas.Draw(0, 0, bm2);
  Form1.Caption := 'done';
  bm1.Destroy; bm2.Destroy; bm.Destroy;
end;

Взято из

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

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

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

Взято из

Почему я должен устанавливать BDE?

Почему я должен устанавливать BDE?

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


Типичная ошибка! BDE это не поддержка alias! компоненты Дельфи такие как Table, Query, Database - почти вообще ничего не делают! - это только удобный интерфейс к BDE. Т.е. BDE реально читает и пишет в базы данных, обнавляет файлы, управляет транзакциями, сортирует данные, исполняет SQL запросы. BDE с одной стороны имеет BDE Admin для ее управления, а с другой API, которые и использует Дельфи в компонентах. Если вам надо обойтись без BDE вы должны использовать другие драйвера доступа к базам данных: ODBC, DAO, ADO, RDO - многие из них имеют свои API или COM интерфейсы которые вы можете использовать (напрямую, либо найти компоненты для этого, кроме того ADO входит в стандартную поставку дельфей, но через него приконнектится к парадоксу довольно затруднительно). Если же все эти драйвера вас не устраивают то вам надо написать свой драйвер к базе данных (можно прямо в коде программы), он должен обеспечивать:

1) Чтение и запись базы
2) Поддержка транзакций
3) Исполнение SQL запросов
4) Поддержка индексов и ключей
5) Поддержка многопользовательского доступа.
6) Стандартный набор API которые позволят подключаться компонентам типа Table, Query

Есть так же сторонние библиотеки для доступа к базам данных через свои собственные драйвера: HALCYON, или Апполо (Предложил МММ);
vkDBF- компонент для работы с ДБФ для Дельфы6/5 без БДЕ.(Предложил Free)

Автор ответа: Vit
Взято с Vingrad.ru


Допустим написал я программку для работы с некоторой базой данных, каким образом можно перетащить её на другой комп, если на нём нету никакого database desktop чтоб настроить Alias'ы, никаких библиотек нужных? Вы хотите сказать что никуда не деться и придётся заказчикам всем ставить с диска Delphi DB Desktop ?

Вы немного не понимаете архитектуру обращения к базе данных, BDE это вовсе не система настройки Alias'ов, не DB Desktop и не Database Administrator! Программа на Дельфи как и на любом другом языке общается с базами данных через особые драйвера баз данных, собственно компоненты TTablу/TQuery ничего не делают с базой данных, они только дают возможность в удобной форме послать запрос драйверу и интерпретировать ответ от драйвера, все запросы, все физические операции с базой данных делает вовсе не код вашего exe файла, а драйвер базы данных, который в данном случае входит в состав BDE. Примерно так же как когда вы сохраняете файл на диске вы же не даёте напрямую команду BIOSу записать на диск номер такой-то дорожку такую-то сектор такой-то, вы пишете имя файла, а драйвер диска входящий в состав операционной системы сам знает в какие сектора что писать. Точно то же и с базами данных - существует драйвер, который физически работает с таблицами, а вы лишь пользуетесь компонентами, которые знают как работать с драйвером (не с базой данных!) и позволяют Вам это делать довольно удобным способом. Чтобы унифицировать работу и не иметь отдельного совершенно разного интерфейса к разным базам данных используют так называемые системы доступа к базам данных - это наборы драйверов ко всем более или менее распространённым базам данных, которые имеют более или менее стандартный интерфейс для программиста, единые программы их конфигурирования и единую идеологию построения. Одной из таких систем является BDE - Borland Database Engine - по русски, в дословном переводе - Борландовский движок для баз данных - заметьте, не конфигурация и не DB Desktop - а "движок", ядро, именно то что и обеспечивает работу с базами данных. Компоненты TTable/TQuery без BDE работать не будут - там просто нет тех API с которыми они оперируют. Физически BDE представляет из себя:
1) Файл хранящий настрйки
2) Несколько DLL обеспечивающих общую работоспособность BDE
3) Драйвера для различных баз данных (Paradox, MS SQL Server, InterBase и т.д.)
4) Служебные утилиты для конфигурации и простых операций с базами данных (DB Desktop, BDE Administrator)
5) SQL Link - система специальных драйверов для серверных баз данных с улучшенной архитектурой под приложения клиент-сервер
Наличие файлов пунктов 1 и 2 - абсолютно необходимо, из пункта 3 - Вам в простейшем случае нужен лишь тот драйвер которым Вы пользуетесь. Файлы пунктов 4 и 5 - вспомогательные, для работоспособности BDE не имеют абсолютной необходимости.
Отвечая на Ваш вопрос - да, всем заказчикам надо поставить BDE, и ничего в этом страшного нет, так как любая маломальски сложная система обычно требует установки многих третьесторонних продуктов и ничего страшного в этом нет, во-вторых BDE бесплатна и вы можете её ставить где угодно и кому угодно, в третьих - BDE практически не мешает никаким другим программам, если они её не пользуют, практически не трогает реестр и занимает не так уж много места - по современным меркам - совсем мало, и в четвёртых - любой инсталлятор, например Install Shield "знает" как устанавливать BDE, поэтому если вы создадите нормальную инсталляцию Вашей программы, как любого серьёзного продукта, то инсталляция BDE будет проходить совершенно прозрачно и никому не будет мешать.

Автор:

Vit

Взято из

Почему MDI Child форма при закрывании просто минимизируется?

Почему MDI Child форма при закрывании просто минимизируется?

Обрабатывайте событие OnClose для формы и выставляйте в нем параметр Action в caFree. Дело в том, что его значение по умолчанию для MDI Child форм caMinimize. Кстати, если сделать Action := caNone, то форму нельзя будет закрыть

Взято с

Почему методы рисования Delphi (например MoveTo и LineTo) рисуют на один пиксел короче?

Почему методы рисования Delphi (например MoveTo и LineTo) рисуют на один пиксел короче?

Так работает большинство графических систем, включая Windows. Библиотека VCL просто передает вызовы в функции GDI. Если Вы хотите нарисовать линию с последним пикселом включительно просто добавте единицу к координатам.

Почему таблица или select показывается

Почему таблица или select показывается в Grid быстро, а перемещение в конец таблицы происходит долго?

Когда вы открываете набор данных при помощи TTable, BDE производит fetch только такого количества записей, которые помещаются в Grid. Если вы захотели переместиться в конец таблицы, то для большинства SQL-серверов возможно перемещение по записям только вперед - т.е. если вам потребуется поместить указатель в середину таблицы то BDE пришлось-бы заново перечитывать записи с ее начала. Причина такой работы в том, что SQL-серверы в большинстве возвращают результаты запросов в виде последовательных наборов записей. В навигационных БД напротив, возможно физическое позиционирование на любую запись таблицы.

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

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

TTable-же напротив, показывает всю таблицу, и запросы для получения содержимого таблицы формируются автоматически. Поэтому TTable при нажатии вами в TDBGrid клавиш Ctrl-End сформирует запрос типа

SELECT * FROM TABLE ORDER BY INDEXFIELD DESC 

и покажет только видимые в DBGrid записи "с конца". При этом, если нет DESC индекса по полю INDEXFIELD, сортировка данных (ORDER BY) будет производиться на диске. И чем больше записей в таблице, тем дольше. Для того, чтобы перемещение по Ctrl-End для TTable происходило быстро, нужно создать DESC индекс по полю сортировки. В этом случае операцию перехода в конец таблицы TTable выполнит практически мгновенно. Пользователи Delphi C/S могут посмотреть операторы, выдаваемые TTable SQL-серверу при помощи SQL Monitor.

Более подробно на эту тему см. документ http://www.ibase.ru/devinfo/bde.htm


Borland Interbase / Firebird FAQ
Borland Interbase / Firebird Q&A, версия 2.02 от 31 мая 1999
последняя редакция от 17 ноября 1999 года.
Часто задаваемые вопросы и ответы по Borland Interbase / Firebird
Материал подготовлен в Демо-центре клиент-серверных технологий. (Epsylon Technologies)
Материал не является официальной информацией компании Borland.
E-mail mailto:delphi@demo.ru
www: http://www.ibase.ru/
Телефоны: 953-13-34
источники: Borland International, Борланд АО, релиз Interbase 4.0, 4.1, 4.2, 5.0, 5.1, 5.5, 5.6, различные источники на WWW-серверах, текущая переписка, московский семинар по Delphi и конференции, листсервер ESUNIX1, листсервер mers.com.
Cоставитель: Дмитрий Кузьменко

Почему такие большие программы сделанные в Дельфи?

Почему такие большие программы сделанные в Дельфи?

Это плата за визуальность и объектность. Простая форма, это не так просто как кажется. Код простой формы включает в себя:

1) Обработчик событий от Windows
2) Базовые классы оконного приложения: TApplication, TMouse, TScreen и т.д.
3) Весь класс TForm + все его предки + все используемые им классы.
и многое другое.

Зачем это нужно? Ну например ты не используешь метод формы "Close", зачем его реализацию совать в код? Да затем что логика в том, что чужое приложение может послать сообщение твоему окну и инициализировать работу этого метода. Или допустим ты не пользуешь какое-нибудь свойство или метод - но его можно передать в твое приложение как строку и инициализировать их использование. Т.е. на этапе компилляции компиллятор совершенно не имеет понятия какие из методов объектов ты будешь использовать. Ты даже можешь использовать методы родительских классов формы и компиллятор не будет знать об этом - логика программы может "решить" их использовать по ходу дела, при определенных обстоятельствах. Так например работают многие руссификаторы - в файле национальных установок прописаны свойства компонентов, и эти свойства при выполнении программы используются. При написании программы программист "разрешает" изменять любые свойства любых объектов и это реализовано. Таким образом компиллятор вынужден загружать всю библиотеку, вместе с реализацией методов которые вообще никогда не будут реализованы.

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

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

PS. Многие среды создают видимость компактного кода - например VB - дает небольшие программы за счет того что использует огромную библиотеку VBRunxx.DLL. А MS VC++ зачастую требует библиотеку MFC. На Дельфи можно сделать тоже - в опциях проекта есть возможность компиллировать с пакетами - тогда библиотеки будут поставляться в виде отдельных файлов BPL - а сама программа будет маленькой. Если вы например поставляете 10 програм - то так и надо сделать - тогда все библиотеки будут храниться только в одном экземпляре, и программы будут очень небольшими. Если программа одна, то понятное дело что этим вы ничего не сэкономите.

Автор ответа: Vit
Взято с Vingrad.ru

Почему в операторе SELECT для VIEW нельзя использовать ORDER BY?

Почему в операторе SELECT для VIEW нельзя использовать ORDER BY?

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

Borland Interbase / Firebird FAQ
Borland Interbase / Firebird Q&A, версия 2.02 от 31 мая 1999
последняя редакция от 17 ноября 1999 года.
Часто задаваемые вопросы и ответы по Borland Interbase / Firebird
Материал подготовлен в Демо-центре клиент-серверных технологий. (Epsylon Technologies)
Материал не является официальной информацией компании Borland.
E-mail mailto:delphi@demo.ru
www: http://www.ibase.ru/
Телефоны: 953-13-34
источники: Borland International, Борланд АО, релиз Interbase 4.0, 4.1, 4.2, 5.0, 5.1, 5.5, 5.6, различные источники на WWW-серверах, текущая переписка, московский семинар по Delphi и конференции, листсервер ESUNIX1, листсервер mers.com.
Cоставитель: Дмитрий Кузьменко

Почему возникает ошибка Access Violation?

Почему возникает ошибка Access Violation?

Ошибка "Access Violation" возникает, когда идёт обращение к памяти к которой обращение запрещено. Это возможно во многих случаях, но наиболее типичные ситуации я попытаюсь перечислить:

1) Обращение к не созданному объекту.

var e:TEdit;
begin
  e.text:='Hello world!';
end;

В данном случае объект e ещё не создан и идёт обращение к памяти, которая ещё не выделена.


2) Обращение к уже разрушенному объекту:

var e:TEdit;
begin
  ...
  e.free;
  ...
  e.text:='Hello world';
end;

Тут есть хитрость, допустим вы хотите проверить есть ли объект и модернизируете код:

if e<>nil then e.text:='Hello world!';

или

if assigned(e) then  e.text:='Hello world!';

Особенно часто приходится такое делать когда
надо уничтожить объект:

if e<>nil then e.free;

Так вот - такой код может быть источником ошибки, так как метод Free автоматически не устанавливает указатель в Nil. Обязательно после каждого Free используйте установление указателя в nil:

e.free;
e:=nil;

3) При выходе за границы динамического массива обычно генерится ошибка "Index out of bound", но возможно и возникновение Access Violation, особенно когда не стоят опции компилляции для проверки границ массивов. Эта ошибка может быть очень сложна в отлаживании - дело в том что допустим у вас есть массив а длиной в 10 элементов, в пишете:

a[20]:=something;

И эта строка может пройти как и надо, без всяких проблем, но её выполнение повредит какой-то другой код, причём каждый раз другой! Теперь самая безобидная операция типа i:=10 может вдруг внезапно дать Access Violation.

3) На форме на onCreate вызывается что-то с других форм - эти другие формы на этот момент еще не созданы

4) На форме на onDestroy вызывается что-то с других форм - эти другие формы на этот момент уже разрушены


Автор Vit
Взято с Vingrad.ru

Поддерживает ли процессор технологию 3DNow

Поддерживает ли процессор технологию 3DNow

{$ifndef ver80} // так как будем использовать 32-битный регистр
    function 3DNowSupport: Boolean; assembler; 
    asm 
      push  ebx 
      mov   @Result, True 
      mov   eax, $80000000 
      dw    $A20F            
      cmp   eax, $80000000 
      jbe   @NOEXTENDED    // 3DNow не поддерживается
      mov   eax, $80000001 
      dw    $A20F            
      test  edx, $80000000 
      jnz    @EXIT          // 3DNow поддерживается
      @NOEXTENDED: 
      mov  @Result, False 
      @EXIT: 
      pop ebx 
    end; 
    {$endif}

Поддержка блокировок

Поддержка блокировок

Each function listed below returns information about lock status or acquires or releases a lock at the table or record level.



DbiAcqPersistTableLock:
Acquires an exclusive persistent lock on the table preventing other users from using the table
or creating a table of the same name.

DbiAcqTableLock:
Acquires a table-level lock on the table associated with the given cursor.

DbiGetRecord:
Record positioning functions have a lock parameter.

DbiIsRecordLocked:
Checks the lock status of the current record.

DbiIsTableLocked:
Returns the number of locks of a specified type acquired on the table associated with the
given session.

DbiIsTableShared:
Determines whether the table is physically shared or not.

DbiOpenLockList:
Creates an in-memory table containing a list of locks acquired on the table.

DbiOpenUserList:
Creates an in-memory table containing a list of users sharing the same network file.

DbiRelPersistTableLock:
Releases the persistent table lock on the specified table.

DbiRelRecordLock:
Releases the record lock on either the current record of the cursor or only the locks acquired
in the current session.

DbiRelTableLock:
Releases table locks of the specified type associated with the current session (the session in
which the cursor was created).

DbiSetLockRetry:
Sets the table and record lock retry time for the current session.

Взято с

Delphi Knowledge Base

Поддержка курсоров

Поддержка курсоров

Each function listed below returns information about a cursor, or performs a task that performs a cursor-related task such as positioning of a cursor, linking of cursors, creating and closing cursors, counting of records associated with a cursor, filtering, setting and comparing bookmarks, and refreshing all buffers associated with a cursor.



DbiActivateFilter:
Activates a filter.

DbiAddFilter:
Adds a filter to a table, but does not activate the filter (the record set is not yet altered).

DbiApplyDelayedUpdates:
When cached updates cursor layer is active, writes all modifications made to cached data to the
underlying database.

DbiBeginDelayedUpdates:
Creates a cached updates cursor layer so that users can make extended changes to temporarily
cached table data without writing to the actual table, thereby minimizing resource locking.

DbiBeginLinkMode:
Converts a cursor to a link cursor. Given an open cursor, prepares for linked access. Returns a
new cursor.

DbiCloneCursor:
Creates a new cursor (clone cursor) which has the same result set as the given cursor
(source cursor).

DbiCloseCursor:
Closes a previously opened cursor.

DbiCompareBookMarks:
Compares the relative positions of two bookmarks in the result set associated with the cursor.

DbiDeactivateFilter:
Temporarily stops the specified filter from affecting the record set by turning the filter off.

DbiDropFilter:
Deactivates and removes a filter from memory, and frees all resources.

DbiEndDelayedUpdates:
Closes a cached updates cursor layer ending the cached updates mode.

DbiEndLinkMode:
Ends linked cursor mode, and returns the original cursor.

DbiExtractKey:
Retrieves the key value for the current record of the given cursor or from the supplied record buffer.

DbiForceRecordReread:
Rereads a single record from the server on demand, refreshing one row only, rather than clearing
the cache.

DbiForceReread:
Refreshes all buffers associated with the cursor, if necessary.

DbiFormFullName:
Returns the fully qualified table name.

DbiGetBookMark:
Saves the current position of a cursor to the client-supplied buffer called a bookmark.

DbiGetCursorForTable:
Finds the cursor for the given table.

DbiGetCursorProps:
Returns the properties of the cursor.

DbiGetExactRecordCount:
Retrieves the current exact number of records associated with the cursor. NEW FUNCTION BDE 4.0

DbiGetFieldDescs:
Retrieves a list of descriptors for all the fields in the table associated with the cursor.

DbiGetLinkStatus:
Returns the link status of the cursor.

DbiGetNextRecord:
Retrieves the next record in the table associated with the cursor.

DbiGetPriorRecord:
Retrieves the previous record in the table associated with the given cursor.

DbiGetProp:
Returns a property of an object.

DbiGetRecord:
Retrieves the current record, if any, in the table associated with the cursor.

DbiGetRecordCount:
Retrieves the current number of records associated with the cursor.

DbiGetRecordForKey:
Finds and retrieves a record matching a key and positions the cursor on that record.

DbiGetRelativeRecord:
Positions the cursor on a record in the table relative to the current position of the cursor.

DbiGetSeqNo:
Retrieves the sequence number of the current record in the table associated with the cursor.

DbiLinkDetail:
Establishes a link between two tables such that the detail table has its record set limited to the
set of records matching the linking key values of the master table cursor.

DbiLinkDetailToExp:
Links the detail cursor to the master cursor using an expression.

DbiMakePermanent:
Changes a temporary table created by DbiCreateTempTable into a permanent table.

DbiOpenTable:
Opens the given table for access and associates a cursor handle with the opened table.

DbiResetRange:
Removes the specified table's limited range previously established by the function DbiSetRange.

DbiSaveChanges:
Forces all updated records associated with the cursor to disk.

DbiSetFieldMap:
Sets a field map of the table associated with the given cursor.

DbiSetProp:
Sets the specified property of an object to a given value.

DbiSetRange:
Sets a range on the result set associated with the cursor.

DbiSetToBegin:
Positions the cursor to BOF (just before the first record).

DbiSetToBookMark:
Positions the cursor to the location saved in the specified bookmark.

DbiSetToCursor:
Sets the position of one cursor (the destination cursor) to that of another (the source cursor).

DbiSetToEnd:
Positions the cursor to EOF (just after the last record).

DbiSetToKey:
Positions an index-based cursor on a key value.

DbiSetToRecordNo:
Positions the cursor of a dBASE table to the given physical record number.

DbiSetToSeqNo:
Positions the cursor to the specified sequence number of a Paradox table.

DbiUnlinkDetail:
Removes a link between two cursors.

Взято с

Delphi Knowledge Base

Поддержка пользователей, защита

Поддержка пользователей, защита

Cодержание раздела:







См. также статьи в других разделах:

Подключен ли в своем компе протокол TCP/IP?

Подключен ли в своем компе протокол TCP/IP?

Думаю что надёжнее всего "ping 127.0.0.1" потому что другие методы не дадут уверенности что протокол работает нормально.

Почему именно ping 127.0.0.1?

127.0.0.1 - или по другому localhost - это предопределённый протоколом TCP/IP собственный (внутренний) адрес компьютера, так что если TCP/IP установлен и работает, то этот адрес точно есть и должен пинговаться без проблем, кроме того он пингуется без выхода в сеть, и удобен если надо отличить неработоспособность протокола (драйвера) от поломок вне компьютера(хаб, свич, разъёмы, провода, сервера, другие компьютеры).

Автор ответа: Vit
Взято с Vingrad.ru



uses Registry;

function TCPIPInstalled: boolean;
var 
  Reg:   TRegistry; 
  RKeys: TStrings; 
begin 
 Result:=False; 
 try 
  Reg := TRegistry.Create; 
  RKeys := TStringList.Create; 
  Reg.RootKey:=HKEY_LOCAL_MACHINE; 
  if Reg.OpenKey('\Enum\Network\MSTCP', False) Then 
   begin 
     reg.GetKeyNames(RKeys); 
     Result := RKeys.Count > 0; 
   end; 
 finally 
  Reg.free; 
  RKeys.free; 
 end; 

Взято с Исходников.ru

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

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

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

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

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

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

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

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

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


Наталия Елманова
Взято с Исходников.ru

Подключение сетевого диска

Подключение сетевого диска

Автор: Eber Irigoyen

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


//Пример открытия стандартного диалога 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
  WNetConnectionDialog(Handle,RESOURCETYPE_DISK) 
end; 

//Так же можно подключить и принтер 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  WNetConnectionDialog(Handle,RESOURCETYPE_PRINT) 
end; 

//либо можно использовать следующий код 
procedure TForm1.Button2Click(Sender: TObject); 
var 
NetResource: TNetResource; 
begin 
  { заполняем структуру TNetResource } 
  NetResource.dwType       := RESOURCETYPE_DISK; 
  NetResource.lpLocalName  := 'S:'; 
  NetResource.lpRemoteName := '\\myserver\public'; 
  NetResource.lpProvider   := ''; 

  { подключаем сетевой ресурс, используя структуру TNetResource } 
  If ( WNetAddConnection2(NetResource, 
                         '', {Password (if needed) or empty} 
                         '', {User name (if needed) or empty} 
                         CONNECT_UPDATE_PROFILE)<>NO_ERROR) Then 
     Raise Excepcion.Create('unable to map drive') 
  //так же существуют другие константы для определения возникшей ошибки 
  //ERROR_ACCESS_DENIED, ERROR_ALREADY_ASSIGNED, и т.д. 
end; 

//так же можно и отключить сетевой ресурс... 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  if WNetCancelConnection2( 'S:',0,TRUE) <> NO_ERROR then 
    Raise Exception.create('Error disconnecting map drive'); 
  //соответственно можно использовать другие константы для определения ошибки
  //ERROR_DEVICE_IN_USE, ERROR_NOT_CONNECTED, и т.д. 
end;

Взято с Исходников.ru


Подключение и отключение сетевых дисководов

Для работы с сетевыми дисководами (и ресурсами типа LPT порта) в WIN API 16 и WIN API 32 следующие функции:

1.Подключить сетевой ресурс
WNetAddConnection(NetResourse,Password,LocalName:PChar):longint;
где NetResourse - имя сетевого ресурса (например '\\P166\c')
Password - пароль на доступ к ресурсу (если нет пароля, то пустая строка)
LocalName - имя, под которым сетевой ресурс будет отображен на данном компьютере (например 'F:')

Пример подключения сетевого диска WNetAddConnection('\\P166\C','','F:');
Функция возвращает код ошибки. Для всех кодов предописаны константы, наиболее часто используемые :
NO_ERROR - Нет ошибок - успешное завершение
ERROR_ACCESS_DENIED - Ошибка доступа
ERROR_ALREADY_ASSIGNED - Уже подключен. Наиболее часто возникает при повторном вызове данной функции с теми-же параметрами.
ERROR_BAD_DEV_TYPE - Неверный тип устройства.
ERROR_BAD_DEVICE - Неверное устройство указано в LocalName
ERROR_BAD_NET_NAME - Неверный сетевой путь или сетевое имя
ERROR_EXTENDED_ERROR - Некоторая ошибка сети (см. функцию WNetGetLastError для подробностей)
ERROR_INVALID_PASSWORD - Неверный пароль
ERROR_NO_NETWORK - Нет сети

2.Отключить сетевой ресурс
WNetCancelConnection(LocalName:PChar;ForseMode:Boolean):Longint;
где
LocalName - имя, под которым сетевой ресурс был подключен к данному компьютеру (например 'F:')
ForseMode - режим отключения :
False - корректное отключение. Если отключаемый ресурс еще используется, то отключения не произойдет (например, на сетевом диске открыт файл)
True - скоростное некорректное отключение. Если ресурс используется, отключение все равно произойдет и межет привести к любым последствиям (от отсутствия ошибок до глухого повисания)

Функция возвращает код ошибки. Для всех кодов предописаны константы, наиболее часто используемые :
NO_ERROR - Нет ошибок - успешное завершение
ERROR_DEVICE_IN_USE - Ресурс используется
ERROR_EXTENDED_ERROR - Некоторая ошибка сети (см. функцию WNetGetLastError для подробностей)
ERROR_NOT_CONNECTED - Указанное ус-во не является сетевым
ERROR_OPEN_FILES - На отключаемом сетевом диске имеются открытые файлы и параметр ForseMode=false

Рекомендация: при отключении следует сначала попробовать отключить устройство с параметром ForseMode=false и при ошибке типа ERROR_OPEN_FILES выдать запрос с сообщением о том, что ус-во еще используется и предложением отключить принудительно, и при согласии пользователя повторить вызов с ForseMode=true

Источник: 

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

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

у всех TField существует свойство DisplayText которое используется всеми визуальными компонентами чувствительными к данным (DataAware), в том числе и TDBGrid'ом. Т.е. TDBGrid выводит именно это свойство. В свою очередь, значение этого свойства по умолчанию равно значению из поля БД, с учетом свойства DisplayFormat (у кого оно есть). Но это по умолчанию.
Реально-же, у всех TField есть событие OnGetText. Если оно определено для поля, то DisplayText этого поля будет возвращать то, что вернет OnGetText.
Словами слишком запутанно, проще на примере:
Если поля созданы в дизайнере, то требуемому полю (например FFF) вешаем обработчик FFFOnGetText событию OnGetText.
Если-же поля создаются динамически, то соответственно вешаем обработчик динамически.
Пример обработчика:

procedure FFFOnGetText(Sender: TField; var Text: string; DisplayText: Boolean); 
begin 
  if DisplayText then Text := AnsiUpperCase(Text); 
end;

С таким обработчиком, в поле FFF DBGrid'а, все символы будут заглавными, вне зависимости какие они в БД.
Естественно в БД они не меняются. При этом возникает интересный эффект. Если вы начнете редактировать поле FFF, то оно приобретет вид такой как в БД , до тех пор пока Вы не закончите редактирование.
Естественно это работает и для TDBEdit и пр.

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

Автор:

Петрович

Взято из

Поиск файлов

Поиск файлов

Теперь поговорим о поиске файлов. Для этой цели могут использоваться процедуры FindFirst, FindNext, FindClose, при участии переменной типа TSearchRec которая хранит информацию о текущем статусе поиска и характеристики последнего найденного файла.

Пример иллюстрирующий поиск всех файлов и каталогов в определенном каталоге:

Var SearchRec:TSearchRec;
...
If FindFirst('c:\Windows\*.*', faAnyFile, SearchRec)=0 then
repeat  
{Вот здесь мы можем делать с найденным файлом что угодно  
SearchRec.name - имя файла  
ExpandFileName(SearchRec.name) - имя файла с полным путем}   
until FindNext(SearchRec) <> 0;  
FindClose(SearchRec);

Примечания по приведенному коду:
1) Первыми в список могут попадать файлы с именами "." и ".." - это ДОСовские имена для переходов на "родительский уровень", иногда нужна обработка для их игнорирования.
2) FindFirst в качестве первого параметра принимает шаблон для поиска, так как он был принят для ДОС. Если шаблон не включает путь то файлы будут искаться в текущем каталоге.
3) FindFirst требует задания атрибута для файла - здесь мы искали все файлы, если надо какие-то определенные (например только скрытые, или только каталоги) то надо это указать, список всех атрибутов я уже приводил выше.
4) SearchRec переменная связывает во едино FindFirst и FindNext, но требует ресурсов для своей работы, поэтому желательно ее освободить после поиска процедурой FindClose(SearchRec) - на самом деле утечки памяти небольшие, но если программа работает в цикле и долгое время пожирание ресурсов будет значительным.
5)FindFirst/FindNext - работают не открывая файлы, поэтому они корректно находят даже Swap файлы Windows...

Поиск файлов по дереву каталогов с заходом в подкаталоги разобран

Поиск фраз и записей переменной длины

Поиск фраз и записей переменной длины

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

при внесении в базу данных новой записи она сканируется на предмет определения ключевых слов (это может быть как предопределенный список ключевых слов, так и всех слов, не встречающиеся в стоп-листе [пример: "the", "of", "and"])

ключевые слова вносятся в список ключевых слов со ссылкой на номер записи, например, "hang",46 или "PC",22.

когда пользователь делает запрос, мы извлекаем все записи, где встречается каждое из ключевых слов, например, "hang" может возвратить номера записей 11, 46 и 22, тогда как "PC" - записи с номерами 91, 22 и 15.

затем мы объединяем числа из всех списков c помощью какого-либо логического оператора, например, результатом приведенного выше примера может быть запись под номером 22 (в случае логического оператора AND), или записи 11, 15, 22, 46 и 91 (в случае оператора OR). Затем извлекайте и выводите эти записи.

для синонимов определите таблицу синонимов (например, "hang","kaput"), и также производите поиск синонимов, добавляя их к тому же списку как и оригинальное слово.

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

Конечно, есть множестно технических деталей, которые необходимо учесть, например, организация списков, их эффективное управление и объединение. Оптимизация этой характеристики может вам дать очень быстрое время поиска (примером удачный реализаций могут служить двигатели поиска Nexus, Lycos или WebCrawler, обрабатывающие сотни тысяч записей в течение секунды).

Взято из

Поиск нужных данных

Поиск нужных данных

Теперь разберём более эффективные способы нахождения нужной записи
в таблице.

А если нам надо перейти к вполне конкретной строке (записи)? Можно конечно
организовать такой цикл и найти нужную запись, но это громоздко, неудобно,
и главное очень медлено! Для этого можно использовать метод таблицы Locate.

Например в нашей задаче нам надо найти запись где в поле Category значение
"Cod". Этого можно добится примерно следующим кодом:

Table1.Locate('Category','Cod',[loCaseInsensitive]);

Можно "повесить" этот код на кнопку и убедится, что после выполнения этого
кода активная запись стала именно та которая нам и нужна. Итак что же за параметры
мы передаём этому методу? Первый параметер - это имя поля, второй параметер -
это значение поля, третий опции поиска (см. справку Дельфи). А что будет если
такого значения нет? Например:

Table1.Locate('Category','Cod123',[loCaseInsensitive]);

Ничего не будет, правда метод Locate - это функция и она возвращает значение Boolean
в зависимости от того, найдена запись или нет.
Преобразовав код как

if Table1.Locate('Category','Cod123',[loCaseInsensitive]) then
  showmessage('Record is located seccessful!')
else
  showmessage('Record is not found!');

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

Table1.Locate('Category','Co',[])

не сможет найти запись, а

Table1.Locate('Category','Co',[loPartialKey])

вполне правильно найдёт запись с значением 'Cod'.

А если нам надо найти значение по двум полям? В этой таблице искать так бесполезно,
так как все поля разные. Переключим таблицу на другую. Для этого удалим с формы
все визуальные компоненты кроме DBGrid и DBNavigator (так как у новой таблицы
будет совсем другой список полей). В коде напишем что-то
типа:

Table1.active:=false; //закрыли таблицу
Table1.tablename:='items.db';//ассоциируем с новой таблицей на диске
Table1.active:=true; //открыли таблицу

Откомпилируем код, убедимся, что теперь мы видим совсем другую таблицу.

Теперь давайте найдём такую запись, где ItemNo=1 и Discount=50, для этого нам надо
применить Locate следующим образом:

Table1.Locate('ItemNo;Discount',VarArrayOf([1,50]),[]);

Теперь несколько примечаний:

1) Для Дельфи 6/7 - добавьте "Uses Variants;"
2) Первый параметер - это список имён полей через ; без пробелов
3) Второй параметер - это массив вариант - значений полей. Почему вариант? Потому что
поля могут быть разных типов и в этом массиве вполне можно задать значения
разных типов: VarArrayOf([1,'Вася', True, 3.14]) 

Поиск пересечений графика с осью OX

Поиск пересечений графика с осью OX

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

function F(x: double): double;
begin
  result := sin(x);
end;

procedure TForm1.Button1Click(Sender: TObject);
const
  left = -10;
  right = 10;
var
  x1, x2: double;
  y1, y2: double;
  k, b: double;
  x, y: double;
  d1, d2: double;
begin
  x1 := left;
  y1 := f(x1);
  repeat
    x2 := x1 + 0.1;
    y2 := f(x2);
    if y1 * y2 < 0 then begin
      repeat
        y1 := f(x1);
        y2 := f(x2);
        k := (y1 - y2) / (x1 - x2);
        b := y1 - k * x1;
        x := -b / k;
        y := k * x + b;
        d1 := sqr(x1 - x) + sqr(y1 - y);
        d2 := sqr(x2 - x) + sqr(y2 - y);
        if d1 > d2 then begin
          d1 := d2;
          x1 := x;
        end else x2 := x;
      until d1 < 1E-20;
      ListBox1.Items.Add(FloatToStr(x1));
    end;
    x1 := x2;
    y1 := y2;
  until x2 > right;
end;


Взято с сайта

Поиск по нескольким полям

Поиск по нескольким полям

keyfields:='name;name_1;n_dom;n_kw';
keyvalues:=VarArrayOf([combobox1.Text,combobox2.Text, edit2.Text, edit3.text]);
if dmod.qrfiz.Locate(keyfields,keyvalues,[])=false then
  dmod.qrfiz.Locate('id',id1,[]);

Взято из

Поиск в базе данных

Поиск в базе данных

перевод одноимённой статьи с delphi.about.com

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

В данной статье будут рассмотрены различные способы поиска данных разработке ADO-приложений в Delphi

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

Давайте рассмотрим несколько способов расположения данных, полученных из БД посредствам компонента ADODataset (для Таблицы и для Запроса).

Locate
Этот универсальный метод поиска устанавливает текущую запись как первую строку, удовлетворяющую набору критериев поиска. Используя метод Locate мы можем искать значения одного или более полей, расположенных в массиве переменных. В приведённом ниже коде, метод Locate ищет первую запись, содержащую строку 'Zoom' в поле 'Name'. Если вызов Locate возвращает True - то запись найдена и установлена как текущая.

AdoTable1.Locate('Name','Zoom',[]);

{...или...}

var ffield, fvalue: string;
    opts : TLocateOptions;
    
ffield := 'Name';
fvalue := 'zoom';
opts := [loCaseInsensitive];

if not AdoTable1.Locate(ffield, fvalue, opts) then
  ShowMessage(fvalue + ' not found in ' + ffield);

Lookup
Метод Lookup не перемещает курсор в соответствующую строку, а только возвращает её значение. Lookup возвращает массив переменных, содержащих значения из полей, указанных в разделённом точкой с запятой списке имён, значения которых должны быть возвращены из интересующей нас строки. Если соответствующих нашему запросу строк не найдено, то Lookup вернёт пустую (Null) переменную.

Следующий пример заполняет заполняет массив переменных LookupRes

var LookupRes: Variant;

LookupRes := ADOTable1.Lookup
  ('Name', 'Zoom', 'Author; Description');

if not VarIsNull(LookupRes) then
 ShowMessage(VarToStr(LookupRes[0])) //имя автора


Одно из преимуществ методов Locate и Lookup, состоит в том, что они не требуют, чтобы таблица была проиндексирована. Однако, функция Locate будет работать намного быстрее, если таблица будет проиндексирована.

Индексирование


Индексирование помогает находить и сортировать записи намного быстрее. Вы можете создавать индексы основанные на одном поле либо на нескольких полях. Индексирование нескольких полей позволяет Вам различать записи, в которых первое поле может иметь то же самое значение. В большинстве случаев при частом поиске/сортировке желательно индексировать поля. Например, если Вы ищете определённый тип приложения в поле Type, то Вы можете создать индекс на это поле для ускорения поиска по типу. Следует упомянуть, что первичный ключ таблицы автоматически проиндексирован, а так же Вы не можете индексировать поля с типом данных OLE Object. И ещё, обратите внимание, что если многие из значений в поле те же самые, то индексирование в данном случае не ускорит процесс получения данных из БД.

BDE (не ADO) Delphi предоставляет нам определённые функции для работы с таблицами базы данных, которые позволяют нам производить поиск необходимых значений. Вот некоторые из них Goto, GoToKey, GoToNearest, Find, FindKey, Find Nearest, и т.д. Для более полной справки по этим методам, Вам следует посмотреть в справке Delphi, в разделе: Searching for records based on indexed fields. ADO напротив не поддерживает эти методы. Вместо этого он представляет метод Seek.


Seek
В ADO метод Seek использует индекс для поиска данных. Наример, при поиске в базе данных Access, если не задать индекс, то база данных будет использовать Первичный индексный ключ.
Seek используется для поиска записей с указанным значением (или значениями) в поле (либо полях) на которых основан текущий индекс. Если Seek не находит желаемую строку, то никакой ошибки не выдаётся, а курсор устанавливается в конец данных. Seek возвращает значение boolean, указывающее на успешность поиска: True если запись была найдена либо False если записей удовлетворяющих нашим требований не было найдено.

Метод GetIndexNames в компоненте TADOTable возвращает список (например: ячеек combo box) доступных индексов для таблицы.

 ADOTable1.GetIndexNames(ComboBox1.Items);


Этот же список доступен в режиме разработки в свойстве IndexName компонента TADOTable. Свойство IndexFieldNames может использоваться как альтернативный метод для определения индекса используемого в таблице. В IndexFieldNames, мы указываем имя каждого поля для использования в таблице.

Метод Seek имеет следующее определение:

function Seek(const KeyValues: Variant; SeekOption: TSeekOption = soFirstEQ): Boolean; 

· KeyValues массив значений Variant. Так как индекс состоит из одного или более столбцов, то массив содержит значения, которые будут сравниваться с соответствующими столбцами.
· SeekOption указывает на тип сравнивания между колонками индекса и соответствующим KeyValues.

SeekOption Назначение
soFirstEQ Указатель на запись позиционируется в первую удовлетворяющую требованиям запись, если она найдена, либо в конец таблицы, если не найдена
soLastEQ Указатель на запись позиционируется на последнюю удовлетворяющую требованиям запись если она найдена, либо в конец таблицы если нет.
soAfterEQ Указатель на запись позиционируется на удовлетворяющую требованиям запись, если таковая найдена, либо сразу после той, которая была найдена.
soAfter Указатель на запись позиционируется сразу после той, которая была найдена.
soBeforeEQ Указатель на запись позиционируется на удовлетворяющую требованиям запись, если таковая найдена, либо перед той, которая была найдена.
soBefore Указатель на запись позиционируется перед той записью, которая была найдена.

Примечание 1: метод Seek поддерживает курсоры только на стороне сервера (server-side). Seek не будет работать, если значение свойства CursorLocation равно clUseClient. Для этого используется метод Supports для определения основного провайдера, поддерживающего Seek.

Примечание 2: когда Вы используйте метод Seek для нескольких полей, то Seek поля должны быть в том же самом порядке как поля в основной таблице. Если это не так, то метод Seek выдаст ошибку.

Примечание 3: Вы не сможете использовать метод Seek в компоненте TADOQuery.

Чтобы определять, была ли соответствующая запись найдена, мы используем свойства BOF или EOF (в зависимости от направления поиска). Следующий код использует индекс, указанный в ComboBox, чтобы найти значение, содержащееся в окне редактирования Edit1.

var strIndex: string;

strIndex := ComboBox1.Text; //из примера выше

if ADOTable1.Supports(coSeek) then begin
 with ADOTable1 do begin
   Close;
   IndexName := strIndex;
   CursorLocation := clUseServer;
   Open;
   Seek (Edit1.Text, soFirstEQ);
  end;
  if ADOTable1.EOF then
   ShowMessage ('Record value NOT found');
end

Взято с Исходников.ru

Поиск записи с помощью TQuery

Поиск записи с помощью TQuery

Компонент TQuery не предусматривает основанный на индексе поиск, подобный реализованному в компоненте TTable (FindKey, GotoKey и GotoNearest). Поэтому возникает следующий вопрос: как в данных, возвращаемых запросом TQuery, найти определенную запись?

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

Вот функция, выполняющая последовательный поиск в результатах запроса TQuery:

var
pb: TProgressBar;
begin
...

function SeqSearch(AQuery: TQuery; AField, AValue: String): Boolean;
begin
  with AQuery do 
  begin
    First;
    while (not Eof) and (not (FieldByName(AField).AsString = AValue)) do
      Next;
    SeqSearch := not Eof;
  end;
end;




Данная функция требует три параметра:

AQuery: тип TQuery; компонент TQuery, в котором необходимо выполнить поиск.
AField: тип String; имя поля, с величиной которого проиходит сравнение значение поиска.
AValue: тип String; искомая величина. Если поля имеет тип отличный от типа String, искомая величина должна быть преобразована к типу данных.
Возвращаемая логическая величина указывает на успешность выполнения функции (True) или отсутствие результата поиска (False).
Альтернативой служит использование метода заключения в скобки. На концептуальном уровне данный метод действует отчасти подобно индексу bb-дерева. Он основывается на методе сравнения значения текущей строки набора данных и искомой величины с последующей проверкой на выполнение одного из трех возможных условий:


Величина поля будет больше чем значение поиска, или...
Величина поля будет меньше чем значение поиска, или...
Величина поля равняется значению поиска.
Данный метод сужает область данных, отбрасывая при каждой итерации записи, не удовлетворяющие приведенным выше условиям до тех пор, пока первые два условия выполняться не будут. Полученные данные сравнивается с искомой величиной и, если они совпадают, считается что функция выполнена успешно (success), или окончилась неудачей (failure, если искомая величина ни разу не встретилась, т.е. результат поиска не содержит ни одной строки).
Функционально данный процесс находит поля, удовлетворяющие условиям поиска, за количество итераций меньшее или равное числу записей. При этом возможно только два результата сравнения текущего поля и искомой величины: меньше чем/равняется/больше чем. Первоначально устанавливается диапазон чисел. Меньшая граница диапазона задается целым числом, начало процесса поиска устанавливается на 0 или величину меньшую, чем значение первой строки набора данных. Верхняя граница диапазона является также целым числом, содержащим значение свойства RecordCount экземпляра TQuery. Текущий указатель строки перемещается в в точку, лежащую посередине между нижней и верхней границей диапазона. Значение записи в этой точке сравнивается с искомой величиной. Если значение поля меньше или равно искомой величине, значит искомая величина находится в нижней части набора данных, поэтому верхняя граница диапазона перемещается к позиции текущей строки. Если значение поля больше величины поиска, то искомая величина находится в верхней части набора данных, поэтому к текущему указателю перемещается нижняя граница диапазона. Повторяя этот процесс, количество удовлетворяющих условиям поиска записей при каждой итерации уменьшается в два раза. В конечном счете должна остаться только одна строка.

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



function Locate(AQuery: TQuery; AField, AValue: string): Boolean;
var
  Hi, Lo: Integer;
begin
  with AQuery do
  begin
    First;
    {Устанавливаем верхнюю границу диапазона строк}
    Hi := RecordCount;
    {Устанавливаем нижнюю границу диапазона строк}
    Lo := 0;
    {Текущий указатель перемещаем в в точку, лежащую посередине
    между нижней и верхней границей диапазона}
    MoveBy(RecordCount div 2);
    while (Hi - Lo) > 1 do
    begin
      {Значение поля больше искомой величины, величина в первой половине}
      if (FieldByName(AField).AsString > AValue) then
      begin
        {Вычисляем нижнюю границу верхнего поддиапазона общего диапазона}
        Hi := Hi - ((Hi - Lo) div 2);
        MoveBy(((Hi - Lo) div 2) * -1);
      end
        {Найденное поле меньше искомой величины, нужно искать в верхней половине}
      else
      begin
        {Перемещаем вверх нижнюю границу общего диапазона}
        Lo := Lo + ((Hi - Lo) div 2);
        MoveBy((Hi - Lo) div 2);
      end;
    end;
    {Обрабатываем нечетную нумерацию строк}
    if (FieldByName(AField).AsString > AValue) then
      Prior;
    Locate := (FieldByName(AField).AsString = AValue)
  end;
end;




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

Данная функция также требует три параметра, как и функция SeqSearch, описанная выше.

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

Чем этот метод лучше последовательного поиска? Во-первых, данный метод не производит сравнение всех строк, как это делает метод последовательного поиска, а опрашивает часть записей. Если искомая величина не располагается в числе первых 1,000 строк, то этот метод окажется быстрее чем метод последовательного поиска. Поскольку этот процесс всегда использует одинаковое количество записей, то время поиска будет одинаковым и когда искомая величина находится в записи с номером 1,000, и когда она находится в записи с номером 90,000. Это в корне отличается от последовательного поиска, когда время поиска напрямую зависит от местонахождения искомой величины.

Эти методы могут использоваться в любых результатах запроса TQuery? Нет. Все дело в технологии: описанные методы пользуются такими понятиями, как направление поиска, нижняя и верхняя границы диапазона. Это означает, что набор данных должен быть последователен и непрерывен, т.е. для получения результатов TQuery должен использовать SQL-запросы, содержащие ключевую фразу ORDER BY. Размер полученного набора данных также является показателем для выбора метода. Метод заключения в скобки выгоднее использовать при большом наборе данных. В случае, когда число записей невелико (1,000 и менее строк), метод последовательного поиска все же будет быстрее.


Как мне найти запись (осуществить 'Find') в TQuery?

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

Объявляем: FindSearch : Boolean и инициализируем значением True.



function LookForString(target, source: string): boolean;
{ в случае игнорирования перед вызовом pos необходимо
преобразовать source и target в верхний регистр }
begin
  LookForString := pos(target, source);
end;

procedure SearchName(searchtype: string; stringtofind: string);
var
  OldCursor: TCursor;
  CurrentPos: TBookmark;
  found: boolean;
begin
  if Form1.Query1.State = dsEdit then
    Form1.Query1.Post;
  if StringToFind = '' then
    exit;
  OldCursor := Screen.Cursor;
  Screen.Cursor := crHourGlass;
  with Form1 do
  begin
    CurrentPos := Query1.GetBookmark;
    Query1.DisableControls;
    found := false;
    if searchtype <> 'prev' then { первый или следующий }
    begin
      if searchtype = 'first' then
        Query1.First
      else if not Query1.EOF then
        Query1.Next;
      while (not Query1.EOF) and (not found) do
      begin
        if LookForString(StringToFind, MemberName) <> 0 then
          found := true;
        if not found then
          Query1.Next;
      end;
    end
    else
    begin { prev }
      if not Query1.BOF then
        Query1.Prior;
      while (not Query1.BOF) and (not found) do
      begin
        if LookForString(StringToFind, MemberName) <> 0 then
          found := true;
        if not found then
          Query1.Prior;
      end;
    end;
    Screen.Cursor := OldCursor;
    if found then
    begin
      FindSearch := false;
      ChangeFindCaption;
      UpdateStatusLabel;
    end
    else
    begin
      MessageDlg('Больше ничего не найдено.', mtInformation,
        [mbOK], 0);
      Query1.GotoBookmark(CurrentPos);
    end;
    Query1.EnableControls;
    Query1.FreeBookmark(CurrentPos);
  end; { конец работы с Form1 }
end;

procedure TForm1.FindButtonClick(Sender: TObject);
begin
  if FindSearch then
    SearchName('first', Page0Edit.Text)
  else
    SearchName('next', Page0Edit.Text);
end;

Взято из

Поиск записи в больших таблицах

Поиск записи в больших таблицах

Автор: Александр Куприн

В свою очередь хочу предложить на Ваш суд небольшую процедуру, которая мне очень помогла. Процедура позволяет переходить на любую из записей в таблице (формат Paradox или DBase). Необходимость в ней возникла, когда мне пришлось работать с таблицей размером в 10 и более тысяч записей у которой было несколько калькулируемых полей и полей подлинкованных из объектов TQuery. При использовании метода TTable.MoveBy программа медленно и печально замолкала (вообще-то она работала, но как?!). Встретил я этот пример в технической документации Borland (2656), где сравнивались функции Paradox Engine и BDE. Пример был написан на C. Вот его интерпретация на Delphi:



usesBDE;
...

procedure MoveToRec(RecNo: longint; taSingle: TDBDataSet);
// переход на логическую запись
var
  ErrorCode: DBIResult;
  CursorProps: CurProps;
begin
  ErrorCode := DbiGetCursorProps(taSingle.Handle, CursorProps);
  if ErrorCode = DBIERR_NONE then
  begin
    case TTable(taSingle).TableType of
      ttParadox: ErrorCode := DbiSetToSeqNo(taSingle.Handle, RecNo);
      ttDBase: ErrorCode := DbiSetToRecordNo(taSingle.Handle, RecNo);
    end; { case..}
    taSingle.Resync([rmCenter]);
  end { if..}
end; { procedure MoveToRec }

Взято из

Поиск значения при вводе

Поиск значения при вводе

Каким способом можно производить поиск подходящих величин в момент ввода? Табличный курсор (визуально) должен перемещаться к наиболее подходящему значению при добавлении пользователем новых символов водимой величины.

Первоначально код писался под Delphi 1. Это может и не лучшее решение, но это работает.

Для поиска величины таблица держится открытой. Индекс должен, естественно, принадлежать полю, используемому элементом управления EditBox. В случае изменения содержимого EditBox, новое значение используется для вызова стандартной функции FindNearest таблицы TTable. Возвращаемая величина снова присваивается свойcтву Text элемента EditBox.

Я привел лишь общее решение задачи. Фактически во время изменения значения я включал таймер на период 1/3 секунды и в обработчике события OnTimer проводил операцию поиска (с выключением таймера). Это позволяло пользователю набирать без задержки нужный текст без необходимости производить поиск в расчете на вновь введенный символ (поиск проводился только при возникновении задержки в 1/3 секунды).

Вам также может понадобиться специальный обработчик нажатия клавиши backspace или добавления символа в любое место строки.

Вместо возвращения результатов элементу EditBox (который перезаписывает введенное пользователем значение), вы можете передавать результаты другому элементу управления, например компоненту ListBox. Вы также можете отобразить несколько наиболее подходящих значений, к примеру так:



procedureEdit1OnChange(...);
var
  i: integer;
begin
  if not updating then
    exit;
  {сделайте обновление где-нибудь еще -
  например при срабатывании таймера}
  updating := false;
  Table1.FindNearest([Edit1.text]);
  ListBox1.clear;
  i := 0;
  while (i < 5) and (not (table1.eof)) do
  begin
    listbox.items.add(Table1.fields[0].asString);
    inc(i);
    table1.next;
  end;
  listbox1.itemindex := 0;
end;

 

Взято из

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

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

Я написал компонент-отладчик, выводящий в дереве все компоненты. Попробуйте этот код. Вызывайте функцию DisplayProperties как показано ниже:

DisplayProperties(Form1,{Вы можете использовать любой компонент}
  Outline1.Lines, {Допускается любой TStrings-объект}
  0); {0 - "стартовый", корневой уровень}

DisplayProperties(AObj: TObject; AList: TStrings; iIndentLevel: Integer);
var
  Indent: string;
  ATypeInfo: PTypeInfo;
  ATypeData: PTypeData;
  APropTypeData: PTypeData;
  APropInfo: PPropInfo;
  APropList: PPropList;
  iProp: Integer;
  iCnt: Integer;
  iCntProperties: SmallInt;
  ASecondObj: TObject;

procedure AddLine(sLine: string);
begin
  AList.Add(Indent + #160 + IntToStr(iProp) + ': ' + APropInfo^.Name
    + ' (' + APropInfo^.PropType^.Name + ')' + sLine);
end;

begin

  try
    Indent := GetIndentSpace(iIndentLevel);

    ATypeInfo := AObj.ClassInfo;
    ATypeData := GetTypeData(ATypeInfo);
    iCntProperties := ATypeData^.PropCount;
    GetMem(APropList, SizeOf(TPropInfo) * iCntProperties);
    GetPropInfos(ATypeInfo, APropList);

    for iProp := 0 to ATypeData^.PropCount - 1 do
      begin
        APropInfo := APropList^[iProp];
        case APropInfo^.PropType^.Kind of
          tkInteger:
            AddLine(' := ' + IntToStr(GetOrdProp(AObj, APropInfo)));
          tkChar:
            AddLine(' := ' + chr(GetOrdProp(AObj, APropInfo)));
          tkEnumeration:
            begin
              APropTypeData := GetTypeData(APropInfo^.PropType);
              if APropTypeData^.BaseType^.Name <> APropInfo^.PropType^.Name then
                AddLine(' := ' + IntToStr(GetOrdProp(AObj, APropInfo)))
              else
                AddLine(' := ' + APropTypeData^.NameList);
            end;
          tkFloat:
            AddLine(' := ' + FloatToStr(GetFloatProp(AObj, APropInfo)));
          tkString:
            AddLine(' := "' + GetStrProp(AObj, APropInfo) + '"');
          tkSet:
            begin
              AddLine(' := ' + IntToStr(GetOrdProp(AObj, APropInfo)));
            end;
          tkClass:
            begin
              ASecondObj := TObject(GetOrdProp(AObj, APropInfo));
              if ASecondObj = nil then
                AddLine(' := NIL')
              else
                begin
                  AddLine('');
                  DisplayProperties(ASecondObj, AList, iIndentLevel + 1);
                end;
            end;
          tkMethod:
            begin
              AddLine('');
            end;
        else
          AddLine(' := >>НЕИЗВЕСТНО<<');
        end;
      end;
  except {Выводим исключение и продолжаем дальше}
    on e: Exception do ShowMessage(e.Message);
  end;

  FreeMem(APropList, SizeOf(TPropInfo) * iCntProperties);
end;

function GetIndentSpace(iIndentLevel: Integer): string;
var iCnt: Integer;
begin
  Result := '';
  for iCnt := 0 to iIndentLevel - 1 do
    Result := Result + #9;
end;

- Thomas von Stetten

Взято из

Советов по Delphi от

Сборник Kuliba

Показываем/Скрываем System Tray

Показываем/Скрываем System Tray

Автор: Ruslan Abu Zant

Вы, наверное, видели множество примеров, которые показывают как скрывать панель задач или кнопку Пуск. Но вот как скрыть только System Tray ?

procedure hideStartbutton(visi: boolean);
var
  Tray, Child: hWnd;
  C: array[0..127] of Char;
  S: string;

begin
  Tray := FindWindow('Shell_TrayWnd', nil);
  Child := GetWindow(Tray, GW_CHILD);
  while Child <> 0 do
    begin
      if GetClassName(Child, C, SizeOf(C)) > 0 then
        begin
          S := StrPAS(C);
          if UpperCase(S) = 'TRAYNOTIFYWND' then
            begin
              if Visi then
                ShowWindow(Child, 1)
              else
                ShowWindow(Child, 0);
            end;
        end;
      Child := GetWindow(Child, GW_HWNDNEXT);
    end;
end;

для того, чтобы обатно её показать, используйте

hideStartbutton(true); 

или hideStartbutton(false); 
чтобы скрыть !!

Взято с Исходников.ru

Показываем всплывающие подсказки в различных панелях StatusBar

Показываем всплывающие подсказки в различных панелях StatusBar

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

{ Добавьте CommCtrl в uses. }
{ в интерфейсе формы для статусбара } 
  private 
    procedure AppShowHint(var HintStr: string; var CanShow: boolean; 
      var HintInfo: THintInfo);

procedure TForm1.FormCreate(Sender: TObject); 
begin 
  Application.OnShowHint := AppShowHint; 
end;

procedure TForm1.AppShowHint(var HintStr: string; var CanShow: boolean; 
var HintInfo: THintInfo); 
const 
  PanelHints: array [0..6] of string = 
    ('Cursor position', 'Ascii char', 'Bookmarks', 'Caps lock', 
    'Insert/Overwrite', 'File size', 'File name');
var 
  x: integer; 
  R: TRect; 
begin 
  if HintInfo.HintControl = StatusBar1 then 
  begin 
    for x := 0 to StatusBar1.Panels.Count-1 do 
    begin 
      SendMessage(StatusBar1.Handle, SB_GETRECT, x, Longint(@R)); 
      if PtInRect(R, HintInfo.CursorPos) then 
      begin 
        HintStr := PanelHints[x]; 
        InflateRect(R, 3, 3);
        { Устанавливаем CursorRect говоря системе проверить новые
        строки с подсказками, когда курсор покинет этот прямоугольник. } 
        HintInfo.CursorRect := R; 
        break; 
      end; 
    end; 
  end; 
end;

Взято с Исходников.ru

Получаем и устанавливаем различные режимы видео адаптера?

Получаем и устанавливаем различные режимы видео адаптера?

(Перевод одноимённой статьи с сайта delphi.about.com )

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

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

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

Данная функция имеет на входе переменную типа TDevMode, в которой помещаются параметры. Сам тип TDevMode имеет множество переменных, относящихся к видео адаптеру. А именно, он включает в себя разрешение видео адаптера в пикселях (dmPelsWidth, dmPelsHeight), разрядность цвета (в битах на пиксель), поддерживаемая при данном разрешении (dmBitsPerPel), частота обновления (dmDisplayFrequency) и другие.

procedure TForm1.FormCreate(Sender: TObject);
var
 i       : Integer;
 DevMode : TDevMode;
begin
 i:=0;
 while EnumDisplaySettings(nil,i,DevMode) do begin
   with Devmode do
    ListBox1.Items.Add
     (Format('%dx%d %d Colors',
     [dmPelsWidth,dmPelsHeight,1 shl dmBitsperPel]));
   Inc(i);
 end;
end;

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

procedure TForm1.Button1Click(Sender: TObject);
var
  DevMode    : TDeviceMode;
  liRetValue : Longint;
begin
 if EnumDisplaySettings
    (nil,Listbox1.ItemIndex,Devmode) then
  liRetValue := ChangeDisplaySettings
                  (DevMode, CDS_UPDATEREGISTRY);

  SendMessage(HWND_BROADCAST,
              WM_DISPLAYCHANGE,
              SPI_SETNONCLIENTMETRICS,
              0); 
end;


Функция ChangeDisplaySettings возвращает значение long integer. Это значение можно использовать для определения успешности выполнения функции, сравнив со значениями из списка констант.


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

Внимание: Многие адаптеры (особенно старые) могут не поддерживать смену разрешения без перезагрузки компьютера.

Внимание: SendMessage используется для того, чтобы информировать все окна о смене видео-режима.

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

...
type
  TForm1 = class(TForm)
  ListBox1: TListBox;
    ...
  private
    procedure WMDisplayChange(var Message:TMessage);
      message WM_DISPLAYCHANGE;
...
procedure
  TForm1.WMDisplayChange(var Message: TMessage);
begin
  ShowMessage('Changes in display detected!');
  inherited;
end;

Взято с Исходников.ru

---

---