nyuuzyou/wikis huggingface dataset:
Как добавить событие OnMouseLeave?

=== Как добавить событие OnMouseLeave? ===
Все потомки TComponent могут посылать сообщения CM_MOUSEENTER и CM_MOUSELEAVE во время вхождения и покидания курсора мыши области компонента. Если вам необходимо, чтобы ваши компоненты обладали реакцией на эти события, необходимо написать для них соответствующие обработчики. 
procedure CMMouseEnter(var msg:TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var msg: TMessage); message CM_MOUSELEAVE;
..
..
..
procedure MyComponent.CMMouseEnter(var msg:TMessage);
begin
 inherited;
 { действия на вход мыши в область компонента }
end;
procedure MyComponent.CMMouseLeave(var msg: TMessage);
begin
 inherited;
 { действия на покидание мыши области компонента }
end; 
Дополнение 
Часто приходится сталкиваться с ситуацией, когда необходимо обработать два важных события для визуальных компонентов: 
 MouseEnter - когда событие мыши входит в пределы визуального компонента; 
 MouseLeave - когда событие мыши оставляет его пределы.
Известно, что все Delphi объявляет эти сообщения в виде: 
* Cm_MouseEnter; 
* Cm_MouseLeave.
Т.е. все визуальные компоненты, которые порождены от TControl, могут отлавливать эти события. Следующий пример показывает как создать наследника от TLabel и добавить два необходимых события OnMouseLeave и OnMouseEnter.
(*///////////////////////////////////////////////////////*)
(*// Author: Briculski Serge
(*// E-Mail: bserge@airport.md
(*// Date: 26 Apr 2000
(*///////////////////////////////////////////////////////*)
unit BS_Label;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls;
type
 TBS_Label = class(TLabel)
 private
 { Private declarations }
 FOnMouseLeave: TNotifyEvent;
 FOnMouseEnter: TNotifyEvent;
 procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
 procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
 protected
 { Protected declarations }
 public
 { Public declarations }
 published
 { Published declarations }
 property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
 property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
 end;
procedure Register;
implementation
procedure Register;
begin
 RegisterComponents('Custom', [TBS_Label]);
end;
{ TBS_Label }
procedure TBS_Label.CMMouseEnter(var Message: TMessage);
begin
 if Assigned(FOnMouseEnter) then
 FOnMouseEnter(Self);
end;
procedure TBS_Label.CMMouseLeave(var Message: TMessage);
begin
 if Assigned(FOnMouseLeave) then
 FOnMouseLeave(Self);
end;
end.
Source: Взято с http://delphiworld.narod.ru
ID: 00344
Как добавить текст в footer документа?

"Подвал" документа:
aDoc := WordApp.Documents.Add(EmptyParam, EmptyParam);
aDoc.Sections.Item(1).Footers.Item(wdHeaderFooterPrimary).Range.Text := 'This is a footer';
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 04427
Category:COM
Category:MS Office
Как добавить текст в header документа?

aDoc := WordApp.Documents.Add(EmptyParam, EmptyParam);
aDoc.Sections.Item(1).Headers.Item(wdHeaderFooterPrimary).Range.Text := 'This is a header';
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 04426
Category:COM
Category:MS Office
Как добавить текст к закладке?

uses
 ComObj;
procedure TForm1.Button1Click(Sender: TObject);
const
 // Word Document to open
 YourWordDocument = 'c:\test\worddoc.doc';
var
 BookmarkName, Doc, R: OleVariant;
begin
 // Start a Word instance
 try
 WordApp := CreateOleObject('Word.Application');
 except
 ShowMessage('Could not start MS Word!');
 end;
 // Open your Word document
 WordApp.Documents.Open(YourWordDocument);
 Doc := WordApp.ActiveDocument;
 // name of your bookmark
 BookmarkName := 'MyBookMark';
 // Check if bookmark exists
 if Doc.Bookmarks.Exists(BookmarkName) then
 begin
 R := Doc.Bookmarks.Item(BookmarkName).Range;
 // Add text at our bookmark
 R.InsertAfter('Text in bookmark');
 // You make a text formatting like changing its color
 R.Font.Color := clRed;
 end;
 // Save your document and quit Word
 if not VarIsEmpty(WordApp) then
 begin
 WordApp.DisplayAlerts := 0;
 WordApp.Documents.Item(1).Save;
 WordApp.Quit;
 BookmarkName := Unassigned;
 R := Unassigned;
 WordApp := Unassigned;
 end;
end;
Source: Взято с Delphi Knowledge Base: http://www.baltsoft.com/
ID: 04423
Category:COM
Category:MS Office
Как добавить текущую страницу TWebbrowser в favorites?

// You need: 1 TEdit, 2 TButtons, 1 TWebbrowser
// Du brauchst: 1 TEdit, 2 TButtons, 1 TWebbrowser
const
 NotAllowed: set of Char = ['"'] + ['/'] + ['\'] + ['?'] + [':'] + ['*'] +
 ['<'] + ['>'] + ['|'];
implementation
{$R *.DFM}
function Load(Path, Key: string): string;
var
 Reg: TRegistry;
begin
 Reg := TRegistry.Create;
 try
 Reg.RootKey := HKEY_CURRENT_USER;
 Reg.OpenKey(Path, False);
 try
 Result := Reg.ReadString(Key);
 except
 Result := ;
 end;
 Reg.CloseKey;
 finally
 Reg.Free;
 end;
end;
function WinDir: string;
var
 WinDir: PChar;
begin
 WinDir := StrAlloc(MAX_PATH);
 GetWindowsDirectory(WinDir, MAX_PATH);
 Result := string(WinDir);
 if Result[Length(Result)] <> '\' then
 Result := Result + '\';
 StrDispose(WinDir);
end;
function GetSysDir: string;
var
 dir: array [0..MAX_PATH] of Char;
begin
 GetSystemDirectory(dir, MAX_PATH);
 Result := StrPas(dir);
end;
// Navigate to a page
procedure TForm1.Button1Click(Sender: TObject);
begin
 Webbrowser1.Navigate(edit1.Text);
end;
// Add the current page to the favorites
procedure TForm1.Button2Click(Sender: TObject);
var
 url: TStringList;
 fav: string;
 title, b: string;
 i: Integer;
 c: Char;
begin
 fav := Load('Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders','Favorites');
 url := TStringList.Create;
 try
 url.Add('[InternetShortcut]');
 url.Add('URL=' + webbrowser1.LocationURL);
 url.Add('WorkingDirectory=' + WinDir());
 url.Add('IconIndex=0');
 url.Add('ShowCommand=7');
 url.Add('IconFile=' + GetSysDir() + '\url.dll');
 title := Webbrowser1.LocationName;
 b := ;
 for i := 1 to Length(title) do
 begin
 c := title[i];
 if not (c in NotAllowed) then
 begin
 b := b + Webbrowser1.LocationName[i];
 end;
 end;
 url.SaveToFile(fav + '\' + b + '.url');
 finally
 url.Free;
 end;
end;
end.
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 03461
Category:Связь
Category:WebBrowser
Как добавить файл в меню Пуск/Документы

=== Как добавить файл в меню Пуск/Документы ===
Эта программа добавляет файл "File.txt" в "Пуск/Документы". 
uses ShlOBJ;
procedure TForm1.Button1Click(Sender: TObject);
begin
 SHAddToRecentDocs(SHARD_PATH, PChar('File.txt'));
end;
 e-mail: delphi4all@narod.ru
 e-mail: aleksey@sch103.krasnoyarsk.su
Author: : Алексей Денисов
ID: 01803
Как добавить функции картографирования в приложение

Очень просто, идешь на http://www.dataplus.ru/win/DownLoad.htm и скачиваешь MapObjects LT Evaluation Copy (1,756 Mb) и MapObjects LT samples (3,343 Mb). Все это может работать под Visual Basic, Visual C++, Delphi и PowerBuilder. Ну а если есть деньги то советую MapObjects 2.1 http://www.dataplus.ru/WIN/NEWS/2001/May/MO2.1.htm
ID: 03630
Category:Графика
Как добавлять в ListView полноцветные иконки?

=== Как добовлять в ListView полноцветные иконки? ===
procedure TForm1.FormCreate(Sender: TObject);
var
 SysIL : THandle;
 SysSIL : THandle;
 SFI : TSHFileInfo;
begin
 SysImageList1 := TImageList.Create(self);
 with SysImageList1 do
 begin
 Width := 16;
 Height := 16;
 SysSIL := SHGetFileInfo(, 0, SFI, SizeOf(SFI),
 SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
 if SysSIL <> 0 then
 begin
 SysImageList1.Handle := SysSIL;
 ShareImages := True;
 end;
 end;
 SysImageList2 := TImageList.Create(self);
 with SysImageList2 do
 begin
 Width := 32;
 Height := 32;
 SysIL := SHGetFileInfo(, 0, SFI, SizeOf(SFI),
 SHGFI_SYSICONINDEX or SHGFI_LARGEICON);
 if SysIL <> 0 then
 begin
 SysImageList2.Handle := SysIL;
 ShareImages := True;
 end;
 end;
end;
function GetIconIndex(const AFile: string; Attrs: DWORD): integer;
var
 SFI: TSHFileInfo;
begin
 SHGetFileInfo(PChar(AFile), Attrs, SFI, SizeOf(TSHFileInfo),
 SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);
 Result := SFI.iIcon;
end;
with ListView.Items.Add do
begin
 Caption := FName;
 ImageIndex := GetIconIndex(Caption, FILE_ATTRIBUTE_NORMAL);
 SubItems.Add(FSize); 
 SubItems.Add(FType);
 SubItems.Add(FDateTime);
end;
Author: alexanderm
Source: Взято из http://forum.sources.ru
ID: 00634
Как добавлять колонки в обычный Listbox (TListbox)?

=== Как добавлять колонки в обычный Listbox (TListbox)? ===
Класс TListbox содержит свойство TabWith:
ListBox1.TabWith := 50; 
ListBox1.Items.Add('Column1'#9'Column2'); // #9 это символ Tab
Source: Взято из http://forum.sources.ru
ID: 00649
Как добиться верной работы фильтра на запросах и на неиндексированных таблицах

=== Как добиться верной работы фильтра на запросах и на неиндексированных таблицах ===
(Т.е. при работе программы наблюдалась следующая картина: в результате очередной фильтрации оставалось видно 4 записи из восьми. Добавляем букву к фильтру, остается, допустим, две. Убираем букву, которую только что добавили, в гриде все равно видно только две записи)
Эта проблема была в Delphi 3.0 только на TQuery, а в Delphi 3.01 появилась и в TTable. Лечится так (простой пример):
procedure TMainForm.Edit1Change(Sender: TObject);
begin
 if Length(Edit1.Text) > 0 then
 begin
 Table1.Filtered := True;
 UpdateFilter(Table1);
 end
 else
 Table1.Filtered := False;
end;
procedure TMainForm.UpdateFilter(DataSet: TDataSet);
var
 FR: TFilterRecordEvent;
begin
 with DataSet do
 begin
 FR := OnFilterRecord;
 if Assigned(FR) and Active then
 begin
 DisableControls;
 try
 OnFilterRecord := nil;
 OnFilterRecord := FR;
 finally
 EnableControls;
 end;
 end;
 end;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 02627
Как добраться до конкретного фрейма?

var
 HTML_Doc: IHTMLDocument2;
 Window: IHTMLWindow2;
 oRange1: variant;
 name_frame: OleVariant;
begin
 HTML_Doc := WebBrowser1.Document as IHTMLDocument2;
 Window := HTML_Doc.parentWindow as IHTMLWindow2;
 name_frame := 'mainFrame';
 oRange1 := Window.frames.item(name_frame).document.body.createTextRange;
end;
Author: Good Man
Source: Vingrad.ru http://forum.vingrad.ru
ID: 03490
Category:Связь
Category:WebBrowser
Как долго запущена Windows?

=== Как долго запущена Windows? ===
Ниже приведён код обработчика события OnClick для Button1. Он показывает диалоговое окошко с текстом в следующем формате
 Windows started on Thursday, February 10, 2000 at 11:42:46 AM 
 Its been up for 0 days, 3 hours, 22 minutes, 54 seconds 
procedure TForm1.Button1Click(Sender: TObject); 
var 
 ndays: double; 
 ticks: LongInt; 
 btime: TDateTime; 
begin 
 { Функция GetTickCount получает количество миллисекунд, прошедших с момента старта Windows }
 ticks := GetTickCount; 
 { Чтобы получить дни, необходимо разделить на количество миллисекунд в дне, 24*60*60*1000=86400000 } 
 ndays := ticks/86400000; 
 { теперь вычитаем из текущей даты полученное количество дней работы Windows }
 bTime := now-ndays; 
 { показываем диалоговое окошко с сообщением }
 ShowMessage( 
 FormatDateTime('"Windows started on" dddd, mmmm d, yyyy, ' + 
 '"at" hh:nn:ss AM/PM', bTime) + #10#13 + 
 'Its been up for ' + IntToStr(Trunc(nDays)) + ' days,' + 
 FormatDateTime(' h "hours," n "minutes," s "seconds"',ndays)); 
end;
Source: Взято из http://forum.sources.ru
ID: 01652
----
function UpTime: string;
const
 TicksPerDay: Integer = 1000 * 60 * 60 * 24;
 TicksPerHour: Integer = 1000 * 60 * 60;
 TicksPerMinute: Integer = 1000 * 60;
 TicksPerSecond: Integer = 1000;
var
 t: Longword;
 d, h, m, s: Integer;
begin
 t := GetTickCount;
 d := t div TicksPerDay;
 Dec(t, d * TicksPerDay);
 h := t div TicksPerHour;
 Dec(t, h * TicksPerHour);
 m := t div TicksPerMinute;
 Dec(t, m * TicksPerMinute);
 s := t div TicksPerSecond;
 Result := 'Uptime: ' + IntToStr(d) + ' Days ' + IntToStr(h) + ' Hours ' + IntToStr(m) +
 ' Minutes ' + IntToStr(s) + ' Seconds';
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 Label1.Caption := UpTime;
end;
Source: Взято с сайта: http://www.swissdelphicenter.ch
ID: 01653
----
Чтобы определить сколько времени прошло с момента последней перезагрузки системы необходимо воспользоваться функцией
 GetCurrentTime: LongInt; 
Возвращаемое значение: время в миллисекундах. 
Пример использования: 
Edit1.Text := FloatToStr(GetCurrentTime / 1000) + ' секунд с момента перезагрузки';
Source: http://delphiworld.narod.ru
ID: 01654
Как заблокировать TDBGrid от автодобавления новой записи

=== Как заблокировать TDBGrid от автодобавления новой записи ===
Добавьте в обработчик события вашего TTable "BeforeInsert" следующую строку:
procedure TForm1.Tbable1BeforeInsert(DataSet: TDataset);
begin
 Abort; // <<---эту строчку
end;
Осуществляем перехват нажатия клавиши и проверку на конец файла (end-of-file):
procedure TForm8.DBGrid1KeyDown(Sender: TObject;
 var Key: Word; Shift: TShiftState);
begin
 if (Key = VK_DOWN) then
 begin
 TTable1.DisableControls;
 TTable1Next;
 if TTable1.EOF then
 Key := 0
 else
 TTable1.Prior;
 TTable1.EnableControls;
 end;
end;
Source: Взято с http://delphiworld.narod.ru
ID: 03059
Category:Базы данных
Category:DBGrid
Как заблокировать доступ к дисководу?

=== Как заблокировать доступ к дисководу? ===
const
 FILE_DEVICE_FILE_SYSTEM: Integer = $00000009;
 METHOD_BUFFERED: Integer = $00000000;
 FILE_ANY_ACCESS: Integer = $00000000;
function CTL_CODE(DeviceType, FunctionNo, Method, Access: Integer): Integer;
begin
 Result := (DeviceType shl 16) or (Access shl 14) or (FunctionNo shl 2) or (Method);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
 LHandle: THandle;
 BytesReturned: Cardinal;
 MsgBuf: PChar;
 FSCTL_LOCK_VOLUME: Integer;
begin
 FSCTL_LOCK_VOLUME := CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 6, METHOD_BUFFERED, FILE_ANY_ACCESS);
 LHandle := CreateFile('\\.\A:', GENERIC_READ or GENERIC_WRITE,
 FILE_SHARE_READ or FILE_SHARE_WRITE,
 nil, OPEN_EXISTING,
 FILE_ATTRIBUTE_NORMAL or FILE_FLAG_DELETE_ON_CLOSE, 0);
 if LHandle <> 0 then
 begin
 if DeviceIOControl(LHandle, FSCTL_LOCK_VOLUME, nil, 0, nil, 0, BytesReturned, nil) then
 ShowMessage('Дисковод заблокирован. Нажмите ОК для разблокирования.')
 else
 begin
 if FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_FROM_SYSTEM,
 nil, GetLastError(), 0, @MsgBuf, 0, nil) > 0 then
 begin
 ShowMessage('Ошибка DeviceIOControl: ' + MsgBuf);
 LocalFree(Cardinal(MsgBuf));
 end
 else
 ShowMessage('Ошибка при вызове DeviceIOControl!');
 end;
 CloseHandle(LHandle);
 end
 else
 ShowMessage('Ошибка при вызове CreateFile!');
end;
Author: p0s0l
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 01382
Как заблокировать реакцию на клавиатуру компонента?

=== Как заблокировать реакцию на клавиатуру компонента? ===
В обработчике события onKeyDown попробуй поставить: 
Key := 0; 
Author: Vit (www.delphist.com, www.drkb.ru, www.unihighlighter.com, www.nevzorov.org)
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 00360
Как заблокировать функцию вставки записи в компоненте TDBGrid?

=== Как заблокировать функцию вставки записи в компоненте TDBGrid? ===
Не могли бы вы подсказать, как заблокировать функцию вставки записи непосредственно в компоненте TDBGrid с сохранением всех остальных возможностей редактирования таблицы.
Наиболее разумным представляется создать обработчик события OnBeforeInsert компонента TTable, TQuery или TClientDataSet, данные из которых отображаются в TDBGrid. Сам компонент TDBGrid не имеет подходящего события для обработки, так как это компонент, предназначенный только для создания пользовательского интерфейса, а в данном случае следует, по существу, запретить добавление записей в таблицу.
Author: Наталия Елманова
Source: Взято из http://forum.sources.ru
ID: 03033
Category:Базы данных
Category:DBGrid
Как забыть о необходимости разрушать объекты?

=== Как забыть о необходимости разрушать объекты? ===
type
 ISelfDestroy = interface;
 //forget about GUID, if you are not using COM
 TSelfDestroy = class(TInterfacedObject, ISelfDestroy)
 private
 FObject: TObject;
 public
 constructor Create(AObject: TObject);
 destructor Destroy; override;
 end;
implementation
constructor TSelfDestroy.Create(AObject: TObject);
begin
 FObject := AObject;
end;
destructor TSelfDestroy.Destroy;
begin
 FreeAndNil(FObject);
 inherited;
end;
// So when you use, just do like this...
procedure TForm1.Button1Click(Sender: TObject);
var
 MyObject: TMyObject;
 SelfDestroy: ISelfDestroy; // not TSelfDestroy !!
begin
 MyObject := TMyObject.Create;
 SelfDestroy := TSelfDestroy.Create(MyObject);
 // The MyObject will free automatically as soon as ISelfDestroy
 // goes out of scope.
 // Carry on your code here...
end;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 00122
Как завершить любой процесс, в том числе и системный

=== Как завершить любой процесс, в том числе и системный ===
// Включение, применение и отключения привилегии.
// Для примера возьмем привилегию отладки приложений 'SeDebugPrivilege'
// необходимую для завершения ЛЮБЫХ процессов в системе (завершение процессов
// созданных текущим пользователем привилегия не нужна.
function ProcessTerminate(dwPID: Cardinal): Boolean;
var
 hToken: THandle;
 SeDebugNameValue: Int64;
 tkp: TOKEN_PRIVILEGES;
 ReturnLength: Cardinal;
 hProcess: THandle;
begin
 Result := False;
 // Добавляем привилегию SeDebugPrivilege
 // Для начала получаем токен нашего процесса
 if not OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
 exit;
 // Получаем LUID привилегии
 if not LookupPrivilegeValue(nil, 'SeDebugPrivilege', SeDebugNameValue) then
 begin
 CloseHandle(hToken);
 exit;
 end;
 tkp.PrivilegeCount:= 1;
 tkp.Privileges[0].Luid := SeDebugNameValue;
 tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
 // Добавляем привилегию к нашему процессу
 AdjustTokenPrivileges(hToken, False, tkp, SizeOf(tkp), tkp, ReturnLength);
 if GetLastError() <> ERROR_SUCCESS then exit;
 // Завершаем процесс. Если у нас есть SeDebugPrivilege, то мы можем
 // завершить и системный процесс
 // Получаем дескриптор процесса для его завершения
 hProcess := OpenProcess(PROCESS_TERMINATE, FALSE, dwPID);
 if hProcess = 0 then exit;
 // Завершаем процесс
 if not TerminateProcess(hProcess, DWORD(-1)) then exit;
 CloseHandle(hProcess);
 // Удаляем привилегию
 tkp.Privileges[0].Attributes := 0;
 AdjustTokenPrivileges(hToken, FALSE, tkp, SizeOf(tkp), tkp, ReturnLength);
 if GetLastError() <> ERROR_SUCCESS then exit;
 Result := True;
end;
// Название добавление/удаление привилегии немного неправильные. Привилегия или
// есть в токене процесса или ее нет. Если привилегия есть, то она может быть в
// двух состояниях - или включена или отключена. И в этом примере мы только
// включаем или выключаем необходимую привилегию, а не добавляем ее.
Source: Взято с http://delphiworld.narod.ru
ID: 02148
Как завершить сеанс работы или перезагрузить Windows NT?

=== Как завершить сеанс работы или перезагрузить Windows NT? ===
Для этого нам потребуются определённые привелегии:
function SetPrivilege(aPrivilegeName: string; AEnabled: Boolean): Boolean; 
var 
 TPPrev, TP: TTokenPrivileges; 
 Token: THandle; 
 dwRetLen: DWord; 
begin 
 Result := False; 
 OpenProcessToken(GetCurrentProcess,TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, @Token); 
 TP.PrivilegeCount := 1; 
 if LookupPrivilegeValue(nil, PChar(aPrivilegeName), TP.Privileges[0].LUID) then 
 begin 
 if AEnabled then 
 TP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED; 
 else 
 TP.Privileges[0].Attributes := 0; 
 dwRetLen := 0; 
 Result := AdjustTokenPrivileges(Token, False, TP, SizeOf(TPPrev), TPPrev, dwRetLen); 
 end; 
 CloseHandle(Token); 
end; 
function WinExit(iFlags: Integer): Boolean; 
// возможные флаги:
// EWX_LOGOFF 
// EWX_REBOOT 
// EWX_SHUTDOWN 
begin 
 Result := True; 
 if SetPrivilege('SeShutdownPrivilege', True) then 
 begin 
 if (not ExitWindowsEx(iFlags, 0)) then 
 begin 
 Result := False; 
 end; 
 SetPrivilege('SeShutdownPrivilege', False);
 end 
 else 
 begin 
 Result := False; 
 end; 
end;
Source: Взято из http://forum.sources.ru
ID: 01669
Как загрузить BMP файл из DLL?

=== Как загрузить BMP файл из DLL? ===
procedure TForm1.Button1Click(Sender: TObject);
var
 AModule: THandle;
begin
 AModule := LoadLibrary('Images.dll');
 Image1.Picture.BitMap.LoadFromResourceName(AModule, 'StartMine');
 FreeLibrary(AModule);
end;
Author: Baa
Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 02156
Как загрузить HTML код непосредственно в TWebbrowser?

uses
 ActiveX;
procedure WB_LoadHTML(WebBrowser: TWebBrowser; HTMLCode: string);
var
 sl: TStringList;
 ms: TMemoryStream;
begin
 WebBrowser.Navigate('about:blank');
 while WebBrowser.ReadyState < READYSTATE_INTERACTIVE do
 Application.ProcessMessages;
 if Assigned(WebBrowser.Document) then
 begin
 sl := TStringList.Create;
 try
 ms := TMemoryStream.Create;
 try
 sl.Text := HTMLCode;
 sl.SaveToStream(ms);
 ms.Seek(0, 0);
 (WebBrowser.Document as IPersistStreamInit).Load(TStreamAdapter.Create(ms));
 finally
 ms.Free;
 end;
 finally
 sl.Free;
 end;
 end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
 WB_LoadHTML(WebBrowser1,'SwissDelphiCenter');
end;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 03459
Category:Связь
Category:WebBrowser
Как загрузить webpage с скрытым IP?

{ Add a button and memo }
implementation
{$R *.dfm}
uses
 Urlmon;
procedure TForm1.Button1Click(Sender : TObject);
var
 ca: IInterface;
 rls: Integer;
 stat: IBindStatusCallBack;
 rr: Cardinal;
 tag: _tagBindInfo;
 exGuid: TGuid;
 noIp: Pointer;
 res: HResult;
begin
 // Make a 0.0.0.0 ip giud
 exGuid.D1 := rr;
 exGuid.D2 := Word('0');
 exGuid.D3 := Word('.');
 // Set Tag options
 with tag do
 begin
 // set "0." ip guid
 iid := exGuid;
 // set needed size
 cbSize := sizeOf('www.big-x.cjb.net');
 // Add ip hiding ( not tested, but should work )
 securityAttributes.lpSecurityDescriptor := noIp;
 securityAttributes.nLength := Length('0.0.0.0');
 securityAttributes.bInheritHandle := True;
 end;
 { Extra: res := stat.GetBindInfo(rr, tag);}
 // Start downloading webpage
 try
 urlmon.URLDownloadToFile(ca, 'www.big-x.cjb.net', 'filename.htm', 1, stat);
 except
 ShowMessage('Could not download the webpage!');
 end;
 // Load the webpage source to a memo
 memo1.Lines.LoadFromFile('filename.htm');
end;
Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 03579
Category:Связь
Category:Web
Как загрузить и отмасштабировать JPEGImage в TImage

try
 Image1.Picture.Graphic := nil;
 Image1.Picture.LoadFromFile(jpegfile);
except
 on EInvalidGraphic do
 Image1.Picture.Graphic := nil;
end;
if Image1.Picture.Graphic is TJPEGImage then
begin
 TJPEGImage(Image1.Picture.Graphic).Scale := Self.Scale;
 TJPEGImage(Image1.Picture.Graphic).Performance := jpBestSpeed;
end;
Source: http://delphiworld.narod.ru/
ID: 03795
Category:Графика
Category:Jpeg
Как загрузить иконку CD-ROM?

=== Как загрузить иконку CD-ROM? ===
function GetCDIcon(Drive: Char): TIcon; 
var 
 ico: TIcon; 
 ini: TIniFile; 
 s, p: string; 
 i, j: Integer; 
begin 
 // Abbrechen wenn "AutoRun.Inf" nicht existiert. 
 // Abort if "AutoRun.inf" doesn't exists. 
 if FileExists(Drive + ':\autorun.inf') = False then Exit; 
 // "AutoRun.inf" offnen 
 // Opens the "AutoRun.inf" 
 ini := TIniFile.Create(Drive + ':\autorun.inf'); 
 ico := TIcon.Create; 
 try 
 // Dateinamen lesen 
 // Read the filename 
 s := ini.ReadString('Autorun', 'ICON', ); 
 // Abbrechen, wenn kein Icon festgelegt wurde 
 // Abort if there is no icon specified 
 if s = then Exit; 
 // Icon von Datei laden 
 // load the icon from a file 
 if FileExists(s) then ico.LoadFromFile(s); 
 if FileExists(Drive + ':\' + s) then ico.LoadFromFile(Drive + ':\' + s); 
 // Icon aus einer Resource laden 
 // Load the icon from a Win32 resource 
 if (FileExists(s) = False) and (FileExists(Drive + ':\' + s) = False) then 
 begin 
 for j := (Pos(',', s) + 1) to Length(s) do 
 begin 
 p := p + s[j]; 
 end; 
 i := StrToInt(p); 
 for j := Length(s) downto (Pos(',', s)) do 
 Delete(s, j, Length(s)); 
 if FileExists(s) = False then s := Drive + ':\' + s; 
 ico.Handle := ExtractIcon(hinstance, PChar(s), i); 
 end; 
 Result := ico; 
 finally 
 ini.Free; 
 end; 
end; 
Source: Взято с сайта http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 01400