nyuuzyou/wikis huggingface dataset:
Как получить список всех зарегистрированных typelibs?

uses
 Registry;
procedure EnumTypeLibs(TypeLibNames: TStrings);
var
 f: TRegistry;
 keyNames, keyVersions, keyInfos: TStringList;
 keyName, keyVersion, keyInfo, tlName: string;
 i, j, k: Integer;
begin
 TypeLibNames.Clear;
 keyNames := nil;
 keyVersions := nil;
 keyInfos := nil;
 f := TRegistry.Create;
 keyNames := TStringList.Create;
 keyVersions := TStringList.Create;
 keyInfos := TStringList.Create;
 try
 f.RootKey := HKEY_CLASSES_ROOT;
 if not f.OpenKey('TypeLib', False) then raise
 Exception.Create('TRegistry.Open');
 f.GetKeyNames(keyNames);
 f.CloseKey;
 for i := 0 to keyNames.Count - 1 do
 begin
 keyName := keyNames.Strings[i];
 if not f.OpenKey(Format('TypeLib\%s', [keyName]), False) then Continue;
 f.GetKeyNames(keyVersions);
 f.CloseKey;
 for j := 0 to keyVersions.Count - 1 do
 begin
 keyVersion := keyVersions.Strings[j];
 if not f.OpenKey(Format('TypeLib\%s\%s', [keyName, keyVersion]), False) then
 Continue;
 tlName := f.ReadString();
 f.GetKeyNames(keyInfos);
 f.CloseKey;
 {$B-}
 for k := 0 to keyInfos.Count - 1 do
 begin
 keyInfo := keyInfos.Strings[k];
 if (keyInfo = ) or (keyInfo[1] < '0') or (keyInfo[1] > '9') then Continue;
 if not f.OpenKey(Format('TypeLib\%s\%s\%s\win32', [keyName, keyVersion,
 keyInfo]), False) then Continue;
 f.CloseKey;
 TypeLibNames.Add(Format('%s ver.%s', [tlName, keyVersion]));
 end;
 {$B+}
 end;
 end;
 finally
 f.Free;
 keyNames.Free;
 keyVersions.Free;
 keyInfos.Free;
 end;
end;
// Example Call:
procedure TForm1.Button1Click(Sender: TObject);
begin
 EnumTypeLibs(ListBox1.Items);
end;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 04325
Category:COM
Как получить список всех назначенных событий?

=== Как получить список всех назначенных событий? ===
uses TypInfo;
{ .... }
procedure TForm1.Button1Click(Sender: TObject);
var 
 x, y, z: Word;
 pl: PPropList;
begin
 y := GetPropList(Self, pl);
 for x := 0 to y - 1 do
 begin
 if Copy(pl[x].Name, 1, 2) <> 'On' then Continue;
 if GetMethodProp(Self, pl[x].Name).Code <> nil then
 Memo1.Lines.Add(Self.Name + ' - ' + pl[x].Name);
 end;
 for z := 0 to Self.ComponentCount - 1 do
 begin
 y := GetPropList(Self.Components[z], pl);
 for x := 0 to y - 1 do
 begin
 if Copy(pl[x].Name, 1, 2) <> 'On' then Continue;
 if GetMethodProp(Self.Components[z], pl[x].Name).Code <> nil then
 Memo1.Lines.Add(Self.Components[z].Name + ' - ' + pl[x].Name);
 end;
 end;
end;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 00124
Как получить список загруженных драйверов?

=== Как получить список загруженных драйверов? ===
{
 This code takes advantage of the undocumented NtQuerySystemInformation
 API to obtain a list of loaded drivers under Windows NT.
}
const
 DRIVER_INFORMATION = 11;
type
 TPDWord = ^DWORD;
 TDriverInfo = packed record
 Address: Pointer;
 Unknown1: DWORD;
 Unknown2: DWORD;
 EntryIndex: DWORD;
 Unknown4: DWORD;
 Name: array [0..MAX_PATH + 3] of Char;
 end;
var
 NtQuerySystemInformation: function (infoClass: DWORD;
 buffer: Pointer;
 bufSize: DWORD;
 returnSize: TPDword): DWORD; stdcall = nil;
