nyuuzyou/wikis huggingface dataset:
Шифрование текстовых полей таблицы Interbase

=== Шифрование текстовых полей таблицы Interbase ===
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Шифрование текстовых полей таблицы Interbase
Простенько но шустро шифрует текстовую строку VarChar в текстовую
строку VarChar, пригодную для сохранения в текстовом поле базы Interbase.
НЕ ЗАТРАГИВАЕТ ПРОБЕЛЫ!
Метод генерации (в начале) и изменения ключа (в 2-местах!) в вашей программе
лучше изменить от исходного в сторону усложнения, но не трогать "And 127" в конце.
Для работы с Char возможно стоит добавить "Trim(S1);" в самое начало.
Зависимости: Windows, SysUtils, DB
Copyright: Vemer
Дата: 16 ноября 2003 г.
***************************************************** }
function Morf(S1: string; T: Boolean): string;
var
 LS: Byte; // длина строки
 KB: Byte; // ключ, байт
 I: Byte; // Счетчик
 B: Byte; // байт строки
 W: Smallint; // буфер для ключа
 S2: string; // результат
begin
 LS := Length(S1);
 S2 := ;
 KB := LS * LS; //-------Изменить/Усложнить!And 127 не трогать!
 if T = False then // Выбор между шифрованием и дешифрованием
 begin
 for I := 1 to LS do
 begin // шифрование
 B := Byte(S1[I]);
 if B > 32 then
 begin
 W := B + KB;
 if W > 255 then
 W := W - 223;
 B := W;
 end; //If
 S2 := S2 + Chr(B);
 KB := (KB + (I * 2)) and 127;
 //-(1) Изменить/Усложнить! And 127 не трогать!
 end; // For
 end
 else
 begin // дешифровка
 for I := 1 to LS do
 begin
 B := Byte(S1[I]);
 if B > 32 then
 begin
 W := B - KB;
 if W < 33 then
 W := W + 223;
 B := W;
 end; //If
 S2 := S2 + Chr(B);
 KB := (KB + (I * 2)) and 127;
 //---(2) Сделать как в (1)! And 127 не трогать!
 end; //For
 end; //Else
 Result := S2;
end;
// Пример использования:
// В вычисляемом поле для отображения текста в нормальном виде:
TableNewName.Value := Morf(TableName.Value, True);
// Для занесения в таблицу в зашифрованном виде например из Edit:
TableName.Value := Morf(Edit.Text, False);
Author: Vemer
Source: http://delphibase.endimus.com
ID: 02932
Category:Базы данных
Category:Interbase
Шифрование файлов при помощи NTFS функций

=== Шифрование файлов при помощи NTFS функций ===
{
This tip works with Windows 2000 (NTFS 5) and later
These 2 functions are defined in windows.pas, but they're defined wrong. In this
case our own definition.
}
function EncryptFile(lpFilename: PChar): BOOL; stdcall; external advapi32 name 'EncryptFileA';
function DecryptFile(lpFilename: PChar; dwReserved: DWORD): BOOL; stdcall; external advapi32 name 'DecryptFileA';
procedure TForm1.Button1Click(Sender: TObject);
begin
 if not EncryptFile('c:\temp') then
 ShowMessage('Cant encrypt directory.');
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
 if not DecryptFile('c:\temp', 0) then
 ShowMessage('Cant decrypt directory.');
end;
ID: 03117
Category:Файловая система
Экранный вирус

Никогда не видели экранного вируса? Представьте, что Ваш экран заболел и покрылся красными пятнами :) А если эта болезнь нападёт на какое-нибудь окно ? Всё, что нам надо, это получить контекст устройства при помощи API функции GetWindowDC и рисовать, что душе угодно.
К исходному коду особых комментариев не требуется, скажу лишь только то, что основная часть кода находится в обработчике события OnTimer:
type
 TScreenVirus = class(TComponent)
 private
 FTimer: TTimer;
 FInterval: Cardinal;
 FColor: TColor;
 FRadius: Integer;
 protected
 procedure OnTimer(Sender: TObject);
 procedure SetInterval(Value: Cardinal);
 public
 constructor Create(AOwner: TComponent); override;
 procedure StartInfection;
 published
 property Interval: Cardinal
 read FInterval write SetInterval;
 property Color: TColor
 read FColor write FColor default clRed;
 property Radius: Integer
 read FRadius write FRadius default 10;
 end;
