nyuuzyou/wikis huggingface dataset:
Получить список пользователей, подключённых к сети

unit NetUtils;
interface
uses
 Windows, Classes;
function GetContainerList(ListRoot: PNetResource): TList;
type
 {$H+}
 PNetRes = ^TNetRes;
 TNetRes = record
 dwScope: Integer;
 dwType: Integer;
 dwDisplayType: Integer;
 dwUsage: Integer;
 LocalName: string;
 RemoteName: string;
 Comment: string;
 Provider: string;
 end;
 {H-}
implementation
uses SysUtils;
type
 PnetResourceArr = ^TNetResource;
{ возвращает список сетевых имён с подуровня ListRoot, каждый
элемент списка TList - это PNetRec, где поле RemoteName определяет
соответственно сетевое имя элемента списка. Если ListRoot=nil, то
возвращается самый верхний уровень типа:
1. Microsoft Windows Network
2. Novell Netware Network
Чтобы получить список доменов сети Microsoft, нужно вызвать эту
функцию второй раз, передав ей в качестве параметра,
соответствующий элемент списка, полученного при первом её вызове.
Чтобы получить список компьютеров домена - вызвать третий раз... }
function GetContainerList(ListRoot: PNetResource): TList;
var
 TempRec: PNetRes;
 Buf: Pointer;
 Count, BufSize, Res: DWORD;
 lphEnum: THandle;
 p: PNetResourceArr;
 i: SmallInt;
 NetworkList : TList;
begin
 NetworkList := TList.Create;
 Result:=nil;
 BufSize := 8192;
 GetMem(Buf, BufSize);
 try
 Res := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK,
 RESOURCEUSAGE_CONTAINER{0}, ListRoot,lphEnum);
 { в результате получаем ссылку lphEnum }
 if Res <> 0 then
 raise Exception(Res);
 Count := $FFFFFFFF; { требуем выдать столько записей в список, сколько есть }
 Res := WNetEnumResource(lphEnum, Count, Buf, BufSize);
 { в буфере Buf - списочек в виде массива указателей на структуры
 типа TNetResourceArr, а в Count - число этих структур }
 if Res = ERROR_NO_MORE_ITEMS then
 Exit;
 if (Res <> 0) then
 raise Exception(Res);
 P := PNetResourceArr(Buf);
 for I := 0 to Count - 1 do
 begin
 // Требуется копирование из буфера, так как он
 // действителен только до следующего вызова функций группы WNet
 New(TempRec);
 TempRec^.dwScope := P^.dwScope;
 TempRec^.dwType := P^.dwType ;
 TempRec^.dwDisplayType := P^.dwDisplayType ;
 TempRec^.dwUsage := P^.dwUsage ;
 { имеются ввиду вот эти указатели }
 TempRec^.LocalName := StrPas(P^.lpLocalName);
 { в смысле - строки PChar }
 TempRec^.RemoteName := StrPas(P^.lpRemoteName);
 TempRec^.Comment := StrPas(P^.lpComment);
 TempRec^.Provider := StrPas(P^.lpProvider);
 NetworkList.Add(TempRec);
 Inc(P);
 end;
 Res := WNetCloseEnum(lphEnum);
 { а следующий вызов - вот он! }
 if Res <> 0 then
 raise Exception(Res);
 Result := NetWorkList;
 finally
 FreeMem(Buf);
 end;
end;
end.
Source: http://delphiworld.narod.ru
ID: 03312
Category:Связь
Получить список файлов в ListView как в проводнике

=== Получить список файлов в ListView как в проводнике ===
procedure TForm1.Button1Click(Sender: TObject);
var
 ListItem: TListItem;
 sr: TSearchRec;
 NewColumn: TListColumn;