function GetDriverInfo: string;
var
 temp, Index, numBytes, numEntries: DWORD;
 buf: TPDword;
 driverInfo: ^TDriverInfo;
begin
 if @NtQuerySystemInformation = nil then
 NtQuerySystemInformation := GetProcAddress(GetModuleHandle('ntdll.dll'),
 'NtQuerySystemInformation');
 // Obtain required buffer size
 NtQuerySystemInformation(DRIVER_INFORMATION, @temp, 0, @numBytes);
 // Allocate buffer
 buf := AllocMem(numBytes * 2);
 NtQuerySystemInformation(DRIVER_INFORMATION, buf, numBytes * 2, @numBytes);
 numEntries := buf^;
 driverInfo := Pointer(DWORD(buf) + 12);
 Result := ;
 for Index := 1 to numEntries do
 begin
 Result := Result + #$D#$A + 'Address: $' + IntToHex(DWORD(driverInfo^.Address), 8) +
 'Name: "' + (driverInfo^.Name) + '"';
 Inc(driverInfo);
 end;
 Delete(Result, 1, 2);
 FreeMem(buf);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 ListBox1.Items.Add(GetDriverInfo)
end;
// Thanks to Madshi for helping me translate from C++ Code
// Original Code (C++) :
// NtDriverList v1.0
// Copyright 1998, 1999 Yariv Kaplan
// WWW.INTERNALS.COM
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php 
ID: 02232
Как получить список инсталлированных програм?

uses
 Registry;
procedure TForm1.Button1Click(Sender: TObject);
const
 UNINST_PATH = 'SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall';
var
 Reg: TRegistry;
 SubKeys: TStringList;
 ListItem: TlistItem;
 i: Integer;
 sDisplayName, sUninstallString: string;
begin
{
 ListView1.ViewStyle := vsReport;
 ListView1.Columns.Add;
 ListView1.Columns.Add;
 ListView1.Columns[0].Caption := 'DisplayName';
 ListView1.Columns[1].Caption := 'UninstallString';
 ListView1.Columns[0].Width := 300;
 ListView1.Columns[1].Width := 300;
}
 Reg := TRegistry.Create;
 with Reg do
 try
 with ListView1.Items do
 try
 BeginUpdate;
 Clear;
 RootKey := HKEY_LOCAL_MACHINE;
 if OpenKeyReadOnly(UNINST_PATH) then
 begin
 SubKeys := TStringList.Create;
 try
 GetKeyNames(SubKeys);
 CloseKey;
 for i := 0 to subKeys.Count - 1 do
 if OpenKeyReadOnly(Format('%s\%s', [UNINST_PATH, SubKeys[i]])) then
 try
 sDisplayName := ReadString('DisplayName');
 sUninstallString := ReadString('UninstallString');
 if sDisplayName <> then
 begin
 ListItem := Add;
 ListItem.Caption := sDisplayName;
 ListItem.subitems.Add(sUninstallString);
 end;
 finally
 CloseKey;
 end;
 finally
 SubKeys.Free;
 end;
 end;
 finally
 ListView1.AlphaSort;
 EndUpdate;
 end;
 finally
 CloseKey;
 Free;
 end;
end;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 04534
Category:Разработка приложений
Как получить список папок Outlook?

uses
 ComObj;
procedure RetrieveOutlookFolders(tvFolders: TTreeView);
 procedure LoadFolder(ParentNode: TTreeNode; Folder: OleVariant);
 var
 i: Integer;
 Node: TTreeNode;
 begin
 for i := 1 to Folder.Count do
 begin
 Node := tvFolders.Items.AddChild(ParentNode, Folder.Item[i].Name);
 LoadFolder(Node, Folder.Item[i].Folders);
 end;
 end;
var
 outlook, NameSpace: OLEVariant;
begin
 outlook := CreateOleObject('Outlook.Application');
 NameSpace := outlook.GetNameSpace('MAPI');
 LoadFolder(nil, NameSpace.Folders);
 outlook := Unassigned;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 RetrieveOutlookFolders(TreeView1);
end;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 04441
Category:COM
Category:MS Office
Как получить список процессов?

