nyuuzyou/wikis huggingface dataset:
Показывать значки элементов списка в TRichEdit

=== Показывать значки элементов списка в TRichEdit ===
uses
 RichEdit;
procedure TForm1.Button1Click(Sender: TObject);
var
 fmt: TParaformat2;
begin
 FillChar(fmt, SizeOf(fmt), 0);
 fmt.cbSize := SizeOf(fmt);
 // The PARAFORMAT2 structure is used to set the numbering style. 
 // This is done through the following structure members: 
 fmt.dwMask := PFM_NUMBERING or PFM_NUMBERINGSTART or PFM_NUMBERINGSTYLE or
 PFM_NUMBERINGTAB;
 // Set the following values (bitwise-or them together) to identify 
 // which of the remaining structure members are valid: 
 // PFM_NUMBERING, PFM_NUMBERINGSTART, PFM_NUMBERINGSTYLE, and PFM_NUMBERINGTAB 
 fmt.wNumbering := 2;
 //0 no numbering or bullets 
 //1 (PFN_BULLET) uses bullet character 
 //2 Uses Arabic numbers (1, 2, 3, ...). 
 //3 Uses lowercase letters (a, b, c, ...). 
 //4 Uses uppercase letters (A, B, C, ...). 
 //5 Uses lowercase Roman numerals (i, ii, iii, ...). 
 //6 Uses uppercase Roman numerals (I, II, III, ...). 
 //7 Uses a sequence of characters beginning with the Unicode 
 // character specified by the wNumberingStart member. 
 fmt.wNumberingStart := 1;
 // Starting value for numbering. 
 fmt.wNumberingStyle := $200;
 // Styles for numbering: 
 // 0 : Follows the number with a right parenthesis. 1) 
 // $100 : Encloses the number in parentheses. (1) 
 // $200 : Follows the number with a period. 1. 
 // $300 : Displays only the number. 1 
 // $400 : Continues a numbered list without applying the next number or bullet. 
 // $8000 : Starts a new number with wNumberingStart. 
 fmt.wNumberingTab := 1440 div 4;
 // Minimum space between a paragraph number and the paragraph text, in twips 
 RichEdit1.Perform(EM_SETPARAFORMAT, 0, lParam(@fmt));
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01032
Покрашенный StringGrid

=== Покрашенный StringGrid ===
...вы можете попробовать использовать StringGrid. У него имеется свойство Objects, через которое вы можете назначать объекты. Создайте объект, содержащий переменную типа TColor, и назначьте это Objects[col,row], что позволит иметь к нему доступ в любое время. Назначьте событие OnDrawCell StringGrid, позволяющее рисовать текст ячейки правильного цвета. Чтобы убедиться, что ячейка выбрана, воспользуйтесь свойством Selection, содержащим то, что выбрал пользователь. Все это должно выглядеть приблизительно так:
type
 TStrColor = class(TObject)
 public
 Color: TColor;
 { вы могли бы также определить частные и публичные методы доступа }
 end;
implementation
procedure TForm1.FormCreate(Sender: TObject)
var
 i, j: Integer;
begin
 with StringList1 do
 for i := 0 to ColCount - 1
 for j := 0 to RowCount - 1
 Objects[i, j] := TStrColor.Create;
end;
procedure TForm1.StringGrid1DrawCell(Sender: TObject; Col, Row: Longint;
 Rect: TRect; State: TGridDrawState);
var
 OldColor: TColor;
begin
 with StringGrid1.Canvas do
 begin
 OldColor := Font.Color;
 Font.Color := (StringGrid1.Objects[col, row] as TStrColor).Color;
 TextOut(Rect.Left + 2, Rect.Top + 2, StringGrid1.Cells[Col, Row]);
 Font.Color := OldColor;
 end;
end;
procedure TForm1.ProcessSelection(Sender: TObject);
var
 i, j: Integer;
begin
 with StringGrid1.Selection do
 for i := Left to Right do
 for j := Top to Bottom do
 MessageDlg(IntToStr(i) + ',' + IntToStr(j) + '-' +
 IntToStr((StringGrid1.Objects[i, j] as TStrColor).Color),
 mtInformation, [mbOk], 0);