begin
 NewColumn := ListView1.Columns.Add;
 NewColumn := ListView1.Columns.Add; // добавляются колонки
 if FindFirst('*.*', faAnyFile - faDirectory - faVolumeId, sr) = 0 then
 begin
 ListItem := ListView1.Items.Add; // создается объект
 ListItem.Caption := sr.Name;
 ListItem.SubItems.Add(IntToStr(sr.Size));
 ListItem.SubItems.Add(DateTimeToStr(FileDateToDateTime(sr.Time)));
 while FindNext(sr) = 0 do
 begin
 ListItem := ListView1.Items.Add;
 ListItem.Caption := sr.Name;
 ListItem.SubItems.Add(IntToStr(sr.Size));
 ListItem.SubItems.Add(DateTimeToStr(FileDateToDateTime(sr.Time)));
 end;
 FindClose(sr);
 end;
end;
Source: http://delphiworld.narod.ru/
ID: 01144
Получить список шрифтов и их размеров для текущего принтера

Следующий пример помещает в компонент TMemo список шрифтов и их размеров для текущего принтера.
uses Printers;
function EnumFontFamilyProc(var lf: TLogFont;
 var tm: TNewTextMetric;
 FontType: integer;
 var Memo: TMemo): integer
{$IFDEF WIN32} stdcall;
{$ELSE}; export;
{$ENDIF}
begin
 Memo.Lines.Add(StrPas(@lf.lfFaceName) +
 #32 + IntToStr(lf.lfHeight));
 Result := 1;
end;
function EnumFontFamiliesProc(var lf: TLogFont;
 var tm: TNewTextMetric;
 FontType: integer;
 var Memo: TMemo): integer
{$IFDEF WIN32} stdcall;
{$ELSE}; export;
{$ENDIF}
begin
 if FontType = TRUETYPE_FONTTYPE then
 begin
 Memo.Lines.Add(StrPas(@lf.lfFaceName) + #32 + 'All Sizes');
 end
 else
 EnumFontFamilies(Printer.Handle,
 @lf.lfFaceName,
 @EnumFontFamilyProc,
 LongInt(@Memo));
 Result := 1;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
 tm: TTextMetric;
 i: integer;
begin
 if PrintDialog1.Execute then
 begin
 EnumFontFamilies(Printer.Handle,
 nil,
 @EnumFontFamiliesProc,
 LongInt(@Memo1));
 end;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 03219
Category:Принтер
Получить статус питания

=== Получить статус питания ===
procedure TForm1.Button1Click(Sender: TObject);
var
 SysPowerStatus: TSystemPowerStatus;
begin
 GetSystemPowerStatus(SysPowerStatus);
 if Boolean(SysPowerStatus.ACLineStatus) then
 begin
 ShowMessage('System running on AC.');
 end
 else
 begin
 ShowMessage('System running on battery.');
 ShowMessage(Format('Battery power left: %d percent.', [SysPowerStatus.BatteryLifePercent]));
 end;
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01680
Получить текст элемента перечисляемого типа

=== Получить текст элемента перечисляемого типа ===
// For example, if you have some enum type
// Als Beispiel, wenn dieser Aufzahlungstyp vorhanden ist
{....} 
type 
 TYourEnumType = (One, Two, Three, Four, Five, Six, Seven, Eight, Nine, Ten); 
{....} 
{ 
 And you want in run-time to get a string with same value for each of 
 them (for example, fill the Listbox items with enum values), then you 
 can use the next procedure: 
} 
uses TypInfo; 
procedure TForm1.Button1Click(Sender: TObject); 
var 
 i: Integer; 
begin 
 for i := Ord(Low(TYourEnumType)) to Ord(High(TYourEnumType)) do 
 ListBox1.Items.Add(GetEnumName(TypeInfo(TYourEnumType), i)); 
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 00781
Получить установленный по умолчанию Screen Saver

=== Получить установленный по умолчанию Screen Saver ===
uses
 Inifiles, ShellApi;
procedure TForm1.Button1Click(Sender: TObject);
var
 Ini: TInifile;
 ScreenSaverFile: string;
 function GetLongFileName(const FileName: string): string;
 var
 aInfo: TSHFileInfo;
 begin
 if SHGetFileInfo(PChar(FileName), 0, aInfo, SizeOf(aInfo), SHGFI_DISPLAYNAME) <> 0 then
 Result := string(aInfo.szDisplayName)
 else
 Result := FileName;
 end;
begin
 Ini := TInifile.Create('system.ini');
 ScreenSaverFile := GetLongFileName(Ini.Readstring('boot', 'SCRNSAVE.EXE', 'Not Available'));
 Ini.Free;
 label1.Caption := ScreenSaverFile;
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 02383
Получить цвет пикселя на рабочем столе

=== Получить цвет пикселя на рабочем столе ===
function DesktopColor(const X, Y: Integer): TColor;
var
 c: TCanvas;
begin
 c := TCanvas.Create;
 try
 c.Handle := GetWindowDC(GetDesktopWindow);
 Result := GetPixel(c.Handle, X, Y);
 finally
 c.Free;
 end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
 Pos: TPoint;
begin
 GetCursorPos(Pos);
 Panel1.Color := DesktopColor(Pos.X, Pos.Y);
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01833
Получить язык MS Word

Как узнать язык установленного MS Word?
// Можно инициализировать экземпляр Word.Application и прочитать CountryID:
var
 word: OLEVariant;
begin
 word := CreateOLEObject('Word.Application');
 CountryID := word.System.Country;
 word.Quit;
 word := UnAssigned;
end;
 // Затем сравните CountryID со следующими значениями:
 wdUS = $00000001;
 wdCanada = $00000002;
 wdLatinAmerica = $00000003;
 wdNetherlands = $0000001F;
 wdFrance = $00000021;
 wdSpain = $00000022;
 wdItaly = $00000027;
 wdUK = $0000002C;
 wdDenmark = $0000002D;
 wdSweden = $0000002E;
 wdNorway = $0000002F;
 wdGermany = $00000031;
 wdPeru = $00000033;
 wdMexico = $00000034;
 wdArgentina = $00000036;
 wdBrazil = $00000037;
 wdChile = $00000038;
 wdVenezuela = $0000003A;
 wdJapan = $00000051;
 wdTaiwan = $00000376;
 wdChina = $00000056;
 wdKorea = $00000052;
 wdFinland = $00000166;
 wdIceland = $00000162;
Source: http://www.swissdelphicenter.ch
ID: 04439
Category:COM
Category:MS Office
Поместить/получить строку из буфера обмена (Заплатка к стандартным)

=== Поместить/получить строку из буфера обмена (Заплатка к стандартным) ===
{ **** UBPFD *********** by kladovka.net.ru ****
>> Поместить/получить строку из буфера обмена (Заплатка к стандартным)
Под Win2k попытка вставить русскую строку в Clipboard 
ClipBoard.AsText:='Проба' с последующей вставкой в Word'е 
показывает кракозябрики.. Расследование показало, что виноваты 
мелкомягкие (как обычно :) ) С целью нивелирования различий между 
всеми Win-платформами были написаны эти 2 ф-ции..
Принимают на вход/возвращают строку в Unicode - WideString.. 
но не надо беспокоиться, Дельфи сам вставит при необходимости 
конвертацию в/из AnsiString.
Если платформа поддерживает уникод (NT), то используется этот формат, 
иначе вызываются стандартные процедуры/ф-ции.
Удачи!
Зависимости: ClipBrd
Copyright: Shaman_Naydak
Дата: 26 июня 2002 г.
********************************************** }
procedure PutStringIntoClipBoard(const Str: WideString);
var
 Size: Integer;
 Data: THandle;
 DataPtr: Pointer;
begin
 Size:=Length(Str);
 if Size = 0 then exit;
 if not IsClipboardFormatAvailable(CF_UNICODETEXT) then
 Clipboard.AsText:=Str
 else
 begin
 Size:=Size shl 1 + 2;
 Data := GlobalAlloc(GMEM_MOVEABLE+GMEM_DDESHARE, Size);
 try
 DataPtr := GlobalLock(Data);
 try
 Move(Pointer(Str)^, DataPtr^, Size);
 Clipboard.SetAsHandle(CF_UNICODETEXT, Data);
 finally
 GlobalUnlock(Data);
 end;
 except
 GlobalFree(Data);
 raise;
 end;
 end;
end;
function GetStringFromClipboard: WideString;
var
 Data: THandle;
begin
 if not IsClipboardFormatAvailable(CF_UNICODETEXT) then
 Result:=Clipboard.AsText
 else
 begin
 Clipboard.Open;
 Data := GetClipboardData(CF_UNICODETEXT);
 try
 if Data <> 0 then
 Result := PWideChar(GlobalLock(Data))
 else
 Result := ;
 finally
 if Data <> 0 then GlobalUnlock(Data);
 Clipboard.Close;
 end;
 end;
end;
Source: kladovka.net.ru
ID: 01900
Поместить список контролов и пунктов меню в TTreeView

=== Поместить список контролов и пунктов меню в TTreeView ===
uses
 ComCtrls, Menus, Classes, Forms, Controls, Windows, Messages;
function GetControlCaption(Control: TWinControl): ShortString;
// Slightly modified version of Twister's Tip
//
// function GetCaptionAtPoint(pt: TPoint): string;
//
var
 TextLength: Integer;
 Text: PChar;
begin
 if not Boolean(Control.Handle) then Exit;
 Result := Control.Name; // if Control doesn't have Caption
 // Control.Name is returned
 TextLength := SendMessage(Control.Handle, WM_GETTEXTLENGTH, 0, 0);
 if TextLength 0 then
 begin
 GetMem(Text, TextLength + 1);
 SendMessage(Control.Handle, WM_GETTEXT, TextLength + 1, Integer(Text));
 Result := Text;
 FreeMem(Text);
 end;
end;
// function GetCaptionAtPoint(pt: TPoint): ShortString;
// begin
// Result:= GetControlCaption(FindVCLWindow(pt));
// end;
procedure FindAllMenuItems(AppTree: TTreeView; MenuItem: TMenuItem; Parent: TTreeNode);
var
 loop: Integer;
 Node: TTreeNode;
 mItem: TMenuItem;
 Name: ShortString;
begin
 for loop := 0 to MenuItem.Count - 1 do
 begin
 mItem := MenuItem.Items[loop];
 Name := mItem.Caption;
 Node := AppTree.Items.AddChildObject(Parent, Name, mItem);
 if mItem.Count <> 0 then
 FindAllMenuItems(AppTree, mItem, Node);
 end;
end;
procedure FindAllControls(AppTree: TTreeView; Comp: TComponent; Parent: TTreeNode);
var
 Child: TComponent;
 loop, start, Index: Integer;
 Name: ShortString;
 Node, Mnode: TTreeNode;
begin
 start := 0;
 if Comp is TApplication then
 begin
 // Parent:= AppTree.Items.AddObjectFirst(Parent, 'Application', nil);
 // if you want to see the root ('Application') uncomment
 start := 1;
 end;
 for loop := start to Comp.ComponentCount - 1 do
 begin
 Child := Comp.Components[loop];
 Name := Child.Name;
 if Child is TControl then
 begin
 if Child is TWinControl then
 begin // does Child have Caption property??
 Name := GetControlCaption(TWinControl(Child));
 end;
 Node := AppTree.Items.AddChildObject(Parent, Name, Child);
 if Child.ComponentCount <> 0 then
 FindAllControls(AppTree, Child, Node);
 end;
 if Child is TMenu then
 begin
 Node := AppTree.Items.AddChildObject(Parent, Name, Child);
 for Index := 0 to TMenu(Child).Items.Count - 1 do
 begin
 Mnode := AppTree.Items.AddChildObject(Node, TMenu(Child).Items[Index].Caption,
 TMenu(Child).Items[Index]);
 FindAllMenuItems(AppTree, TMenu(Child).Items[Index], Mnode);
 end;
 end;
 end;
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01121
Помещение компонентов в StringGrid

=== Помещение компонентов в StringGrid ===
Некоторое время тому назад такой вопрос уже ставился: возможно ли поместить элемент управления, например, CheckBox или ComboBox внутрь компонента ...Grid. Я сегодня помозговал и нашел неплохую, на мой взгляд, технологию. Это работает! Вот решение для тех, кто этим интересуется: 
При создании компонента (в обработчике OnCreate), создайте его объекты Objects[C,R], например TCheckBox.Create(Self). Имейте в виду, что вы должны присвоить ячейкам Cells[C,R] какие-либо значения прежде, чем чем вы сможете иметь доступ к Objects[C,R]. Установите у вновь созданного компонента свойство Visible в FALSE, а свойство parent в SELF. Осуществите другую необходимую инициализацию. Имейте в виду, что вы должны внести необходимые модули в список uses, если создаете тип компонента, которого нигде кроме как на форме нет. 
Создайте процедуру, берущую координаты колонки/строки и правильно позиционирующую соотвествующий объект в пределах прямоугольника ячейки, например:
{ Размещаем содержимое компонента в области прямоугольника ячейки }
procedure TForm1.FixObjPosn(vCol, vRow: LongInt);
var
 R: TRect;
begin
 R := StringGrid1.CellRect(vCol, vRow);
 if StringGrid1.Objects[vCol, vRow] is TControl then
 begin
 with TControl(StringGrid1.Objects[vCol, vRow]) do
 begin
 if R.Right = R.Left then { прямоугольник ячейки невидим }
 Visible := False
 else
 begin
 InflateRect(R, -1, -1);
 OffsetRect(R, StringGrid1.Left + 1, StringGrid1.Top + 1);
 BoundsRect := R;
 Visible := True;
 end;
 end;
 end;
end;
смещение позиции необходимо, поскольку CellRect рассчитывается относительно верхнего левого угла строки сетки, и родителем компонента является форма). 
В обработчике события сетки OnSelectCell проверьте, располагается ли элемент Objects в текущей колонке Col и строке Row TControl - если так, установите его свойство visible в FALSE. Теперь вызовите процедуру установления координат из шага 2 для *НОВЫХ* Col и Row, передавая их из параметров обработчика события в параметры функции. 
В обработчике OnTopLeftChanged просто вызовите FixObjPosn 
В обработчике события OnDrawCell во-первых, если ячейка выбрана, EXIT. Если элемент ячейки Objects не TControl, также EXIT. В противном случае вам нужно создать код, обеспечивающий отрисовку "фасада" каждого типа элемента управления, которого вы разместили в сетке. 
Обратите внимание на то, что если вы делаете что-либо с элементом управления, на который влияют ДРУГИЕ элементы управления (например, изменение статуса какой-либо радиокнопки из группы, или операции enable/disable), вы должны вызвать метод сетки Refresh.
Опс! Это звучит немного запутанно, но это работает. Успехов!
Source: Взято с http://delphiworld.narod.ru
ID: 00384
Помещение формы в поток