=== Как получить список процессов? ===
Эта функция возвращает результат: запущено ли приложение, переданное ей в качестве параметра. Функция просматривает список всех процессов и делает вывод.
function IsRunning(sName: string): Boolean; 
var 
 han: THandle; 
 ProcStruct: PROCESSENTRY32; // from "tlhelp32" in uses clause 
 sID: string; 
begin 
 Result := False; 
 // Get a snapshot of the system 
 han := CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0); 
 if han = 0 then 
 exit; 
 // Loop thru the processes until we find it or hit the end 
 ProcStruct.dwSize := SizeOf(PROCESSENTRY32); 
 if Process32First(han, ProcStruct) then 
 begin 
 repeat 
 sID := ExtractFileName(ProcStruct.szExeFile); 
 // Check only against the portion of the name supplied, ignoring case 
 if UpperCase(Copy(sId, 1, Length(sName))) = UpperCase(sName) then 
 begin 
 // Report we found it 
 Result := True; 
 Break; 
 end; 
 until not Process32Next(han, ProcStruct); 
 end; 
 // clean-up 
 CloseHandle(han); 
end;
Author: Song
Source: Взято из http://forum.sources.ru
ID: 02045
Как получить список таблиц Interbase?

=== Как получить список таблиц? ===
Список таблиц пользователя можно получить запросом системной таблицы rdb$relations.
Пример, демонстрирующий как это сделать - вставляет отсортированные по алфавиту имена таблиц в список TListBox (lbSourceTables).
begin
 ibcSourceList.SQL.Clear;
 ibcSourceList.SQL.Add('SELECT rdb$relation_name FROM rdb$relations');
 ibcSourceList.SQL.Add('WHERE rdb$system_flag = 0');
 ibcSourceList.SQL.Add('ORDER BY rdb$relation_name');
 ibcSourceList.Open;
 while not ibcSourceList.Eof do
 begin
 lbSourceTables.Items.Add(ibcSourceList.Fields[0].AsString);
 ibcSourceList.Next;
 end;
 ibcSourceList.Close;
end;
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 02906
Category:Базы данных
Category:Interbase
Как получить список таблиц в базе Access?

=== Как получить список таблиц в базе Access? ===
var
 t: TStringList;
begin
 ADOConnection.GetTableNames(t, False);
end;
Author: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)
ID: 02760
Как получить список установленных модемов в Win95/98?

=== Как получить список установленных модемов в Win95/98? ===
unit PortInfo;
interface
uses Windows, SysUtils, Classes, Registry;
function EnumModems: TStrings;
implementation
function EnumModems: TStrings;
var
 R: TRegistry;
 s: ShortString;
 N: TStringList;
 i: integer;
 j: integer;
begin
 Result := TStringList.Create;
 R := TRegistry.Create;
 try
 with R do
 begin
 RootKey := HKEY_LOCAL_MACHINE;
 if OpenKey('\System\CurrentControlSet\Services\Class\Modem', False) then
 begin
 if HasSubKeys then
 begin
 N := TStringList.Create;
 try
 GetKeyNames(N);
 for i := 0 to N.Count - 1 do
 begin
 CloseKey; { + }
 OpenKey('\System\CurrentControlSet\Services\Class\Modem', False); { + }
 OpenKey(N[i], False);
 s := ReadString('AttachedTo');
 for j := 1 to 4 do
 if Pos(Chr(j + Ord('0')), s) > 0 then
 Break;
 Result.AddObject(ReadString('DriverDesc'), TObject(j));
 CloseKey;
 end;
 finally
 N.Free;
 end;
 end;
 end;
 end;
 finally
 R.Free;
 end;
end;
end.
Source: Взято с сайта http://blackman.wp-club.net/
ID: 01465
Как получить список часовых поясов?

=== Как получить список часовых поясов? ===
uses
 Registry;
implementation
var
 reg: TRegistry;
 ts: TStrings;
 i: integer;
