nyuuzyou/wikis huggingface dataset:
Проверка значения строки

=== Проверка значения строки ===
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Проверка значения строки
Функция предназначена для проверки значения строки.
Зависимости: нет
Автор: Separator, vilgelm@mail.kz, Алматы
Copyright: Сергей Вильгельм
Дата: 6 января 2003 г.
***************************************************** }
type
 TTypeStr = (tsString, tsDate, tsNumber);
function CheckString(const Value: string): TTypeStr;
begin
 if StrToDateTimeDef(Value, 0) = 0 then
 if StrToIntDef(Value, 0) = 0 then
 Result := tsString
 else
 Result := tsNumber
 else
 Result := tsDate
end;
Source: http://delphibase.endimus.com
ID: 00914
Проверка на наличие числа в массиве

{ **** UBPFD *********** by kladovka.net.ru ****
>> Проверка наличия числа в массиве
Функция проверяет, находится ли число N в массиве Values
Зависимости: нет
Dimka Maslov, mainbox@endimus.ru, ICQ:148442121, Санкт-Петербург
Copyright: Dimka Maslov
Дата: 28 мая 2002 г.
********************************************** }
function Among(N: Integer; const Values: array of Integer): LongBool;
asm
 push ebx
 xor ebx, ebx
@@10:
 test ecx, ecx
 jl @@30
 cmp eax, [edx]
 jne @@20
 not ebx
 jmp @@30
@@20:
 add edx, 4
 dec ecx
 jmp @@10
@@30:
 mov eax, ebx
 pop ebx
end;
Пример использования:
Among(N, [1, 2, 3, 4, 5])
Author: Dimka Maslov
ID: 04190
Category:Алгоритмы
Проверка наличия BDE

=== Проверка наличия BDE ===
unit Findbde;
interface
implementation
uses
 Controls,
 SysUtils,
 WinTypes,
 WinProcs,
 Dialogs;
var
 IdapiPath: array[0..255] of Char;
 IdapiHandle: THandle;
initialization
 GetProfileString('IDAPI', 'DLLPath', 'C:\', IdapiPath, 255);
 { следующие строки "изолируют" первый путь к каталогу из IdapiPath в случае, если их несколько }
 if Pos(';', StrPas(IdapiPath)) <> 0 then
 begin
 StrPCopy(IdapiPath, Copy(StrPas(IdapiPath), 1, Pred(Pos(';', StrPas(IdapiPath)))));
 end;
 IdapiHandle := LoadLibrary(StrCat(IdapiPath, '\IDAPI01.DLL'));
 if IdapiHandle < HINSTANCE_ERROR then
 begin
 if MessageDlg('ОШИБКА: Borland Database Engine (IDAPI) не найдена' +
 'перед следующей попыткой ее необходимо установить....',
 mtError, [mbOK], 0) = mrOK then
 Halt
 end
 { IDAPI в системе не установлена }
 else
 begin
 FreeLibrary(IdapiHandle);
 { IDAPI Установлена в системе }
 end;
end.
Сборник Kuliba
Source: Взято из Советов по Delphi от Валентина Озерова
ID: 02487
----
==== Способ 1 ====
Следующая функция получает структуру SysVersion и записывает результаты в stringlist.
uses dbierrs, DBTables;
function fDbiGetSysVersion(SysVerList: TStringList): SYSVersion;
var
 Month, Day, iHour, iMin, iSec: Word;
 Year: SmallInt;
begin
 Check(DbiGetSysVersion(Result));
 if (SysVerList <> nil) then
 begin
 with SysVerList do
 begin
 Clear;
 Add(Format('ENGINE VERSION=%d', [Result.iVersion]));
 Add(Format('INTERFACE LEVEL=%d', [Result.iIntfLevel]));
 Check(DbiDateDecode(Result.dateVer, Month, Day, Year));
 Add(Format('VERSION DATE=%s', [DateToStr(EncodeDate
 (Year, Month, Day))]));
 Check(DbiTimeDecode(Result.timeVer, iHour, iMin, iSec));
 Add(Format('VERSION TIME=%s', [TimeToStr(EncodeTime
 (iHour, iMin, iSec div 1000, iSec div 100))]));
 end;
 end;
end;
Вызов этой функции выглядит следующим образом:
var hStrList: TStringList;
 Ver: SYSVersion;
begin
 hStrList:= TStringList.Create;
 try
 Ver := fDbiGetSysVersion(hStrList);
 except
 ShowMessage('BDE not installed !');
 end;
 ShowMessage(IntToStr(Ver.iVersion));
 Memo1.Lines.Assign(hStrList);
 hStrList.Destroy;
end;
Возможные результаты (отображаемые в memo-поле):
 ENGINE VERSION=500
 INTERFACE LEVEL=500
 VERSION DATE=09.06.98
 VERSION TIME=17:06:13
==== Способ 2 ====
Читаем ключ в реестре:
RootKey := HKEY_LOCAL_MACHINE;
OpenKey(`SOFTWARE\Borland\Database Engine`, False);
try
 s := ReadString(`CONFIGFILE01`);
 // BDE установлена
finally
 CloseKey;
end;
==== Способ 3 ====
Можно попробовать установить BDE
 IsBDEExist := (dbiInit(nil) = 0)
PS: Последний способ более предпочтителен, так как анинсталлер мог удалить BDE-файлы, но оставить в реестре ключ :)
Source: Взято из http://forum.sources.ru
ID: 02490
Проверка наличия числа в массиве

