nyuuzyou/wikis huggingface dataset:
Симуляция нажатия кнопки при наличии DBGrid

=== Симуляция нажатия кнопки при наличии DBGrid ===
В случае нажатия клавиши Enter, клавиша по умолчанию не срабатывает, если у вас на форме расположен компонент DBGrid, но вы можете создать обработчик события DBGrid OnKeypUp, уведомляющий кнопку по умолчанию о ее "нажатии" при реальном нажатии клавиши Enter. Пример:
{ Код DBGrid OnKeyUp. Default-кнопка - BitBtn1. }
if Key = VK_RETURN then
begin
 PostMessage(BitBtn1.Handle, WM_LBUTTONDOWN, Word(0), LongInt(0)) ;
 PostMessage(BitBtn1.Handle, WM_LBUTTONUP, Word(0), LongInt(0)) ;
end ;
Source: Взято с http://delphiworld.narod.ru
ID: 03078
Category:Базы данных
Category:DBGrid
Синхронизация TabSet c ListBox

=== Синхронизация TabSet c ListBox ===
Что-то аналогичное я делал раньше, тем не менее, вместо Listbox я использовал dbGrid со следующими опциями: 
 [dgAlwaysShowEditor, dgTabs, dgRowSelect, dgAlwaysShowSelection, dgConfirmDelete, dgCancelOnExit] 
Кроме того, я привел код, который я использовал в ответ на щелчок на закладке, таким образом изменяя запись в dbgrid.
procedure TForm1.TabSet1Change(Sender: TObject; NewTab: Integer;
 var AllowChange: Boolean);
begin
 Table1.FindNearest([Chr(NewTab+65)]);
 Table2.FindNearest([Chr(NewTab+65)]);
end;
procedure TForm1.TabSet1Click(Sender: TObject);
var
 I: integer;
begin
 with TabSet1 do
 begin
 if TabIndex > -1 then
 begin
 with ListBox1 do
 begin
 for I := 0 to Items.Count - 1 do
 begin
 if Pos(Tabs[TabIndex], Items[I]) = 1 then
 begin
 ItemIndex := I;
 break;
 end;
 end;
 end;
 end;
 end;
end;
Source: http://delphiworld.narod.ru/
ID: 01181
Синхронизация двух компонентов ScrollBox

=== Синхронизация двух компонентов ScrollBox ===
Решить задачу помогут обработчики событий OnScroll (в данном примере два компонента ScrollBox (ScrollBar1 и ScrollBar2) расположены на форме TMainForm): 
procedure TMainForm.ScrollBar1Scroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
begin
 ScrollBar2.Position := ScrollPos;
end;
procedure TMainForm.ScrollBar2Scroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
begin
 ScrollBar1.Position := ScrollPos;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 01228
Синхронизация завершения работы Windows

=== Синхронизация завершения работы Windows ===
{ 
Works only on Windows NT/2000/XP systems 
}
function TimedShutDown(Computer: string; Msg: string; Time: Word; Force: Boolean; Reboot: Boolean): Boolean;
var
 rl: Cardinal;
 hToken: Cardinal;
 tkp: TOKEN_PRIVILEGES;
begin
 // get user privileges to shutdown the machine, we are talking about win nt and 2k here 
 if not OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
 ShowMessage('Cannot open process token.')
 else
 begin
 if LookupPrivilegeValue(nil, 'SeShutdownPrivilege', tkp.Privileges[0].Luid) then
 begin
 tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
 tkp.PrivilegeCount := 1;
 AdjustTokenPrivileges(hToken, False, tkp, 0, nil, rl);
 if GetLastError <> ERROR_SUCCESS then
 ShowMessage('Error adjusting process privileges.');
 end
 else
 ShowMessage('Cannot find privilege value.');
 end;
 Result := InitiateSystemShutdown(PChar(Computer), PChar(Msg), Time, Force, Reboot)
end;
// Start shut down 
procedure TForm1.Button1Click(Sender: TObject);
begin
 if not TimedShutDown('\\computername', 'you have to shutdown', 30, true, true) then
 ShowMessage('function failed...');