=== Помещение формы в поток ===
Delphi имеет в своем распоряжении классную функцию, позволяющую сделать это:
procedure WriteComponentResFile(const FileName: string;
 Instance: TComponent);
Просто заполните имя файла, в котором вы хотите сохранить компонент, и читайте его затем следующей функцией:
function ReadComponentResFile(const FileName: string;
 Instance: TComponent): TComponent;
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 00306
Помогите спрятать программу из списка задач?

=== Помогите спрятать программу из списка задач? ===
Или Как заказать сервисный процесс ?
unit Stealth;
interface
uses
 WinTypes, WinProcs, Classes, Forms, SysUtils, Controls, Messages;
type
 TStealth = class(TComponent)
 private
 FHideApp: boolean;
 procedure SetHideApp(Value: boolean);
 protected
 { Protected declarations }
 procedure HideApplication;
 procedure ShowApplication;
 public
 { Public declarations }
 constructor Create(AOwner: TComponent); override;
 destructor Destroy; override;
 // procedure Loaded; override;
 published
 { Published declarations }
 property HideApp: boolean read FHideApp write SetHideApp default False;
 end;
function RegisterServiceProcess(dwProcessID, dwType: integer): integer;
 stdcall; external 'KERNEL32.DLL';
procedure Register;
implementation
destructor TStealth.Destroy;
begin
 ShowApplication;
 inherited Destroy;