end;
Этот компонент не позволяет делать многочисленный выбор.... 
Source: https://delphisources.ru/pages/faq/base/colored_stringgrid.html
ID: 01082
----
В данном модуле демонстрируется техника изменения цвета у выводимого в StringGrid текста.
unit Strgr;
interface
uses
 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
 Forms, Dialogs, Grids, StdCtrls, DB;
type
 TForm1 = class(TForm)
 StringGrid1: TStringGrid;
 procedure StringGrid1DrawCell(Sender: TObject; Col, Row: Longint;
 Rect: TRect; State: TGridDrawState);
 private
 { Private declarations }
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.StringGrid1DrawCell(Sender: TObject; Col, Row: Longint;
 Rect: TRect; State: TGridDrawState);
const
 CharOffset = 3;
begin
 with StringGrid1.Canvas do
 begin
 Font.Color := clMaroon;
 TextOut(Rect.Left + CharOffset, Rect.Top + CharOffset, 'L');
 Font.Color := clNavy;
 TextOut(Rect.Left + CharOffset + TextWidth('L'),
 Rect.Top + CharOffset, 'loyd');
 end;
end;
end.
Source: http://delphiworld.narod.ru/
ID: 01083
Полноэкранный режим

=== Полноэкранный режим ===
function SetFullscreenMode: Boolean;
var
 DeviceMode: TDevMode;
begin
 with DeviceMode do
 begin
 dmSize := SizeOf(DeviceMode);
 dmBitsPerPel := 16;
 dmPelsWidth := 640;
 dmPelsHeight := 480;
 dmFields := DM_BITSPERPEL or DM_PELSWIDTH or DM_PELSHEIGHT;
 result := False;
 if ChangeDisplaySettings(DeviceMode, CDS_TEST or CDS_FULLSCREEN) <>
 DISP_CHANGE_SUCCESSFUL then
 Exit;
 Result := ChangeDisplaySettings(DeviceMode, CDS_FULLSCREEN) =
 DISP_CHANGE_SUCCESSFUL;
 end;
end;
procedure RestoreDefaultMode;
var
 T: TDevMode absolute 0;
begin
 ChangeDisplaySettings(T, CDS_FULLSCREEN);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 if setFullScreenMode then
 begin
 sleep(7000);
 RestoreDefaultMode;
 end;
end;
Source: http://delphiworld.narod.ru/
ID: 00809
Получаем имена ODBC-источников

=== Получаем имена ODBC-источников ===
uses Registry;
procedure TForm1.GetDataSourceNames(System: Boolean);
var
 reg: TRegistry;
begin
 ListBox1.Items.Clear;
 reg := TRegistry.Create;
 try
 if System then
 reg.RootKey := HKEY_LOCAL_MACHINE
 else
 reg.RootKey := HKEY_CURRENT_USER;
 if reg.OpenKey('\Software\ODBC\ODBC.INI\ODBC Data Sources', False) then
 begin
 reg.GetValueNames(ListBox1.Items);
 end;
 finally
 reg.CloseKey;
 FreeAndNil(reg);
 end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 // Системные DSNs
 GetDataSourceNames(True);
 // Пользовательские DSNs
 GetDataSourceNames(False);
end;
Source: Взято с http://delphiworld.narod.ru
ID: 02682
Получаем имена файлов, скопированных в буфер обмена

=== Получаем имена файлов, скопированных в буфер обмена ===
procedure TForm1.Button1Click(Sender: TObject); 
var 
 f: THandle; 
 buffer: array [0..MAX_PATH] of Char; 
 i, numFiles: Integer; 
begin 
 if not Clipboard.HasFormat(CF_HDROP) then Exit; 
 Clipboard.Open; 
 try 
 f := Clipboard.GetAsHandle(CF_HDROP); 
 if f <> 0 then 
 begin 
 numFiles := DragQueryFile(f, $FFFFFFFF, nil, 0); 
 memo1.Clear; 
 for i := 0 to numfiles - 1 do 
 begin 
 buffer[0] := #0; 
 DragQueryFile(f, i, buffer, SizeOf(buffer)); 
 memo1.Lines.Add(buffer); 
 end; 
 end; 
 finally 
 Clipboard.Close; 
 end; 
end;
Source: http://delphiworld.narod.ru/
ID: 01895
Получать слова нужной длины при перестановке букв в указанном слове

