if tile then Reg.WriteString('desktop', 'TileWallpaper', '1')
else Reg.WriteString('desktop', 'TileWallpaper', '0');
Reg.Free;
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, nil, SPIF_SENDWININICHANGE);
end;
{procedure setWallPaper(fileName:string);
begin
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, pChar(fileNAme), 0);
end;}
procedure refreshWindowsDesktop;
begin
SendMessage(FindWindow('Progman', 'Program Manager'), WM_COMMAND, $A065, 0);
end;
procedure mouseEmul(absPoint:TPoint; up,down:boolean);
begin
//Положение курсора мыши задается в "абсолютных" координатах ("Mickeys"),
//где 65535 "Mickeys" равно ширине экрана.
absPoint.x := Round(absPoint.x * (65535 / Screen.Width));
absPoint.y := Round(absPoint.y * (65535 / Screen.Height));
{Переместим курсор мыши}
Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MOVE, absPoint.x, absPoint.y, 0, 0);
if down then Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTDOWN, absPoint.x, absPoint.y, 0, 0);
if up then Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTUP, absPoint.x, absPoint.y, 0, 0);
end;
//просимулировать нажатие клавиши мыши
procedure SendMouseClick(x,y:integer;wHandle:THandle);
begin
sendmessage(wHandle, WM_LBUTTONDOWN, MK_LBUTTON, x+(y shl 16));
sendmessage(wHandle, WM_LBUTTONUP, MK_LBUTTON, x+(y shl 16));
application.processMessages;
end;
procedure monitorState(state:boolean);
begin
if state then SendMessage(Application.Handle, wm_SysCommand, SC_MonitorPower, -1)
else SendMessage(Application.Handle, wm_SysCommand, SC_MonitorPower, 0);
end;
procedure execWait(const comLine:string);
var
si:Tstartupinfo;
p:Tprocessinformation;
begin
fillChar(Si, SizeOf(Si), 0);
with Si do begin
cb := SizeOf(Si);
dwFlags := startf_UseShowWindow;
wShowWindow := 4;
end;
Createprocess(nil, pChar(comLine), nil, nil, false, Create_default_error_mode, nil, nil, si, p);
Waitforsingleobject(p.hProcess, infinite);
end;
procedure shellExec(const fileName:string);
begin
shellExecute(0, Nil, pChar(fileName), Nil, Nil, SW_NORMAL);
end;
procedure Delay(msecs : DWORD);
var
FirstTick : DWORD;
begin
FirstTick:=GetTickCount;
repeat
Application.ProcessMessages;
until GetTickCount-FirstTick >= msecs;
end;
function HDDSerialNum(const drivePath:string{'C:\'}):integer;
var
SerialNum:Pdword;
a,b:Dword;
buffer:array [0..255] of char;
begin
result:=0;
new(SerialNum);
if getVolumeInformation(pChar(drivePath), buffer, sizeof(buffer), SerialNum, a, b, nil, 0) then result:=SerialNum^;
Dispose(SerialNum);
end;
//фактически определяется запущена ли сейчас среда Delphi
function isDelphiRunning:boolean;
var H1, H2, H3, H4 : Hwnd;
const
A1 : array[0..12] of char = 'TApplication'#0;