=== Проверка наличия числа в массиве ===
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Проверка наличия числа в массиве
Функция проверяет, находится ли число N в массиве Values
Зависимости: нет
Автор: Dimka Maslov, mainbox@endimus.ru, ICQ:148442121, Санкт-Петербург
Copyright: Dimka Maslov
Дата: 28 мая 2002 г.
***************************************************** }
function Among(N: Integer; const Values: array of Integer): LongBool;
asm
 push ebx
 xor ebx, ebx
@@10:
 test ecx, ecx
 jl @@30
 cmp eax, [edx]
 jne @@20
 not ebx
 jmp @@30
@@20:
 add edx, 4
 dec ecx
 jmp @@10
@@30:
 mov eax, ebx
 pop ebx
end;
// Пример использования: 
Among(N, [1, 2, 3, 4, 5]) 
Source: http://delphibase.endimus.com
ID: 00808
Проверка пересечения двух отрезков

{ **** UBPFD *********** by kladovka.net.ru ****
>> Проверка пересечения двух отрезков
X1,Y1,X2,Y2 - координаты первого отрезка
X3,Y3,X4,Y4 - координаты второго отрезка
Возвращает True, если отрезки пересекаются, иначе - False.
Зависимости: System
Автор: Fenik, fenik@nm.ru, Новоуральск
Copyright: Николай Федоровских
Дата: 24 ноября 2005 г.
********************************************** }
function CrossLines(X1,Y1,X2,Y2, X3,Y3,X4,Y4: Integer): Boolean;
begin
 Result := (((X3-X1)*(Y2-Y1) - (Y3-Y1)*(X2-X1)) *
 ((X4-X1)*(Y2-Y1) - (Y4-Y1)*(X2-X1)) <= 0)
 and
 (((X1-X3)*(Y4-Y3) - (Y1-Y3)*(X4-X3)) *
 ((X2-X3)*(Y4-Y3) - (Y2-Y3)*(X4-X3)) <= 0)
end;
Author: Fenik
ID: 04129
Category:Алгоритмы
Category:Графика
Category:Геометрия
Проверка пересечения двух прямоугольников (TRect)

