Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001

• Название: Советы по Delphi. Версия 1.4.3 от 1.1.2001
• Автор: Валентин Озеров
• Жанр: Программирование

…начиная с 1001. Смотрите другие файлы…

---

 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