nyuuzyou/wikis huggingface dataset:
Изменение иконки приложения

=== Изменение иконки приложения ===
Присвойте свойству Application.Icon другую иконку и вызовите функцию
InvalidateRect(Application.Handle, NIL, True);
... для немедленной перерисовки.
Source: http://delphiworld.narod.ru/
ID: 02361
----
=== Изменять иконку приложения или окна во время его работы ===
Изменять иконку приложения или окна достаточно просто - для этого у TApplication и TForm предусмотрено свойство Icon. Смена иконки может вестись обычным присвоением свойству Icon нового значения:
Form1.Icon := Image1.Picture.Icon;
При этом происходит не присвоение указателя (как казалось бы), а копирование данных посредством вызова Assign, который производится в методе TForm.SetIcon
Source: http://delphiworld.narod.ru/
ID: 02362
----
=== Загрузка иконки из ресурса ===
Загрузка производится типовым вызовом API:
Form1.Icon.Handle := LoadIcon(hInstance, 'имя иконки в ресурсе');
Причем имя в ресурсе желательно писать всегда в верхнем регистре
Все сказанное выше пригодно и для приложения, только в этом случае вместо Form1 выступает Application. Для принудительной перерисовки кнопки приложения в панеле задач можно применить вызов
InvalidateRect(Application.Handle, nil, True);
Source: http://delphiworld.narod.ru/
ID: 02363
----
=== Пример организации простейшей анимации иконки приложения ===
procedure TForm1.Timer1Timer(Sender: TObject);
begin
 Inc(IconIndex);
 case IconIndex of
 1: Application.Icon.Assign(Image1.Picture.Icon);
 2: Application.Icon.Assign(Image2.Picture.Icon);
 else IconIndex := 0;
 end;
 InvalidateRect(Application.Handle, nil, True);
end;
При этом естественно предполагается, что в Image1 и Image2 загружены иконки.
Source: http://delphiworld.narod.ru/
ID: 02364
----
=== Как заставить приложение показывать различные иконки при различных разрешениях дисплея? ===
Для этого достаточно текущее разрешение экрана и в соответствии с ним изменить дескриптор иконки приложения. Естественно, что Вам придется создать в ресурсах новые иконки.
Поместите следующий код в файл проекта (.DPR) Вашего приложения:
Application.Initialize;
Application.CreateForm(TForm1, Form1);
case GetDeviceCaps(GetDC(Form1.Handle), HORZRES) of
 640: Application.Icon.Handle := LoadIcon(hInstance, 'ICON640');
 800: Application.Icon.Handle := LoadIcon(hInstance, 'ICON800');
 1024: Application.Icon.Handle := LoadIcon(hInstance, 'ICON1024');
 1280: Application.Icon.Handle := LoadIcon(hInstance, 'ICON1280');
end;
Application.Run;
Source: http://delphiworld.narod.ru/
ID: 02365
Изменение контрастности изображения

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Изменение контрастности изображения
Value - значение контрастности на отрезке [-100..100]
Local - если True, то применяется "местный контраст",
если False, то - "общий" (более красивый)
Зависимости: Windows
Автор: Fenik, chook_nu@uraltc.ru, Новоуральск
Copyright: Николай Федоровских
Дата: 14 июля 2003 г.
***************************************************** }
procedure Contrast(Bitmap: TBitmap; Value: Integer; Local: Boolean);
 function BLimit(B: Integer): Byte;
 begin
 if B < 0 then
 Result := 0
 else if B > 255 then
 Result := 255
 else
 Result := B;
 end;
var
 Dest: pRGBTriple;
 x, y, mr, mg, mb, W, H, tr, tg, tb: Integer;
 vd: Double;
