nyuuzyou/wikis huggingface dataset:
Подключение через TMySQLClien & TMySQLResult

=== Подключение через TMySQLClien & TMySQLResult ===
Решение нашел...
# Без использования dbExpress, а с использованием специальных классов TMySQLClien & TMySQLResult.
# Все эти файлы ( файл приаттачит Secandr (90 кил)) надо положить либо в папку с проектом, либо в <Delphi_dir>/lib.
# Код:
Сразу говорю, показал только основные моменты. Код, для определения ошибок и т.п. писать не стал.
uses
 uMysqlClient, uMysqlCT, uMysqlErrors, uMysqlHelpers, uMysqlNet, uMysqlNewPassword, uMysqlSSL, uMysqlVio;
type
 TMainForm = class(TForm)
 public
 procedure Connect();
 procedure QueryData(Query: string); // Результирующий запрос (заносим данные в таблицу)
 procedure QueryNoData(Query: string); // insetrt, delete - нет полученных данных
 end;
var
 SQLConnection: TMysqlClient; // Объявляем переменную для соединения.
 Grid: TStringGrid;
implementation
// Установка соединения
procedure TMainForm.Connect();
begin
 SQLConnection := TMysqlClient.Create;
 with SQLConnection do
 begin
 Host := 'localhost';
 User := 'root';
 Password := ;
 Db := 'mysql';
 try
 Connect;
 except on Exception do
 begin
 Application.MessageBox('К сожалению, соединиться с MySQL-сервером не удалось. Проверьте правильность ввода всех параметров.' , 'Ошибка соединения', 0);
 exit;
 end;
 end;
 end;
end;
// Выполнение запроса:
procedure TMainForm.QueryData( Query : string );
var
 mysql_result: TMySQLResult;
 i, j: Integer;
 OK: Boolean;
begin
 OK := True;
 try
 mysql_result := SQLConnection.Query(Query, True, OK);
 except on Exception do
 begin
 Application.MessageBox('Запрос не выполнился.', 'Ошибка соединения', 0);
 exit;
 end;
 end;
 with Grid do
 begin
 ColCount := mysql_result.FieldsCount;
 RowCount := mysql_result.RowsCount+1;
 if RowCount = 1 then
 FixedRows := 0
 else
 FixedRows := 1;
 for i := 0 to mysql_result.RowsCount - 1 do
 begin
 for j := 0 to mysql_result.FieldsCount do
 Cells[j, i+1] := mysql_result.FieldValue(j);
 mysql_result.Next();
 end;
 end;
 
 mysql_result.Free();
end;
procedure TMainForm.QueryNoData(Query: string);
begin
 // Аналогично предыдущей процедуре, без внесения данных в таблицу. для запросов Insert, Update .....
end;
Author: Mal Hack 
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 02938
Category:Базы данных
Category:MySQL
Подмена данных в визуальных 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 и пр.
Этот способ удобно применять когда нужно выполнить только текстовое преобразование для отображения значения поля.
Author: Петрович
Source: Взято из http://forum.sources.ru
ID: 03085
Category:Базы данных
Category:DBNavigator
Подсветить HTML теги в RichEdit

=== Подсветить HTML теги в RichEdit ===
procedure HTMLSyntax(RichEdit: TRichEdit; TextCol,
 TagCol, DopCol: TColor); 
var 
 i, iDop: Integer; 
 s: string; 
 Col: TColor; 
 isTag, isDop: Boolean; 
begin 
 iDop := 0; 
 isDop := False; 
 isTag := False; 
 Col := TextCol; 
 RichEdit.SetFocus; 
 for i := 0 to Length(RichEdit.Text) do 
 begin 
 RichEdit.SelStart := i; 
 RichEdit.SelLength := 1; 
 s := RichEdit.SelText; 
 if (s = '<') or (s = '{') then isTag := True; 
 if isTag then 
 if (s = '"') then 
 if not isDop then 
 begin 
 iDop := 1; 
 isDop := True; 
 end 
 else 
 isDop := False; 
 if isTag then 
 if isDop then 
 begin 
 if iDop <> 1 then Col := DopCol; 
 end 
 else 
 Col := TagCol 
 else 
 Col := TextCol; 
 RichEdit.SelAttributes.Color := Col; 
 iDop := 0; 
 if (s = '>') or (s = '}') then isTag := False; 
 end; 
 RichEdit.SelLength := 0; 