begin
 reg := TRegistry.Create;
 reg.RootKey := HKEY_LOCAL_MACHINE;
 reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Time Zones', false);
 if reg.HasSubKeys then
 begin
 ts := TStringList.Create;
 reg.GetKeyNames(ts);
 reg.CloseKey;
 for i := 0 to ts.Count -1 do
 begin
 reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Time Zones\' + ts.Strings[i], false);
 Memo1.Lines.Add(ts.Strings[i]);
 Memo1.Lines.Add(reg.ReadString('Display'));
 Memo1.Lines.Add(reg.ReadString('Std'));
 Memo1.Lines.Add(reg.ReadString('Dlt'));
 Memo1.Lines.Add('----------------------');
 reg.CloseKey;
 end;
 ts.Free;
 end
 else
 reg.CloseKey;
 reg.free;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 01635
Как получить средний цвет между двумя цветами?

function GetColorBetween(StartColor, EndColor: TColor; Pointvalue, Von, Bis: Extended): TColor;
var
 F: Extended;
 r1, r2, r3, g1, g2, g3, b1, b2, b3: Byte;
 function CalcColorBytes(fb1, fb2: Byte): Byte;
 begin
 Result := fb1;
 if fb1 < fb2 then
 Result := FB1 + Trunc(F * (fb2 - fb1));
 if fb1 > fb2 then
 Result := FB1 - Trunc(F * (fb1 - fb2));
 end;
begin
 if Pointvalue <= Von then
 begin
 Result := StartColor;
 exit;
 end;
 if Pointvalue >= Bis then
 begin
 Result := EndColor;
 exit;
 end;
 F := (Pointvalue - von) / (Bis - Von);
 asm
 mov EAX, Startcolor
 cmp EAX, EndColor
 je @@exit
 mov r1, AL
 shr EAX,8
 mov g1, AL
 shr Eax,8
 mov b1, AL
 mov Eax, Endcolor
 mov r2, AL
 shr EAX,8
 mov g2, AL
 shr EAX,8
 mov b2, AL
 push ebp
 mov al, r1
 mov dl, r2
 call CalcColorBytes
 pop ecx
 push ebp
 Mov r3, al
 mov dL, g2
 mov al, g1
 call CalcColorBytes
 pop ecx
 push ebp
 mov g3, Al
 mov dL, B2
 mov Al, B1
 call CalcColorBytes
 pop ecx
 mov b3, al
 XOR EAX,EAX
 mov AL, B3
 SHL EAX,8
 mov AL, G3
 SHL EAX,8
 mov AL, R3
 @@Exit:
 mov @result, eax
 end;
end;
ID: 03691
----
//------------------------------------------------------------------------------
// Function for getting mixed color from two given colors, with a relative
// distance from two colors determined by Position value inside
// MinPosition..MaxPosition range
// Author: Dmitri Papichev (c) 2001
// License type: Freeware
//------------------------------------------------------------------------------
function GetMixedColor(const StartColor,
 EndColor: TColor;
 const MinPosition,
 Position,
 MaxPosition: Integer): TColor;
var
 Fraction: Double;
 R, G, B,
 R0, G0, B0,
 R1, G1, B1: Byte;
begin
 { process Position out of range situation }
 if (MaxPosition < MinPosition) then
 begin
 raise Exception.Create
 ('GetMixedColor: MaxPosition is less then MinPosition');
 end;
 { if Position is outside MinPosition..MaxPosition range, the closest boundary
 is effectively substituted through the adjustment of Fraction }
 Fraction := Min(1, Max(0, (Position - MinPosition) / (MaxPosition - MinPosition)));
 { extract the intensity values }
 R0 := GetRValue(StartColor);
 G0 := GetGValue(StartColor);
 B0 := GetBValue(StartColor);
 R1 := GetRValue(EndColor);
 G1 := GetGValue(EndColor);
 B1 := GetBValue(EndColor);
 { calculate the resulting intensity values }
 R := R0 + Round((R1 - R0) * Fraction);
 G := G0 + Round((G1 - G0) * Fraction);
 B := B0 + Round((B1 - B0) * Fraction);
 { combine intensities in a resulting color }
 Result := RGB(R, G, B);
end;
Source: http://www.baltsoft.com/
ID: 03692
Category:Графика
Category:Цвета и палитры
Как получить статус принтера?

function TestPrinterStatus(LPTPort: Word): Byte;
var
 Status: byte;
 CheckLPT: word;