begin
 if Value = 0 then
 Exit;
 W := Bitmap.Width - 1;
 H := Bitmap.Height - 1;
 if Local then
 begin
 mR := 128;
 mG := 128;
 mB := 128;
 end
 else
 begin
 tr := 0;
 tg := 0;
 tb := 0;
 for y := 0 to H do
 begin
 Dest := Bitmap.ScanLine[y];
 for x := 0 to W do
 begin
 with Dest^ do
 begin
 Inc(tb, rgbtBlue);
 Inc(tg, rgbtGreen);
 Inc(tr, rgbtRed);
 end;
 Inc(Dest);
 end;
 end;
 mB := Trunc(tb / (W * H));
 mG := Trunc(tg / (W * H));
 mR := Trunc(tr / (W * H));
 end;
 if Value > 0 then
 vd := 1 + (Value / 10)
 else
 vd := 1 - (Sqrt(-Value) / 10);
 for y := 0 to H do
 begin
 Dest := Bitmap.ScanLine[y];
 for x := 0 to W do
 begin
 with Dest^ do
 begin
 rgbtBlue := BLimit(mB + Trunc((rgbtBlue - mB) * vd));
 rgbtGreen := BLimit(mG + Trunc((rgbtGreen - mG) * vd));
 rgbtRed := BLimit(mR + Trunc((rgbtRed - mR) * vd));
 end;
 Inc(Dest);
 end;
 end;
end;
Author: Fenik
Source: http://delphibase.endimus.com
ID: 03855
Category:Графика
Category:Bitmap
Изменение месторасположения *.NET-файла

=== Изменение месторасположения *.NET-файла ===
Кто-нибудь знает как изменить месторасположение файла PDOXUSRS.NET во время выполнения программы?
DbiSetProp(hSessionHandle, sesNetFile, PChar('c:\newdir'));
Для получения дескриптора сеанса, если вы используете сессию по умолчанию, необходимо вызвать DbiGetCurrSession()
Сборник Kuliba
Author: Scott Frolich
Source: Взято из Советов по Delphi от Валентина Озерова
ID: 02531
Изменение палитры при выводе изображения

Да, это не тривиальная задача! Палитра дочернего MDI-окна попортила нервов не одному мне.
В обработчике сообщения WM_PaletteChanged вы можете убедиться, что видимая TImage.Picture.Bitmap.Palette всегда "реализована". Так..
 private
 procedure WMPaletteChanged(var Msg: TWMPaletteChanged); message WM_PaletteChanged;
{...}
procedure Form1.WMPaletteChanged(var Msg: TWMPaletteChanged);
begin
 if Msg.PalChg <> Form1.Handle then
 begin
 PaletteChanged(true);
 Msg.Result := 0;
 end;
end;
Теперь вы можете масштабировать неотображенное изображение как вы хотите и не иметь проблем. Единственное, о чем вам необходимо помнить, если вы хотите вывести неотображенное изображение на видимый TImage, вам необходимо вызвать PaletteChanged снова после того, как изображение выведено. С кодом, который мы использовали...
Image1.Picture.Bitmap := obitmap;
PaletteChanged(true);
Если вы не делаете этот вызов, изображение отобразится с неправильной палитрой.
Source: http://delphiworld.narod.ru
ID: 03708
Category:Графика
Category:Цвета и палитры
Изменение размера

Функция изменяет размер битмапа, вычисляя средний цвет прямоугольника из пикселей и записывая в пиксель или прямоугольник пикселей внутри другого битмапа (приемника). Получается глядкое изображение без искажений, в отличие от стандартного метода StretchDraw.
Наверное, у этого алгоритма есть своё название, не знаю..
Ну и, есть что оптимизировать..
procedure TFormConvertir.ResizeBitmap(imgo, imgd: TBitmap; nw, nh: Integer);
var
 xini, xfi, yini, yfi, saltx, salty: Single;
 x, y, px, py, tpix: Integer;
 PixelColor: TColor;
 r, g, b: LongInt;
 function MyRound(const X: Double): Integer;
 begin
 Result := Trunc(x);
 if Frac(x) >= 0.5 then
 if x >= 0 then
 Result := Result + 1
 else
 Result := Result - 1;
 // Result := Trunc(X + (-2 * Ord(X < 0) + 1) * 0.5);
 end;