end;
// Abort shut down 
procedure TForm1.Button2Click(Sender: TObject);
begin
 AbortSystemShutdown('\\computername');
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01678
Сканирование доменов локальной сети

Переменная List заполняется списком доменов. Функция возвращает код ошибки обращения к сети.
function FillNetLevel(xxx: PNetResource; list: TStrings): Word;
type
 PNRArr = ^TNRArr;
 TNRArr = array[0..59] of TNetResource;
var
 x: PNRArr;
 tnr: TNetResource;
 I: integer;
 EntrReq, SizeReq, twx: Integer;
 WSName: string;
begin
 Result := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY,
 RESOURCEUSAGE_CONTAINER, xxx, twx);
 if Result = ERROR_NO_NETWORK then Exit;
 if Result = NO_ERROR then
 begin
 New(x);
 EntrReq := 1;
 SizeReq := SizeOf(TNetResource) * 59;
 while (twx <> 0) and (WNetEnumResource(twx, EntrReq, x, SizeReq) <> ERROR_NO_MORE_ITEMS) do
 begin
 for i := 0 to EntrReq - 1 do
 begin
 Move(x^[i], tnr, SizeOf(tnr));
 case tnr.dwDisplayType of
 RESOURCEDISPLAYTYPE_DOMAIN:
 begin
 if tnr.lpRemoteName <> then
 WSName:= tnr.lpRemoteName
 else
 WSName:= tnr.lpComment;
 list.Add(WSName);
 end;
 else
 FillNetLevel(@tnr, list);
 end;
 end;
 end;
 Dispose(x);
 WNetCloseEnum(twx);
 end;
end;
Источник: http://dmitry9.nm.ru/info/
ID: 03307
== См. также ==
* Как найти все компьютеры в сети?
Category:Связь
Сканирование локальной сети.

Пример демонстрирующий быстрое сканирование диапазона адресов на наличие ресурсов общего доступа.
* Скачать демонстрационный пример
Демонстрационная программа сканирования сети на основе WNetOpenEnum, WNetEnumResource, WNetCloseEnum
* Скачать демонстрационный пример
Author: Александр (Rouse_) Багель
Source: http://rouse.drkb.ru
ID: 03333
== См. также ==
* Демонстрационная программа сканирования сети
* Получение IP адресов всех компьютеров в рабочей группе
Category:Связь
Сканирование строки начиная с указанной позиции с целью нахождения слова

=== Сканирование строки начиная с указанной позиции с целью нахождения слова ===
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Сканирование строки начиная с указанной позиции с целью нахождения слова.
Функция предназначена для разбиения строки на слова. Границы слов
определяются по разделителям.
Описание параметров:
S - строка, в которой производится поиск;
StartPos - на входе принимает позицию с которой начинается сканирование
строки, на выходе содержит позицию символа, с которого начинается слово;
WordLen - на выходе содержит длину найденного слова;
Delimiters - множество, содержащее символы-разделители слов;
Возвращаемое значение - true если слово найдено, инече false;
Зависимости: SysUtils
Copyright: Алексей Вуколов
Дата: 18 апреля 2002 г.
***************************************************** }
function WordScan(const S: string; var StartPos, WordLen: integer;
 Delimiters: TSysCharSet): boolean;
var
 i, l: integer;
begin
 Result := false;
 WordLen := 0;
 i := StartPos;
 l := length(s);
 StartPos := 0;
 while i <= l do
 if s[i] in Delimiters then
 Inc(i)
 else
 begin
 StartPos := i;
 break;
 end;
 while i <= l do
 if not (s[i] in Delimiters) then
 begin
 Inc(i);
 Inc(WordLen);
 end
 else
 break;
 Result := WordLen <> 0;
end;
Пример использования: 
Консольная программа, выводящая на экран слова из заданной строки.
program Project1;
{$APPTYPE CONSOLE}
uses SysUtils;
var
 s: string;
 wStart, wLen: integer;
begin
 s := 'This is a test string. String contains delimiters.';
 wStart := 1;
 wLen := 0;
 while WordScan(s, wStart, wLen, [' ', '.', ',']) do
 begin
 WriteLn(copy(s, wStart, wLen));
 Inc(wStart, wLen);
 end;
 ReadLn();