=== Получать слова нужной длины при перестановке букв в указанном слове ===
{ 
 Definition: Permutation 
 A permutation is an arrangement of n objects, arranged in groups of size r 
 without repetition where order is important. 
 P(n,r) = n! / (n-r)! 
 Example: Find all two-letter permutations of the letters "ABC" 
 n = ABC 
 r = 2 
 Output: AB AC BA BC CA CB 
}
 { 
 Definition: Permutation 
 Eine Permutation ist eine Anordnung von n Objekten ohne Wiederholung. 
 Dabei spielt die Reihenfolge der Elemente in den Mengen keine Rolle. 
 P(n,r) = n! / (n-r)! 
 Beispiel: Finde alle 2-Buchstaben Kombinationen von "ABC" 
 n = ABC 
 r = 2 
 Ergebnis: AB AC BA BC CA CB 
}
 { 
 The following is a console Program: 
 Choose File, New, Console Application 
}
program Permute;
{$APPTYPE CONSOLE}
uses SysUtils;
var
 R, Slen: Integer;
procedure P(var A: string; B: string);
var
 J: Word;
 C, D: string;
begin
 { P(N,N) >> R=Slen }
 if Length(B) = SLen - R then
 begin
 Write(' {' + A + '} '); {Per++}
 end
 else
 begin
 for J := 1 to Length(B) do
 begin
 C := B;
 D := A + C[J];
 Delete(C, J, 1);
 P(D, C);
 end;
 end;
end;
var
 Q, S, S2: string;
begin
 S := ' ';
 S2 := ' ';
 while (S <> ) and (S2 <> ) do
 begin
 Writeln();
 Writeln();
 Write('P(N,R) N=? : ');
 ReadLn(S);
 SLen := Length(S);
 Write('P(N,R) R=? : ');
 ReadLn(S2);
 if s2 <> then R := StrToInt(S2);
 Writeln();
 Q := ;
 P(Q, S);
 end;
end.
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 00927
Получение IP адресов всех компьютеров в рабочей группе

var
 Computer: array[1..500] of string[25];
 ComputerCount: Integer;
procedure FindAllComputers(Workgroup: string);
var
 EnumHandle: THandle;
 WorkgroupRS: TNetResource;
 Buf: array[1..500] of TNetResource;
 BufSize: Integer;
 Entries: Integer;
 Result: Integer;
begin
 ComputerCount := 0;
 Workgroup := Workgroup + #0;
 FillChar(WorkgroupRS, SizeOf(WorkgroupRS), 0);
 with WorkgroupRS do
 begin
 dwScope := 2;
 dwType := 3;
 dwDisplayType := 1;
 dwUsage := 2;
 lpRemoteName := @Workgroup[1];
 end;
 WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, @WorkgroupRS, EnumHandle);
 repeat
 Entries := 1;
 BufSize := SizeOf(Buf);
 Result := WNetEnumResource(EnumHandle, Entries, @Buf, BufSize);
 if (Result = NO_ERROR) and (Entries = 1) then
 begin
 Inc(ComputerCount);
 Computer[ComputerCount] := StrPas(Buf[1].lpRemoteName);
 end;
 until (Entries <> 1) or (Result <> NO_ERROR);
 WNetCloseEnum(EnumHandle);
end;
Author: Song
Source: http://forum.sources.ru
ID: 03314
== См. также ==
* Демонстрационная программа сканирования сети
* Сканирование локальной сети.
Category:Связь
Получение OpenGL расширений

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Получение OpenGL расширений
Зависимости: OpenGL
Автор: Gua, gua@ukr.net, ICQ:141585495, Simferopol
Copyright: Gua
Дата: 18 июля 2002 г.
***************************************************** }
function GetOGLExtensions: string;
var
 DC: HDC;
 hrc: HGLRC;
 { Установка формата пикселей }
 procedure SetDCPixelFormat;
 var
 DC: HDC;
 nPixelFormat: Integer;
 pfd: TPixelFormatDescriptor;
 begin
 FillChar(pfd, SizeOf(pfd), 0);
 nPixelFormat := ChoosePixelFormat(DC, @pfd);
 SetPixelFormat(DC, nPixelFormat, @pfd);
 end;