begin
 // Установка размера результата
 imgd.Width := nw;
 imgd.Height := nh;
 // Вычисляем ширину и высоту каждого прямоугольника исходного битмапа
 saltx := imgo.Width / nw;
 salty := imgo.Height / nh;
 yfi := 0;
 for y := 0 to nh - 1 do
 begin
 // Устанавливаем начальную и конечную координату Y прямоугольника
 yini := yfi;
 yfi := yini + salty;
 if yfi >= imgo.Height then yfi := imgo.Height - 1;
 xfi := 0;
 for x := 0 to nw - 1 do
 begin
 // Устанавливаем начальную и конечную координату X прямоугольника
 xini := xfi;
 xfi := xini + saltx;
 if xfi >= imgo.Width then xfi := imgo.Width - 1;
 // Вычисление среднего цвета прямоугольника
 r := 0;
 g := 0;
 b := 0;
 tpix := 0;
 for py := MyRound(yini) to MyRound(yfi) do
 begin
 for px := MyRound(xini) to MyRound(xfi) do
 begin
 Inc(tpix);
 PixelColor := ColorToRGB(imgo.Canvas.Pixels[px, py]);
 r := r + GetRValue(PixelColor);
 g := g + GetGValue(PixelColor);
 b := b + GetBValue(PixelColor);
 end;
 end;
 // Рисуем получившийся пиксель
 imgd.Canvas.Pixels[x, y] :=
 RGB(MyRound(r / tpix), MyRound(g / tpix), MyRound(b / tpix));
 end;
 end;
end;
ID: 03833
== См. также ==
* How to scale bitmap by percent?
* Изменение размера
* Растягивание изображения
* Масштабирование для Canvas
* Как качественно увеличить изображение при помощи билинейной интерполяции
Category:Графика
Category:Bitmap
Изменение размеров колонок в StringGrid

=== Изменение размеров колонок в StringGrid ===
Ниже приведён пример кода, который позволяет автоматически подогнать размер колонки в компоненте TStringGrid, под размер самой длинной строки текста в колонке:
procedure AutoSizeGridColumn(Grid: TStringGrid; column: integer);
var
 i: integer;
 temp: integer;
 max: integer;
begin
 max := 0;
 for i := 0 to (Grid.RowCount - 1) do
 begin
 temp := Grid.Canvas.TextWidth(grid.cells[column, i]);
 if temp > max then
 max := temp;
 end;
 Grid.ColWidths[column] := Max + Grid.GridLineWidth + 3;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 AutoSizeGridColumn(StringGrid1, 1);
end;
Source: Взято из http://forum.sources.ru
ID: 00605
Изменение регистра букв

=== Изменение регистра букв ===
В Delphi есть три функции для изменения регистра: upcase, lowercase, uppercase. Но они работают только для латинского алфавита. Чтобы сделать аналогичные функции для русского алфавита я использовал то, что в кодировке Windows-1251 буквы расставлены по алфавиту, как большие, так и маленькие. То есть номер большой буквы связан с номером маленькой константой. И в русском, и в английском алфавитах маленькие буквы находятся за большими с разностью в 32 символа.
Здесь реализованы четыре функции: upcase и locase для изменения регистра одного символа, и uppercase и lowercase для изменения регистра строки
function UpCase(ch: Char): Char;
begin
 if (ch in ['a'..'z', 'а'..'я']) then
 Result := Chr(Ord(ch) - 32)
 else
 Result := ch;
end;
function LoCase(ch: Char): Char;
begin
 if (ch in ['A'..'Z', 'А'..'Я']) then
 Result := Chr(Ord(ch) + 32)
 else
 Eesult := ch;
end;
function UpperCase(s: string): string;
var
 i: Integer;
begin
 Result := s;
 for i := 1 to Length(Result) do
 if (Result[i] in ['a'..'z', 'а'..'я']) then
 Result[i] := Chr(Ord(Result[i]) - 32);
end;
function LowerCase(s: string): string;
var
 i: integer;
begin
 Result := s;
 for i := 1 to Length(result) do
 if (Result[i] in ['A'..'Z', 'А'..'Я']) then
 Result[i] := Chr(Ord(Result[i]) + 32);
end;
procedure TForm1.Button1Click(Sender: TObject);
const
 s = 'zZцЦ.';
var
 i: Integer;
begin
 Form1.Caption := 'DownCase: ';
 for i := 1 to Length(s) do
 Form1.Caption := Form1.Caption + LoCase(s[i]);
 Form1.Caption := Form1.Caption + ' UpCase: ';
 for i := 1 to Length(s) do
 Form1.Caption := Form1.Caption + UpCase(s[i]);
 Form1.Caption := Form1.Caption + ' UpperCase: ' + UpperCase(s);
 Form1.Caption := Form1.Caption + ' LowerCase: ' + LowerCase(s);
end;
Source: Взято с сайта http://blackman.wp-club.net/
ID: 01935
Изменение скорости привода CD-ROM