{ **** UBPFD *********** by kladovka.net.ru ****
>> Проверка пересечения двух прямоугольников (TRect)
Функция использовалась для проверки пересекаемости 2-х форм, панелей и т.п. Причем пересекаться они могут и не углами, а, например, находиться один полностью в другом.
Зависимости: нет
Автор: MikeZ, Zhuravsky2@Yandex.ru, Kiev
Copyright: MikeZ (C) 2003
Дата: 8 октября 2003 г.
********************************************** }
function OverlapRects(R1, R2: TRect): Boolean;
var
 Temp: TRect;
begin
 Result := False;
 if not UnionRect(Temp, R1, R2) then Exit;
 if (Temp.Right - Temp.Left <= R1.Right - R1.Left + R2.Right - R2.Left)
 and (Temp.Bottom - Temp.Top <= R1.Bottom - R1.Top + R2.Bottom - R2.Top) then
 Result := True;
end;
Author: MikeZ
ID: 04126
Category:Алгоритмы
Category:Графика
Category:Геометрия
Проверка попадания точки в треугольник

{ **** UBPFD *********** by kladovka.net.ru ****
>> Проверка попадания точки в треугольник
Проверяет попадает ли точка P в треугольник ABC.
Вершины должны быть перечислены против часовой стрелки.
Зависимости: нет
Автор: Fenik, fenik@nm.ru, Новоуральск
Copyright: Николай Федоровских
Дата: 8 октября 2004 г.
********************************************** }
{ Внимание!! Вершины должны быть заданы против часовой стрелки!
 A
 / \
 / \
 B-----C }
function PtInTriang(const P, A, B, C: TPoint): Boolean;
begin
 Result := False;
 if (P.x-A.x)*(A.y-B.y) - (P.y-A.y)*(A.x-B.x) >= 0 then
 if (P.x-B.x)*(B.y-C.y) - (P.y-B.y)*(B.x-C.x) >= 0 then
 if (P.x-C.x)*(C.y-A.y) - (P.y-C.y)*(C.x-A.x) >= 0 then
 Result := True;
end;
Author: Fenik
ID: 04128
Category:Алгоритмы
Category:Графика
Category:Геометрия
Проверка правильности E-mail адреса

Если пользователю Вашего приложения необходимо вводить почтовый адрес, то возникает потребность в проверке адреса на правильность. Конечно способов сделать это существует множество, но этот, на мой взгляд, самый короткий и доступный для понимания.
Совместимость: Delphi 3.x (или выше)
function IsValidEmail(const Value: string): Boolean;
 function CheckAllowed(const s: string): Boolean;
 var
 i: Integer;
 begin
 Result := False;
 for i := 1 to Length(s) do
 begin
 { недопустимый символ в s - значит недопустимый адрес }
 if not (s[i] in ['a'..'z', 'A'..'Z', '0'..'9', '_', '-', '.']) then
 Exit;
 end;
 Result := True;
 end;
var
 i: Integer;
 namePart, serverPart: string;
begin
 // начало выполнения IsValidEmail
 Result := False;
 i := Pos('@', Value);
 if i = 0 then
 Exit;
 namePart := Copy(Value, 1, i - 1);
 serverPart := Copy(Value, i + 1, Length(Value));
 // @ не указано имя или сервер не указаны; минимально для сервера. "a.com"
 if (Length(namePart) = 0) or ((Length(serverPart) < 1)) then
 Exit;
 i := Pos('.', serverPart);
 // должно иметь точку и как минимум два знака от конца
 if (i = 0) or (i > (Length(serverPart) - 1)) then
 Exit;
 Result := CheckAllowed(namePart) and CheckAllowed(serverPart);
end;
Author: Udo Nesshoever 
Source: http://forum.sources.ru
ID: 03407
Category:Связь
Category:Электронная почта
Проверка правильности даты

=== Проверка правильности даты ===
function DateExists(Date: string; Separator: char): Boolean;
var
 OldDateSeparator: Char;