begin
 DC := GetDC(0);
 SetDCPixelFormat;
 hrc := wglCreateContext(DC);
 wglMakeCurrent(DC, hrc);
 Result := StrPas(PChar(glGetString(GL_EXTENSIONS)));
 wglMakeCurrent(0, 0);
 wglDeleteContext(hrc);
 ReleaseDC(0, DC);
 DeleteDC(DC);
end;
Пример использования:
MessageDlg(GetOGLExtensions,mtInformation,[mbOK],0);
Author: Gua
Source: http://delphibase.endimus.com
ID: 03953
Category:Графика
Category:OpenGL
Получение SID пользователя, под которым запущен процесс

=== Получение SID пользователя, под которым запущен процесс ===
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls;
type
 TForm1 = class(TForm)
 Button1: TButton;
 procedure Button1Click(Sender: TObject);
 end;
 PTokenUser = ^TTokenUser;
 TTokenUser = record
 User: array[0..0] of TSIDAndAttributes;
 end;
 procedure ConvertSidToStringSid(SID: PSID; var StringSid: LPSTR); stdcall;
 external advapi32 name 'ConvertSidToStringSidA';
var
 Form1: TForm1;
implementation
{$R *.dfm}
function GetCurrentUserSID: String;
var
 TokenHandle: THandle;
 TokenInformationClass: TTokenInformationClass;
 TokenInformation: PTokenUser;
 ReturnLength: DWORD;
 StringSid: LPSTR;
begin
 Result := ;
 if OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, TokenHandle) then
 try
 TokenInformationClass := TokenUser;
 GetTokenInformation(TokenHandle, TokenInformationClass, nil, 0, ReturnLength);
 if GetLastError = ERROR_INSUFFICIENT_BUFFER then
 begin
 TokenInformation := GetMemory(ReturnLength);
 if TokenInformation <> nil then
 try
 if GetTokenInformation(TokenHandle, TokenInformationClass,
 TokenInformation, ReturnLength, ReturnLength) then
 begin
 ConvertSidToStringSid(TokenInformation^.User[0].Sid, StringSid);
 Result := StringSid;
 end;
 finally
 FreeMemory(TokenInformation);
 end;
 end;
 finally
 CloseHandle(TokenHandle);
 end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 ShowMessage(GetCurrentUserSID);
end;
end.
Author: Rouse_
Source: Взято из http://forum.sources.ru
ID: 02123
Получение времени удаленного компьютера, Пример использования NetRemoteTOD

unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls;
type
 TForm1 = class(TForm)
 Button1: TButton;
 procedure Button1Click(Sender: TObject);
 end;
 PTIME_OF_DAY_INFO = ^TIME_OF_DAY_INFO;
 TIME_OF_DAY_INFO = record
 tod_elapsedt : DWORD;
 tod_msecs : DWORD;
 tod_hours : DWORD;
 tod_mins : DWORD;
 tod_secs : DWORD;
 tod_hunds : DWORD;
 tod_timezone : Longint;
 tod_tinterval: DWORD;
 tod_day : DWORD;
 tod_month : DWORD;
 tod_year : DWORD;
 tod_weekday : DWORD;
 end;
 function NetRemoteTOD(Server: PWChar; var pBuffer: PTIME_OF_DAY_INFO): DWORD;
 stdcall; external 'NETAPI32.DLL';
 function NetApiBufferFree(pBuffer: Pointer): DWORD;
 stdcall; external 'NETAPI32.DLL';
var
 Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
 TOD: PTIME_OF_DAY_INFO;
begin
 if NetRemoteTOD('\\192.168.2.108', TOD) = 0 then
 try
 with TOD^ do
 ShowMessage(Format('Data %d %d %d Time %d:%d:%d',
 [tod_day, tod_month, tod_year, tod_hours - (tod_timezone div 60),
 tod_mins, tod_secs]));
 finally
 NetApiBufferFree(TOD);
 end
 else
 RaiseLastOSError;
end;
end.
Author: Rouse_
Source: http://forum.sources.ru
ID: 03325
Category:Связь
Получение данных из Program Manager через DDE

