nyuuzyou/wikis huggingface dataset:
Как получить контекст свойства по его целочисленному значению?

=== Как получить контекст свойства по его целочисленному значению? ===
unit PropertyList;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons;
type
 TMyStream = class(TFileStream)
 private
 FFred: integer;
 published
 property Fred: integer read FFred write FFred;
 end;
type
 TFrmPropertyList = class(TForm)
 SpeedButton1: TSpeedButton;
 ListBox1: TListBox;
 procedure SpeedButton1Click(Sender: TObject);
private
 { Private declarations }
public
 { Public declarations }
end;
var
 FrmPropertyList: TFrmPropertyList;
implementation
{$R *.DFM}
uses
 TypInfo;
procedure ListProperties(AInstance: TPersistent; AList: TStrings);
var
 i: integer;
 pInfo: PTypeInfo;
 pType: PTypeData;
 propList: PPropList;
 propCnt: integer;
 tmpStr: string;
begin
 pInfo := AInstance.ClassInfo;
 if (pInfo = nil) or (pInfo^.Kind <> tkClass) then
 raise Exception.Create('Invalid type information');
 pType := GetTypeData(pInfo); {Pointer to TTypeData}
 AList.Add('Class name: ' + pInfo^.Name);
 {If any properties, add them to the list}
 propCnt := pType^.PropCount;
 if propCnt > 0 then 
 begin
 AList.Add (EmptyStr);
 tmpStr := IntToStr(propCnt) + ' Propert';
 if propCnt > 1 then
 tmpStr := tmpStr + 'ies'
 else
 tmpStr := tmpStr + 'y';
 AList.Add(tmpStr);
 FillChar(tmpStr[1], Length(tmpStr), '-');
 AList.Add(tmpStr);
 {Get memory for the property list}
 GetMem(propList, sizeOf(PPropInfo) * propCnt);
 try
 {Fill in the property list}
 GetPropInfos(pInfo, propList);
 {Fill in info for each property}
 for i := 0 to propCnt - 1 do
 AList.Add(propList[i].Name + ': ' + propList[i].PropType^.Name);
 finally
 FreeMem(propList, sizeOf(PPropInfo) * propCnt);
 end;
 end;
end;
function GetPropertyList(AControl: TPersistent; AProperty: string): PPropInfo;
var
 i: integer;
 props: PPropList;
 typeData: PTypeData;
begin
 Result := nil;
 if (AControl = nil) or (AControl.ClassInfo = nil) then
 Exit;
 typeData := GetTypeData(AControl.ClassInfo);
 if (typeData = nil) or (typeData^.PropCount = 0) then
 Exit;
 GetMem(props, typeData^.PropCount * SizeOf(Pointer));
 try
 GetPropInfos(AControl.ClassInfo, props);
 for i := 0 to typeData^.PropCount - 1 do
 begin
 with Props^[i]^ do
 if (Name = AProperty) then
 result := Props^[i];
 end;
 finally
 FreeMem(props);
 end;
end;
procedure TFrmPropertyList.SpeedButton1Click(Sender: TObject);
var
 c: integer;
begin
 ListProperties(self, ListBox1.Items);
 for c := 0 to ComponentCount - 1 do
 begin
 ListBox1.Items.Add(EmptyStr);
 ListProperties(Components[c], ListBox1.Items);
 end;
end;
end.
Author: Ralph Friedman
Source: Взято из http://www.lmc-mediaagentur.de/dpool
ID: 00267
Как получить координаты курсора в memo-поле?

=== Как получить координаты курсора в memo-поле? ===
procedure CaretPos(H: THandle; var L, C : Word); 
begin 
 L := SendMessage(H, EM_LINEFROMCHAR, -1, 0); 
 C := LoWord(SendMessage(H, EM_GETSEL, 0, 0)) - SendMessage(H, EM_LINEINDEX, -1, 0); 
end; 
procedure TForm1.Button1Click(Sender: TObject); 
var 
 LineNum,ColNum : Word; 
begin 
 CaretPos(Memo1.Handle,LineNum,ColNum); 
 Edit1.Text := IntToStr(LineNum) + ' ' + IntToStr(ColNum); 