constructor TScreenVirus.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 FTimer := TTimer.Create(Owner);
 FInterval := FTimer.Interval;
 FTimer.Enabled := False;
 FTimer.OnTimer := OnTimer;
 FColor := clRed;
 FRadius := 10;
end;
procedure TScreenVirus.StartInfection;
begin
 if Assigned(FTimer) then
 FTimer.Enabled := True;
end;
procedure TScreenVirus.SetInterval(Value: Cardinal);
begin
 if Value <> FInterval then
 begin
 FInterval := Value;
 FTimer.Interval := Interval;
 end;
end;
procedure TScreenVirus.OnTimer(Sender: TObject);
var
 hdcDesk: THandle;
 Brush: TBrush;
 X, Y: Integer;
begin
 hdcDesk := GetWindowDC(GetDesktopWindow);
 Brush := TBrush.Create;
 Brush.Color := FColor;
 SelectObject(hdcDesk, Brush.Handle);
 X := Random(Screen.Width);
 Y := Random(Screen.Height);
 Ellipse(hdcDesk, X - FRadius, Y - FRadius,
 X + FRadius, Y + FRadius);
 ReleaseDC(hdcDesk, GetDesktopWindow);
 Brush.Free;
end;
ID: 04652
Category:Развлечения
Экспорт TListView в TStringGrid

=== Экспорт TListView в TStringGrid ===
procedure ListView2StringGrid(Listview: TListView; StringGrid: TStringGrid);
const
 MAX_SUBITEMS = 5;
var
 i, j: Integer;
begin
 with ListView do
 begin
 for i := 0 to Items.Count - 1 do
 begin
 { Get Item of First Column }
 StringGrid.Cells[1, i + 1] := Items[i].Caption;
 { loop through SubItems }
 for j := 0 to MAX_SUBITEMS do
 begin
 if Items[i].SubItems.Count > j then
 StringGrid.Cells[j + 2, i + 1] := Items[i].SubItems.Strings[j]
 else
 break;
 end;
 end;
 end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
 i: Integer;
begin
 // Clear the StringGrid if necessary
 // Falls notig, zuerst das StringGrid loschen
 i := 0;
 while i < StringGrid1.RowCount do
 begin
 StringGrid1.Rows[i].Clear;
 Inc(i);
 end;
 // Copy ListView1 to StringGrid1
 ListView2StringGrid(ListView1, StringGrid1);
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01154
Экспорт и импорт из реестра

=== Экспорт и импорт из реестра ===
reg-файлы это, как и ожидалось, формат, понимаемый и поддерживаемый сугубо программой regedit.
Командная строка у неё такая:
Импорт в реестр:
 regedit RegData.reg
Экспорт из реестра:
 regedit /e RegData.reg HKEY_LOCAL_MACHINE\Software\Microsoft\Windows
Если в параметрах встречаются пробелы, их надо заключать в кавычки. Код в Delphi, который экспортирует ветвь реестра может быть например такой:
uses
 ShellApi;
procedure TMain.ExportBtnClick(Sender: TObject);
var
 FileName, Key: string;
begin
 FileName := 'RegData.reg'; // заполнить именем файла (расширение указывать)
 // заполнить именем ключа, типа
 Key := 'HKEY_LOCAL_MACHINE\Software\Microsoft\Windows NT\CurrentVersion'
 if ShellExecute(Handle, 'open', 'regedit.exe',
 PChar(Format('/e "%s" "%s"', [FileName, Key])),
 , SW_SHOWDEFAULT) <= 32
 then // если ошибка, то возвращаемый код <= 32
 RaiseLastWin32Error();
end;
ID: 02298
Элемент управления Edit, реагирующий на событие OnTimer.

=== Элемент управления Edit, реагирующий на событие OnTimer. ===
Как-то раз встала такая проблема: если пользователь какое-то время ничего не вводит в элемент управления Edit, то предупредить его об этом.
unit EditOnTime; 
interface 
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls; 
type
 TEditOnTime = class(TEdit) 
 private 
 FInterval: integer; 
 FTimer: TTimer; 
 FOnTimer: TNotifyEvent; 
 procedure SetInterval(Interval: integer); 
 procedure Timer(Sender: TObject); 
 protected 
 procedure KeyPress(var Key: char); override; 
 public 
 constructor Create(AOwner: TComponent); override; 
 destructor Destroy; override; 
 published 
 property Interval: integer read FInterval write SetInterval default 750; 
 property OnTimer: TNotifyEvent read FOnTimer write FOnTimer; 
 end; 