end;
constructor TStealth.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 // fHideform := true;
end;
procedure TStealth.SetHideApp(Value: boolean);
begin
 FHideApp := Value;
 if Value then
 HideApplication
 else
 ShowApplication;
end;
procedure TStealth.HideApplication;
begin
 if not (csDesigning in ComponentState) then
 RegisterServiceProcess(GetCurrentProcessID, 1);
end;
procedure TStealth.ShowApplication;
begin
 if not (csDesigning in ComponentState) then
 RegisterServiceProcess(GetCurrentProcessID, 0);
end;
procedure Register;
begin
 RegisterComponents('My', [TStealth]);
end;
end.
Author: Admin
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 02040
Понятия Instance, Database etc

=== Понятия Instance, Database etc ===
Перевод документации:
; Что такое ORACLE Database?
: Это данные которые будут обрабатываться как единое целое. Database состоит из файлов операционной системы. Физически существуют database files и redo log files. Логически database files содержат словари, таблицы пользователей и redo log файлы. Дополнительно database требует одну или более копий control file.
; Что такое ORACLE Instance?
: ORACLE Instance обеспечивает программные механизмы доступа и управления database. Instance может быть запущен независимо от любой database (без монтирования или открытия любой database). Один instance может открыть только одну database. В то время как одна database может быть открыта несколькими Instance.
Instance состоит из:
* SGA (System Global Area), которая обеспечивает коммуникацию между процессами;
* до пяти (в последних версиях больше) бэкграундовых процессов.
От себя добавлю - database включает в себя tablespace, tablespace включает в себя segments (в одном файле данных может быть один или несколько сегментов, сегменты не могут быть разделены на несколько файлов). segments включают в себя extents.
Author: Nomadic 
Source: Взято с http://delphiworld.narod.ru
ID: 02734
Порог между двумя цветами на Bitmap

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Порог между двумя цветами на Bitmap
Bitmap преобразуется в двухцветное изображение.
Зависимости: Graphics
Автор: Fenik, chook_nu@uraltc.ru, Новоуральск
Copyright: Собственное написание (Николай федоровских)
Дата: 1 июня 2002 г.
***************************************************** }
procedure Threshold(Bitmap: TBitmap; Value: Byte; Color1, Color2: TColor);
type
 TRGB = record
 B, G, R: Byte;
 end;
 pRGB = ^TRGB;
 function ColorToRGB(Color: TColor): TRGB;
 begin
 with Result do
 begin
 R := Lo(Color);
 G := Lo(Color shr 8);
 B := Lo((Color shr 8) shr 8);
 end;
 end;