end;
Хотя в Delphi 5 свойство CaretPos уже включено в memo.
Source: Взято из http://forum.sources.ru
ID: 00547
----
Как получить номер строки memo, в которой находится курсор?
Для этого необходимо послать сообщение EM_LINEFROMCHAR.
 LineNumber := Memo1.Perform(EM_LINEFROMCHAR, -1, 0);
Source: Взято из http://forum.sources.ru
ID: 00548
----
var
 X, Y: LongInt;
begin
 Y := Memo1.Perform(EM_LINEFROMCHAR, Memo1.SelStart, 0);
 X := Memo1.Perform(EM_LINEINDEX, Y, 0);
 inc(Y);
 X := Memo1.SelStart - X + 1;
 Form1.Caption := 'X = ' + IntToStr(X) + ' : ' + 'Y = ' + IntToStr(Y);
end;
Source: http://delphiworld.narod.ru/
ID: 00997
Как получить координаты указателя мыши относительно формы в Дельфи

=== Как получить координаты указателя мыши относительно формы в Дельфи ===
Существует такой тип, как TMouse, который передаёт координаты мышки в любое время, так что помести в обработчик события нажатия мыши на форме его вызов. Подробнее смотри в хелпе. 
Лучше говорить, что существует объект класса TMouse, на него ссылается глобальная переменная Mouse из модуля Controls... А то человек кинется создавать свой экземпляр... 
procedure TForm1.FormClick(Sender: TObject);
var
 MyMouse: TMouse;
begin
 Form1.Caption := IntToStr(MyMouse.CursorPos.x) + 'Х ' + IntToStr(MyMouse.CursorPos.y);
end;
Source: http://delphiworld.narod.ru
ID: 01575
Как получить короткий путь файла если есть длинный и на оборот?

=== Как получить короткий путь файла если есть длинный и на оборот? ===
// Короткий
GetShortPathName(LongPath)
// Наоборот длинный
GetFullPathName(ShortPath)
ID: 03163
----
// Возвращает LongFileName преобразованное в соответствующее короткое имя
function sfn(const LongName: string): string;
var
 i: Integer;
begin
 SetLength(Result, Length(LongName));
 i := GetShortPathName(PChar(LongName), PChar(Result), Length(Result));
 if i > Length(Result) then
 begin
 SetLength(Result, i);
 i := GetShortPathName(PChar(LongName), PChar(Result), Length(Result));
 end;
 SetLength(Result, i);
end;
// Возвращает FileName преобразованное в соответствующее длинное имя
function ShortToLongFileName(FileName: string): string;
var
 KernelHandle: THandle;
 FindData: TWin32FindData;
 Search: THandle;
 GetLongPathName: function(lpszShortPath: PChar; lpszLongPath: PChar;
 cchBuffer: DWORD): DWORD; stdcall;