Установите соединение DDEClientConv с сервером и установите обоим DdeTopic в 'ProgMan'. Вызовите RequestData и передайте 'Groups' как элемент (item); обратно вы получите список имен групп. Вызовите RequestData с одним из имен групп и вы получите детальную информацию о группе. Вероятно дальше вы захотите передать полученные данные в ListBox, т.к. сразу можно увидеть что мы имеем и как затем это можно обработать, например:
var P: PChar;
begin
 P := DdeClientConv1.RequestData('Groups');
 ListBox1.Items.SetText(P);
 StrDispose(P);
 
 with ListBox1 do
 P := DdeClientConv1.RequestData(Items[ItemIndex]);
 ListBox2.Items.SetText(P);
 StrDispose(P);
end;
Source: http://delphiworld.narod.ru/
ID: 04503
Category:DDE
Получение дескриптора ODBC соединения

=== Получение дескриптора ODBC соединения ===
Я как-то обращал ваше внимание на трудность получения дескриптора ODBC соединения посредством DBE. После тесного общения со службой поддержки Borland, я наконец нашел решение как это сделать. Вот этот код:
unit Getprop;
interface
uses
 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
 Forms, Dialogs, Grids, DBGrids, StdCtrls, DB, DBTables,
 DBIProcs, DBITypes, DBIErrs;
type
 TForm1 = class(TForm)
 Table1: TTable;
 DataSource1: TDataSource;
 Button1: TButton;
 Button2: TButton;
 DBGrid1: TDBGrid;
 Edit1: TEdit;
 procedure Button1Click(Sender: TObject);
 procedure Button2Click(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
 Table1.active := True;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
 hTmpDB: hDBIDb;
 iLen: word;
begin
 Check(DbiGetProp(hDBIObj(Table1.DBhandle), dbNATIVEHNDL, @hTmpDB, sizeof(hDBIDb), iLen));
 Edit1.text := inttostr(longint(htmpdb));
end;
end
Author: Chris Fioravanti
Source: Взято из Советов по Delphi от Валентина Озерова
ID: 02681
Получение значения бита в двойном слове

=== Получение значения бита в двойном слове ===
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Получение значения бита в двойном слове
Функция возвращает значение бита с номером Index в двойном слове Value
Зависимости: нет
Автор: Dimka Maslov, mainbox@endimus.ru, ICQ:148442121, Санкт-Петербург
Copyright: Dimka Maslov
Дата: 21 мая 2002 г.
***************************************************** }
function Bit(Value, Index: Integer): Boolean;
asm
 bt eax, edx
 setc al
 and eax, 0FFh
end;
Source: http://delphibase.endimus.com
ID: 00825
Получение имени конфигурации HardWare profile

=== Получение имени конфигурации HardWare profile ===
function GettingHWProfileName: string; // Win95OSR2 or later and NT4.0 or later
var
 pInfo: tagHW_PROFILE_INFOA;
begin
 GetCurrentHwProfile(pInfo);
 Result := pInfo.szHwProfileName;
end;
ID: 01330
Получение имени модуля по хендлу окна

=== Получение имени модуля по хендлу окна ===
function GetModuleFileNameExW(hProcess: THandle; hModule: HMODULE; lpFilename: PWideChar;
 nSize: DWORD): DWORD; stdcall; external 'PSAPI.DLL';
function WindowGetEXE(wnd: HWND): string;
var
 wt: array[0..MAX_PATH-1] of WChar;
 r: Integer;
 prc: THandle;
 prcID: Cardinal;
begin
 Result := ;
 if GetWindowThreadProcessID(wnd, prcID) <> 0 then
 begin
 prc := OpenProcess(PROCESS_ALL_ACCESS, False, prcID);
 if prc <> 0 then
 try
 r := GetModuleFileNameExW(prc, GetWindowLong(wnd, GWL_HINSTANCE), wt, MAX_PATH*2);
 if r = 0 then
 r := GetModuleFileNameExW(prc, 0, wt, MAX_PATH*2);
 if r <> 0 then
 Result := wt;
 finally
 CloseHandle(prc)
 end
 end
end;
function SetProcessDebugPrivelege(): Boolean;
var
 hToken: THandle;
 tp: TTokenPrivileges;
 rl: Cardinal;