var
 x, y: Word;
 C1, C2: TRGB;
 Dest: pRGB;
begin
 Bitmap.PixelFormat := pf24Bit;
 C1 := ColorToRGB(Color1);
 C2 := ColorToRGB(Color2);
 for y := 0 to Bitmap.Height - 1 do
 begin
 Dest := Bitmap.ScanLine[y];
 for x := 0 to Bitmap.Width - 1 do
 begin
 // если среднеарифметическое R, G и B больше Value,
 // то точку (x, y) закрашиваем цветом Color1,
 // иначе - цветом Color2
 if (Dest^.r + Dest^.g + Dest^.b) / 3 > Value then
 Dest^ := C1
 else
 Dest^ := C2;
 Inc(Dest);
 end;
 end;
end;
Пример использования:
Threshold(FBitmap, 127, clWhite, clBlack);
Author: Fenik, chook_nu@uraltc.ru, Новоуральск
Source: http://delphibase.endimus.com
ID: 03787
Category:Графика
Category:Bitmap
Послать Alt + буква другому приложению

=== Послать Alt + буква другому приложению ===
Как мне программно нажать ALT + буква(VK_...) в другом приложении. Хендл я нашел, делаю так
SendMessage(Handle_, WM_KEYDOWN, VK_MENU,0);
SendMessage(Handle_, WM_KEYDOWN, VK_F1,0);
SendMessage(Handle_, WM_KEYUP, VK_F1,0);
но у меня не получается, что не так?
Попробуй так
SendMessage(Handle, WM_KEYDOWN, Byte(C), $20000001);
Source: Взято из http://forum.sources.ru
ID: 02116
После внесения изменений в реестр, некоторые программы не видят их