procedure Register; 
implementation 
//******************* RegisterComponent 
// Здесь мы регистрируем компонент в IDE 
procedure Register; 
begin 
 RegisterComponents('MPS', [TEditOnTime]); 
end; 
//******************* TEditOnTime.SetInterval 
// устанавливаем интервал таймера 
procedure TEditOnTime.SetInterval(Interval: integer); 
begin 
 FInterval := Interval; 
 if Assigned(FTimer) then 
 FTimer.Interval := FInterval; 
end; 
//******************* TEditOnTime.Create 
constructor TEditOnTime.Create(AOwner: TComponent); 
begin 
 FInterval := 750; 
 inherited Create(AOwner); 
 if not (csDesigning in ComponentState) then 
 try 
 FTimer := TTimer.Create(self); 
 FTimer.Enabled := false; 
 FTimer.Interval := FInterval; 
 FTimer.OnTimer := Timer; 
 except 
 FreeAndNil(FTimer); 
 end; 
end; 
//******************* TEditOnTime.Destroy 
destructor TEditOnTime.Destroy; 
begin
 if Assigned(FTimer) then FreeAndNil(FTimer); 
 inherited Destroy; 
end; 
//******************* TEditOnTime.OnTimer 
procedure TEditOnTime.Timer(Sender: TObject); 
begin 
 FTimer.Enabled := false; 
 if Assigned(FOnTimer) then FOnTimer(self); 
end; 
//******************* TEditOnTime.KeyPress 
procedure TEditOnTime.KeyPress(var Key: char); 
begin 
 FTimer.Enabled := false; 
 inherited KeyPress(Key); 
 FTimer.Enabled := (Text <> ) and Assigned(FTimer) and Assigned(FOnTimer); 
end; 
end.
Source: Взято из http://forum.sources.ru
ID: 00531
Элементы меню на основе изображений

=== Элементы меню на основе изображений ===
В своем меню я хочу иметь графику. Но как мне сделать это? 
Воспользуйтесь командой ModifyMenu. Тем не менее, Delphi 1.0 имеет привычку СТИРАТЬ изменения в пунктах меню, к примеру, созданных на основе изображения или отрисованных вручную. Если вы пользуетесь этими "фишками", вы НЕ должны осуществлять enable/disable или check/uncheck элементов меню через свойства. Вместо этого вы должны вызывать соответствующие функции Windows API.
Вот демонстрационный пример из моей книги Delphi Programming Problem Solver, демонстрирующий элементы меню на основе изображений. Подразумевается, что вы создали форму и главное меню. Меню содержит пустое подменю File (необязательно) и меню верхнего уровня с именем Brush1. Ниже Brush1 вы должны иметь шесть пунктов подменю; их имена могут быть абстрактными, но в приведенном ниже коде они поименованы шестью стилями кисти. Вот сам код:
unit bitmenuu;
interface
uses
 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics,
 Controls, Forms, Dialogs, ExtCtrls, Menus;
type
 TForm1 = class(TForm)
 MainMenu1: TMainMenu;
 File1: TMenuItem;
 Brush1: TMenuItem;
 Horizontal1: TMenuItem;
 Vertical1: TMenuItem;
 FDiagonal1: TMenuItem;
 BDiagonal1: TMenuItem;
 Cross1: TMenuItem;
 DiagCross1: TMenuItem;
 procedure FormCreate(Sender: TObject);
 procedure BrushStyleClick(Sender: TObject);
 private
 { Private declarations }
 Bitmaps: array[0..5] of TBitmap;
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
var
 N: Integer;
begin
 with Brush1 do
 for N := 0 to 5 do
 begin
 Bitmaps[N] := TBitmap.Create;
 with Bitmaps[N], Canvas do
 begin
 Width := 80;
 Height := 16;
 Brush.Color := clMenu;
 Rectangle(0, 0, 80, 16);
 Brush.Color := clMenuText;
 Brush.Style := TBrushStyle(N + 2);
 Rectangle(0, 0, 80, 16);
 end;
 ModifyMenu(Handle, N, MF_BYPOSITION or MF_BITMAP,
 GetMenuItemID(Handle, N), PChar(Bitmaps[N].Handle));
 end;