begin
 Status := 0;
 if (LPTPort >= 1) and (LPTPort <= 3) then
 begin
 CheckLPT := LPTPort - 1;
 asm
 mov dx, CheckLPT;
 mov al, 0;
 mov ah, 2;
 int 17h;
 mov &Status, ah;
 end;
 end;
 Result := Status;
end;
{
 Pass in the LPT port number you want to check & get the following back:
 01h - Timeout
 08h - I/O Error
 10h - Printer selected
 20h - Out of paper
 40h - Printer acknowledgement
 80h - Printer not busy (0 if busy)
 Note:
 This function doesn't work under NT, it gives an access violation
 from the DOS interrupt call.
}
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 03199
Category:Принтер
Как получить строковое значение перечисляемого типа?

=== Как получить строковое значение перечисляемого типа? ===
procedure GetEnumNameList(Pti: PTypeInfo; AList: 
 TStrings; X: Integer);
{(**********************************************************
 Will return in AList string version of an 
enumerated type less the first X characters .
 eg X = 4
 and
 type
 eXORBuySell = (
 XOR_BUY,
 XOR_SELL
 );
 GetEnumNameList(TypeInfo(eXORBuySell), ComboBox1.Items, 4);
 Now ComboBox1.Items[0] = 'BUY'
 and ComboBox1.Items[1] = 'SELL'
************************************************************)}
var
 I: Integer;
begin
 AList.Clear;
 with GetTypeData(pti)^ do
 for I := MinValue to MaxValue do
 AList.Add(Copy(GetEnumName(pti, I), X + 1, 255));
end;
Source: Взято с сайта http://www.torry.net
ID: 00285
Как получить строковый путь узла TTreeView?

=== Как получить строковый путь узла TTreeView? ===
{*--------------------------------------------- 
 Parent Text 
 ---------------------------------------------*} 
function SrNodeTree(pTreeNode: TTreeNode; var sRuta: string): string; 
begin 
 sRuta := pTreeNode.Text + ' > ' + sRuta; 
 if pTreeNode.Level = 0 then Result := sRuta 
 else 
 Result := SrNodeTree(pTreeNode.Parent, sRuta); 
end; 
{*--------------------------------------------- 
 Click an Item 
 ---------------------------------------------*} 
procedure TForm1.TreeView1Click(Sender: TObject); 
var 
 sPath: string; 
begin 
 Label1.Caption := SrNodeTree(TreeView1.Selected, sPath); 
end; 
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 00627
----
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Получение пути заголовков к узлу в TreeView
Функция выдает путь к указанному узлу (к ноде) в TreeView
в виде строки заголовков узлов, разделенных символом Separator.
Зависимости: ComCtrls
Copyright: Собственное написание (lipskiy)
Дата: 02 мая 2002 г.
***************************************************** }
function GetPathToNode(Node: TTreeNode; Separator: Char): string;
begin
 Result := ;
 if Node = nil then
 exit;
 while Node <> nil do
 begin
 Result := Node.Text + Separator + Result;
 Node := Node.Parent;
 end;
 Delete(Result, Length(Result), 1);
end;
Source: http://delphibase.endimus.com
ID: 01119
Как получить текст HTML Документа из TWebBrowser без тегов

uses mshtml, activex;
procedure GetHtmlCode(WebBrowser: TWebBrowser; FileName: string);
var
 htmlDoc: IHtmlDocument2;
 PersistFile: IPersistFile;
begin
 htmlDoc := WebBrowser.document as IHtmlDocument2;
 PersistFile := HTMLDoc as IPersistFile;
 PersistFile.Save(StringToOleStr(FileName), True);
end;
Source: http://delphiworld.narod.ru
ID: 03496
----
var
 Document: IHTMLDocument2;
begin
 Document := WB.Document as IHtmlDocument2;
 if Document <> nil then
 Memo1.Text := (Document.all.Item(NULL, 0) as IHTMLElement).OuterHTML;
Source: http://delphiworld.narod.ru
ID: 03497
Category:Связь
Category:WebBrowser
Как получить текущее время?

