Вопрос:
Как определить каталог Windows?
Ответ:
Вызовите функцию GetWindowsDirectory(). Если Вас интересует каталог System, вызовите
функцию GetSystemDirectory().
Пример:
{$IFNDEF WIN32}
const MAX_PATH = 144;
{$ENDIF}
procedure TForm1.Button1Click(Sender: TObject);
var
a : Array[0..MAX_PATH] of char;
begin
GetWindowsDirectory(a, sizeof(a));
ShowMessage(StrPas(a));
GetSystemDirectory(a, sizeof(a));
ShowMessage(StrPas(a));
end;
Наверх к содержанию
Вопрос:
Как определить размер рабочего стола без Тaskbar'а?
Ответ:
Воспользуйтесь функцией SystemParametersInfo(), переслав ей в качестве параметров
- SPI_GETWORKAREA и адрес структуры типа TRect, куда будут передан полученный
результат.
Пример:
procedure TForm1.Button1Click(Sender: TObject);
var
r : TRect;
begin
SystemParametersInfo(SPI_GETWORKAREA,
0,
@r,
0);
Memo1.Lines.Add(IntToStr(r.Top));
Memo1.Lines.Add(IntToStr(r.Left));
Memo1.Lines.Add(IntToStr(r.Bottom));
Memo1.Lines.Add(IntToStr(r.Right));
end;
Наверх к содержанию
Вопрос:
Как закрыть CD програмно?
Ответ:
Вызовите функцию mciSendCommand (из библиотекиMMSystem) передав ей параметр MCI_SET_DOOR_CLOSED.
Пример:
uses MMSystem;
procedure CloseCD(Drive : char);
var
mp : TMediaPlayer;
begin
result := false;
Application.ProcessMessages;
mp := TMediaPlayer.Create(nil);
mp.Visible := false;
mp.Parent := Application.MainForm;
mp.Shareable := true;
mp.DeviceType := dtCDAudio;
mp.FileName := Drive + ':';
mp.Open;
Application.ProcessMessages;
mciSendCommand(mp.DeviceID,
MCI_SET, MCI_SET_DOOR_CLOSED, 0);
Application.ProcessMessages;
mp.Close;
Application.ProcessMessages;
mp.free;
result := true;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
CloseCD('D');
end;
Наверх к содержанию
Вопрос:
Как определить свободное дисковое пространство на дисках размером больше 2 ГБ?
Ответ:
Вызовите функцию GetDiskFreeSpaceEx(). Возвращаемый функцией результат типа integers
конвертируйте в doubles.
Пример:
function GetDiskFreeSpaceEx(lpDirectoryName: PAnsiChar;
var lpFreeBytesAvailableToCaller : Integer;
var lpTotalNumberOfBytes: Integer;
var lpTotalNumberOfFreeBytes: Integer) : bool;
stdcall;
external kernel32
name 'GetDiskFreeSpaceExA';
procedure GetDiskSizeAvail(TheDrive : PChar;
var TotalBytes : double;
var TotalFree : double);
var
AvailToCall : integer;
TheSize : integer;
FreeAvail : integer;
begin
GetDiskFreeSpaceEx(TheDrive,
AvailToCall,
TheSize,
FreeAvail);
{$IFOPT Q+}
{$DEFINE TURNOVERFLOWON}
{$Q-}
{$ENDIF}
if TheSize >= 0 then
TotalBytes := TheSize else
if TheSize = -1 then begin
TotalBytes := $7FFFFFFF;
TotalBytes := TotalBytes * 2;
TotalBytes := TotalBytes + 1;
end else
begin
TotalBytes := $7FFFFFFF;
TotalBytes := TotalBytes + abs($7FFFFFFF - TheSize);
end;
if AvailToCall >= 0 then
TotalFree := AvailToCall else
if AvailToCall = -1 then begin
TotalFree := $7FFFFFFF;
TotalFree := TotalFree * 2;
TotalFree := TotalFree + 1;
end else
begin
TotalFree := $7FFFFFFF;
TotalFree := TotalFree + abs($7FFFFFFF - AvailToCall);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
TotalBytes : double;
TotalFree : double;
begin
GetDiskSizeAvail('C:\',
TotalBytes,
TotalFree);
ShowMessage(FloatToStr(TotalBytes));
ShowMessage(FloatToStr(TotalFree));
end;
Наверх к содержанию
Вопрос:
Как спрятать Панель Задач Windows (Task Bar)?
Ответ:
Вначале необходимо вызвать функцию FindWindow(), чтобы определить handle TaskBar.
Затем вызвите функцию ShowWindow(), передав ей в качестве параметра костанту SW_HIDE.
Пример:
procedure TForm1.Button1Click(Sender: TObject);
var
hTaskBar : THandle;
begin
hTaskbar := FindWindow('Shell_TrayWnd', Nil);
ShowWindow(hTaskBar, SW_HIDE);
end;
procedure TForm1.Button2Click(Sender: TObject);
var
hTaskBar : THandle;
begin
hTaskbar := FindWindow('Shell_TrayWnd', Nil);
ShowWindow(hTaskBar, SW_SHOWNORMAL);
end;
Наверх к содержанию
Вопрос:
Как определить подключен ли компюетер к сети.
Ответ:
Воспользуйтесь функцией GetSystemMetrics(), переслав ей флаг SM_NETWORK.
Пример:
procedure TForm1.Button1Click(Sender: TObject);
begin
if GetSystemMetrics(SM_NETWORK) AND $01 = $01 then
ShowMessage('Machine is attached to network') else
ShowMessage('Machine is not attached to network');
end;
Наверх к содержанию
Вопрос:
Как добавить документ в меню ПУСК - ДОКУМЕНТЫ?
Ответ:
Используйте функцию SHAddToRecentDocs.
Пример:
uses ShlOBJ;
procedure TForm1.Button1Click(Sender: TObject);
var
s : string;
begin
s := 'C:\DownLoad\ntkfaq.html';
SHAddToRecentDocs(SHARD_PATH, pChar(s));
end;
Наверх к содержанию
Вопрос:
Как программно изменить текущий порт принтера?
Ответ:
Используйте метод SetPrinter класса TPrinter.
Пример:
uses Printers;
{$IFNDEF WIN32}
const MAX_PATH = 144;
{$ENDIF}
procedure TForm1.Button1Click(Sender: TObject);
var
pDevice : pChar;
pDriver : pChar;
pPort : pChar;
hDMode : THandle;
PDMode : PDEVMODE;
begin
if PrintDialog1.Execute then begin
GetMem(pDevice, cchDeviceName);
GetMem(pDriver, MAX_PATH);
GetMem(pPort, MAX_PATH);
Printer.GetPrinter(pDevice, pDriver, pPort, hDMode);
Printer.SetPrinter(pDevice, PDriver, 'FILE:', hDMode);
FreeMem(pDevice, cchDeviceName);
FreeMem(pDriver, MAX_PATH);
FreeMem(pPort, MAX_PATH);
Printer.BeginDoc;
Printer.Canvas.TextOut(100, 100, 'Delphi Is RAD!');
Printer.EndDoc;
end;
end;
Наверх к содержанию
Вопрос:
Как корректно определить изменения в оборудовании PlugNPlay?
Ответ:
Пример:
type
TForm1 = class(TForm)
Button1: TButton;
private
{ Private declarations }
procedure WMDeviceChange(var Message: TMessage);
message WM_DEVICECHANGE;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
const DBT_DEVICEARRIVAL = $8000;
const DBT_DEVICEQUERYREMOVE = $8001;
const DBT_DEVICEQUERYREMOVEFAILED = $8002;
const DBT_DEVICEREMOVEPENDING = $8003;
const DBT_DEVICEREMOVECOMPLETE = $8004;
const DBT_DEVICETYPESPECIFIC = $8005;
const DBT_CONFIGCHANGED = $0018;
procedure TForm1.WMDeviceChange(var Message: TMessage);
var
s : string;
begin
{Do Something here}
case Message.wParam of
DBT_DEVICEARRIVAL :
s := 'A device has been inserted and is now available';
DBT_DEVICEQUERYREMOVE: begin
s := 'Permission to remove a device is requested';
ShowMessage(s);
{True grants premission}
Message.Result := integer(true);
exit;
end;
DBT_DEVICEQUERYREMOVEFAILED :
s := 'Request to remove a device has been canceled';
DBT_DEVICEREMOVEPENDING :
s := 'Device is about to be removed';
DBT_DEVICEREMOVECOMPLETE :
s := 'Device has been removed';
DBT_DEVICETYPESPECIFIC :
s := 'Device-specific event';
DBT_CONFIGCHANGED :
s:= 'Current configuration has changed'
else s := 'Unknown Device Message';
end;
ShowMessage(s);
inherited;
end;
Наверх к содержанию
Вопрос:
Как после записи в ini-файл сбросить cache на диск, чтоб задействовать изменения?
Ответ:
Вызовите функцию WriteProfileString() или WritePrivateProfileString(), передав
ей в качестве параметров секции, ключа и строки - nil.
Пример:
WriteProfileString(nil, nil, nil);
WritePrivateProfileString(nil, nil, nil, FileName);
Наверх к содержанию
Вопрос:
Как с помощью Проводника открыть конкретный каталог?
Ответ:
Пример:
uses ShellApi;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShellExecute(0,
'explore',
'C:\WINDOWS',
nil,
nil,
SW_SHOWNORMAL);
end;
Наверх к содержанию
Вопрос:
Как запустить аплет Панели управления?
Ответ:
Запустить аплет Панели управления можно вызвав функцию WinExec, для выполнения
файла control.exe, которому передано имя аплета. Обычно аплеты панели управления
расположены в каталоге System Windows и имеют расширение .cpl.
Пример:
procedure TForm1.Button1Click(Sender: TObject);
begin
WinExec('C:\WINDOWS\CONTROL.EXE TIMEDATE.CPL',
sw_ShowNormal);
WinExec('C:\WINDOWS\CONTROL.EXE MOUSE',
sw_ShowNormal);
WinExec('C:\WINDOWS\CONTROL.EXE PRINTERS',
sw_ShowNormal);
end;
Наверх к содержанию
Вопрос:
Как печатать в цвете?
Ответ:
Обычно нет необходимости переводить принтер в режим цветной печати, если он установлен
в этот режим. Windows автоматически переведет цветную печать в черно-белую, если
принтер не поддерживает цветной печати. Если Вам необходимо програмно изменить
режим цвета, Вы можете обратится к структуре DevMode драйвера принтера.
Пример:
uses Printers;
procedure TForm1.Button1Click(Sender: TObject);
var
Device : array[0..255] of char;
Driver : array[0..255] of char;
Port : array[0..255] of char;
hDMode : THandle;
PDMode : PDEVMODE;
begin
with Printer do begin
PrinterIndex := PrinterIndex;
GetPrinter(Device, Driver, Port, hDMode);
if hDMode <> 0 then begin
pDMode := GlobalLock(hDMode);
if pDMode <> nil then begin
pDMode.dmFields := pDMode.dmFields or dm_Color;
pDMode.dmColor := DMCOLOR_COLOR;
GlobalUnlock(hDMode);
end;
end;
PrinterIndex := PrinterIndex;
BeginDoc;
Canvas.Font.Color := clRed;
Canvas.TextOut(100,100, 'Red As A Rose!');
EndDoc;
end;
end;
Наверх к содержанию
Вопрос:
Как открыть URL браузером, установленным по умолчанию?
Ответ:
Используйте функцию ShellExecute.
Пример:
uses ShellAPI;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShellExecute(Form1.Handle,
nil,
'http://www.borland.com',
nil,
nil,
SW_SHOWNORMAL);
end;
Наверх к содержанию
Вопрос:
Как стереть ехе-файл во время его исполнения?
Ответ:
Это не возможно. Вы можете стереть его во время следующего запуска Windows, добавив
ключ RunOnce:
HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunOnce
Пример:
uses
Registry;
procedure TForm1.Button1Click(Sender: TObject);
var
reg: TRegistry;
begin
reg := TRegistry.Create;
with reg do begin
RootKey := HKEY_LOCAL_MACHINE;
LazyWrite := false;
OpenKey('Software\Microsoft\Windows\CurrentVersion\RunOnce',
false);
WriteString('Delete Me!','command.com /c del FILENAME.EXT');
CloseKey;
free;
end;
end;
Наверх к содержанию
Вопрос:
Как програмноинсталировать шрифты TrueType?
Ответ:
Скопируйте файл шрифта в директорию Windows\Fonts, и добавьте строку с именем
шрифта и его расположением в разделе "'Software\Microsoft\Windows\CurrentVersion\Fonts".
Вызовите функцию AddFontRecource(), а затем передайте системе сообщение WM_FONTCHANGE.
И наконец, для удоления установленного шрифта, вызовите функцию RemoveFontRecource(),
а затем передайте системе сообщение WM_FONTCHANGE.
Пример:
uses Registry;
procedure TForm1.Button1Click(Sender: TObject);
var
reg: TRegistry;
b : bool;
begin
CopyFile('C:\DOWNLOAD\FP000100.TTF',
'C:\WINDOWS\FONTS\FP000100.TTF', b);
reg := TRegistry.Create;
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.LazyWrite := false;
reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Fonts',
false);
reg.WriteString('TESTMICR (TrueType)','FP000100.TTF');
reg.CloseKey;
reg.free;
{Add the font resource}
AddFontResource('c:\windows\fonts\FP000100.TTF');
SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
{Remove the resource lock}
RemoveFontResource('c:\windows\fonts\FP000100.TTF');
SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
end;
Наверх к содержанию
Вопрос:
Как получить список часовых поясов?
Ответ:
Пример:
uses Registry;
procedure TForm1.Button1Click(Sender: TObject);
var
reg : TRegistry;
ts : TStrings;
i : integer;
begin
reg := TRegistry.Create;
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.OpenKey(
'SOFTWARE\Microsoft\Windows\CurrentVersion\Time Zones',
false);
if reg.HasSubKeys then begin
ts := TStringList.Create;
reg.GetKeyNames(ts);
reg.CloseKey;
for i := 0 to ts.Count -1 do begin
reg.OpenKey(
'SOFTWARE\Microsoft\Windows\CurrentVersion\Time Zones\' +
ts.Strings[i],
false);
Memo1.Lines.Add(ts.Strings[i]);
Memo1.Lines.Add(reg.ReadString('Display'));
Memo1.Lines.Add(reg.ReadString('Std'));
Memo1.Lines.Add(reg.ReadString('Dlt'));
Memo1.Lines.Add('----------------------');
reg.CloseKey;
end;
ts.Free;
end else
reg.CloseKey;
reg.free;
end;
Наверх к содержанию
Вопрос:
Какие значения возвращает функция GetTimeZoneInformation()?
Ответ:
const TIME_ZONE_ID_UNKNOWN = 0;
const TIME_ZONE_ID_STANDARD = 1;
const TIME_ZONE_ID_DAYLIGHT = 2;
Наверх к содержанию
Вопрос:
Как сделать прозрачным фон текста?
Ответ:
Используйте функцию SetBkMode().
Пример:
procedure TForm1.Button1Click(Sender: TObject);
var
OldBkMode : integer;
begin
with Form1.Canvas do begin
Brush.Color := clRed;
FillRect(Rect(0, 0, 100, 100));
Brush.Color := clBlue;
TextOut(10, 20, 'Not Transparent!');
OldBkMode := SetBkMode(Handle, TRANSPARENT);
TextOut(10, 50, 'Transparent!');
SetBkMode(Handle, OldBkMode);
end;
end;
Наверх к содержанию
Вопрос:
Как получить информацию о версии файла?
Ответ:
Для этого необходимо вызвать несколько функций API. В приведеннном ниже примере
проверяется версия shell32.dll. Функция возвращает значение True - если версия
DLL больше или равна 4.71
function TForm1.CheckShell32Version: Boolean;
procedure GetFileVersion(FileName: string; var Major1, Major2,
Minor1, Minor2: Integer);
{ Helper function to get the actual file version information }
var
Info: Pointer;
InfoSize: DWORD;
FileInfo: PVSFixedFileInfo;
FileInfoSize: DWORD;
Tmp: DWORD;
begin
// Get the size of the FileVersionInformatioin
InfoSize := GetFileVersionInfoSize(PChar(FileName), Tmp);
// If InfoSize = 0, then the file may not exist, or
// it may not have file version information in it.
if InfoSize = 0 then
raise Exception.Create('Can''t get file version information for '
+ FileName);
// Allocate memory for the file version information
GetMem(Info, InfoSize);
try
// Get the information
GetFileVersionInfo(PChar(FileName), 0, InfoSize, Info);
// Query the information for the version
VerQueryValue(Info, '\', Pointer(FileInfo), FileInfoSize);
// Now fill in the version information
Major1 := FileInfo.dwFileVersionMS shr 16;
Major2 := FileInfo.dwFileVersionMS and $FFFF;
Minor1 := FileInfo.dwFileVersionLS shr 16;
Minor2 := FileInfo.dwFileVersionLS and $FFFF;
finally
FreeMem(Info, FileInfoSize);
end;
end;
var
tmpBuffer: PChar;
Shell32Path: string;
VersionMajor: Integer;
VersionMinor: Integer;
Blank: Integer;
begin
tmpBuffer := AllocMem(MAX_PATH);
// Get the shell32.dll path
try
GetSystemDirectory(tmpBuffer, MAX_PATH);
Shell32Path := tmpBuffer + '\shell32.dll';
finally
FreeMem(tmpBuffer);
end;
// Check to see if it exists
if FileExists(Shell32Path) then
begin
// Get the file version
GetFileVersion(Shell32Path, VersionMajor, VersionMinor, Blank, Blank);
// Do something, such as require a certain version
// (such as greater than 4.71)
if (VersionMajor >= 4) and (VersionMinor >= 71) then
Result := True
else
Result := False;
end
else
Result := False;
end;
Наверх к содержанию
Вопрос:
Как создать иконку из bitmap'а?
Ответ:
Нужно создать два bitmap'а: bitmap-маску ("AND" bitmap) и bitmap-картинку (XOR
bitmap). Потом передать дескрипторы "AND" и "XOR" bitmap-ов API функции CreateIconIndirect()
Пример:
procedure TForm1.Button1Click(Sender: TObject);
var
IconSizeX : integer;
IconSizeY : integer;
AndMask : TBitmap;
XOrMask : TBitmap;
IconInfo : TIconInfo;
Icon : TIcon;
begin
{Get the icon size}
IconSizeX := GetSystemMetrics(SM_CXICON);
IconSizeY := GetSystemMetrics(SM_CYICON);
{Create the "And" mask}
AndMask := TBitmap.Create;
AndMask.Monochrome := true;
AndMask.Width := IconSizeX;
AndMask.Height := IconSizeY;
{Draw on the "And" mask}
AndMask.Canvas.Brush.Color := clWhite;
AndMask.Canvas.FillRect(Rect(0, 0, IconSizeX, IconSizeY));
AndMask.Canvas.Brush.Color := clBlack;
AndMask.Canvas.Ellipse(4, 4, IconSizeX - 4, IconSizeY - 4);
{Draw as a test}
Form1.Canvas.Draw(IconSizeX * 2, IconSizeY, AndMask);
{Create the "XOr" mask}
XOrMask := TBitmap.Create;
XOrMask.Width := IconSizeX;
XOrMask.Height := IconSizeY;
{Draw on the "XOr" mask}
XOrMask.Canvas.Brush.Color := ClBlack;
XOrMask.Canvas.FillRect(Rect(0, 0, IconSizeX, IconSizeY));
XOrMask.Canvas.Pen.Color := clRed;
XOrMask.Canvas.Brush.Color := clRed;
XOrMask.Canvas.Ellipse(4, 4, IconSizeX - 4, IconSizeY - 4);
{Draw as a test}
Form1.Canvas.Draw(IconSizeX * 4, IconSizeY, XOrMask);
{Create a icon}
Icon := TIcon.Create;
IconInfo.fIcon := true;
IconInfo.xHotspot := 0;
IconInfo.yHotspot := 0;
IconInfo.hbmMask := AndMask.Handle;
IconInfo.hbmColor := XOrMask.Handle;
Icon.Handle := CreateIconIndirect(IconInfo);
{Destroy the temporary bitmaps}
AndMask.Free;
XOrMask.Free;
{Draw as a test}
Form1.Canvas.Draw(IconSizeX * 6, IconSizeY, Icon);
{Assign the application icon}
Application.Icon := Icon;
{Force a repaint}
InvalidateRect(Application.Handle, nil, true);
{Free the icon}
Icon.Free;
end;
Наверх к содержанию
Вопрос:
Как преобразовать RGB-цвет в оттенки серого?
Ответ:
В приведенном примере для преобразования RGB-цвета используются коэффициенты,
принятые в телевидении:
function RgbToGray(RGBColor : TColor) : TColor;
var
Gray : byte;
begin
Gray := Round((0.30 * GetRValue(RGBColor)) +
(0.59 * GetGValue(RGBColor)) +
(0.11 * GetBValue(RGBColor )));
Result := RGB(Gray, Gray, Gray);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Shape1.Brush.Color := RGB(255, 64, 64);
Shape2.Brush.Color := RgbToGray(Shape1.Brush.Color);
end;
Наверх к содержанию
Вопрос:
Как держать приложение в минимизированном виде?
Ответ:
Установите свойство WindowState в Minimized. Создайте обработчик сообщения WM_QueryOpen.
Пример:
{Place this code in the private section of the Form declaration}
procedure WMQueryOpen(VAR Msg : TWMQueryOpen); message WM_QUERYOPEN;
{Place this code in the Form implementation section}
procedure TForm1.WMQueryOpen(VAR Msg : TWMQueryOpen);
begin
Msg.Result := 0;
end;
Наверх к содержанию
Вопрос:
при вызове функции RegisterClass я получаю ошибку: "Incompatible types: 'TPersistantClass'
and 'TWndClassA'"
Ответ:
Функция RegisterClass() обьявлена в модулях Classes и Windows unit. Чтобы вызвать
функцию из модуля Windows просто добавте префикс "Windows."
Пример:
procedure TForm1.Button1Click(Sender: TObject);
wc : TWndClass;
begin
Windows.RegisterClass(wc)
end;
Наверх к содержанию
Вопрос:
Как принять файлы, брошенные на мою форму по drag & drop
Ответ:
Нужно сообщить Windows, что ваша форма принимает файлы по drag & drop с помощью
функции Shell API DragAcceptFiles.(в обработчике события form create) Затем нужно
реагироавть на сообытия drag & drop чтобы принять файлы. (см. пример)
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
private
procedure WMDROPFILES(var Message: TWMDROPFILES);
message WM_DROPFILES;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
uses ShellApi;
procedure TForm1.FormCreate(Sender: TObject);
begin
{Let Windows know we accept dropped files}
DragAcceptFiles(Form1.Handle, True);
end;
procedure TForm1.WMDROPFILES(var Message: TWMDROPFILES);
var
NumFiles : longint;
i : longint;
buffer : array[0..255] of char;
begin
{How many files are being dropped}
NumFiles := DragQueryFile(Message.Drop,
-1,
nil,
0);
{Accept the dropped files}
for i := 0 to (NumFiles - 1) do begin
DragQueryFile(Message.Drop,
i,
@buffer,
sizeof(buffer));
Form1.Memo1.Lines.Add(buffer);
end;
end;
end.
Наверх к содержанию
Вопрос:
Как создать задержку не подвешивая систему без компонента TTimer ?
Ответ:
В примере используется вызов Application.ProcessMessages для того, чтобы Windows
обрабатывал сообщения во время цикла задержки.
procedure Delay(ms : longint);
var
TheTime : LongInt;
begin
TheTime := GetTickCount + ms;
while GetTickCount < TheTime do
Application.ProcessMessages;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage('Start Test');
Delay(2000);
ShowMessage('End Test');
end;
Наверх к содержанию
Вопрос:
Как програмно перезагрузить Windows?
Ответ:
Используйте функцию ExitWindows().
В качестве первого параметра ей передается она из трех констант:
EW_RESTARTWINDOWS
EW_REBOOTSYSTEM
EW_EXITANDEXECAPP
Второй параметр используется для перезагрузки компьютера в
режиме эмуляции MS DOS.
Пример:
ExitWindows(EW_RESTARTWINDOWS, 0 );
Наверх к содержанию