begin
 Result := False;
 if not OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken) then exit;
 try
 if not LookupPrivilegeValue(nil, 'SeDebugPrivilege', tp.Privileges[0].Luid) then exit;
 tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
 tp.PrivilegeCount := 1;
 Result := AdjustTokenPrivileges(hToken, False, tp, 0, nil, rl) and (GetLastError=0);
 finally
 CloseHandle(hToken);
 end
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
 SetProcessDebugPrivelege();
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 ShowMessage(WindowGetExe(hWnd));
end;
PS только для NT4 и выше. Для Win9x юзать GetWindowModuleFileName.
Author: Krid
Source: Взято из http://forum.sources.ru
ID: 02133
Получение имени пользователя и домена

// Пример получения имени пользователя и домена под которым работает
// текущий поток или процесс
type
 PTOKEN_USER = ^TOKEN_USER;
 _TOKEN_USER = record
 User: TSidAndAttributes;
 end;
 TOKEN_USER = _TOKEN_USER;
function GetCurrentUserAndDomain(szUser: PChar; var chUser: DWORD;
 szDomain: PChar; var chDomain: DWORD): Boolean;
var
 hToken: THandle;
 cbBuf: Cardinal;
 ptiUser: PTOKEN_USER;
 snu: SID_NAME_USE;
begin
 Result := False;
 // Получаем маркер доступа текущего потока нашего процесса
 if not OpenThreadToken(GetCurrentThread(), TOKEN_QUERY, True, hToken) then
 begin
 if GetLastError() <> ERROR_NO_TOKEN then exit;
 // В случае ошибки - получаем маркер доступа нашего процесса.
 if not OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, hToken) then exit;
 end;
 // Вызываем GetTokenInformation для получения размера буфера
 if not GetTokenInformation(hToken, TokenUser, nil, 0, cbBuf) then
 if GetLastError() <> ERROR_INSUFFICIENT_BUFFER then
 begin
 CloseHandle(hToken);
 exit;
 end;
 if cbBuf = 0 then exit;
 // Выделяем память под буфер
 GetMem(ptiUser, cbBuf);
 // В случае удачного вызова получим указатель на TOKEN_USER
 if GetTokenInformation(hToken, TokenUser, ptiUser, cbBuf, cbBuf) then
 begin
 // Ищем имя пользователя и его домен по его SID
 if LookupAccountSid(nil, ptiUser.User.Sid, szUser, chUser, szDomain, chDomain, snu) then
 Result := True;
 end;
 // Освобождаем ресурсы
 CloseHandle(hToken);
 FreeMem(ptiUser);
end;
// Использовать функцию можно так :
var
 Domain, User: array [0..50] of Char;
 chDomain, chUser: Cardinal;
begin
 chDomain := 50;
 chUser :=50;
 if GetCurrentUserAndDomain(User, chuser, Domain, chDomain) then
 //...
end;
// Если вам необходимо получить только имя пользователя - используйте GetUserName
// Данный пример можно использовать и для определения - запущен ли процесс
// системой или пользователем. Учетной записи Localsystem соответствует
// имя пользователя - SYSTEM и домен NT AUTORITY (лучше проверить на практике)
Source: http://delphiworld.narod.ru
ID: 03313
Category:Связь
Получение имени шрифта, зная имя файла шрифта

=== Получение имени шрифта, зная имя файла шрифта ===
 function GetFontResourceInfoW(FontPath: PWideChar; var BufSize: DWORD; FontName: PWideChar; dwFlags: DWORD): DWORD; stdcall; external 'GDI32.DLL';
* FontPath - указатель на Wide-строку, содержащую путь к файлу шрифта;
* BufSize - указатель на DWORD-переменную, содержащую размер выходного буфера. После выполнения функции в этой переменной будет содержаться необходимая длина буфера;
* FontName - указатель на буфер, в случае успешного выполнения будет содержать Wide-строку имени шрифта;
* dwFlags - какие-то флаги, если рыться в функции GetFontResourceInfoW особым случаем является когда dwFlags=4, но зачем это, я так и не понял - в результате будет возвращен тот же путь к файлу; ну а для получения имени шрифта флаг должен быть равен 1.
function GetFontName(FontFileA: PChar): String;
type
 TGetFontResourceInfoW = function (FontPath: PWideChar; var BufSize: DWORD; FontName: PWideChar; dwFlags: DWORD): DWORD; stdcall;
var
 GetFontResourceInfoW: TGetFontResourceInfoW;
 FontFileW: PWideChar;
 FontNameW: PWideChar;
 FontFileWSize, FontNameSize: DWORD;