end; 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
 RichEdit1.Lines.BeginUpdate; 
 HTMLSyntax(RichEdit1, clBlue, clRed, clGreen); 
 RichEdit1.Lines.EndUpdate; 
end;
Source: http://delphiworld.narod.ru/
ID: 01014
Подсветить изображение

Эффект подсветки как при выделении значков на рабочем столе Windows.
{
Question:
 Does anyone know of a way that I can achieve the same effect on a bitmap
 that windows achieves when you single click on an icon on the desktop? In
 other words, I want to "sorta highlight" a bitmap and let the user know that
 it's selected.
Answer:
 To me it appears as if the icons on my desktop are highlighted by overlaying
 them with a certain color, so I guess the following routine is of use.
}
procedure Highlight(ASource, ATarget: TBitmap; AColor: TColor);
// alters ASource to ATarget by making it appear as if
// looked through
// colored glass as given by AColor
// ASource, ATarget must have been created.
// Isn't as slow as it looks.
// Physics courtesy of a post by K.H. Brenner
var
 i, j: Integer;
 s, t: PRGBTriple;
 r, g, b: Byte;
 cl: TColor;
begin
 cl := ColorToRGB(AColor);
 r := GetRValue(cl);
 g := GetGValue(cl);
 b := GetBValue(cl);
 ASource.PixelFormat := pf24bit;
 ATarget.PixelFormat := pf24bit;
 ATarget.Width := aSource.Width;
 ATarget.Height := aSource.Height;
 for i := 0 to ASource.Height - 1 do
 begin
 s := ASource.Scanline[i];
 t := ATarget.Scanline[i];
 for j := 0 to ASource.Width - 1 do
 begin
 t^.rgbtBlue := (b * s^.rgbtBlue) div 255;
 t^.rgbtGreen := (g * s^.rgbtGreen) div 255;
 t^.rgbtRed := (r * s^.rgbtRed) div 255;
 Inc(s);
 Inc(t);
 end;
 end;
end;
Source: http://www.swissdelphicenter.ch
ID: 03902
Category:Графика
Category:Bitmap
Подсветить ссылки в TRichEdit

=== Подсветить ссылки в TRichEdit ===
{ 
 So what we need: 
 1. drop on your form a RichEdit component from win32 page of component 
 palette 
 2. in OnCreate event of your form write the next code: 
}
procedure TForm1.FormCreate(Sender: TObject);
var
 mask: Word;
begin
 mask := SendMessage(Handle, EM_GETEVENTMASK, 0, 0);
 SendMessage(RichEdit1.Handle, EM_SETEVENTMASK, 0, mask or ENM_LINK);
 SendMessage(RichEdit1.Handle, EM_AUTOURLDETECT, Integer(True), 0);
 RichEdit1.Text := 'SwissDelphiCenter.com: '#13#10 +
 ' Site is located at www.SwissDelphiCenter.com';
end;
 { 
 After that your Richedit will convert automatically any URLs in highlighted 
 (blue color and underlined). Even if you'll start to enter any text directly 
 in Richedit, any begings for URL will be converted too (not only existing 
 text string but new too) 
}
// 3. now we must detect mouse clicks in URL range. For this task we must 
// override WndProc method of our form: 
type
 TForm1 = class(TForm)
 protected
 procedure WndProc(var Message: TMessage); override;
 end;
// 4. the implementation looks like this: 
procedure TForm1.WndProc(var Message: TMessage);
var
 p: TENLink;
 strURL: string;
begin
 if (Message.Msg = WM_NOTIFY) then
 begin
 if (PNMHDR(Message.lParam).code = EN_LINK) then
 begin
 p := TENLink(Pointer(TWMNotify(Message).NMHdr)^);
 if (p.Msg = WM_LBUTTONDOWN) then
 begin
 SendMessage(RichEdit1.Handle, EM_EXSETSEL, 0, Longint(@(p.chrg)));
 strURL := RichEdit1.SelText;
 ShellExecute(Handle, 'open', PChar(strURL), 0, 0, SW_SHOWNORMAL);
 end
 end
 end;
 inherited;