begin
 Result := True;
 OldDateSeparator := DateSeparator;
 DateSeparator := Separator;
 try
 try
 StrToDate(Date);
 except
 Result := False;
 end;
 finally
 DateSeparator := OldDateSeparator;
 end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
 if DateExists('35.3.2001', '.') then
 begin
 {your code}
 end;
end;
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 00195
----
function ValidDate(const S: String): Boolean;
BEGIN
 Result := True;
 try
 StrToDate(S);
 except
 ON EConvertError DO
 Result := False;
 end;
END
Source: http://delphiworld.narod.ru
ID: 00738
Проверяем находится ли файл на локальном диске

=== Проверяем находится ли файл на локальном диске ===
function IsOnLocalDrive(aFileName: string): Boolean;
var
 aDrive: string;
begin
 aDrive := ExtractFileDrive(aFileName);
 if (GetDriveType(PChar(aDrive)) = DRIVE_REMOVABLE) or
 (GetDriveType(PChar(aDrive)) = DRIVE_FIXED) then
 Result := True
 else
 Result := False;
end;
// Example, Beispiel:
procedure TForm1.Button1Click(Sender: TObject);
begin
 if OpenDialog1.Execute then
 if IsOnLocalDrive(OpenDialog1.FileName) then
 ShowMessage(OpenDialog1.FileName + ' is on a local drive.');
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 03161
Category:Файловая система
Программа рисует на форме календарь на 2002 год

=== Программа рисует на форме календарь на 2002 год ===
В связи с наступающим Новым годом я решил посвятить выпуск календарю. Ниже приведенная программа рисует на форме календарь на 2002 год. Для каждого месяца сначала выводится его название (используется глобальная переменная LongMonthNames модуля SysUtils), далее выводятся сокращенные названия дней недели (глобальная переменная ShortDayNames модуля SysUtils) и, наконец, выводятся сами числа. Количество дней в месяце записано в массиве months. Чтобы определить, високосный это год или нет, используется функция IsLeapYear. 
const year = 2002; // Год календаря
var months: array [1..12] of byte;
procedure TForm1.FormCreate(Sender: TObject);
begin
 Form1.Caption := 'Календарь на ' + IntToStr(year) + ' год';
 Form1.Color := clWhite;
 // Длины месяцев:
 months[1] := 31;
 months[2] := 28 + ord(IsLeapYear(year));
 months[3] := 31;
 months[4] := 30;
 months[5] := 31;
 months[6] := 30;
 months[7] := 31;
 months[8] := 31;
 months[9] := 30;
 months[10] := 31;
 months[11] := 30;
 months[12] := 31;
end;
procedure TForm1.FormPaint(Sender: TObject);
const // Настройки размеров календаря:
 MonthDX = 150;
 MonthDY = 135;
 DayDX = 20;
 DayDY = 15;
 MonthH = 20;
var
 month, i: integer;
 day: integer;
 s: string[2];
begin
 with Form1.Canvas do for month := 1 to 12 do begin
 // Вывод названия месяца:
 Font.Name := 'Times';
 Font.Size := 13;
 TextOut((month - 1) mod 3 * MonthDX, (month - 1) div 3 * MonthDY,
 LongMonthNames[month]);
 Font.Name := 'Courier';
 Font.Size := 8;
 // Вывод названий дней недели:
 for day := 1 to 7 do
 TextOut((month - 1) mod 3 * MonthDX,
 day mod 7 * DayDY + (month - 1) div 3 * MonthDY + MonthH,
 ShortDayNames[(day + 1) mod 7 + 1]);
 // Определение дня недели первого числа месяца:
 day := DayOfWeek(EncodeDate(year, month, 1)) - 2;
 if day < 0 then inc(day, 7);
 // Вывод чисел:
 for i := 1 to months[month] do begin
 str(i: 2, s);
 TextOut(day div 7 * DayDX + (month - 1) mod 3 * MonthDX + DayDX,
 day mod 7 * DayDY + (month - 1) div 3 * MonthDY + MonthH, s);
 inc(day);
 end;
 end;