=== После внесения изменений в реестр, некоторые программы не видят их ===
Необходимо послать всем окнам сообщение WM_WININICHANGE с указанием полного адреса измененного адреса ключа.
procedure TForm1.Button1Click(Sender: TObject);
begin
 SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, LongInt(PChar('RegistrySection')));
end;
Author: Автор: Олег Кулабухов 
Source: http://delphiworld.narod.ru/
ID: 02290
== См. также ==
* Как уведомить все приложения, что реестр был изменён?
После логина возникает EExternalError 0xC0000008

=== После логина возникает EExternalError 0xC0000008 ===
Windows 4.0 + Delphi 2.01 C/S + Oracle Client 7.3 + Oracle Server 7.3. После логина в базу данных возникает "EExternalError 0xC0000008". Что делать?
Снести Oracle Trace Collection Services.
 Copyright (C) Alexey Mahotkin 1997-1999
ID: 02735
Постраничная прокрутка Memo, когда фокус находится на Edit

=== Постраничная прокрутка Memo, когда фокус находится на Edit ===
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
 if Key = VK_F8 then
 SendMessage(Memo1.Handle, { HWND для Memo }
 WM_VSCROLL, { сообщение Windows }
 SB_PAGEDOWN, { на страницу вниз }
 0) { не используется }
 else if Key = VK_F7 then
 SendMessage(Memo1.Handle, WM_VSCROLL, SB_PAGEUP, 0);