=== Изменение скорости привода CD-ROM ===
Находим в интернете файл ASPI.pas (еще есть wnaspi32.pas), подключаем его к проекту, пишем следующий код:
function SetCDSpeed(Host, Target: Byte; Speed: Integer): Boolean;
var
 dwASPIStatus: DWORD;
 hEvent: THandle;
 srbExec: SRB_ExecSCSICmd;
begin
 if Speed < 176 then
 begin
 Result := False;
 Exit;
 end;
 hEvent := CreateEvent(nil, True, False, nil);
 Fillchar(srbExec,sizeof(SRB_ExecSCSICmd), 0);
 srbExec.SRB_Cmd := SC_EXEC_SCSI_CMD;
 srbExec.SRB_Flags := SRB_DIR_OUT or SRB_EVENT_NOTIFY;
 srbExec.SRB_Target := Target;
 srbExec.SRB_HaId := Host;
 srbExec.SRB_Lun := 0;
 srbExec.SRB_SenseLen := SENSE_LEN;
 srbExec.SRB_CDBLen := 12;
 srbExec.SRB_PostProc := Pointer(hEvent);
 srbExec.CDBByte[0] := $BB; // команда изменения скорости привода
 srbExec.CDBByte[2] := Speed shr 8;
 srbExec.CDBByte[3] := Speed;
 srbExec.CDBByte[4] := $FF;
 srbExec.CDBByte[5] := $FF;
 ResetEvent(hEvent);
 dwASPIStatus := SendASPI32Command(@srbExec);
 if dwASPIStatus = SS_PENDING then
 begin
 WaitForSingleObject(hEvent, INFINITE);
 end;
 if srbExec.SRB_Status <> SS_COMP then
 begin
 MessageBox(0, 'Error processing the SRB.', 'Error', MB_OK);
 Result := False;
 end
 else
 Result := True;
 end;
end;
Какие параметры передавать - написано в том же ASPI.pas 
Author: Rouse_
Source: Взято из http://forum.sources.ru
ID: 01411
Изменить размер кнопки ПУСК

=== Изменить размер кнопки ПУСК ===
procedure TForm1.Button1Click(Sender: TObject);
begin
 MoveWindow(FindWindowEx(FindWindow('Shell_TrayWnd', nil), 0, 'Button', nil), 
 300, 0, 80, 22, True);
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01798
Изменить цвет выделения для TRichEdit

=== Изменить цвет выделения для TRichEdit ===
uses
 RichEdit;
procedure RE_SetSelBgColor(RichEdit: TRichEdit; AColor: TColor);
var
 Format: CHARFORMAT2;
begin
 FillChar(Format, SizeOf(Format), 0);
 with Format do
 begin
 cbSize := SizeOf(Format);
 dwMask := CFM_BACKCOLOR;
 crBackColor := AColor;
 Richedit.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Longint(@Format));
 end;
end;
// Example: Set clYellow background color for the selected text. 
procedure TForm1.Button1Click(Sender: TObject);
begin
 RE_SetSelBgColor(RichEdit1, clYellow);
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01029
Изменить цвет неактивного TEdit

=== Изменить цвет неактивного TEdit ===
{Question: 
How can I change the color of a disabled (Edit1.Enabled := false;) control? 
I do not want the normal grey color. 
Answer: 
Two options: 
1) place the control on a panel and disable the panel instead of the control. 
This way the color stays to whatever you set it. 
2) make a descendent and take over the painting when it is disabled. 
Here is an example:}
unit PBExEdit;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls,
 Forms, Dialogs, StdCtrls;
type
 TPBExEdit = class(TEdit)
 private
 { Private declarations }
 FDisabledColor: TColor;
 FDisabledTextColor: TColor;
 procedure WMPaint(var msg: TWMPaint); message WM_PAINT;
 procedure WMEraseBkGnd(var msg: TWMEraseBkGnd); message WM_ERASEBKGND;
 procedure SetDisabledColor(const Value: TColor); virtual;
 procedure SetDisabledTextColor(const Value: TColor); virtual;
 protected
 { Protected declarations }
 public
 { Public declarations }
 constructor Create(aOwner: TComponent); override;
 published
 { Published declarations }
 property DisabledTextColor: TColor read FDisabledTextColor
 write SetDisabledTextColor default clGrayText;
 property DisabledColor: TColor read FDisabledColor
 write SetDisabledColor default clWindow;
 end;
procedure Register;
 implementation
procedure Register;
begin
 RegisterComponents('PBGoodies', [TPBExEdit]);