end;
Source: http://delphiworld.narod.ru
ID: 00739
Программно нажимаем Print Screen

=== Программно нажимаем Print Screen ===
Приведённая здесь функция делает копию изображения экрана и сохраняет её в буфере обмена (Clipboard). Так же необходимо включить в Ваш проект файл ClipBrd.pas. 
procedure SendScreenImageToClipboard;
var
 bmp: TBitmap;
begin
 bmp := TBitmap.Create;
 try
 bmp.Width := Screen.Width;
 bmp.Height := Screen.Height;
 BitBlt(bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height,
 GetDC(GetDesktopWindow), 0, 0, SRCCopy);
 Clipboard.Assign(bmp);
 finally
 bmp.Free;
 end;
end;
Следующая функция скопирует изображение экрана в в bitmap. Переменная bitmap *должна* быть инициализирована до вызова этой функции. 
procedure GetScreenImage(bmp: TBitmap);
begin
 bmp.Width := Screen.Width;
 bmp.Height := Screen.Height;
 BitBlt(bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height,
 GetDC(GetDesktopWindow), 0, 0, SRCCopy);
end;
Source: http://delphiworld.narod.ru/
ID: 01507
Программное сжатие базы данных Access используя JRO

=== Программное сжатие базы данных Access используя JRO ===
{ **** UBPFD *********** by kladovka.net.ru ****
>> Программное сжатие базы данных Access используя JRO (Jet Replication Objects)
Процедура позволяет сжать базу данных в формате Access, используя JRO (Jet Replication Objects). Действие аналогичное пункту меню в Access "Сервис -> Служебные программы -> Сжать и восстановить базу данных".
Параметры:
* DatabaseName - путь к исходной (не сжатой) базе данных
* DestDatabaseName - путь к сжатой базе данных (по умолчанию пустой - в этом случае исходная база заменяется сжатой)
* Password - пароль базы данных (по умолчанию пустой)
PS. этот код был написан в связи с тем что аналогичная процедура через DAO у многих не работала (по пока неизвестным для меня причинам)
Зависимости: windows,SysUtils,ComObj,Dialogs (Dialogs можно исключить используя MessageBox для вывода сообщения исключительной ситуации)
Copyright: Сапронов Алексей (Savva)
Дата: 9 сентября 2002 г.
********************************************** }
procedure CompactDatabase_JRO(DatabaseName: string; DestDatabaseName: string = ; Password: string = );
const
 Provider = 'Provider=Microsoft.Jet.OLEDB.4.0;';
var
 TempName: array[0..MAX_PATH] of Char; // имя временного файла
 TempPath: string; // путь до него
 Name: string;
 Src, Dest: WideString;
 V: Variant;
begin
 try
 Src := Provider + 'Data Source=' + DatabaseName;
 if DestDatabaseName <> then
 Name := DestDatabaseName
 else
 begin
 // выходная база не указана - используем временный файл
 // получаем путь для временного файла
 TempPath := ExtractFilePath(DatabaseName);
 if TempPath = then
 TempPath := GetCurrentDir;
 // получаем имя временного файла
 GetTempFileName(PChar(TempPath), 'mdb', 0, TempName);
 Name := StrPas(TempName);
 end;
 DeleteFile(PChar(Name)); // этого файла не должно существовать :))
 Dest := Provider + 'Data Source=' + Name;
 if Password <> then
 begin
 Src := Src + ';Jet OLEDB:Database Password=' + Password;
 Dest := Dest + ';Jet OLEDB:Database Password=' + Password;
 end;
 V := CreateOleObject('jro.JetEngine');
 try
 V.CompactDatabase(Src, Dest); // сжимаем
 finally
 V := 0;
 end;
 if DestDatabaseName = then
 begin // т.к. выходная база не указана
 DeleteFile(PChar(DatabaseName)); //то удаляем не упакованную базу
 RenameFile(Name, DatabaseName); // и переименовываем упакованную базу
 end;
 except
 // выдаем сообщение об исключительной ситуации
 on E: Exception do ShowMessage(E.Message);
 end;