begin
 Result := ;
 GetFontResourceInfoW := GetProcAddress(GetModuleHandle('gdi32.dll'), 'GetFontResourceInfoW');
 if @GetFontResourceInfoW = nil then Exit;
 if AddFontResource(FontFileA) = 0 then Exit;
 FontFileWSize := (Length(FontFileA)+1)*2;
 GetMem(FontFileW, FontFileWSize);
 StringToWideChar(FontFileA, FontFileW, FontFileWSize);
 FontNameSize := 0;
 FontNameW := nil;
 GetFontResourceInfoW (FontFileW, FontNameSize, FontNameW, 1);
 GetMem (FontNameW, FontNameSize);
 FontNameW^ := #0; // на случай какого-нибудь облома
 GetFontResourceInfoW (FontFileW, FontNameSize, FontNameW, 1);
 Result := FontNameW;
 FreeMem (FontFileW);
 FreeMem (FontNameW);
 RemoveFontResource(FontFileA);
end;
Пример вызова: 
 GetFontName('C:\MyFonts\FUTURA.TTF') - возвратит 'FuturaEugenia'.
PS: Всё бы хорошо, но эта функция хоть и есть в Win9x, только её там вызывать нельзя - пишет "This function is only valid in Windows NT mode."...
FontView в Win9x использует EnumFontFamiliesEx (видимо по предложенному Vit'ом и x77 способу)...
FontView в WinNT использует GetFontResourceInfo (в импорте вообще нет EnumFontFamiliesEx или других Enum*)...
Author: p0s0l
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 01930
Получение информации о TaskBar

=== Получение информации о TaskBar ===
Для вывода информации мы будет использовать компонент TStringGrid с закладки Additional. 
Сначала вам нужно будет после 
var
 Form1: TForm1;
добавить следующий код: 
 AppBarData: TAppBarData;
 bAlwaysOnTop, bAutoHide: Boolean;
 Clrect, rect: TRect;
 Edge: UInt;
затем после слова Implementation пишем 
procedure DetectTaskBar;
begin
 AppBarData.hWnd := FindWindow('Shell_TrayWnd', nil);
 AppBarData.cbSize := SizeOf(AppBarData);
 bAlwaysOnTop := (SHAppBarMessage(ABM_GETSTATE, AppBardata) and ABS_ALWAYSONTOP) <> 0;
 bAutoHide := (SHAppBarMessage(ABM_GETSTATE, AppBardata) and ABS_AUTOHIDE) <> 0;
 GetClientRect(AppBarData.hWnd, Clrect);
 GetWindowRect(AppBarData.hwnd, rect);
 if rect.top > 0 then
 Edge := ABE_BOTTOM
 else
 if rect.bottom < screen.height then
 Edge := ABE_TOP
 else
 if rect.right < screen.width then
 Edge := ABE_LEFT
 else
 Edge := ABE_RIGHT;
end;
и осталось описать самое главное - обработчик нажатия кнопки: 
procedure TForm1.Button1Click(Sender: TObject);
begin
 DetectTaskBar;
 StringGrid1.Cells[0,0] := 'Выше других окон';
 StringGrid1.Cells[0,1] := 'Автоматически убирать с экрана';
 StringGrid1.Cells[0,2] := 'Клиентская область';
 StringGrid1.Cells[0,3] := 'Оконная область';
 StringGrid1.Cells[0,4] := 'Края';
 if bAlwaysOnTop = true then
 StringGrid1.Cells[1,0] := 'true'
 else
 StringGrid1.Cells[1,0] := 'false';
 if bAutoHide = true then
 StringGrid1.Cells[1,1] := 'true'
 else
 StringGrid1.Cells[1,1] := 'false';
 StringGrid1.Cells[1,2] := IntToStr(Clrect.Left)+':'+IntToStr(Clrect.Top) +
 ':'+IntToStr(Clrect.Right)+':'+IntToStr(Clrect.Bottom);
 StringGrid1.Cells[1,3] := IntToStr(rect.Left)+':'+IntToStr(rect.Top) +
 ':'+IntToStr(rect.Right)+':'+IntToStr(rect.Bottom);
 StringGrid1.Cells[1,4] := IntToStr(Edge);
end;
Source: Взято с http://delphiworld.narod.ru
ID: 01776