end;
{ 
 5. Now you can compile your project (don't forget to include Richedit and 
 ShellAPI units in uses clause). 
}
Language: en
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01015
Подсветка компонента во время перемещения над ним мыши

=== Подсветка компонента во время перемещения над ним мыши ===
Вы должны обрабатывать сообщения CM_MOUSEENTER и CM_MOUSELEAVE примерно таким образом:
type
 TYourObject = class(TAnyControl)
 private
 FMouseInPos: Boolean;
 procedure CMMouseEnter(var AMsg: TMessage); message CM_MOUSEENTER;
 procedure CMMouseLeave(var AMsg: TMessage); message CM_MOUSELEAVE;
 end;
implementation
procedure TYourObject.CMMouseEnter(var AMsg: TMessage);
begin
 FMouseInPos := True;
 Refresh;
end;
procedure TYourObject.CMMouseLeave(var AMsg: TMessage);
begin
 FMouseInPos := False;
 Refresh;
end;
...затем читать параметр FMouseInPos при прорисовке области компонента или использовать иное решение. 
Source: http://delphiworld.narod.ru
ID: 01597
Подсказка при вводе в Edit

=== Подсказка при вводе в Edit ===
Сегодня поговорим о том, как помочь пользователю ввести в поле ввода текст. Для этого компьютер должен по первым буквам вводимого слова догадаться, что хочет написать пользователь, и предложить ему этот вариант. Один из способов это сделать - дописывать не хватающие буквы к слову, но выделять их. 
Нужно решить три задачи:
# определить вводимые символы,
# найти слово, начинающееся с этих символов,
# добавить не хватающие символы и выделить их. 
Для решения первой задачи достаточно найти первый символ, не являющийся буквой. Для решения второй задачи можно использовать поиск в StringList. Вставить недостающие символы удобно в специальной переменной типа String. 
В этом примере словарь состоит из названий чисел (на английском): от 1 до 10. Иногда словарь можно пополнять, добавляя туда незнакомые слова, вводимые пользователем. 
var
 words: TStringList;
procedure TForm1.FormCreate(Sender: TObject);
begin
 words := TStringList.Create;
 words.Sorted := True;
 words.Add('one');
 words.Add('two');
 words.Add('four');
 words.Add('five');
 words.Add('six');
 words.Add('seven');
 words.Add('eight');
 words.Add('nine');
 words.Add('ten');
end;
procedure TForm1.Edit1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
const
 chars: set of char = ['A'..'Z', 'a'..'z', 'А'..'Я', 'а'..'я'];
var
 w: string;
 i: Integer;
 s: string;
 full: string;
 SelSt: Integer;
begin
 if Key = 13 then
 begin
 Edit1.SelStart := Edit1.SelStart + Edit1.SelLength;
 Edit1.SelLength := 0;
 Exit;
 end;
 s := Edit1.Text;
 SelSt := Edit1.SelStart;
 i := SelSt;
 if (Length(s) > i) and (s[i+1] in chars) then Exit;
 w := ;
 while (i >= 1) and (s[i] in chars) do
 begin
 w := s[i] + w;
 Dec(i);
 end;
 if Length(w) <= 0 then Exit;
 words.Find(w, i);
 if (i >= 0) and (UpperCase(Copy(words[i], 1, Length(w))) = UpperCase(w)) then
 begin
 full := words[i];
 Insert(Copy(full, Length(w) + 1, Length(full)), s, SelSt + 1);
 Edit1.Text := s;
 Edit1.SelStart := SelSt;
 Edit1.SelLength := Length(full) - Length(w);
 end;
end;
Source: http://delphiworld.narod.ru/
ID: 00542
== См. также ==
* Edit с возможностью автоматического выбора
Подсчет слов в Richedit

=== Подсчет слов в Richedit ===
function GetWord: boolean;
var
 s: string; { предположим что слова не содержат > 255 символов }
 c: char;
begin
 Result := False;
 s := ' ';
 while not Eof(f) do
 begin
 Read(f, c);
 if not (c in ['a'..'z', 'A'..'Z' {,... и т.д, и т.п.}]) then
 break;
 s := s + c;
 end;
 Result := (s <> ' ');