end;
Source: http://delphiworld.narod.ru/
ID: 01006
Построение древа TreeView из базы данных

=== Построение древа TreeView из базы данных ===
procedure TOrgColumn.LoadTreeView;
type
 PItemData=^TItemData;
 TItemData=record
 Index:Integer;
 end;
var
 tnNew: TTreeNode;
 idNewItem: PItemData;
 i: integer;
begin
 TreeView1.Items.Clear;
 with data.QOrganCol do
 begin
 Active := false;
 SQL.Clear;
 SQL.Add('SELECT * FROM OrganizationColumns.DB');
 SQL.Add('ORDER BY NumColumn, Name');
 ExecSQL;
 Active := True;
 end;
 data.QOrganCol.First;
 while data.QOrganCol.Eof <> True do
 begin
 tnNew := nil;
 if data.QOrganCol.Fields[2].AsInteger > 0 then
 for i := 0 to TreeView1.Items.Count-1 do
 begin
 if PItemData(TreeView1.Items[i].Data).Index = data.QOrganCol.Fields[2].AsInteger then
 tnNew := TreeView1.Items[i];
 end;
 with TreeView1.Items.AddChild(tnNew, data.QOrganCol.Fields[3].AsString) do
 begin
 ImageIndex := 1;
 SelectedIndex := 0;
 idNewItem := new(PItemData);
 Data := idNewItem;
 idNewItem.Index := dmodule.data.QOrganCol.Fields[0].AsInteger;
 end;
 data.QOrganCol.Next;
 end;
end;
Author: dron-s 
Source: Взято из http://forum.sources.ru
ID: 03089
Category:Базы данных
Category:DBTreeView