end;
Пример использования:
db.Close;
CompactDatabase_JRO('c:\database.mdb', 'c:\Archiv\database_pack.mdb', 'password');
db.open;
Author: savva, savva@nm.ru, ICQ:126578975, Орел
ID: 02769
Програмное выключение клавиатуры и мыши

=== Програмное выключение клавиатуры и мыши ===
winexec(Pchar('rundll32 keyboard,disable'), sw_Show); // Клава OFF 
winexec(Pchar('rundll32 mouse,disable'), sw_Show); // Маус OFF 
кстати а вот так клава врубается
Отрубить
asm 
 in al,21h
 or al,00000010b
 out 21h,al
end;
Врубить
asm 
 in al,21h
 mov al,0
 out 21h,al
end;
Author: Radmin
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 01608
----
BlockInput(), живёт в user32.dll 
Author: Song
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 01609
----
Как скрыть курсор мышки
Поместите в событие OnClick в button1 и button2 следующие коды.Если курсор мышки скрыт, то выбрать button2 можно клавишей Tab.
procedure TForm1.Button1Click(Sender: TObject);
begin
 ShowCursor(False);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
 ShowCursor(True);
end;
Source: Взято из http://forum.sources.ru
ID: 01610
----
// Выключение курсора
procedure TForm1.Button1Click(Sender: TObject);
var
 CState: Integer;
begin
 CState := ShowCursor(True);
 while Cstate >= 0 do
 Cstate := ShowCursor(False);
end;
// Включение курсора
procedure TForm1.Button2Click(Sender: TObject);
var
 Cstate: Integer;
begin
 Cstate := ShowCursor(True);
 while CState < 0 do
 CState := ShowCursor(True);
end;
Source: Взято с http://delphiworld.narod.ru
ID: 01611
Прозрачность в Delphi 6

=== Прозрачность в Delphi 6 ===
Перевод одноимённой статьи с сайта delphi.about.com )
В Delphi 6 разработчикам Windows-приложений доступна одна из замечательных возможностей создавать (полу)прозрачные формы (окна). В Delphi 6 класс TForm поддерживает формы со слоями, которые имеют свойства AlphaBlend, AlphaBlendValue, TransparentColor, и TransparentColorValue.
Прозрачность в форме означает то, что пользователь может видеть то, что находится позади формы.
Чтобы подготовить форму к прозрачности, Вам потребуется установить свойство AlphaBlend в True. Если AlphaBlend установлено в True, то свойство AlphaBlendValue указывает степень прозрачности. Это свойство позволяет задать значения от 0 до 255. 0 указывает на полную прозрачность окна, в то время как 255 указывает на непрозрачное окно.
Так же возможно устанавливать свойства AlphaBlend и AlphaBlendValue во время разработки (или во время выполнения приложения) при помощи Object Inspector.
Возможно, Вы подумаете, что такая возможность в Delphi, может Вам пригодиться довольно редко, однако прозрачностью можно довольно эффективно привлекать внимание пользователей Вашей программы:
procedure TAboutBox.FormClose(Sender: TObject; var Action: TCloseAction);
var
 i, cavb: 0..255;
begin
 if AlphaBlend = False then
 begin
 AlphaBlendValue := 255;
 AlphaBlend := True;
 end;
 cavb := AlphaBlendValue;
 for i := cavb downto 0 do
 begin
 AlphaBlendValue := i;
 Application.ProcessMessages;
 end