end;
procedure GetWordCount(TextFile: string);
begin
 Count := 0;
 AssignFile(f, TextFile);
 Reset(f);
 while not Eof(f) do
 if GetWord then
 Inc(Count);
 CloseFile(f);
end;
Source: http://delphiworld.narod.ru/
ID: 01031
Позволяет ли QuickReport выгружать данные в формате Microsoft Excel?

Позволяет ли QuickReport выгружать данные в формате Microsoft Excel?
Quick Report не позволяет выгружать данные в формате Microsoft Excel. Но последние его версии позволяют сохранять отчеты в формате CSV (Comma Separated Value) и HTML, и оба эти формата можно прочесть с помощью Excel.
Помимо этого, для генерации отчета можно использовать автоматизацию Excel (Automation, ранее назвалось OLE Automation. - Прим. ред.), вообще не прибегая к использованию QuickReport.
Author: Наталия Елманова
Source: Взято из http://forum.sources.ru
ID: 03268
Category:Создание отчетов
Позиционирование TSaveDialog

=== Позиционирование TSaveDialog ===
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, CommDlg;
type
 TMySaveDialog = class(TSaveDialog)
 protected
 procedure WndProc(var Message: TMessage); override;
 end;
 TForm1 = class(TForm)
 Button1: TButton;
 procedure Button1Click(Sender: TObject);
 end;
var
 Form1: TForm1;
implementation
{$R *.dfm}
procedure TMySaveDialog.WndProc(var Message: TMessage);
const
 X = 10;
 Y = 30;
begin
 with Message do
 begin
 if ((Msg = WM_NOTIFY) and (POFNotify(LParam)^.hdr.code = CDN_INITDONE))
 or ((Msg = WM_UPDATEUISTATE) and (WParamLo = UIS_SET)) then
 begin
 if Owner is TForm then
 SetWindowPos(GetParent(Handle), HWND_TOP, X, Y, 0, 0, SWP_NOSIZE);
 end
 else
 inherited;
 end
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 TMySaveDialog.Create(Self).Execute;
end;
end.
Author: Александр (Rouse_) Багель
Source: Взято из http://forum.sources.ru
ID: 01219
----
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls;
type
 TForm1 = class(TForm)
 SaveDialog1: TSaveDialog;
 Button1: TButton;
 procedure SaveDialog1Show(Sender: TObject);
 procedure Button1Click(Sender: TObject);
 private
 { Private declarations }
 public
 end;
var
 Form1: TForm1;
implementation
{$R *.dfm}
{ TForm1 }
function NewSaveDlgProc(wnd:HWND; uMsg:DWORD; wParam:Integer; lParam:integer):integer; stdcall;
begin
 if uMsg = WM_SHOWWINDOW then
 MoveWindow(wnd, 10, 30, 500, 100, True);
 Result := CallWindowProc(Pointer(GetWindowLong(wnd, GWL_USERDATA)), wnd, uMsg, wParam, lParam);
end;
procedure TForm1.SaveDialog1Show(Sender: TObject);
begin
 SetWindowLong(GetParent(SaveDialog1.Handle), GWL_USERDATA,
 SetWindowLong(GetParent(SaveDialog1.Handle), DWL_DLGPROC, DWORD(@NewSaveDlgProc)));
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 SaveDialog1.Execute
end;
end.
Author: Krid
Source: Взято из http://forum.sources.ru
ID: 01220
Позиционирование каретки в TStringGrid

=== Позиционирование каретки в TStringGrid ===
{
 The following code allows you to position the caret
 in a cell (InplaceEditor) of a StringGrid.
 We need a Cracker class to access the InplaceEditor.
}
type
 TGridCracker = class(TStringGrid);
implementation
procedure SetCaretPosition(Grid: TStringGrid; col, row, x_pos: Integer);
begin
 Grid.Col := Col;
 Grid.Row := Row;
 with TGridCracker(Grid) do
 InplaceEditor.SelStart := x_pos;
end;
// Get the Caret position from the focussed cell
// Ermittelt die Caret-Position der aktuellen Zelle
function GetCaretPosition(Grid: TStringGrid): Integer;
begin
 with TGridCracker(Grid) do
 Result := InplaceEditor.SelStart;