end;
constructor TPBExEdit.Create(aOwner: TComponent);
begin
 inherited;
 FDisabledColor := clWindow;
 FDisabledTextColor := clGrayText;
end;
procedure TPBExEdit.SetDisabledColor(const Value: TColor);
begin
 if FDisabledColor <> Value then
 begin
 FDisabledColor := Value;
 if not Enabled then
 Invalidate;
 end;
end;
procedure TPBExEdit.SetDisabledTextColor(const Value: TColor);
begin
 if FDisabledTextColor <> Value then
 begin
 FDisabledTextColor := Value;
 if not Enabled then
 Invalidate;
 end;
end;
procedure TPBExEdit.WMEraseBkGnd(var msg: TWMEraseBkGnd);
var
 Canvas: TCanvas;
begin
 if Enabled then
 inherited
 else
 begin
 Canvas:= TCanvas.Create;
 try
 Canvas.Handle := msg.DC;
 SaveDC(msg.DC);
 try
 canvas.Brush.Color := FDisabledColor;
 canvas.Brush.Style := bsSolid;
 canvas.Fillrect(clientrect);
 msg.Result := 1;
 finally
 RestoreDC(msg.DC, - 1);
 end;
 finally
 canvas.free
 end;
 end;
end;
procedure TPBExEdit.WMPaint(var msg: TWMPaint);
var
 Canvas: TCanvas;
 ps: TPaintStruct;
 CallEndPaint: Boolean;
begin
 if Enabled then
 inherited
 else
 begin
 CallEndPaint := False;
 Canvas:= TCanvas.Create;
 try
 if msg.DC <> 0 then
 begin
 Canvas.Handle := msg.DC;
 ps.fErase := true;
 end
 else
 begin
 BeginPaint(Handle, ps);
 CallEndPaint:= True;
 Canvas.handle := ps.hdc;
 end;
 if ps.fErase then
 Perform(WM_ERASEBKGND, Canvas.Handle, 0);
 SaveDC(canvas.handle);
 try
 Canvas.Brush.Style := bsClear;
 Canvas.Font := Font;
 Canvas.Font.Color := FDisabledTextColor;
 Canvas.TextOut(1, 1, Text);
 finally
 RestoreDC(Canvas.Handle, - 1);
 end;
 finally
 if CallEndPaint then
 EndPaint(handle, ps);
 Canvas.Free
 end;
 end;
end;
end.
Language: en
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 00980
Изменить шрифт TStatusBar

=== Изменить шрифт TStatusBar ===
{ 
 To use this example, you need a TStatusBar and at least one Panel. 
 Then change the style of StatusBar1.Panels[0] to 
 psOwnerDraw and add the code below to the OnDrawPanel handler. 
}
 procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar;
 Panel: TStatusPanel; const Rect: TRect);
 var
 SomeText: string;
 begin
 if Panel = StatusBar1.Panels[0] then
 begin
 SomeText := 'Hello!';
 Panel.Width := Trunc(StatusBar1.Canvas.TextWidth(SomeText) * 1.5);
 with StatusBar.Canvas do
 begin
 Brush.Color := clWhite;
 FillRect(Rect);
 Font.Name := 'Arial';
 Font.Color := clRed;
 Font.Style := Font.Style + [fsItalic, fsBold];
 TextRect(Rect, Rect.Left + 1, Rect.Top, SomeText);
 end;
 end;
 end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 00956
Изменить экранный курсор без необходимости возвращать предыдущий

=== Изменить экранный курсор без необходимости возвращать предыдущий ===
// By implementing Interface we can set the cursor without restore it in the end.
// Example: In convensional way...
var
 Cur: TCursor;
begin
 Cur := Screen.Cursor;
 Screen.Cursor := crSQLWait;
 // do coding here
 // What happend is that if your code did not finish, the screen cursor will
 // remain as crSQLWait.. even with try..finally block (sometimes)
 Screen.Cursor := Cur;
end;
// By using interface, we can implement as follows
type
 ImyCursor = interface
 [(GUID - Ctrl - Shift - G)]
 end;
 TmyCursor = class(TInterfacedObjects, ImyCursor);
 private
 FCursor: TCursor;
 public
 constructor Create;
 destructor Destroy; override;
 end;
implementation
TmyCursor.Create;
begin
 FCursor := Screen.Cursor;
end;
TmyCursor.Destroy;
begin
 Screen.Cursor := FCursor;
 inherited;