end;
Вышеприведённый код, в событие OnClose для формы about, создаёт плавно изменяющийся эффект. Когда пользователь попытается закрыть диалоговое окошко, то форма плавно исчезнет. Делается это путём циклического уменьшения AlphaBlendValue до нуля.
Другие два новый свойства формы в Delphi 6, это TransparentColor и TransparentColorValue. TransparentColor, это булевое свойство, которое указывает, будет определённый цвет, указанный в TransparentColorValue прозрачным. То есть, мы можем задать прозрачность только определённому цвету.
И в заключение хотелось бы указать на главный недостаток. Все свойства, описанные выше, не будут работать, если приложение запущено не под Windows 2000 или выше, и если процессор на компьютере ниже P90.
Source: Взято из http://forum.sources.ru
ID: 00447
Произвести поиск байта или слова в строке

=== Произвести поиск байта или слова в строке ===
У семейства x86 есть группа специализированных строковых инструкций, одна из которых - scasb/scasw - производит поиск байта/слова в строке. Использовать преимущества этой инструкции в Delphi позволяют длинные строки, которых в старых паскалях не было. 
Никаких сложностей с пониманием, на мой взгляд, быть не должно. Единственное это смена режима открытия файла (FileMode := 0), которая позволит открыть файлы заблокированные ядром Windows и сдвиг указателя файла при чтении нового блока влево на длину искомой строки. Сдвиг делается на случай разрезания искомой строки на части при чтении файла. Полный текст проверенной программы: 
program search;
{$APPTYPE CONSOLE}
uses SysUtils;
const buffSize = 16384;
var F : File;
var buff : AnsiString;
var oldFileMode : integer;
var SearchString: shortString='SunSB';
var SearchPos : integer = -1;
var readed : integer;
var blockStart: integer;
begin
 SetLength(buff, buffSize);
 AssignFile(F, 'Speedometer2.exe');
 oldFileMode := FileMode;
 FileMode := 0;
 Reset(F, 1);
 while not Eof(F) do
 begin
 blockStart := filePos(F);
 BlockRead(F, buff[1], buffSize, readed);
 SearchPos := Pos(SearchString, buff);
 if SearchPos > 0 then
 begin
 WriteLn('Substr found at pos ', blockStart + SearchPos );
 break;
 end;
 if readed = buffSize then
 Seek(F, (FilePos(F) - Length(SearchString)));
 end;
 CloseFile(F);
 FileMode := oldFileMode;
 SetLength(buff, 0);
 if SearchPos = 0 then
 WriteLn('Substr not found.');
 ReadLn();
end.
Source: http://sunsb.dax.ru
Прокрутка TreeView, чтобы держать выделение посередине

=== Прокрутка TreeView, чтобы держать выделение посередине ===
procedure TMyForm.TreeChange(Sender: TObject; Node: TTreeNode);
var
 i: integer;
 pp, cp: TTreeNode;
begin
 if Assigned(Tree.Selected) then
 begin
 cp := Tree.Selected;
 pp := cp;
 for i := 1 to Round(Tree.Height/30) do
 if cp <> nil then
 begin
 pp := cp;
 cp := cp.GetPrevVisible;
 end;
 Tree.TopItem := pp;
 end;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 00629
Прокрутка для TListView или TTreeView

=== Прокрутка для TListView или TTreeView ===
// KEYWORDS: SendMessage, WM_HSCROLL, WM_VSCROLL
// scroll a ListView vertically down
SendMessage(ListView1->Handle, WM_VSCROLL, SB_LINEDOWN, 0);
// scroll a TreeView vertically up
SendMessage(TreeView1->Handle, WM_VSCROLL, SB_LINEUP, 0);
// Here are some other scroll parameters that can be sent...
{
SB_BOTTOM Scrolls to the lower right.
SB_ENDSCROLL Ends scroll.
SB_LINEDOWN Scrolls one line down.
SB_LINEUP Scrolls one line up.
SB_PAGEDOWN Scrolls one page down.
SB_PAGEUP Scrolls one page up.
SB_TOP Scrolls to the upper left.
}
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01148