end;
// Example / Beispiel:
// Set the focus on col 1, row 3 and position the caret at position 5
// Fokusiert die Zelle(1,3) und setzt den Cursor auf Position 5
procedure TForm1.Button1Click(Sender: TObject);
begin
 StringGrid1.SetFocus;
 SetCaretPosition(StringGrid1, 1, 3, 5);
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 02341
Позиционирование курсора как в предыдущей строке

=== Позиционирование курсора как в предыдущей строке ===
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls,
 Forms, Dialogs, StdCtrls, ComCtrls;
type
 TForm1 = class(TForm)
 Button1: TButton;
 Button2: TButton;
 RichEdit1: TRichEdit;
 procedure RichEdit1KeyPress(Sender: TObject; var Key: Char);
 private
 { Private declarations }
 public
 { Public declarations }
end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
uses
 richedit;
procedure TForm1.RichEdit1KeyPress(Sender: TObject; var Key: Char);
var
 line, col, indent: integer;
 S: string;
begin
 if key = #13 then
 begin
 key := #0;
 with Sender as TRichEdit do
 begin
 { figure out line and column position of caret }
 line := Perform(EM_EXLINEFROMCHAR, 0, SelStart);
 Col := SelStart - Perform(EM_LINEINDEX, line, 0);
 { get part of current line in front of caret }
 S := Copy(Lines[line], 1, col);
 { count blanks and tabs in this string }
 indent := 0;
 while (indent < Length(S)) and (S[indent + 1] in [' ', #9]) do
 Inc(indent);
 { insert a linebreak followed by the substring of blanks and tabs }
 SelText := #13#10 + Copy(S, 1, indent);
 end;
 end;
end;
end.
Source: http://delphiworld.narod.ru/
ID: 01020
Позиция дочерних MDI-окон

=== Позиция дочерних MDI-окон ===
Проблема, с которой я столкнулся, заключается в том, что нижняя часть дочерней формы загораживает панель состояния родительской формы... 
У меня была аналогичная проблема -- она проявлялась при условии, когда свойство главной формы WindowState устанавливалось на wsMinimized. 
Вот мое решение: добавьте этот небольшой метод к вашей главной форме:
interface
procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
implementation
procedure TMainForm.CMShowingChanged(var Message: TMessage);
var
 theRect: TRect;
begin
 inherited;
 theRect := GetClientRect;
 AlignControls(nil, theRect);
end;
Это работает, поскольку вызов AlignControls (в TForm) делает две вещи: 
выравнивает элементы управления (включая ваш проблемный StatusBar) и 
вновь позиционирует окно клиента относительно главной формы (оно ссылается на ClientHandle) после того, как элементы управления будут выравнены... что, впрочем, мы и хотели. 
Source: Взято с http://delphiworld.narod.ru
ID: 00496
Позиция курсора в TRichEdit

=== Позиция курсора в TRichEdit ===
Так как вопрос довольно часто поднимается в форумах, то хотелось бы привести ответ на него. Итак, как же получить текущие координаты курсора (Row и Col) в TRichEdit ?
Вот пример решения данной проблемы:
Procedure TForm1.GetPosition(Sender: TRichEdit);
var
 iX,iY : Integer;
 TheRichEdit : TRichEdit;
begin
 iX := 0; iY := 0;
 TheRichEdit := TRichEdit(Sender);
 iY := SendMessage(TheRichEdit.Handle, EM_LINEFROMCHAR, TheRichEdit.SelStart, 0);
 iX := TheRichEdit.SelStart - SendMessage(TheRichEdit.Handle, EM_LINEINDEX, iY, 0);
 Panel1.Caption := IntToStr(iY + 1) + ':' + IntToStr(iX + 1) ;
end;
procedure TForm1.RichEditMouseDown(Sender: TObject;
 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
 GetPosition(RichEdit);
end;
procedure TForm1.RichEditKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
 GetPosition(RichEdit);
end;
Source: Взято из http://forum.sources.ru
ID: 00569
Позиция ячейки в TDBGrid

=== Позиция ячейки в TDBGrid ===
В TCustomGrid определен метод CellRect, который, к сожалению, защищен. Это означает, что данный метод доступен только для TCustomGrid и его наследников. Но все-таки существует немного мудреное решение вызова данного метода:
type
 TMyDBGrid = class(TDBGrid)
 public
 function CellRect(ACol, ARow: Longint): TRect;
 end;
function TMyDBGrid.CellRect(ACol, ARow: Longint): TRect;
begin
 Result := inherited CellRect(ACol, ARow);
end;
Вы можете сделать приведение типа вашего DBGrid к TMyDBGrid (это возможно, поскольку CellRect статический метод) и вызвать CellRect:
Rectangle := TMyDBGrid(SomeDBGrid).CellRect(SomeColumn, SomeRow);
procedure TfmLoadIn.DBGrid1DrawColumnCell(Sender: TObject;
 const Rect: TRect; DataCol: Integer; Column: TColumn;
 State: TGridDrawState);
const
 Disp = 2; // Правильно выравниваем компонент
begin
 inherited;
 if (gdFocused in State) then
 begin
 if (Column.FieldName = 'TYPEDescription') then
 begin
 dlTYPEDescription.Left := Rect.Left + DBGrid1.Left + Disp;
 dlTYPEDescription.Top := Rect.Top + DBGrid1.top + Disp;
 dlTYPEDescription.Width := Rect.Right - Rect.Left;
 dlTYPEDescription.Height := Rect.Bottom - Rect.Top;
 dlTYPEDescription.Visible := True;
 end;
 end;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 03047
Category:Базы данных
Category:DBGrid
Поиск N-ого вхождения подстроки в строку

=== Поиск N-ого вхождения подстроки в строку ===
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Поиск N-ого вхождения подстроки в строку
Зависимости: SysUtils
Автор: panov, panov@hotbox.ru, Екатеринбург
Copyright: panov
Дата: 19 апреля 2002 г.
***************************************************** }
function SearchString(const FindStr, SourceString: string; Num: Integer):
 Integer;
var
 FirstSym: PChar; // Ссылка на первый символ
 function MyPos(const FindStr, SourceString: PChar; Num: Integer): PChar;
 begin
 Result := AnsiStrPos(SourceString, FindStr);
 // Поиск вхождения подстроки в строку
 if (Result = nil) then
 Exit; // Подстрока не найдена
 Inc(Result); // Смещаем указатель на следующий символ
 if Num = 1 then
 Exit; // Если нужно первое вхождение - заканчиваем
 if num > 1 then
 Result := MyPos(FindStr, Result, num - 1);
 // Рекурсивный поиск следующего вхождения
 end;
begin
 FirstSym := PChar(SourceString);
 // Присваиваем адрес первого символа исходной строки
 Result := MyPos(PChar(FindStr), PChar(SourceString), Num) - FirstSym;
 // Номер позиции в строке
 if Result < 0 then
 Result := 0; // Возвращаем номер позиции
end;
// Пример использования: 
var
 StrF, StrSrc: string;
 n: Integer;
begin
 StrF := 'стр';
 StrSrc := 'Поиск подстроки в строке';
 n := SearchString(StrF, StrSrc, 2); //n будет равна 19
end;
Source: http://delphibase.endimus.com
ID: 00869
Поиск записи в больших таблицах

=== Поиск записи в больших таблицах ===
В свою очередь хочу предложить на Ваш суд небольшую процедуру, которая мне очень помогла. Процедура позволяет переходить на любую из записей в таблице (формат Paradox или DBase). Необходимость в ней возникла, когда мне пришлось работать с таблицей размером в 10 и более тысяч записей у которой было несколько вычисляемых полей и полей подлинкованных из объектов TQuery. При использовании метода TTable.MoveBy программа медленно и печально замолкала (вообще-то она работала, но как?!). Встретил я этот пример в технической документации Borland (2656), где сравнивались функции Paradox Engine и BDE. Пример был написан на C. Вот его интерпретация на Delphi:
uses BDE;
// переход на логическую запись
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;
 taSingle.Resync([rmCenter]);
 end;
end;
Author: Александр Куприн 
Source: Взято с http://delphiworld.narod.ru
ID: 02566