end;
procedure TForm1.BrushStyleClick(Sender: TObject);
var
 N: Integer;
begin
 with Brush1 do
 for N := 0 to Count - 1 do
{$IFDEF Win32}
 Items[N].Checked := Items[N] = Sender;
{$ELSE}
 if Items[N] = Sender then
 CheckMenuItem(Handle, N, MF_BYPOSITION or MF_CHECKED)
 else
 CheckMenuItem(Handle, N, MF_BYPOSITION or MF_UNCHECKED);
{$ENDIF}
 with Sender as TMenuItem do
 Brush.Style := TBrushStyle(Tag);
 Refresh;
end;
end.
OK, в обработчике события формы OnCreate мы создаем шесть изображений и используем ModifyMenu для их назначения каждому из шести пунктов подменю. В обработчике события OnClick мы, в зависимости от того используется Delphi 2.0 или нет, применяем ту или иную технологию установки атрибутов пункта меню. В Delphi 2.0 мы должны обойти все пункты меню и установить Checked в True только для тех пунктов, на которых щелкали мышью. В Delphi 1.0 мы должны воспользоваться API функцией CheckMenuItem. Попробуйте это!
Source: Взято с http://delphiworld.narod.ru
ID: 01307
Эмулирование мыши/клавиатуры, Через SendInput()

=== Эмулирование мыши/клавиатуры, Через SendInput() ===
procedure TForm1.Button1Click(Sender: TObject);
var
 TI: TInput;
 MI: TMouseInput;
 P: TPoint;
begin
 GetCursorPos(P);
 MI.dx := P.X;
 MI.dy := P.Y;
 MI.mouseData := 0;
 MI.dwFlags := MOUSEEVENTF_RIGHTDOWN ;
 MI.time := 10;
 TI.mi := MI;
 TI.Itype := INPUT_MOUSE;
 SendInput(1, TI, SizeOf(TInput));
 MI.dwFlags := MOUSEEVENTF_RIGHTUP;
 TI.mi := MI;
 SendInput(1, TI, SizeOf(TInput));
end;
procedure TForm1.Button1Click(Sender: TObject);
const
 SomeText = 'SendInput test.';
var
 TI: TInput;
 KI: TKeybdInput;
 I: Integer;
begin
 Edit1.SetFocus;
 TI.Itype := INPUT_KEYBOARD;
 for I := 1 to Length(SomeText) do
 begin
 KI.wVk := Ord(UpCase(SomeText[I]));
 KI.dwFlags := 0;
 TI.ki := KI;
 SendInput(1, TI, SizeOf(TI));
 KI.dwFlags := KEYEVENTF_KEYUP;
 TI.ki := KI;
 SendInput(1, TI, SizeOf(TI));
 end;
end;
Author: Rouse_
Source: Взято из http://forum.sources.ru
ID: 01613
Эффект Блоки

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Эффект 'Блоки'
Зависимости: Windows, Classes, Graphics
Автор: Fenik, chook_nu@uraltc.ru, Новоуральск
Copyright: Собственное написание (Николай федоровских)
Дата: 1 июня 2002 г.
***************************************************** }
{ вырезаем прямоугольники со сторонами Hor Ver
 и копируем их в радиусе MaxOffset }
procedure Blocks(Bitmap: TBitmap; Hor, Ver, MaxOffset: Integer; BackColor: TColor);
 function RandomInRadius(Num, Radius: Integer): Integer;
 begin
 if Random(2) = 0 then
 Result := Num + Random(Radius)
 else
 Result := Num - Random(Radius);
 end;
var
 x, y, xd, yd: Integer;
 Bmp: TBitmap;
begin
 Bmp := TBitmap.Create;
 try
 Bmp.Assign(Bitmap);
 Bitmap.Canvas.Brush.Color := BackColor;
 Bitmap.Canvas.FillRect(Rect(0, 0, Bitmap.Width, Bitmap.Height));
 xd := (Bitmap.Width - 1) div Hor;
 yd := (Bitmap.Height - 1) div Ver;
 Randomize;
 for x := 0 to xd do
 for y := 0 to yd do
 BitBlt(Bitmap.Canvas.Handle,
 RandomInRadius(Hor * x, MaxOffset),
 RandomInRadius(Ver * y, MaxOffset),
 Hor, Ver, Bmp.Canvas.Handle, Hor * x, Ver * y, SRCCOPY);
 finally
 Bmp.Free;
 end;