=== Как получить текущее время? ===
InterBase поддерживает четыре строковые константы для DATE.
* 'today' - сегодня
* 'yesterday' - вчера
* 'tomorrow' - завтра
* 'now' - сейчас
Используйте их с приведением к типу DATE как на примере ниже.
insert into mytable values(cast('now' as DATE), 'Test')
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 02905
Category:Базы данных
Category:Interbase
Как получить текущую дату?

=== Как получить текущую дату? ===
// make the SQL dependent on type of DBMS
if AppLibrary.Database.DriverName = 'ORACLE' then
 SQL.Add('and entry_date < SYSDATE')
else
 SQL.Add('and entry_date < "TODAY"');
end;
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 02729
Как получить тип файла?

=== Как получить тип файла? ===
uses
 ShellAPI;
function MrsGetFileType(const strFilename: string): string;
var
 FileInfo: TSHFileInfo;
begin
 FillChar(FileInfo, SizeOf(FileInfo), #0);
 SHGetFileInfo(PChar(strFilename), 0, FileInfo, SizeOf(FileInfo), SHGFI_TYPENAME);
 Result := FileInfo.szTypeName;
end;
// Beispiel:
// Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
 ShowMessage('File type is: ' + MrsGetFileType('c:\autoexec.bat'));
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 03145
Category:Файловая система
Как получить цвет строки в HTML формате

Если Вам необходимо создать HTML-файл, то необходимо объявить тэг для цвета шрифта либо цвета фона. Однако просто вставить значение TColor не получится - необходимо преобразовать цвет в формат RGB. В своём наборе SMExport я использую следующую функцию:
function GetHTMLColor(cl: TColor; IsBackColor: Boolean): string;
var
 rgbColor: TColorRef;
begin
 if IsBackColor then
 Result := 'bg'
 else
 Result := ;
 rgbColor := ColorToRGB(cl);
 Result := Result + 'color="#' +
 Format('%.2x%.2x%.2x',
 [GetRValue(rgbColor),
 GetGValue(rgbColor),
 GetBValue(rgbColor)]) + '"';
end;
Source: http://forum.sources.ru
ID: 03535
== См. также ==
* Как преобразовать шестнадцатиричный цвет HTML в TColor
Category:Графика
Category:Цвета и палитры
Category:Web
Как получить цвет строки в HTML формате?

Если Вам необходимо создать HTML-файл, то необходимо объявить тэг для цвета шрифта либо цвета фона. Однако просто вставить значение TColor не получится - необходимо преобразовать цвет в формат RGB. В своём наборе SMExport я использую следующую функцию:
function GetHTMLColor(cl: TColor; IsBackColor: Boolean): string;
var
 rgbColor: TColorRef;
begin
 if IsBackColor then
 Result := 'bg'
 else
 Result := ;
 rgbColor := ColorToRGB(cl);
 Result := Result + 'color="#' + Format('%.2x%.2x%.2x',
 [GetRValue(rgbColor), GetGValue(rgbColor), GetBValue(rgbColor)]) + '"';
end;
Source: http://forum.sources.ru
ID: 03535
ID: 03538
Category:Связь
Category:Web
Как получить часть GUID?

=== Как получить часть GUID? ===
{ You maybe have to access just a part of a GUID. }
{ Const for the function Format(...) }
const
 fsGUID: string = 'D1: $%s'#13#10'D2: $%s'#13#10'D3: $%s'#13#10 +
 'D4: $%s $%s $%s $%s $%s $%s $%s $%s';
 fsGUIDParts: string = 'D%d:%s';
 // Type for the GUID part to be shown
type
 TGUIDPART = (guidp_NoFormat, guidp_All, guidp_D1,
 guidp_D2, guidp_D3, guidp_D4);
{ This GUIDToStringEx function give you the full GUID string
 according with then format string FStr (you can change it !!!) }
function GUIDToStringEx(Guid: TGuid; FStr: string): string; overload;
begin
 Result := Format(FStr,
 [IntToHex(GUID.D1, 8),
 IntToHex(GUID.D2, 4),
 IntToHex(GUID.D3, 4),
 IntToHex(GUID.D4[0], 2),
 IntToHex(GUID.D4[1], 2),
 IntToHex(GUID.D4[2], 2),
 IntToHex(GUID.D4[3], 2),
 IntToHex(GUID.D4[4], 2),
 IntToHex(GUID.D4[5], 2),
 IntToHex(GUID.D4[6], 2),
 IntToHex(GUID.D4[7], 2)
 ]);
end;
{ This GUIDToStringEx function give you the part of the GUID
 to be shown, according to the part type GUIDPart }
function GUIDToStringEx(Guid: TGuid; Part: TGUIDPART): string; overload;
var
 i: Integer;
 S: string;
begin
 S := ;
 case Part of
 guidp_NoFormat: S := GUIDToString(Guid);
 guidp_All: S := GUIDToStringEx(Guid, fsGUID);
 guidp_D1: S := Format(fsGUIDParts, [1, ' $' + IntToHex(GUID.D1, 8)]);
 guidp_D2: S := Format(fsGUIDParts, [2, ' $' + IntToHex(GUID.D2, 4)]);
 guidp_D3: S := Format(fsGUIDParts, [3, ' $' + IntToHex(GUID.D3, 4)]);
 guidp_D4: 
 begin
 for i := 0 to 7 do S := S + ' $' + IntToHex(GUID.D4[i], 2);
 S := Format(fsGUIDParts, [4, S]);
 end;
 else 
 S := '?';
 end;
 Result := S;
end;
{ How to use the different GUIDToStringEx functions }
procedure TForm1.Button1Click(Sender: TObject);
var
 NewGUID: TGUID;
begin
 { Create a new GUID }
 NewGUID := StringToGUID(CreateClassID);
 { Standard formated GUID string }
 label1.Caption := GUIDToStringEx(NewGUID, guidp_NoFormat) +
 #13#10 +
 { Full formated GUID string acc. with fsGUID}
 GUIDToStringEx(NewGUID, fsGUID) +
 #13#10 +
 { Full formated GUID string with default formating}
 GUIDToStringEx(NewGUID, guidp_All) +
 #13#10 +
 { Part D3 of the GUID only }
 GUIDToStringEx(NewGUID, guidp_D3);
end;
Vit - обычно достаточно использовать API функцию CoCreateGuid
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 00080
Как получить число и список всех компонентов, расположенных на TNoteBook?

=== Как получить число и список всех компонентов, расположенных на TNoteBook? ===
procedure TForm1.Button1Click(Sender: TObject);
var
 n: integer;
 p: integer;
begin
 ListBox1.Clear;
 with Notebook1 do
 begin
 for n := 0 to ControlCount - 1 do
 begin
 with TPage(Controls[n]) do
 begin
 ListBox1.Items.Add('Notebook Page: ' + TPage(Notebook1.Controls[n]).Caption);
 for p := 0 to ControlCount - 1 do
 ListBox1.Items.Add(Controls[p].Name);
 ListBox1.Items.Add(EmptyStr);
 end;
 end;
 end;
end;
ID: 01165
----
Вот две малениких процедурки, присваивающие заголовкам всех компонентов Label на всех страницах компонента NoteBook значение 'Foo'. (Я вам не говорил, что это будет ПОЛЕЗНЫМ примером!)
procedure TForm1.Button1Click(Sender: TObject);
var
 M, N: Word;
begin
 for N := 0 to TabbedNotebook1.Pages.Count - 1 do
 with TabbedNotebook1.pages.Objects[N] as TTabPage do
 for M := 0 to ControlCount - 1 do
 if Controls[M] is TLabel then
 with Controls[M] as TLabel do
 Caption := 'Foo';
end;
procedure TForm1.TabSet1Change(Sender: TObject; NewTab: Integer;
 var AllowChange: Boolean);
begin
 Notebook1.PageIndex := TabSet1.TabIndex;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
 M, N: Word;
begin
 for N := 0 to TabbedNotebook1.Pages.Count - 1 do
 with Notebook1.pages.Objects[N] as TPage do
 for M := 0 to ControlCount - 1 do
 if Controls[M] is TLabel then
 with Controls[M] as TLabel do
 Caption := 'Foo';
end; 
Source: http://delphiworld.narod.ru/
ID: 01175