end.
Author: Алексей Вуколов
Source: delphibase.endimus.com
ID: 00882
Сколько БД я могу открыть в одной транзакции?

=== Сколько БД я могу открыть в одной транзакции? ===
Не существует архитектурнго ограничения на такую возможность. Пользователи сообщают о работе одновременно с 17-ю БД.
Author: Дмитрий Кузьменко (http://www.ibase.ru)
ID: 02903
Category:Базы данных
Category:Interbase
Сколько открыто дочерних окон?

=== Сколько открыто дочерних окон? ===
Form1.MDIChildCount
Закрыть все окна:
with Form1 do 
 for i := MDIChildCount-1 DownTo 0 Do
 if Assigned(MDIChildren[i]) then
 begin
 MDIChildren[i].Close;
 end;
Исправлено Bose
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 00492
Сколько памяти использует IB на сервере?

=== Сколько памяти использует IB на сервере? ===
Минимально при запуске - от 1.2 до 3 Мб, далее память распределяется динамически в зависимости от запросов, выполняемых клиентами (от 40 до 400К на клиента). Кроме этого, объем используемой памяти сильно зависит от архитектуры сервера (Classic или SuperServer), операционной системы, размера кэша страниц БД и других настроек. Подробнее по настройкам см. PERFORM.HLP в каталоге INTRBASE\BIN
Author: Дмитрий Кузьменко (http://www.ibase.ru)
ID: 02895
Category:Базы данных
Category:Interbase
Скопировать, удалить, вставить в TWebBrowser

uses
 ActiveX;
// Copy the selected text to the clipboard
procedure TForm1.Button7Click(Sender: TObject);
begin
 try
 WebBrowser1.ExecWB(OLECMDID_COPY, OLECMDEXECOPT_PROMPTUSER);
 except
 end;
end;
// Cut the selected text
procedure TForm1.Button8Click(Sender: TObject);
begin
 try
 WebBrowser1.ExecWB(OLECMDID_CUT, OLECMDEXECOPT_PROMPTUSER);
 except
 end;
end;
// Delete the selected text
procedure TForm1.Button9Click(Sender: TObject);
begin
 try
 WebBrowser1.ExecWB(OLECMDID_DELETE, OLECMDEXECOPT_PROMPTUSER);
 except
 end;
end;
initialization
 OleInitialize(nil);
finalization
 OleUninitialize;
end.
// as of Internet Explorer 4
Source: http://delphiworld.narod.ru
ID: 03470
Category:Связь
Category:WebBrowser
Скопировать HTML-код в буфер обмена

=== Скопировать HTML-код в буфер обмена ===
{
 If you've ever tried sticking html into the clipboard using the usual CF_TEXT
 format then you might have been disappointed to discover that wysiwyg html
 editors paste your offering as if it were just text,
 rather than recognising it as html. For that you need the CF_HTML format.
 CF_HTML is entirely text format and uses the transformation format UTF-8.
 It includes a description, a context, and within the context, the fragment.
 As you may know one can place multiple items of data onto the clipboard for
 a single clipboard entry, which means that the same data can be pasted in a
 variety of different formats in order to cope with target
 applications of varying sophistocation.
 The following example shows how to stick CF_TEXT (and CF_HTML)
 into the clipboard.
}
function FormatHTMLClipboardHeader(HTMLText: string): string;
const
 CrLf = #13#10;
begin
 Result := 'Version:0.9' + CrLf;
 Result := Result + 'StartHTML:-1' + CrLf;
 Result := Result + 'EndHTML:-1' + CrLf;
 Result := Result + 'StartFragment:000081' + CrLf;
 Result := Result + 'EndFragment:°°°°°°' + CrLf;
 Result := Result + HTMLText + CrLf;
 Result := StringReplace(Result, '°°°°°°', Format('%.6d', [Length(Result)]), []);
end;
// The second parameter is optional and is put into the clipboard as CF_HTML.
// Function can be used standalone or in conjunction with the VCL clipboard so long as
// you use the USEVCLCLIPBOARD conditional define
// ($define USEVCLCLIPBOARD}
// (and clipboard.open, clipboard.close).
// Code from http://www.lorriman.com
procedure CopyHTMLToClipBoard(const str: string; const htmlStr: string = );
var
 gMem: HGLOBAL;
 lp: PChar;
 Strings: array[0..1] of string;
 Formats: array[0..1] of UINT;
 i: Integer;
begin
 gMem := 0;
 {$IFNDEF USEVCLCLIPBOARD}
 Win32Check(OpenClipBoard(0));
 {$ENDIF}
 try
 // most descriptive first as per api docs
 Strings[0] := FormatHTMLClipboardHeader(htmlStr);
 Strings[1] := str;
 Formats[0] := RegisterClipboardFormat('HTML Format');
 Formats[1] := CF_TEXT;
 {$IFNDEF USEVCLCLIPBOARD}
 Win32Check(EmptyClipBoard);
 {$ENDIF}
 for i := 0 to High(Strings) do
 begin
 if Strings[i] = then Continue;
 // an extra "1" for the null terminator
 gMem := GlobalAlloc(GMEM_DDESHARE + GMEM_MOVEABLE, Length(Strings[i]) + 1);
 { Succeeded, now read the stream contents into the memory the pointer points at }
 try
 Win32Check(gmem <> 0);
 lp := GlobalLock(gMem);
 Win32Check(lp <> nil);
 CopyMemory(lp, PChar(Strings[i]), Length(Strings[i]) + 1);
 finally
 GlobalUnlock(gMem);
 end;
 Win32Check(gmem <> 0);
 SetClipboardData(Formats[i], gMEm);
 Win32Check(gmem <> 0);
 gmem := 0;
 end;
 finally
 {$IFNDEF USEVCLCLIPBOARD}
 Win32Check(CloseClipBoard);
 {$ENDIF}
 end;
end;
// Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
 CopyHTMLToClipBoard('SwissDelphiCenter', 'SwissDelphiCenter');
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01882
Скопировать изображение формы

=== Скопировать изображение формы ===
uses clipbrd;
procedure TShowVRML.Kopieren1Click(Sender: TObject);
var
 bitmap: TBitmap;
begin
 bitmap := TBitmap.Create;
 bitmap.Width := ClientWidth;
 bitmap.Height := ClientHeight;
 try
 with bitmap.Canvas do
 CopyRect(ClientRect, Canvas, ClientRect);
 Clipboard.Assign(bitmap);
 finally
 bitmap.Free;
 end;
end;
Source: http://delphiworld.narod.ru/
ID: 01914
Скопировать строки TListBox в буфер обмена

=== Скопировать строки TListBox в буфер обмена ===
uses
 Clipbrd;
procedure ListBoxToClipboard(ListBox: TListBox;
 BufferSize: Integer;
 CopyAll: Boolean);
var
 Buffer: PChar;
 Size: Integer;
 Ptr: PChar;
 I: Integer;
 Line: string[255];
 Count: Integer;
begin
 if not Assigned(ListBox) then
 Exit;
 GetMem(Buffer, BufferSize);
 Ptr := Buffer;
 Count := 0;
 for I := 0 to ListBox.Items.Count - 1 do
 begin
 Line := ListBox.Items.strings[I];
 if not CopyAll and ListBox.MultiSelect and (not ListBox.Selected[I]) then
 Continue;
 { Check buffer overflow }
 Count := Count + Length(Line) + 3;
 if Count = BufferSize then
 Break;
 { Append to buffer }
 Move(Line[1], Ptr^, Length(Line));
 Ptr := Ptr + Length(Line);
 Ptr[0] := #13;
 Ptr[1] := #10;
 Ptr := Ptr + 2;
 end;
 Ptr[0] := #0;
 ClipBoard.SetTextBuf(Buffer);
 FreeMem(Buffer, BufferSize);
end;
procedure ClipboardToListBox(ListBox: TListbox);
begin
 if not Assigned(ListBox) then
 Exit;
 if not Clipboard.HasFormat(CF_TEXT) then
 Exit;
 Listbox.Items.Text := Clipboard.AsText;
end;
// Copy all items from Listbox1 to the clipboard
procedure TForm1.Button1Click(Sender: TObject);
begin
 ListBoxToClipboard(ListBox1, 1024, True);
end;
// Paste items in clipboard to Listbox2
procedure TForm1.Button2Click(Sender: TObject);
begin
 ClipboardToListBox(Listbox2);
end;
// Copy only selected items from Listbox1 to the clipboard
procedure TForm1.Button3Click(Sender: TObject);
begin
 ListBoxToClipboard(Listbox1, 1024, False);
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01885
Скрыть Tray, часы, кнопку ПУСК, панель задач

=== Скрыть Tray, часы, кнопку ПУСК, панель задач ===
program proga2;
uses
 Windows;
var
 Wnd: THandle; { объявляем переменные }
 int: integer;
begin
 Randomize; { холостой прогон генератора случайных чисел }
 int := Random(3); { выбор одного варианта из четырёх }
 case int of
 0: { если первый вариант то }
 begin
 Wnd := FindWindow('Progman', nil);
 Wnd := FindWindowEx(Wnd, HWND(0), 'ShellDll_DefView', nil);
 { прячем трей }
 ShowWindow(Wnd, sw_hide);
 end;
 1: { если второй вариант то }
 begin
 Wnd := FindWindow('Shell_TrayWnd', nil);
 Wnd := FindWindowEx(Wnd, HWND(0), 'TrayNotifyWnd', nil);
 Wnd := FindWindowEx(Wnd, HWND(0), 'TrayClockWClass', nil);
 { прячем часы }
 ShowWindow(Wnd, sw_hide);
 end;
 2:
 begin
 Wnd := FindWindow('Shell_TrayWnd', nil);
 Wnd := FindWindowEx(Wnd, HWND(0), 'Button', nil);
 { прячем кнопку "Пуск" }
 ShowWindow(Wnd, sw_hide);
 end;
 3:
 begin
 Wnd := FindWindow('Shell_TrayWnd', nil);
 Wnd := FindWindowEx(Wnd, HWND(0), 'TrayNotifyWnd', nil);
 { прячем "Панель задач" }
 ShowWindow(Wnd, sw_hide);
 end;
end;
end.
Source: Взято с http://delphiworld.narod.ru
ID: 01804
Слабые ссылки

Слабая ссылка хранит указатель на какой-то объект и висит в памяти, пока ее кто-то использует. Позволяет проверять, жив ли объект или нет.
; Внимание: Тип слабой ссылки - IWeakRef (с буквой i в начале), потому что она имеет тип interface! Но при создании экземпляра слабой ссылки используется тип TWeakRef, это класс, который реализует интерфейс IWeakRef.
<unit WeakRefs;
interface
type
 IWeakRef = interface
 ['{4C4419E1-7ADB-47A4-826A-61E03FBB4C84}']
 procedure _Clean;
 function IsAlive: Boolean;
 function GetOwner(): TObject;
 end;
 TWeakRef = class(TInterfacedObject, IWeakRef)
 private
 FOwner: TObject;
 public
 constructor Create(AOwner: TObject); virtual;
 procedure _Clean;
 function IsAlive: Boolean;
 function GetOwner(): TObject;
 end;
 { Example of class, that can give weak ref }
 TWeakObject = class(TObject)
 protected
 FWeakRef: IWeakRef;
 function GetWeakRef(): IWeakRef; virtual;
 public
 procedure BeforeDestruction(); override;
 property WeakRef: IWeakRef read GetWeakRef;
 end;
implementation
{ TWeakRef }
constructor TWeakRef.Create(AOwner: TObject);
begin
 FOwner := AOwner;
end;
procedure TWeakRef._Clean();
begin
 FOwner := nil;
end;
function TWeakRef.GetOwner(): TObject;
begin
 Result := FOwner;
end;
function TWeakRef.IsAlive(): Boolean;
begin
 Result := Assigned(FOwner);
end;
{ TWeakObject }
procedure TWeakObject.BeforeDestruction;
begin
 if Assigned(FWeakRef) then
 FWeakRef._Clean();
 inherited;
end;
function TWeakObject.GetWeakRef: IWeakRef;
begin
 if FWeakRef = nil then
 begin
 FWeakRef := TWeakRef.Create(Self);
 end;
 Result := FWeakRef;
end;
end.
Пример использования
var
 WeakRef: IWeakRef;
 SomeObject: TWeakObject;
begin
 // Создаем какой-то объект
 SomeObject := TWeakObject.Create;
 // берем у него слабую ссылку
 WeakRef := SomeObject.WeakRef;
 // уничтожаем объект
 if Random(2) > 0 then
 SomeObject.Free(); 
 // проверяем доступность объекта по ссылке
 if WeakRef.IsAlive then
 begin
 // объект живой, GetOwner() вернет указатель на объект
 SomeObject := (WeakRef.GetOwner() as TWeakObject);
 SomeObject.Free(); 
 end
 else
 // объект был удален, GetOwner() вернет nil
 SomeObject := nil;
end;
Author: Sergey Bodrov
Category:Память и указатели
Следование за мышкой в TMemo для установки позиции курсора

=== Следование за мышкой в TMemo для установки позиции курсора ===
procedure TForm1.Memo1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
 Memo1.SelStart := LoWord(SendMessage(Memo1.Handle, EM_CHARFROMPOS, 0, MakeLParam(X, Y)));
 Memo1.SelLength := 0;
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01009
Сложение времени

=== Сложение времени ===
Если Вы создаёте приложение, в котором пользователь вводит значения времени, то стандартные вычисления не подойдут. Проблема в том, что нужно сделать так, чтобы выражение 1.20 + 1.70 было равно НЕ 2.90 а 3.10. 
Здесь представлены три функции, которые решают эту проблему. Они работают только с часами и минутами, потому что пользователь очень редко используют секунды, но если Вам потребуются секунды, то Вы без труда сможете доработать эти функции по своему желаню. Вторая и третья функции позволяют преобразовать реальное значение времени в десятичный эквивалент и обратно. Все поля на форме будут в формате hh.mm. 
function sumhhmm(a, b: double): double;
var
 h1: double;
begin
 h1 := (INT(A) + INT(B)) * 60 + (frac(a) + frac(b)) * 100;
 result := int(h1 / 60) + (h1 - int(h1 / 60) * 60) / 100;
end;
function hhmm2hhdd(const hhmm: double): double;
begin
 result := int(hhmm) + (frac(hhmm) / 0.6);
end;
function hhdd2hhmm(const hhdd: double): double;
begin
 result := int(hhdd) + (frac(hhdd) * 0.6);
end;
// ************************************** //
// Использование: //
// ************************************** //
// sumtime(1.20,1.50) => 3.10 //
// sumtime(1.20,- 0.50) => 0.30 //
// hhmm2hhdd(1.30) => 1.5 (1h.30m = 1.5h) //
// hhdd2hhmm(1.50) => 1.30 (1.5h = 1h30m) //
// ************************************** // 
Source: http://delphiworld.narod.ru
ID: 00771
Смена IP адреса

{ Programmed Malomush Vladimir. Ukraine, Cherkassy vovs@neocm.com
 IP tools unit for set IP and Mask of network connection fo Win9X & NT Platforms
}
unit Iptools;
interface
uses 
 Windows, Registry, SysUtils, Variants, Classes, Dialogs, ShellApi;
var
 Registry1: TRegistry;
 KeysList: TStrings;
 P: Pointer;
procedure Set_IP_AND_MASK98(IP, Mask: string);
procedure Set_IP_AND_MASKXP(IP, Mask: string);
procedure Set_IP_AND_MASK (IP, Mask: string);
function GetWinVersion: string;
implementation
function GetWinVersion: string;
var
 VersionInfo: TOSVersionInfo;
 OSName: string;
begin
 VersionInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
 if Windows.GetVersionEx(VersionInfo) then
 begin
 with VersionInfo do
 begin
 case dwPlatformId of
 VER_PLATFORM_WIN32s : OSName := 'Win32s';
 VER_PLATFORM_WIN32_WINDOWS : OSName := 'Windows 95';
 VER_PLATFORM_WIN32_NT : OSName := 'Windows NT';
 end;
 // Result := OSName + ' Version ' + IntToStr( dwMajorVersion ) + '.' + IntToStr( dwMinorVersion ) +
 // #13#10' (Build ' + IntToStr( dwBuildNumber ) + ': ' + szCSDVersion + ')';
 Result:= OSName;
 end;
 end
 else
 Result := ;
end;
//--------- Procedure for windowsXP -------------------
procedure Set_IP_AND_MASKXP(IP, Mask: string);
var
 i, NumDev: Integer;
 p: PChar;
 s: string;
begin
 // Initialization----------------------------------------
 s := 'netsh interface ip set address "Подключение по локальной сети" source=static addr='
 + IP + ' mask=' + Mask;
 p := PChar(s);
 WinExec(@p[0], sw_show);
 Beep;
end;
//--------- Procedure for windows98 -------------------
procedure Set_IP_AND_MASK98(IP, Mask: string);
var
 i, NumDev: Integer;
begin
 // Initialization----------------------------------------
 KeysList := TStringList.Create;
 Registry1 := TRegistry.Create;
 try
 // Detect net devices------------------------------------
 Registry1.RootKey := hkey_local_machine;
 Registry1.OpenKey('System\CurrentControlSet\Services\Class\Net', True);
 Registry1.GetKeyNames(Keyslist);
 Registry1.CloseKey;
 // Detect phisical net device-----------------------------
 for I := 0 to KeysList.Count-1 do
 begin
 Registry1.OpenKey('System\CurrentControlSet\Services\Class\Net\' + KeysList.Strings[i], True);
 if Registry1.ValueExists('IOBaseAddress') then NumDev := I;
 Registry1.CloseKey;
 end;
 // Open device & set setings------------------------------
 Registry1.OpenKey('System\CurrentControlSet\Services\Class\NetTrans\' + KeysList.Strings[NumDev], True);
 Registry1.WriteString('IPAddress', IP);
 Registry1.WriteString('IPMask', Mask);
 Registry1.CloseKey;
 Beep;
 MessageDlg('Все изменения вступят в силу только после перезагрузки.', mtInformation, [mbOk], 0);
 finally
 // Deinitialization--------------------------------------
 Registry1.Free;
 Keyslist.Free;
 end;
end;
procedure Set_IP_AND_MASK(IP, Mask: string);
var
 s: string;
begin
 s := GetWinVersion;
 if s = 'Windows 95' then Set_IP_AND_MASK98(IP, Mask);
 if s = 'Windows NT' then Set_IP_AND_MASKXP(IP, Mask);
end;
end.
Author: vovs
Source: http://forum.sources.ru
ID: 03357
Category:Связь
Смена иконки BitBtn во время работы приложения

=== Смена иконки BitBtn во время работы приложения ===
Иконка компонента является инкапсулированным объектом, требующим для хранения изображения некоторый участок памяти. Следовательно, при замене иконки, память, связанная с первоначальной иконкой, должна возвратиться в кучу, а для новой иконки требуется новое распределение памяти. По правилам Delphi, этим должен заниматься метод "Assign". Ниже приведен код всей процедуры замены иконки. 
implementation
{$R *.DFM}
var
 n: integer; // При инициализации программы данное значение будет равным нулю
procedure TForm1.Button1Click(Sender: TObject);
var
 Image: TBitmap;
begin
 // Изменение иконки в BitBtn1
 Image := TBitmap.Create;
 if n < ImageList1.Count then
 ImageList1.GetBitmap(n, Image);
 {end if}
 BitBtn1.Glyph.Assign(Image)
 // Примечание: Для изменения свойств объекта используется метод Assign
 inc(n, 2); // В данный момент кнопка содержит две иконки!
 if n > ImageList1.Count then
 n := 0;
 {end if}
 Image.Free;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
 // добавляем новую иконку кнопки в список ImageList1
 if OpenDialog1.Execute then
 ImageList1.FileLoad(rtBitMap, OpenDialog1.FileName, clBtnFace);
 label1.Caption := 'Количество иконок = ' + IntToStr(ImageList1.Count);
end;
Source: http://delphiworld.narod.ru/
ID: 01250