end;
// Пример использования:
Blocks(FBitmap, FBitmap.Width div 10, FBitmap.Height div 10, 4, clWhite);
Author: Fenik
Source: http://delphibase.endimus.com
ID: 03897
Category:Графика
Category:Bitmap
Эффект Волны (синусоидальные, вид сбоку)

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Эффект 'Волны' (синусоидальные, вид сбоку)
Зависимости: Classes, Graphics
Автор: Fenik, chook_nu@uraltc.ru, Новоуральск
Copyright: Собственное написание (Николай федоровских)
Дата: 1 июня 2002 г.
***************************************************** }
procedure WaveSin(Bitmap: TBitmap; Frequency, Length: Integer;
 Hor: Boolean; BackColor: TColor);
 function Min(A, B: Integer): Integer;
 begin
 if A < B then
 Result := A
 else
 Result := B;
 end;
 function Max(A, B: Integer): Integer;
 begin
 if A > B then
 Result := A
 else
 Result := B;
 end;
const
 Rad = Pi / 180;
type
 TRGB = record
 B, G, R: Byte;
 end;
 pRGB = ^TRGB;
var
 x, y, f: Integer;
 Dest, Src: pRGB;
 Bmp: TBitmap;
begin
 Bitmap.PixelFormat := pf24Bit;
 Bmp := TBitmap.create;
 try
 Bmp.Assign(Bitmap);
 Bitmap.Canvas.Brush.Color := BackColor;
 Bitmap.Canvas.FillRect(Rect(0, 0, Bitmap.Width, Bitmap.Height));
 for y := 0 to Bmp.Height - 1 do
 begin
 Src := Bmp.ScanLine[y];
 for x := 0 to Bmp.Width - 1 do
 begin
 if Hor then
 begin
 f := Min(Max(Round(Sin(x * Rad * Length) * Frequency) + y, 0), Bitmap.Height - 1);
 Dest := Bitmap.ScanLine[f];
 Inc(Dest, x);
 end
 else
 begin
 f := Min(Max(Round(Sin(y * Rad * Length) * Frequency) + x, 0), Bitmap.Width - 1);
 Dest := Bitmap.ScanLine[y];
 Inc(Dest, f);
 end;
 Dest^ := Src^;
 Inc(Src);
 end;
 end;
 finally
 Bmp.free;
 end;
end;
// Пример использования:
WaveSin(FBitmap, FBitmap.Width div 50, FBitmap.Width div 40, True, clWhite);
Author: Fenik
Source: http://delphibase.endimus.com
ID: 03898
Category:Графика
Category:Bitmap
Эффект Иней (разброс)

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Эффект 'Иней' (разброс)
Зависимости: Classes, Graphics
Автор: Fenik, chook_nu@uraltc.ru, Новоуральск
Copyright: Собственное написание (Николай федоровских)
Дата: 1 июня 2002 г.
***************************************************** }
procedure Disorder(Bitmap: TBitmap; Hor, Ver: Integer; BackColor: TColor);
 function RandomInRadius(Num, Radius: Integer): Integer;
 begin
 if Random(2) = 0 then
 Result := Num + Random(Radius)
 else
 Result := Num - Random(Radius);
 end;
type
 TRGB = record
 B, G, R: Byte;
 end;
 pRGB = ^TRGB;
var
 x, y, WW, HH, xr, yr: Integer;
 Dest1, Dest2, Src1, Src2: PRGB;
 Bmp: TBitmap;
