Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001
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;
A2 : array[0..15] of char = 'TAlignPalette'#0;
A3 : array[0..18] of char = 'TPropertyInspector'#0;
A4 : array[0..11] of char = 'TAppBuilder'#0;
begin
result:=false;
H1 := FindWindow(A1, nil);
H2 := FindWindow(A2, nil);
H3 := FindWindow(A3, nil);
H4 := FindWindow(A4, nil);
if (H1 <> 0) and (H2 <> 0) and (H3 <> 0) and (H4 <> 0) then result:=true;
end;
function getCdromPath:string;
var
w:dword;
Root:string;
i:integer;
begin
result:='';
w:=GetLogicalDrives;
Root := '#:';
for i := 0 to 25 do begin
Root[1] := Char(Ord('A')+i);
if (W and (1 shl i))>0 then
if GetDriveType(Pchar(Root)) = DRIVE_CDROM then begin
result:=Root;
exit;
end;
end;
end;
//Определение готовности дисковода к работе
function DiskInDrive(const Drive: char): Boolean;
var
DrvNum: byte;
EMode: Word;
begin
result := false;
DrvNum := ord(Drive);
if DrvNum >= ord('a') then dec(DrvNum, $20);
EMode := SetErrorMode(SEM_FAILCRITICALERRORS);
try
if DiskSize(DrvNum-$40) <> -1 then result := true
else messagebeep(0);
finally
SetErrorMode(EMode);
end;
end;
function soundCardExists:boolean;
begin
if WaveOutGetNumDevs>0 then result:=true
else result:=false;
end;
function SetTime(DateTime:TDateTime):Boolean;
var
st:TSystemTime;
ZoneTime: TTimeZoneInformation;
begin
GetTimeZoneInformation(ZoneTime);
DateTime:=DateTime+ZoneTime.Bias/1440;
with st do begin
DecodeDate(DateTime, wYear, wMonth, wDay);
DecodeTime(DateTime, wHour, wMinute, wSecond, wMilliseconds);
end;
result:=SetSystemTime(st);
SendMessage(HWND_TOPMOST, WM_TIMECHANGE, 0, 0);
end;
//Окно без закладки в TaskBar
procedure noAppInTaskbar;
begin
ShowWindow(Application.Handle, sw_Hide);
end;
//Определение какие приложения уже запущены
procedure ApplicationList(formHandle: THandle; var stringList: TStringList);
var
nd : hWnd;
buff: ARRAY [0..127] OF Char;
begin
stringList.Clear;
Wnd := GetWindow(formHandle, gw_HWndFirst);
WHILE Wnd <> 0 DO BEGIN
{Не показываем:}
IF (Wnd <> Application.Handle) AND {-Собственное окно}
IsWindowVisible(Wnd) AND {-Невидимые окна}
(GetWindow(Wnd, gw_Owner) = 0) AND {-Дочернии окна}
(GetWindowText(Wnd, buff, sizeof(buff)) <> 0) {-Окна без заголовков}
THEN BEGIN
GetWindowText(Wnd, buff, sizeof(buff));
stringList.Add(StrPas(buff));
END;
Wnd := GetWindow(Wnd, gw_hWndNext);
END;
end;
procedure CDROMOpen;
begin
mciSendString('Set cdaudio door open wait', nil, 0, 0);
end;
procedure CDROMClose;
begin
mciSendString('Set cdaudio door closed wait', nil, 0, 0);
end;
//Запретить/разрешить Ctrl-Alt-Del
procedure CtrlAltDel(state:boolean);
var old:Boolean;
begin
old:=True;
if state then
//Восстановить
SystemParametersInfo(SPI_SCREENSAVERRUNNING, 0, @old, 0)
else
//Убрать
SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, @old, 0);
end;
procedure StartButton(visi:boolean);
Var
Tray, Child : hWnd;
C : Array[0..127] of Char;
S : String;
Begin
Tray := FindWindow('Shell_TrayWnd', NIL);
Child := GetWindow(Tray, GW_CHILD);
While Child <> 0 do Begin
If GetClassName(Child, C, SizeOf(C)) > 0 Then Begin
S := StrPAS(C);
If UpperCase(S) = 'BUTTON' then begin
If Visi then ShowWindow(Child, 1)
else ShowWindow(Child, 0);
end;
End;
Child := GetWindow(Child, GW_HWNDNEXT);
End;
End;
//убрать/показать TaskBar
procedure TaskBar(visi:boolean);
begin
if visi then ShowWindow(FindWindow('Shell_TrayWnd', nil), SW_SHOW) // Показать Taskbar
else ShowWindow(FindWindow('Shell_TrayWnd', nil), SW_HIDE); //Скрыть TaskBar