begin
 KernelHandle := GetModuleHandle('KERNEL32');
 if KernelHandle <> 0 then
 @GetLongPathName := GetProcAddress(KernelHandle, 'GetLongPathNameA');
 // Использю GetLongPathName доступную в windows 98 и выше чтобы
 // избежать проблем доступа к путям UNC в системах NT/2K/XP
 if Assigned(GetLongPathName) then
 begin
 SetLength(Result, MAX_PATH + 1);
 SetLength(Result, GetLongPathName(PChar(FileName), @Result[1], MAX_PATH));
 end
 else
 begin
 Result := ;
 // Поднимаюсь на одну директорию выше от пути к файлу и запоминаю
 // в result. FindFirstFile возвратит длинное имя файла полученное
 // из короткого.
 while (True) do
 begin
 Search := Windows.FindFirstFile(PChar(FileName), FindData);
 if Search = INVALID_HANDLE_VALUE then Break;
 Result := String('\') + FindData.cFileName + Result;
 FileName := ExtractFileDir(FileName);
 Windows.FindClose(Search);
 // Нахожу имя диска с двоеточием.
 if Length(FileName) <= 2 then Break;
 end;
 Result := ExtractFileDrive(FileName) + Result;
 end;
end;
Author: Автор: Alex&Co
Source: http://alex-co.com.ru
ID: 03164
Category:Файловая система
Как получить обновление данных, по событию, а не таймером

=== Как получить обновление данных, по событию, а не таймером ===
{ **** UBPFD *********** by kladovka.net.ru ****
>> Обратная связь от MSSQL-сервера к клиенту
На форуме постоянно возникает вопрос - "Как получить обновление данных, по событию, а не таймером", чтобы снять его раз и навсегда привожу код dll-ки, которая является Extended Stored Procedure с единственной функцией - отправкой UDP-broadcast сообщения.
Зависимости: Windows, SysUtils, IdUDPClient
Copyright: Delirium (Master BRAIN) 2003
Дата: 24 октября 2003 г.
********************************************** }
library Messager;
uses
 Windows,
 SysUtils,
 IdUDPClient;
function srv_rpcparams(srvproc: Pointer): Integer; cdecl; external 'opends60.dll' name 'srv_rpcparams';
function srv_paramdata(srvproc: Pointer; n: Integer): Integer; cdecl; external 'opends60.dll' name 'srv_paramdata';
function srv_paramlen(srvproc: Pointer; n: Integer): Integer; cdecl; external 'opends60.dll' name 'srv_paramlen';
procedure SendUDPMessage(Params: Pointer); stdcall; cdecl; export;
var
 id: TIdUDPClient;
 Msg: string;
 Host, Port: string;
begin
 try
 if srv_rpcparams(Params) < 2 then Exit;
 Host := Copy(PChar(srv_paramdata(Params, 1)), 1, srv_paramlen(Params, 1));
 Port := Copy(Host, Pos(':', Host)+1, Length(Host));
 Delete(Host, Pos(':', Host), Length(Host));
 Msg := Copy(PChar(srv_paramdata(Params, 2)), 1, srv_paramlen(Params, 2));
 id := TIdUDPClient.Create(nil);
 id.BroadcastEnabled := True;
 id.Host := Host;
 id.Port := StrToInt(Port);
 id.ReceiveTimeout := -1;
 id.Send(Msg);
 finally
 id.Free;
 end;
end;
exports SendUDPMessage;
begin
end.
Для регистрации на MSSQL скопировать dll в 
 c:\Program Files\Microsoft SQL Server\80\Tools\Binn
и исполнить скрипт
 sp_addextendedproc 'SendUDPMessage', 'Messager.dll'
На клиенте рекомендую использовать компонент TIdUDPServer.
Передача сообщений осуществляется так
exec SendUDPMessage '255.255.255.255:8080', 'Привет!'
где 255.255.255.255 - broadcast маска, но можно написать и конкретный адрес (192.168.1.10), 8080 - выбранный для использования порт.
Author: Delirium
ID: 02871
Category:Базы данных
Category:MS SQL Server
Как получить описание кода, полученного GetLastError?

=== Как получить описание кода, полученного GetLastError? ===
Функция RTL SysErrorMessage(GetLastError).
procedure TForm1.Button1Click(Sender: TObject);
begin
 { Cause a Windows system error message to be logged }
 ShowMessage(IntToStr(lStrLen(nil)));
 ShowMessage(SysErrorMessage(GetLastError));
end;
ID: 02026
Как получить определённую часть текста из RichEdit?

=== Как получить определённую часть текста из RichEdit? ===
Иногда бывает необходимо получить только часть текста из RichEdit не выделяя его, то есть не используя свойство SelText. Ниже представлен код, который позволяет сделать это.
{ Переопределяем неправильное объявление TTextRange в RichEdit.pas } 
 TTextRange = record 
 chrg: TCharRange; 
 lpstrText: PAnsiChar; 
 end; 
{ RichEdit - RichEdit control 
BeginPos - абсолютное значение первого символа
MaxLength - максимально число получаемых символов }
function REGetTextRange(RichEdit: TRichEdit; 
 BeginPos, MaxLength: Integer): string; 
var 
 TextRange: TTextRange; 
begin 
 if MaxLength > 0 then 
 begin 
 SetLength(Result, MaxLength); 
 with TextRange do 
 begin 
 chrg.cpMin := BeginPos; 
 chrg.cpMax := BeginPos+MaxLength; 
 lpstrText := PChar(Result); 
 end; 
 SetLength(Result, SendMessage(RichEdit.Handle, EM_GETTEXTRANGE, 0, 
 longint(@TextRange))); 
 end 
 else
 Result := ; 
end; 
Следующую функцию можно использовать для получения слова, над которым находится курсор мышки:
{ функция возвращает абсолютное положение символа для данных координат курсора}
function RECharIndexByPos(RichEdit: TRichEdit; X, Y: Integer): Integer; 
var 
 P: TPoint; 
begin 
 P := Point(X, Y); 
 Result := SendMessage(RichEdit.Handle, EM_CHARFROMPOS, 0, longint(@P)); 
end; 
{ X, Y - координаты в rich edit }
{ возвращает слово в текущих координатах курсора }
function REExtractWordFromPos(RichEdit: TRichEdit; X, Y: Integer): string; 
var 
 BegPos, EndPos: Integer; 
begin 
 BegPos := RECharIndexByPos(RichEdit, X, Y); 
 if (BegPos < 0)
 or (SendMessage(RichEdit.Handle, EM_FINDWORDBREAK, WB_CLASSIFY, BegPos)
 and (WBF_BREAKLINE or WBF_ISWHITE) <> 0)
 then 
 begin 
 result := ; 
 exit; 
 end; 
 if SendMessage(RichEdit.Handle, EM_FINDWORDBREAK, WB_CLASSIFY, BegPos-1)
 and (WBF_BREAKLINE or WBF_ISWHITE) = 0 then 
 BegPos := SendMessage(RichEdit.Handle, EM_FINDWORDBREAK, WB_MOVEWORDLEFT, BegPos); 
 EndPos := SendMessage(RichEdit.Handle, EM_FINDWORDBREAK, WB_MOVEWORDRIGHT, BegPos); 
 Result := TrimRight(REGetTextRange(RichEdit, BegPos, EndPos - BegPos)); 
end;
Source: Взято из http://forum.sources.ru
ID: 00565
Как получить параметры Alias?

=== Как получить параметры Alias? ===
The following function uses the GetAliasParams method of TSession to get the directory mapping for an alias:
uses DbiProcs, DBiTypes;
function GetDataBaseDir(const Alias: string): string;
{* Will return the directory of the database given the alias
 (without trailing backslash) *}
var
 sp: PChar;
 Res: pDBDesc;
begin
 try
 New(Res);
 sp := StrAlloc(length(Alias) + 1);
 StrPCopy(sp, Alias);
 if DbiGetDatabaseDesc(sp, Res) = 0 then
 Result := StrPas(Res^.szPhyName)
 else
 Result := ;
 finally
 StrDispose(sp);
 Dispose(Res);
 end;
end;
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 02520
----
{
 Here's a demo to demonstrate how to get info about aliases in Delphi.
 First, create a new project with a listbox and 3 labels (called ListBox1,
 Label1, Label2, and Label3). Then add an OnCreate event handler for the form
 with this code in it:
}
procedure TForm1.FormCreate(Sender: TObject);
begin
 {
 GetAliasNames Populates a string list with the names of persistent
 Borland Database Engine (BDE) aliases.
 }
 Session.GetAliasNames(ListBox1.Items);
end;
{ Now add an OnClick event for the Listbox: }
procedure TForm1.ListBox1Click(Sender: TObject);
var
 tStr: array[0..100] of char;
 Desc: DBDesc;
{
 The DBDesc structure describes a database, using the following fields:
 szName DBINAME Specifies the database alias name.
 szText DBINAME Descriptive text.
 szPhyName DBIPATH Specifies the physical name/path.
 szDbType DBINAME Specifies the database type.
}
begin
 if ListBox1.Items.Count = 0 then
 exit;
 StrPLCopy(tStr, ListBox1.Items.Strings[ListBox1.ItemIndex], High(tStr));
 DbiGetDatabaseDesc(tStr, @Desc);
 with Desc do
 begin
 Label1.Caption := StrPas(Desc.szName);
 Label2.Caption := StrPas(Desc.szPhyName);
 Label3.Caption := StrPas(Desc.szDbType);
 Label4.Caption := StrPas(Desc.szText);
 end;
end;
// Now add the following to the 'uses' clause at the top of the unit:
uses
 {...,}DB, DBTables, DBITypes, DBIProcs;
{********************************************************************}
{
 This Examples is just another approach to get infos about aliases
 Using 2 component (TListBox) and only use 1 uses clause (dbTables)
}
uses
 {...}, DBTables;
type
 TForm1 = class(TForm)
 ListBox1: TListBox;
 ListBox2: TListBox;
{..}
implementation
{..}
procedure TForm1.FormCreate(Sender: TObject);
begin
 { Get Alias Names }
 Session.GetAliasNames(ListBox1.Items);
end;
procedure TForm1.ListBox1Click(Sender: TObject);
begin
 ListBox2.Items.Clear;
 if ListBox1.Items.Count = 0 then
 Exit;
 { Get Alias Driver Names, like Standard, MsAccess, etc }
 ListBox2.Items.Add('DRIVER=' + Session.GetAliasDriverName(ListBox1.Items.Strings
 [ListBox1.ItemIndex]));
 { Get Alias Parameters and add it parameters into listbox2 }
 Session.GetAliasParams(ListBox1.Items.Strings[ListBox1.ItemIndex], ListBox2.Items);
end;
end.
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 02521
Как получить переменные окружения типа PATH и PROMPT?

=== Как получить переменные окружения типа PATH и PROMPT? ===
==== Вариант 1 ====
Для этого используется API функция GetEnvironmentVariable.
GetEnvironmentVariable возвращает значения:
- В случае удачного выполнения функции, возвращаемое значение содержит количество символов, хранящихся в буфере, не включая последнего нулевого.
- Если указанная переменная окружения для текущего процесса не найдена, то возвращаемое значение равно нулю.
- Если буфер не достаточного размера, то возвращаемое значение равно требуемому размеру для хранения строки значения и завершающего нулевого символа.
function GetDOSEnvVar(const VarName: string): string;
var
 i: integer;
begin
 Result := ;
 try
 i := GetEnvironmentVariable(PChar(VarName), nil, 0);
 if i > 0 then
 begin
 SetLength(Result, i);
 GetEnvironmentVariable(Pchar(VarName), PChar(Result), i);
 end;
 except
 Result := ;
 end;
end;
ID: 02207
----
==== Вариант 2 ====
procedure TMainFrm.AddVarsToMemo(Sender: TObject);
var
 p: PChar;
begin
 Memo1.Lines.Clear;
 Memo1.WordWrap := False;
 p := GetEnvironmentStrings();
 while p^ <> #0 do
 begin
 Memo1.Lines.Add(StrPas(p));
 Inc(p, lStrLen(p) + 1);
 end;
 FreeEnvironmentStrings(p);
end;
Source: Взято из http://forum.sources.ru
ID: 02208
Как получить полный исходник HTML?

В IE5, можно получить исходник используя свойство outerHTML тэгов HTML. В IE4 или IE3, Вам понадобится записать документ в файл, а затем загрузить файл в TMemo, TStrings, и т.д.
var
 HTMLDocument: IHTMLDocument2;
 PersistFile: IPersistFile;
begin
 HTMLDocument := WebBrowser1.Document as IHTMLDocument2;
 PersistFile := HTMLDocument as IPersistFile;
 PersistFile.Save(StringToOleStr('test.htm'), True);
 while HTMLDocument.readyState <> 'complete' do
 Application.ProcessMessages;
end;
; Обратите внимание: Вам понадобится импортировать библиотеку MSHTML и добавить MSHTML_TLB как ActiveX, в секцию Uses.
Перевод материала с сайта members.home.com/hfournier/webbrowser.htm
Author: Ron Loewy 
Source: http://blackman.km.ru/myfaq/cont4.phtml
ID: 03487
Category:Связь
Category:WebBrowser
Как получить размер GIF-картинки?

type
 TImageSize = record
 Width: Integer;
 Height: Integer;
 end;
function ReadGIFSize(Stream: TStream): TImageSize;
type
 TGifHeader = record
 Signature: array [0..5] of Char;
 Width, Height: Word;
 end;
var
 Header: TGifHeader;
begin
 FillChar(Header, SizeOf(TGifHeader), #0);
 Result.Width := -1;
 Result.Height := -1;
 with Stream do
 begin
 Seek(0, soFromBeginning);
 ReadBuffer(Header, SizeOf(TGifHeader));
 end;
 if (AnsiUpperCase(Header.Signature) = 'GIF89A') or
 (AnsiUpperCase(Header.Signature) = 'GIF87A') then
 begin
 Result.Width := Header.Width;
 Result.Height := Header.Height;
 end;
end;
procedure TForm1.Button1Click(Sender: TObject);
const
 FileName = 'D:\test.gif';
var
 fs: TFileStream;
 gifsize: TImageSize;
begin
 fs := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
 try
 gifsize := ReadGIFSize(fs);
 ShowMessage(Format('Width=%d Height=%d', [gifsize.Width, gifsize.Height]));
 finally
 fs.Free;
 end;
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 03802
Category:Графика
Как получить размер развёрнутого TComboBox?

=== Как получить размер развёрнутого TComboBox? ===
В течение события FormShow, выпадающему списке дважды посылается сообщение CB_SHOWDROPDOWN, один раз, чтобы он открылся, а второй - чтобы свернулся. Затем посылается сообщение CB_GETDROPPEDCONTROLRECT, передающее адрес TRect. 
Когда вызов SendMessage возвращается, то TRect будет содержать прямоугольник, который соответствует раскрытому ComboBox-у относительно окна. Затем можно вызвать ScreenToClient для преобразования координат TRect-а в координаты относительно клиентской области формы.
var 
 R: TRect; 
procedure TForm1.FormShow(Sender: TObject); 
var 
 T: TPoint; 
begin 
 SendMessage(ComboBox1.Handle, CB_SHOWDROPDOWN, 1, 0); 
 SendMessage(ComboBox1.Handle, CB_SHOWDROPDOWN, 0, 0); 
 SendMessage(ComboBox1.Handle, CB_GETDROPPEDCONTROLRECT, 0, LongInt(@r)); 
 t := ScreenToClient(Point(r.Left, r.Top)); 
 r.Left := t.x; 
 r.Top := t.y; 
 t := ScreenToClient(Point(r.Right, r.Bottom)); 
 r.Right := t.x; 
 r.Bottom := t.y; 
end; 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
 Form1.Canvas.Rectangle(r.Left, r.Top, r.Right, r.Bottom); 
end;
Source: Взято из http://forum.sources.ru
ID: 01156
Как получить размер физической установленной памяти?

=== Как получить размер физической установленной памяти? ===
uses
 Windows, SysUtils;
function DisplayRam: string;
var
 Info: TMemoryStatus;
begin
 Info.dwLength := SizeOf(TMemoryStatus);
 GlobalMemoryStatus(Info);
 Result := Format('%d MB RAM', [(Info.dwTotalPhys shr 20) + 1]);
end;
ID: 01618
----
function Physmem: string;
var
 MemStat: TMemoryStatus;
begin
 MemStat.dwLength := sizeof(MemStat);
 GlobalMemoryStatus(MemStat);
 result := inttoStr(memstat.dwTotalPhys div 1024);
end;
function PhysmemFree: string;
var
 MemStat: TMemoryStatus;
begin
 MemStat.dwLength := sizeof(MemStat);
 GlobalMemoryStatus(MemStat);
 result := inttoStr(memstat.dwAvailPhys div 1024);
end;
function MemLoad: string;
var
 MemStat: TMemoryStatus;
begin
 MemStat.dwLength := sizeof(MemStat);
 GlobalMemoryStatus(MemStat);
 result := inttoStr(memstat.dwMemoryLoad);
end;
function TotalPageFile: string;
var
 MemStat: TMemoryStatus;
begin
 MemStat.dwLength := sizeof(MemStat);
 GlobalMemoryStatus(MemStat);
 result := inttoStr(memstat.dwTotalPageFile div 1024);
end;
function AvailPageFile: string;
var
 MemStat: TMemoryStatus;
begin
 MemStat.dwLength := sizeof(MemStat);
 GlobalMemoryStatus(MemStat);
 result := inttoStr(memstat.dwAvailPageFile div 1024);
end;
function VirTotPageFile: string;
var
 MemStat: TMemoryStatus;
begin
 MemStat.dwLength := sizeof(MemStat);
 GlobalMemoryStatus(MemStat);
 result := inttoStr(memstat.dwTotalVirtual div 1024);
end;
function AvailVir: string;
var
 MemStat: TMemoryStatus;
begin
 MemStat.dwLength := sizeof(MemStat);
 GlobalMemoryStatus(MemStat);
 result := inttoStr(memstat.dwAvailVirtual div 1024);
end;
ID: 01619
----
uses
 Windows;
function TMyApp.GlobalMemoryStatus(Index: Integer): Integer;
var
 MemoryStatus: TMemoryStatus
begin
 with MemoryStatus do
 begin
 dwLength := SizeOf(TMemoryStatus);
 Windows.GlobalMemoryStatus(MemoryStatus);
 case Index of
 1: Result := dwMemoryLoad;
 2: Result := dwTotalPhys div 1024;
 3: Result := dwAvailPhys div 1024;
 4: Result := dwTotalPageFile div 1024;
 5: Result := dwAvailPageFile div 1024;
 6: Result := dwTotalVirtual div 1024;
 7: Result := dwAvailVirtual div 1024;
 else
 Result := 0;
 end;
 end;
end;
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 01620
Как получить разрешение принтера по умолчанию?

uses
 Printers;
function GetPixelsPerInchX: Integer;
begin
 Result := GetDeviceCaps(Printer.Handle, LOGPIXELSX)
end;
function GetPixelsPerInchY: Integer;
begin
 Result := GetDeviceCaps(Printer.Handle, LOGPIXELSY)
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 Caption := Format('x: %d y: %d DPI (dots per inch)',
 [GetPixelsPerInchX, GetPixelsPerInchY]);
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 03201
Category:Принтер
Как получить результирующим полем разницу между хранимой датой и текущей датой

=== Как получить результирующим полем разницу между хранимой датой и текущей датой ===
SELECT CAST((поле_с_датой -"NOW") AS INTEGER) FROM MyBase
Получишь результат в днях.
Source: Взято с http://delphiworld.narod.ru
ID: 03099
Category:Базы данных
Category:SQL
Как получить серийный номер тома жесткого диска?

=== Как получить серийный номер тома жесткого диска? ===
procedure TForm1.Button1Click(Sender: TObject);
var
 VolumeName,
 FileSystemName: array [0..MAX_PATH-1] of Char;
 VolumeSerialNo: DWord;
 MaxComponentLength,
 FileSystemFlags: Integer;
begin
 GetVolumeInformation('C:\', VolumeName, MAX_PATH, @VolumeSerialNo,
 MaxComponentLength, FileSystemFlags,
 FileSystemName, MAX_PATH);
 Memo1.Lines.Add('VName = ' + VolumeName);
 Memo1.Lines.Add('SerialNo = $' + IntToHex(VolumeSerialNo, 8));
 Memo1.Lines.Add('CompLen = ' + IntToStr(MaxComponentLength));
 Memo1.Lines.Add('Flags = $' + IntToHex(FileSystemFlags, 4));
 Memo1.Lines.Add('FSName = ' + FileSystemName);
end; 
Source: https://delphisources.ru
ID: 01384
Как получить сообщение об изменении видео стиля?

=== Как получить сообщение об изменении видео стиля? ===
const
 WM_THEMECHANGED = $031A;
type
 TForm1 = class(TForm)
 {...}
 private
 public
 procedure WMTHEMECHANGED(var Msg: TMessage); message WM_THEMECHANGED;
 end;
{...}
implementation
{...}
procedure TForm1.WMTHEMECHANGED(var Msg: TMessage);
begin
 Label1.Caption := 'Theme changed';
 Msg.Result := 0;
end;
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 00401