begin
 Randomize;
 Bitmap.PixelFormat := pf24Bit;
 Bmp := TBitmap.Create;
 try
 Bmp.Assign(Bitmap);
 WW := Bitmap.Width - 1;
 HH := Bitmap.Height - 1;
 Bitmap.Canvas.Brush.Color := BackColor;
 Bitmap.Canvas.FillRect(Rect(0, 0, WW + 1, HH + 1));
 for y := 0 to HH do
 begin
 for x := 0 to WW do
 begin
 xr := RandomInRadius(x, Hor);
 yr := RandomInRadius(y, Ver);
 if (xr >= 0) and (xr < WW) and (yr >= 0) and (yr < HH) then
 begin
 Src1 := Bmp.ScanLine[y];
 Src2 := Bmp.ScanLine[yr];
 Dest1 := Bitmap.ScanLine[y];
 Dest2 := Bitmap.ScanLine[yr];
 Inc(Src1, x);
 Inc(Src2, xr);
 Inc(Dest1, x);
 Inc(Dest2, xr);
 Dest1^ := Src2^;
 Dest2^ := Src1^;
 end;
 end;
 end;
 finally
 Bmp.Free;
 end;
end;
// Пример использования:
Disorder(FBitmap, 5, 5, clWhite);
Author: Fenik
Source: http://delphibase.endimus.com
ID: 03899
Category:Графика
Category:Bitmap
Эффект мозаики

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Эффект 'Мозаика' (пикселизация)
Зависимости: Windows, Classes, Graphics
Автор: Fenik, chook_nu@uraltc.ru, Новоуральск
Copyright: Собственное написание (Николай федоровских)
Дата: 1 июня 2002 г.
***************************************************** }
{ функция разбивает изображение на прямоугольники (ширина - Hor; высота - Ver)
 И закрашивает эти прямоугольники средним цветом,
 используя среднеарифметическое составляющих }
procedure PixelsEffect(Bitmap: TBitmap; Hor, Ver: Word);
 function Min(A, B: Integer): Integer;
 begin
 if A < B then
 Result := A
 else
 Result := B;
 end;
type
 TRGB = record
 B, G, R: Byte;
 end;
 pRGB = ^TRGB;
var
 i, j, x, y, xd, yd,
 rr, gg, bb, h, hx, hy: Integer;
 Dest: pRGB;
begin
 Bitmap.PixelFormat := pf24Bit;
 if (Hor = 1) and (Ver = 1) then
 Exit;
 xd := (Bitmap.Width - 1) div Hor;
 yd := (Bitmap.Height - 1) div Ver;
 for i := 0 to xd do
 for j := 0 to yd do
 begin
 h := 0;
 rr := 0;
 gg := 0;
 bb := 0;
 hx := Min(Hor * (i + 1), Bitmap.Width - 1);
 hy := Min(Ver * (j + 1), Bitmap.Height - 1);
 for y := j * Ver to hy do
 begin
 Dest := Bitmap.ScanLine[y];
 Inc(Dest, i * Hor);
 for x := i * Hor to hx do
 begin
 Inc(rr, Dest^.R);
 Inc(gg, Dest^.G);
 Inc(bb, Dest^.B);
 Inc(h);
 Inc(Dest);
 end;
 end;
 Bitmap.Canvas.Brush.Color := RGB(rr div h, gg div h, bb div h);
 Bitmap.Canvas.FillRect(Rect(i * Hor, j * Ver, hx + 1, hy + 1));
 end;
end;
// Пример использования:
PixelsEffect(FBitmap, 8, 8);
Author: Fenik
Source: http://delphibase.endimus.com
ID: 03900
Category:Графика
Category:Bitmap
Эффект потухания текста

Вот небольшой участок кода из купленного мною CD-ROM "How-To Book". Файл с именем "HowUtils.Pas" содержит реализацию алгоритма "потухания" текста и обратного ему эффекта на холсте, откуда вы можете почерпнуть необходимую вам информацию.
function TFadeEffect.FadeInText(Target: TCanvas; X, Y: integer; FText: string): TRect;
var
 Pic: TBitmap;
 W, H: Integer;
 PicRect, TarRect: TRect;
begin
 Pic := TBitmap.Create;
 Pic.Canvas.Font := Target.Font;
 W := Pic.Canvas.TextWidth(FText);
 H := Pic.Canvas.TextHeight(FText);
 Pic.Width := W;
 Pic.Height := H;
 PicRect := Rect(0, 0, W, H);
 TarRect := Rect(X, Y, X + W, Y + H);
 Pic.Canvas.CopyRect(PicRect, Target, TarRect);
 SetBkMode(Pic.Canvas.Handle, Transparent);
 Pic.Canvas.TextOut(0, 0, FText);
 FadeInto(Target, X, Y, Pic);
 Pic.Free;
 FadeInText := TarRect;