end;
var
 C: ImyCursor;
begin
 C := TmyCursor.Create;
 Screen.Curosr := crSQLWait; // whatever cursor you like
 // Do coding here without worring to free it.
 // Screen Cursor will restore when the TMyCursor object get out of scope.
end;
Source: http://delphiworld.narod.ru/
ID: 02334
Изменяем заголовок окна

=== Изменяем заголовок окна ===
В примере показывается, как изменять заголовок окна (видимый в списке задач при переключении между приложениями) при минимизации окна в иконку.
Сперва необходимо определить сообщение поумолчанию: 
const 
 DefMsgNorm = 'MyApp version 1.0'; 
 DefMsgIcon = 'MyApp. (Use F12 to turn of)'; 
И добавить две глобальных переменных: 
var 
 ActMsgNorm: string; 
 ActMsgIcon: string; 
Затем при открытии основной формы инициализируем переменные из констант. 
procedure TFormMain.FormCreate(Sender: TObject); 
begin 
 ActMsgNorm := DefMsgNorm; 
 ActMsgIcon := DefMsgIcon; 
 Application.Title := ActMsgNorm; 
end;
Затем достаточно в обработчик OnResize добавить следующий код: 
procedure TFormMain.FormResize(Sender: TObject); 
begin 
 if (FormMain.WindowState = wsMinimized) then 
 Application.Title := ActMsgIcon 
 else 
 Application.Title := ActMsgNorm; 
end; 
Source: Взято из http://forum.sources.ru
ID: 00475
Изменяем цвет TPageControl

=== Изменяем цвет TPageControl ===
type 
 TTabSheet = class(ComCtrls.TTabSheet) 
 private 
 FColor: TColor; 
 procedure SetColor(Value: TColor); 
 procedure WMEraseBkGnd(var Msg: TWMEraseBkGnd); message WM_ERASEBKGND; 
 public 
 constructor Create(AOwner: TComponent); override; 
 property Color: TColor read FColor write SetColor; 
 end; 
implementation 
constructor TTabSheet.Create(AOwner: TComponent); 
begin 
 inherited; 
 FColor := clBtnFace; 
end; 
procedure TTabSheet.SetColor(Value: TColor); 
begin 
 if FColor Value then 
 begin 
 FColor := Value; 
 Invalidate; 
 end; 
end; 
procedure TTabSheet.WMEraseBkGnd(var Msg: TWMEraseBkGnd); 
begin 
 if FColor = clBtnFace then 
 inherited 
 else 
 begin 
 Brush.Color := FColor; 
 Windows.FillRect(Msg.dc, ClientRect, Brush.Handle); 
 Msg.Result := 1; 
 end; 
end; 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
 Tabsheet1.Color := clWhite; 
 TabSheet2.Color := clLime; 
end; 
// PageControl1.OwnerDraw := true ! 
procedure TForm1.PageControl1DrawTab(Control: TCustomTabControl; 
 TabIndex: Integer; const Rect: TRect; Active: Boolean); 
var 
 AText: string; 
 APoint: TPoint; 
begin 
 with (Control as TPageControl).Canvas do 
 begin 
 Brush.Color := clred; 
 FillRect(Rect); 
 AText := TPageControl(Control).Pages[TabIndex].Caption; 
 with Control.Canvas do 
 begin 
 APoint.x := (Rect.Right - Rect.Left) div 2 - TextWidth(AText) div 2; 
 APoint.y := (Rect.Bottom - Rect.Top) div 2 - TextHeight(AText) div 2; 
 TextRect(Rect, Rect.Left + APoint.x, Rect.Top + APoint.y, AText); 
 end; 
 end; 
end;
Source: http://delphiworld.narod.ru/
ID: 01174
Имена сетевого адаптера, системное имя устройства и описание

Имя виртуального устройства можно получить вот так:
const
 MAX_ADAPTER_NAME = 255;