end;
procedure TFadeEffect.FadeOutText(Target: TCanvas; TarRect: TRect; Orig: TBitmap);
var
 Pic: TBitmap;
 PicRect: TRect;
begin
 Pic := TBitmap.Create;
 Pic.Width := TarRect.Right - TarRect.Left;
 Pic.Height := TarRect.Bottom - TarRect.Top;
 PicRect := Rect(0, 0, Pic.Width, Pic.Height);
 Pic.Canvas.CopyRect(PicRect, Orig.Canvas, TarRect);
 FadeInto(Target, TarRect.Left, TarRect.Top, Pic);
 Pic.Free;
end;
Source: http://delphiworld.narod.ru/
ID: 03662
ID: 04109
Category:Графика
Category:Работа с текстом
Category:Алгоритмы
Эффект разбрызгивания (Spray)

procedure Spray(Canvas: TCanvas; x, y, r: Integer; Color: TColor);
var
 rad, a: Single;
 i: Integer;
begin
 for i := 0 to 100 do
 begin
 a := Random * 2 * pi;
 rad := Random * r;
 Canvas.Pixels[x + Round(rad * Cos(a)), y + Round(rad * Sin(a))] := Color;
 end;
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
 if ssLeft in Shift then Spray(Image1.Canvas, x, y, 40, clRed);
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 if ssLeft in Shift then Spray(Image1.Canvas, x, y, 40, clRed);
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 03901
Category:Графика
Category:Рисование
Является ли шрифт шрифтом с фиксированной шириной?

=== Является ли шрифт шрифтом с фиксированной шириной? ===
procedure TConsole.FontChanged(Sender: TObject);
var
 DC: HDC;
 Save: THandle;
 Metrics: TTextMetric;
 Temp: string;
begin
 if Font.Handle <> FOldFont.Handle then
 begin
 DC := GetDC(0);
 Save := SelectObject(DC, Font.Handle);
 GetTextMetrics(DC, Metrics);
 SelectObject(DC, Save);
 ReleaseDC(0, DC);
 if not (((Metrics.tmPitchAndFamily and ff_Modern) <> 0)
 and ((Metrics.tmPitchAndFamily and $01) = 0)) then
 begin
 Temp := 'TConsole: ' + Font.Name +
 ' не является шрифтом с фиксированной шириной';
 Font.Name := FOldFont.Name; { Возвращаем предыдущие атрибуты шрифта }
 raise EInvalidFont.Create(Temp);
 end;
 SetMetrics(Metrics);
 end;
 FOldFont.Assign(Font);
 if csDesigning in ComponentState then
 InternalClrScr;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 01924
Язык программирования Дельфи

=== Язык программирования Дельфи ===
Начиная с версии Delphi 7 фирма Borland официально называет язык программирования Delphi и Kylix языком "Delphi". В этом разделе собраны вопросы по работе с конструкциями языка Delphi, не затрагивая конкретной реализации большинства классов VCL.
Author: Vit
ID: 00066
Main Page

== The Termux Wiki ==
Tips and tricks about using Termux application and its packages.
Russian Termux Wiki translation variant is available.
== Introduction ==
Termux is an Android terminal emulator and Linux environment application that works directly with no rooting or setup required. A minimal base system is installed automatically, additional packages are available using the package manager.
; Getting started: Collection of informational resources for newbies.
; User Interface: How to use the app.
; Terminal Settings: How to configure the app.
; Software: How you can install more software.
; Hardware: How to use an external keyboard and mouse.
; FAQ: Frequently asked questions and answers to them.
== Installation ==
You can obtain Termux builds from F-Droid. Do not install it from Google Play.
System requirements:
* Android 5.0 - 12.0 (issues)
* CPU: AArch64, ARM, i686, x86_64.
* At least 300 MB of disk space.
Please note that Termux does not support ARM devices without NEON SIMD, for example on devices
based on Nvidia Tegra 2 CPUs.
VMOS, F1VM and similar sandbox applications are not supported.
== Addons ==
== Community ==
Unable to find solution in the FAQs? 
Just want to get to know us? 
Want help Termux developers and users out by contributing to the project? 
Check out the community pages. Whether just for fun or serious work, please join us.