type
 PIP_ADAPTER_INDEX_MAP = ^IP_ADAPTER_INDEX_MAP;
 IP_ADAPTER_INDEX_MAP = record
 Index: DWORD;
 Name: array [0..MAX_ADAPTER_NAME-1] of WideChar;
 end;
 PIP_INTERFACE_INFO = ^IP_INTERFACE_INFO;
 IP_INTERFACE_INFO = record
 NumAdapters: Longint;
 Adapter: array [0..0] of IP_ADAPTER_INDEX_MAP;
 end;
 function GetIfEntry(pIfRow: PMibIfRow): DWORD; stdcall external 'iphlpapi.dll';
 function GetNumberOfInterfaces(var pdwIntf: DWORD): DWORD; stdcall; external 'iphlpapi.dll';
 function GetInterfaceInfo(pIfTable: PIP_INTERFACE_INFO; var dwOutBufLen:DWORD): DWORD;
 stdcall; external 'iphlpapi.dll';
 function GetAdapterIndex(AdapterName: PWideChar; var IfIndex: DWORD): DWORD;
 stdcall; external 'iphlpapi.dll';
procedure TMainForm.Button1Click(Sender: TObject);
var
 I, pdwIntf, dwOutBufLen, IfIndex: DWORD;
 lpInfo: PIP_INTERFACE_INFO;
 mirIfDescr: TMibIfRow;
begin
 //if GetNumberOfInterfaces(pdwIntf) = NO_ERROR then
 //begin
 GetInterfaceInfo(nil, dwOutBufLen);
 GetMem(lpInfo, dwOutBufLen);
 try
 if GetInterfaceInfo(lpInfo, dwOutBufLen) = NO_ERROR then
 begin
 for I := 0 to lpInfo^.NumAdapters - 1 do
 begin
 Memo1.Lines.Add('AdapterName: ' + lpInfo^.Adapter[I].Name);
 if GetAdapterIndex(lpInfo^.Adapter[I].Name, IfIndex) = NO_ERROR then
 Memo1.Lines.Add('AdapterIndex: ' + IntToStr(IfIndex))
 else
 RaiseLastOSError;
 ZeroMemory(@mirIfDescr, SizeOf(TMibIfRow));
 mirIfDescr.dwIndex := IfIndex;
 if GetIfEntry(@mirIfDescr) = NO_ERROR then
 Memo1.Lines.Add('AdapterDescription: ' + mirIfDescr.bDescr)
 else
 RaiseLastOSError;
 end;
 end
 else
 RaiseLastOSError;
 finally
 FreeMem(lpInfo);
 end;
 end
 //else
 //RaiseLastOSError;
end;
Author: Rouse_
Source: http://forum.sources.ru
ID: 03323
Category:Связь
Имитация Tab

=== Имитация Tab ===
 SelectNext(Screen.ActiveControl, True, True);
Разместите приведенный код в обработчике одного из событий. SelectNext - защищенный метод TWinControl со следующим прототипом:
procedure SelectNext(CurControl: TWinControl; GoForward, CheckTabStop: Boolean);
Так как форма также является потомком TWinControl, то она имеет доступ к защищенным методам. 
Source: Взято с http://delphiworld.narod.ru
ID: 00362
ID: 01483
Имитация ввода с клавиатуры для консоли

=== Имитация ввода с клавиатуры для консоли ===
const
 ExtendedKeys: set of Byte = [ // incomplete list
 VK_INSERT, VK_DELETE, VK_HOME, VK_END, VK_PRIOR, VK_NEXT,
 VK_LEFT, VK_UP, VK_RIGHT, VK_DOWN, VK_NUMLOCK
 ];
procedure SimulateKeyDown(Key: Byte);
var
 flags: DWORD;
begin
 if Key in ExtendedKeys then
 flags := KEYEVENTF_EXTENDEDKEY
 else
 flags := 0;
 keybd_event(Key, MapVirtualKey(Key, 0), flags, 0);
end;
procedure SimulateKeyUp(Key: Byte);
var
 flags: DWORD;
begin
 if Key in ExtendedKeys then
 flags := KEYEVENTF_EXTENDEDKEY
 else
 flags := 0;
 keybd_event(Key, MapVirtualKey(Key, 0), KEYEVENTF_KEYUP or flags, 0);
end;
procedure SimulateKeystroke(Key: Byte);
var
 flags: DWORD;
 scancode: BYTE;
begin
 if Key in ExtendedKeys then
 flags := KEYEVENTF_EXTENDEDKEY
 else
 flags := 0;
 scancode := MapVirtualKey(Key, 0);
 keybd_event(Key, scancode, flags, 0);
 keybd_event(Key, scancode, KEYEVENTF_KEYUP or flags, 0);
end;
Author: Nomadic
Source: http://delphiworld.narod.ru/
ID: 02201