HARDWARE

Клавиатура
Каким  узнать какая нажата кнопка на клавиатуре (мыши) если активно другое окно?
Как программно переключать раскладку клавиатуры?
Проверка нажатых функциональных клавиш
Определение нажатия определенной клавиши во время загрузки приложения.
Эмуляция нажатия клавиши с кодом #255.
Эквивалент функции SendKeys Visual Basic'а.
Включение/выключение клавиатуры.
Мышь
Как программно эмулировать движение мыши.
Есть ли у мыши колесико.
Включение/выключение мыши.
Монитор
Как узнать текущее и поменять разрешение экрана?
Программное включение/ выключение монитора.
Модем
Как набрать номер с помощью модема в Win32.
Опеределение состояния модема под Win32.
Как получить список установленных модемов в Win95/98?
Использование Tapi (Telephony API).
Прoцессор
Передача процессорных циклов другим приложениям.
Увеличение процессорного времени, выделяемого программе.
Как определить наличие сопроцессора.
Диcк
Как узнать серийный номер диска.
Серийный номер аудио CD.
Как узнать тип диска.
Форматирование диска.
Проверка готовности диска.
Есть ли в CD-ROM Audio CD.
Определение свободного дискового пространства.
Как открыть и закрыть CD.
Принтер
Изменить порт принтера.
Программная установка драйвера принтера.
Цветная печать.
Работа с принтером
Как программно изменить количество копий выводимых в печать?
PlugNPlay
Определить измения оборудования PlugNPlay.
Динамик
Как выключить/включить PC Speaker?
Звуки из динамика.
Управление питанием ЭВМ из Delphi
Управление питанием ЭВМ из Delphi
Видеокарта
Как определить видеокарту

Каким образом можно узнать какая нажата кнопка на клавиатуре (мыши) вне зависимости от того, какое приложение в данный момент активно?
GetAsyncKeyState. И для клавиатуpы, и для мыши.

Наверх к содержанию

Как выключить/включить PC Speaker?
Выключить:
  SyStemParametersInfo(SPI_SETBEEP,0,nil,SPIF_UPDATEINIFILE);

Включить:
  SyStemParametersInfo(SPI_SETBEEP,1,nil,SPIF_UPDATEINIFILE);

Наверх к содержанию

Как программно переключать раскладку клавиатуры?
LoadKeyboardLayout('00000409', KLF_ACTIVATE); // английский

LoadKeyboardLayout('00000419', KLF_ACTIVATE); // русский

Наверх к содержанию

Как узнать текущее разрешение экрана?
Screen.Width, Screen.Height Здесь Вы можете посмотреть предложение из FIDO.RU о замене разрешения экрана:

procedure ChangeDisplayResolution(X, Y : Word);

var

Dm : TDEVMODE;

begin

ZeroMemory(@Dm, SizeOf(TDEVMODE));

Dm.DmSize :=SizeOf(TDEVMODE);

Dm.DmPelsWidth :=X;

Dm.DmPelsHeight :=Y;

Dm.DmFields :=DM_PELSWIDTH or DM_PELSHEIGHT;

ChangeDisplaySettings(Dm, 0);

end;

Наверх к содержанию

4.Проверка нажатых функциональных клавиш
Функция GetKeyState (Win32API) возвращает статус кнопки клавиатуры, переданной ей в качестве параметра. Статус определяет, что кнопка нажата(down), отпущена(up) или переключена(on/off, как например клавиши NumLock или CapsLock). Если старший разряд возвращаемого значения равен 1, то кнопка нажата, иначе она отпущена. Если младший разряд равен 1, то кнопка включена(состояние On), иначе кнопка выключена(off).

SHORT GetKeyState( int  nVirtKey  );
Например:
IF GetKeyState(VK_NUMLOCK)=1 Then ...// Кнопка "NumLock" включена (on)

Вернуться к содержанию

Вопрос:
Как программно выключить монитор?

Ответ:
Программно можно отключить монитор совместимый со стандартом EnergyStar.

Отправьте сообщение wm_SysCommand с параметром WParam= SC_MonitorPower

  и LParam=0 для отключения монитора 
  LParam=1 для включения монитора

В приведенном примере монитор отключается на 10 секунд.

Пример:

  type 
TForm1=class(TForm) 
  Button1: TButton; 
  Timer1: TTimer; 
  procedure FormCreate(Sender: TObject); 
  procedure Timer1Timer(Sender: TObject); 
  procedure Button1Click(Sender: TObject); 
private 
  { Private declarations } 
public 
  MonitorOff : bool; 
  { Public declarations } 
end; 
 
  var 
Form1: TForm1; 
 
  implementation 
 
  {$R *.DFM} 
 
  procedure TForm1.FormCreate(Sender: TObject); 
  begin 
Timer1.Enabled :=false; 
Timer1.Interval :=10000; 
MonitorOff :=false; 
  end; 
 
  procedure TForm1.Timer1Timer(Sender: TObject); 
  begin 
if MonitorOff then begin 
  MonitorOff :=false; 
  SendMessage(Application.Handle, 
wm_SysCommand, 
SC_MonitorPower, 
-1); 
  Timer1.Enabled :=false; 
end; 
  end; 
 
  procedure TForm1.Button1Click(Sender: TObject); 
  begin 
MonitorOff :=true; 
Timer1.Enabled :=true; 
SendMessage(Application.Handle, 
  wm_SysCommand, 
  SC_MonitorPower, 
  0); 
  end;

Вопрос:
Форматирование диска в Win32
Ответ:
ShellAPI функция ShFormatDrive().
Пример:

const SHFMT_DRV_A=0; 
 const SHFMT_DRV_B=1; 
 
 const SHFMT_ID_DEFAULT=$FFFF; 
 
 const SHFMT_OPT_QUICKFORMAT=0; 
 const SHFMT_OPT_FULLFORMAT=1; 
 const SHFMT_OPT_SYSONLY=2; 
 
 const SHFMT_ERROR=-1; 
 const SHFMT_CANCEL=-2; 
 const SHFMT_NOFORMAT=-3; 
 
 function SHFormatDrive(hWnd : HWND; 
  Drive : Word; 
  fmtID : Word; 
  Options : Word) : Longint 
stdcall; external 'Shell32.dll' name 'SHFormatDrive'; 
 
 procedure TForm1.Button1Click(Sender: TObject); 
 var 
  FmtRes : longint; 
 begin 
  try 
  FmtRes:=ShFormatDrive(Handle, 
SHFMT_DRV_A, 
SHFMT_ID_DEFAULT, 
SHFMT_OPT_QUICKFORMAT); 
  case FmtRes  of 
  SHFMT_ERROR : ShowMessage('Error formatting the drive'); 
  SHFMT_CANCEL : 
ShowMessage('User canceled formatting the drive'); 
  SHFMT_NOFORMAT : ShowMessage('No Format') 
  else 
  ShowMessage('Disk has been formatted'); 
  end; 
  except 
  end; 
 
 end;

Вопрос:
Моя программа использует дравер принтера. Возможно ли потихоньку установить драйвер принтера без вмешательства пользователя?
Ответ:
Приведенный пример устанавливает драйвер принтера. Вам необходимо скопировать файлы с драйвером принтера в каталог Windows\System и внести необходимые изменения в файл Win.Ini.

  Примечание: 
  DriverName=Имя драйвера; 
  DRVFILE - имя файла с драйвером без расширения 
  (".drv" - по умолчанию).

Пример:

  procedure TForm1.Button1Click(Sender: TObject); 
  var 
s : array[0..64] of char; 
  begin 
WriteProfileString('PrinterPorts', 
  'DriverName', 
  'DRVFILE,FILE:,15,45'); 
WriteProfileString('Devices', 
  'DriverName', 
  'DRVFILE,FILE:'); 
StrCopy(S, 'PrinterPorts'); 
SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, LongInt(@S)); 
StrCopy(S, 'Devices'); 
SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, LongInt(@S)); 
  end;

Вопрос:
Как набрать номер с помощью модема в Win32?
Ответ:
Используйте функцию Windows API CreateFile() чтобы получить дескриптор порта, и стандартные функции ввода-вывода для связи с полученным портом.
Пример:

  var 
hCommFile : THandle; 
 
  procedure TForm1.Button1Click(Sender: TObject); 
  var 
PhoneNumber : string; 
CommPort : string; 
NumberWritten : LongInt; 
  begin 
PhoneNumber :='ATDT 1-555-555-1212' + #13 + #10; 
CommPort :='COM2'; 
{Open the comm port} 
hCommFile :=CreateFile(PChar(CommPort), 
GENERIC_WRITE, 
0, 
nil, 
OPEN_EXISTING, 
FILE_ATTRIBUTE_NORMAL, 
0); 
if hCommFile=INVALID_HANDLE_VALUE then 
begin 
  ShowMessage('Unable to open '+ CommPort); 
  exit; 
end; 
 
{Dial the phone} 
NumberWritten:=0; 
if WriteFile(hCommFile, 
PChar(PhoneNumber)^, 
Length(PhoneNumber), 
NumberWritten, 
  nil)=false then begin 
  ShowMessage('Unable to write to ' + CommPort); 
end; 
  end; 
 
  procedure TForm1.Button2Click(Sender: TObject); 
  begin 
{Close the port} 
CloseHandle(hCommFile); 
  end;

Вопрос:
Как использовать TAPI для голосового звонка?
Ответ:
См пример.
Пример:

  {tapi Errors} 
const TAPIERR_CONNECTED  =0; 
const TAPIERR_DROPPED =-1; 
const TAPIERR_NOREQUESTRECIPIENT=-2; 
const TAPIERR_REQUESTQUEUEFULL  =-3; 
const TAPIERR_INVALDESTADDRESS  =-4; 
const TAPIERR_INVALWINDOWHANDLE =-5; 
const TAPIERR_INVALDEVICECLASS  =-6; 
const TAPIERR_INVALDEVICEID  =-7; 
const TAPIERR_DEVICECLASSUNAVAIL=-8; 
const TAPIERR_DEVICEIDUNAVAIL=-9; 
const TAPIERR_DEVICEINUSE=-10; 
const TAPIERR_DESTBUSY=-11; 
const TAPIERR_DESTNOANSWER=-12; 
const TAPIERR_DESTUNAVAIL=-13; 
const TAPIERR_UNKNOWNWINHANDLE  =-14; 
const TAPIERR_UNKNOWNREQUESTID  =-15; 
const TAPIERR_REQUESTFAILED  =-16; 
const TAPIERR_REQUESTCANCELLED  =-17; 
const TAPIERR_INVALPOINTER=-18; 
 
  {tapi size constants} 
const TAPIMAXDESTADDRESSSIZE  =80; 
const TAPIMAXAPPNAMESIZE  =40; 
const TAPIMAXCALLEDPARTYSIZE  =40; 
const TAPIMAXCOMMENTSIZE  =80; 
const TAPIMAXDEVICECLASSSIZE  =40; 
const TAPIMAXDEVICEIDSIZE =40; 
 
  function tapiRequestMakeCallA(DestAddress : PAnsiChar; 
AppName : PAnsiChar; 
CalledParty : PAnsiChar; 
Comment : PAnsiChar) : LongInt; 
stdcall; external 'TAPI32.DLL'; 
 
  function tapiRequestMakeCallW(DestAddress : PWideChar; 
AppName : PWideChar; 
CalledParty : PWideChar; 
Comment : PWideChar) : LongInt; 
stdcall; external 'TAPI32.DLL'; 
 
  function tapiRequestMakeCall(DestAddress : PChar; 
AppName : PChar; 
CalledParty : PChar; 
Comment : PChar) : LongInt; 
stdcall; external 'TAPI32.DLL'; 
 
  procedure TForm1.Button1Click(Sender: TObject); 
  var 
DestAddress : string; 
CalledParty : string; 
Comment : string; 
  begin 
DestAddress :='1-555-555-1212'; 
CalledParty :='Frank Borland'; 
Comment :='Calling Frank'; 
tapiRequestMakeCall(pChar(DestAddress), 
PChar(Application.Title), 
pChar(CalledParty), 
PChar(Comment)); 
 
  end; 
 
  end.

Вопрос:
Как определение нажатия определенной клавиши во время загрузки приложения?
Ответ:
Используйту WinAPI функцию GetKeyState() для определения нажатия клавиши в тексте проекта. Для того чтобы увидеть текст файла проекта в главном меню Delphi 3 выберите "View">>"ProjectSource" в Delphi 4 "Project">>"View Source".
Пример:

  program Project1; 
 
  uses 
Windows, 
Forms, 
Unit1 in 'Unit1.pas' {Form1}; 
 
  {$R *.RES} 
 
  begin 
if GetKeyState(vk_F8) < 1 then 
  MessageBox(0, 'F8 was pressed during startup', 'MyApp', mb_ok); 
Application.Initialize; 
Application.CreateForm(TForm1, Form1); 
Application.Run; 
  end.

Вопрос:
Как заставить пикнуть динамик несколько раз с небольшой задержкой между сигналами, не зависящей от тактовой частоты процессора?
Ответ:
См. пример.
Пример:

  procedure Delay(ms : longint); 
  {$IFNDEF WIN32} 
  var 
TheTime : LongInt; 
  {$ENDIF} 
  begin 
  {$IFDEF WIN32} 
Sleep(ms); 
  {$ELSE} 
TheTime :=GetTickCount + ms; 
while GetTickCount < TheTime do 
  Application.ProcessMessages; 
  {$ENDIF} 
  end; 
 
  procedure TForm1.Button1Click(Sender: TObject); 
  begin 
MessageBeep(word(-1)); 
Delay(200); 
MessageBeep(word(-1)); 
Delay(200); 
MessageBeep(word(-1)); 
  end;

Вопрос:
Можно ли отключить кнопку закрытия любого окна?
Ответ:
Да, приведенный пример отключает кнопку закрытия и пункт "закрыть" ситсемного меню заданного окна.

  procedure TForm1.Button1Click(Sender: TObject); 
  var 
hwndHandle : THANDLE; 
hMenuHandle : HMENU; 
  begin 
hwndHandle :=FindWindow(nil, 'Untitled - Notepad'); 
if (hwndHandle <> 0) then begin 
  hMenuHandle :=GetSystemMenu(hwndHandle, FALSE); 
  if (hMenuHandle <> 0) then 
  DeleteMenu(hMenuHandle, SC_CLOSE, MF_BYCOMMAND); 
end; 
  end;

Вопрос:
Как определить имена установленых Com-портов?
Ответ:
Из реестра. См. пример.
Пример:

  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('hardware\devicemap\serialcomm', 
  false); 
ts :=TStringList.Create; 
reg.GetValueNames(ts); 
for i :=0 to ts.Count -1 do begin 
  Memo1.Lines.Add(reg.ReadString(ts.Strings[i])); 
end; 
ts.Free; 
reg.CloseKey; 
reg.free; 
  end;

Вопрос:
Как уступить выделенный моей программе квант процессорного времени другим приложениям?
Ответ:
Вызовите функцию Windows API Sleep() передав ноль в качестве параметра.
Наверх к содержанию 

Вопрос:
Как увеличить процессорное время, выделяемого программе?
Ответ:
Следующий пример изменяет приоритет приложения. Изменение приоритета следует использовать с осторожностью - т.к. присвоение слишком высокого приоритета может привети к медленной работе остальных программ и системы в целом. См. Win32 help for SetThreadPriority() function.
Пример:

  procedure TForm1.Button1Click(Sender: TObject); 
  var 
ProcessID : DWORD; 
ProcessHandle : THandle; 
ThreadHandle : THandle; 
  begin 
ProcessID :=GetCurrentProcessID; 
ProcessHandle :=OpenProcess(PROCESS_SET_INFORMATION, 
  false, 
  ProcessID); 
SetPriorityClass(ProcessHandle, REALTIME_PRIORITY_CLASS); 
ThreadHandle :=GetCurrentThread; 
SetThreadPriority(ThreadHandle, THREAD_PRIORITY_TIME_CRITICAL); 
  end;

Вопрос:
Как опеределить состояние модема под Win32?
Ответ:
См. пример
Пример:

  procedure TForm1.Button1Click(Sender: TObject); 
  var 
CommPort : string; 
hCommFile : THandle; 
ModemStat : DWord; 
  begin 
CommPort :='COM2'; 
 
{Open the comm port} 
hCommFile :=CreateFile(PChar(CommPort), 
GENERIC_READ, 
0, 
nil, 
OPEN_EXISTING, 
FILE_ATTRIBUTE_NORMAL, 
0); 
if hCommFile=INVALID_HANDLE_VALUE then 
begin 
  ShowMessage('Unable to open '+ CommPort); 
  exit; 
end; 
 
{Get the Modem Status} 
if GetCommModemStatus(hCommFile, ModemStat) <> false then begin 
  if ModemStat and MS_CTS_ON <> 0 then 
  ShowMessage('The CTS (clear-to-send) is on.'); 
  if ModemStat and MS_DSR_ON <> 0 then 
  ShowMessage('The DSR (data-set-ready) is on.'); 
  if ModemStat and MS_RING_ON <> 0then 
  ShowMessage('The ring indicator is on.'); 
  if ModemStat and MS_RLSD_ON <> 0 then 
  ShowMessage('The RLSD (receive-line-signal-detect) is 
  on.'); 
  end; 
 
{Close the comm port} 
CloseHandle(hCommFile); 
  end;

Вопрос:
Как узнать серийный номер диска
Ответ:

  procedure TForm1.Button1Click(Sender: TObject); 
  var 
VolumeName, 
FileSystemName  : array [0..MAX_PATH-1] of Char; 
VolumeSerialNo  : DWord; 
MaxComponentLength, 
FileSystemFlags : Integer; 
  begin 
GetVolumeInformation('C:\',VolumeName,MAX_PATH,@VolumeSerialNo, 
MaxComponentLength,FileSystemFlags, 
FileSystemName,MAX_PATH); 
Memo1.Lines.Add('VName='+VolumeName); 
Memo1.Lines.Add('SerialNo=$'+IntToHex(VolumeSerialNo,8)); 
Memo1.Lines.Add('CompLen='+IntToStr(MaxComponentLength)); 
Memo1.Lines.Add('Flags=$'+IntToHex(FileSystemFlags,4)); 
Memo1.Lines.Add('FSName='+FileSystemName); 
  end;

Вопрос:
Как узнать является диск CD-диском,сетевым диском, виртуальным диском или сьемным диском?
Ответ:
Windows API функция GetDriveType().
Пример:

  procedure TForm1.Button1Click(Sender: TObject); 
  begin 
case GetDriveType('C:\') of 
  0 : ShowMessage('The drive type cannot be determined'); 
  1 : ShowMessage('The root directory does not exist'); 
  DRIVE_REMOVABLE:ShowMessage('The disk can be removed'); 
  DRIVE_FIXED : ShowMessage('The disk cannot be removed'); 
  DRIVE_REMOTE  : ShowMessage('The drive is remote (network) drive'); 
  DRIVE_CDROM : ShowMessage('The drive is a CD-ROM drive'); 
  DRIVE_RAMDISK  : ShowMessage('The drive is a RAM disk'); 
end; 
  end;

Вопрос:
Как проверить готовность диска без появления окна ошибки Windows?
Ответ:
Вы можете использовать функцию Windows API SetErrorMode() для отключения диалога Window's critical Error.
Пример:

  function IsDriveReady(DriveLetter : char) : bool; 
  var 
OldErrorMode : Word; 
OldDirectory : string; 
  begin 
OldErrorMode :=SetErrorMode(SEM_NOOPENFILEERRORBOX); 
GetDir(0, OldDirectory); 
{$I-} 
  ChDir(DriveLetter + ':\'); 
{$I+} 
  if IoResult <> 0 then 
  Result :=False 
  else 
  Result :=True; 
 
ChDir(OldDirectory); 
SetErrorMode(OldErrorMode); 
  end; 
 
  procedure TForm1.Button1Click(Sender: TObject); 
  begin 
if not IsDriveReady('A') then 
  ShowMessage('Drive Not Ready') else 
  ShowMessage('Drive is Ready'); 
  end;

Вопрос:

Для закрытия CD-ROM:
--------------------------------------------------------------------------------
mciSendString('Set cdaudio door open wait', nil, 0, handle); 
Для открытия CD-ROM:
--------------------------------------------------------------------------------
mciSendString('Set cdaudio door closed wait', nil, 0, handle); 
Не забудьте включить MMSystem в список используемых модулей (uses).

Вопрос:
Как определить свободное дисковое пространство на дисках размером больше 2 ГБ?
Ответ:
Вызовите функцию GetDiskFreeSpaceEx(). Возвращаемый функцией результат типа integers конвертируйте в doubles.
Пример:

  function GetDiskFreeSpaceEx(lpDirectoryName: PAnsiChar; 
i lpFreeBytesAvailableToCaller : Integer; 
i lpTotalNumberOfBytes: Integer; 
i lpTotalNumberOfFreeBytes: Integer) : bool; 
stdcall; 
external kernel32 
name 'GetDiskFreeSpaceExA'; 
 
  procedure GetDiskSizeAvail(TheDrive : PChar; 
  i TotalBytes : double; 
  i 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;

Вопрос:
Как программно изменить текущий порт принтера?
Ответ:
Используйте метод 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;

Вопрос:
Как печатать в цвете?
Ответ:
Обычно нет необходимости переводить принтер в режим цветной печати, если он установлен в этот режим. 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;

Наверх к содержанию

Вопрос:
Как определить наличие сопроцессора?
Ответ:

В отличие от общепринятого мнения не всее клоны 486/586/686/ и Pentium
имеют сопроцессор для вычислений с плавающей запятой. В примере определяется
наличие сопроцессора и под Win16 и под Win32.

Пример:
{$IFDEF WIN32}
uses Registry;
{$ENDIF}
function HasCoProcesser : bool;
{$IFDEF WIN32}
i
TheKey : hKey;
{$ENDIF}
begin
Result :=true;
{$IFNDEF WIN32}
if GetWinFlags and Wf_80x87=0 then
Result :=false;
{$ELSE}
if RegOpenKeyEx(HKEY_LOCAL_MACHINE,
'HARDWARE\DESCRIPTION\System\FloatingPointProcessor',0,
KEY_EXECUTE, TheKey) <> ERROR_SUCCESS then result :=false;
RegCloseKey(TheKey);
{$ENDIF}
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if HasCoProcesser then
  ShowMessage('Has CoProcessor') 
else
  ShowMessage('No CoProcessor - Windows Emulation Mode');
end;
Наверх к содержанию

Вопрос:
Как узнать серийный номер аудио CD?
Ответ:

CD может иметь или не иметь серийный номер и/или универсальный код продукта
(Universal Product Code). MCI-расширение Windows предоставляет эту информации
с помощью комманды MCI_INFO_MEDIA_IDENTITY command. Эта команда возвращает
уникальную ID-строку.

Пример:
uses MMSystem, MPlayer;
procedure TForm1.Button1Click(Sender: TObject);
i
mp : TMediaPlayer;
msp : TMCI_INFO_PARMS;
MediaString : array[0..255] of char;
ret : longint;
begin
mp :=TMediaPlayer.Create(nil);
mp.Visible :=false;
mp.Parent :=Application.MainForm;
mp.Shareable :=true;
mp.DeviceType :=dtCDAudio;
mp.FileName :='D:';
mp.Open;
Application.ProcessMessages;
FillChar(MediaString, sizeof(MediaString), #0);
FillChar(msp, sizeof(msp), #0);
msp.lpstrReturn :=@MediaString;
msp.dwRetSize :=255;
ret :=mciSendCommand(Mp.DeviceId, MCI_INFO, MCI_INFO_MEDIA_IDENTITY,
  longint(@msp));
if Ret <> 0 then
  begin
  MciGetErrorString(ret, @MediaString, sizeof(MediaString));
  Memo1.Lines.Add(StrPas(MediaString));
  end
else
  Memo1.Lines.Add(StrPas(MediaString));
mp.Close;
Application.ProcessMessages;
mp.free;
end;
end.
Наверх к содержанию

Вопрос:
Как узнать есть ли в заданном CD-ROM'е Audio CD?
Ответ:

Можно использовать функцию Windows API GetDriveType() чтобы определить
является ли дисковод CD-ROM'мом. И функцию API GetVolumeInformation() чтобы
проверить VolumeName на равенство 'Audio CD'.
Пример:

function IsAudioCD(Drive : char) : bool;
i
DrivePath : string;
MaximumComponentLength : DWORD;
FileSystemFlags : DWORD;
VolumeName : string;
Begin
sult :=false;
DrivePath :=Drive + ':\';
if GetDriveType(PChar(DrivePath)) <> DRIVE_CDROM then
  exit;
SetLength(VolumeName, 64);
GetVolumeInformation(PChar(DrivePath),PChar(VolumeName),
Length(VolumeName),nil,MaximumComponentLength,FileSystemFlags,nil,0);
if lStrCmp(PChar(VolumeName),'Audio CD')=0 then
  result :=true;
end;

function PlayAudioCD(Drive : char) : bool;
i
mp : TMediaPlayer;
begin
result :=false;
Application.ProcessMessages;
if not IsAudioCD(Drive) then
  exit;
mp :=TMediaPlayer.Create(nil);
mp.Visible :=false;
mp.Parent :=Application.MainForm;
mp.Shareable :=true;
mp.DeviceType :=dtCDAudio;
mp.FileName :=Drive + ':';
mp.Shareable :=true;
mp.Open;
Application.ProcessMessages;
mp.Play;
Application.ProcessMessages;
mp.Close;
Application.ProcessMessages;
mp.free;
result :=true;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if not PlayAudioCD('D') then
  ShowMessage('Not an Audio CD');
end;
 

Наверх к содержанию

Вопрос:
Как узнать есть ли у мыши колесико?

Ответ:
Свойство "WheelPresent" глобального обьекта "mouse".
 

Наверх к содержанию

Вопрос:
Функция keybd_event() принимает значения до 244 - как мне отправить
нажатие
клавиши с кодом #255 в элемент управления Windows?

Ответ:
Это может понадобится для иностранных языков или для специальных символов. (например,
в русских шрифтах символ с кодом #255 - я прописное). Приведенный в примере метод,
не стоит использовать в случае если символ может быть передан обычным способом
(функцией keybd_event()).

procedure TForm1.Button1Click(Sender: TObject);
i
KeyData : packed record
  RepeatCount : word;
  ScanCode : byte;
  Bits : byte;
end;
begin
{Let the button repaint}
Application.ProcessMessages;
{Set the focus to the window}
Edit1.SetFocus;
{Send a right so the char is added to the end of the line}
//  SimulateKeyStroke(VK_RIGHT, 0);
keybd_event(VK_RIGHT, 0,0,0);
{Let the app get the message}
Application.ProcessMessages;
FillChar(KeyData, sizeof(KeyData), #0);
KeyData.ScanCode :=255;
KeyData.RepeatCount :=1;
SendMessage(Edit1.Handle, WM_KEYDOWN, 255,LongInt(KeyData));
KeyData.Bits :=KeyData.Bits or (1 shl 30);
KeyData.Bits :=KeyData.Bits or (1 shl 31);
SendMessage(Edit1.Handle, WM_KEYUP, 255, LongInt(KeyData));
KeyData.Bits :=KeyData.Bits and not (1 shl 30);
KeyData.Bits :=KeyData.Bits and not (1 shl 31);
SendMessage(Edit1.Handle, WM_CHAR, 255, LongInt(KeyData));
Application.ProcessMessages;
end;
 

Наверх к содержанию

Вопрос:
Некоторые компоненты не меняют курсор мыши до тех пор пока пользователь
не
сдвинет мышь. Как эмулировать движение мыши?

Ответ:
В примере мышка слегка "подталкивается" без участия пользователя.

procedure TForm1.Button1Click(Sender: TObject);
i
pt : TPoint;
begin
Application.ProcessMessages;
Screen.Cursor :=CrHourglass;
GetCursorPos(pt);
SetCursorPos(pt.x + 1, pt.y + 1);
Application.ProcessMessages;
SetCursorPos(pt.x - 1, pt.y - 1);
end;
 
 

Наверх к содержанию

Есть ли в Delphi эквивалент функции SendKeys Visual Basic'а?
Ответ:

Ниже приведена процедура, позволяющаю отправлять нажатия в любой элемент
управления (window control), способный принимать ввод с клавиатуры. Вы
можете использовать эту технику чтобы включать клавиши NumLock, CapsLock
и ScrollLock под Windows NT. Та же техника работает и под Windows 95 для
CapsLock и ScrollLock но не работает для клавиши NumLock.
Обратите внимание, что приведены четыре поцедуры: SimulateKeyDown()
- эмулировать нажатие клавиши (без отпускания) SimulateKeyUp() - эмулировать
отпускание клавиши SimulateKeystroke() - эмулировать удар по клавише (нажатие
и отпускание) и SendKeys(), позволяющие Вам гибко контролировать посылаемые
сообщения клавиатуры.
SimulateKeyDown(), SimulateKeyUp() и SimulateKeystroke() получают коды
виртуальных клавиш (virtural key) (вроде VK_F1). Процедура SimulateKeystroke()
получает дополнительный параметр, полезный при эмуляции нажатия PrintScreen.
Когда этот параметр равен нулю весь экран будет скопирован в буфер обмена
(clipboard). Если дополнительный параметр равен 1 будет скопированно только
активное окно.
Четыре метода "button click" демонстрируют использование: ButtonClick1
- включает capslock ButtonClick2 - перехватывает весь экран в буфер обмена
(clipboard). ButtonClick3 - перехватывает активное окно в буфер обмена
(clipboard). ButtonClick4 - устанавливает фокус в Edit и отправляет в него
строку.
Пример:

procedure SimulateKeyDown(Key : byte);
begin
keybd_event(Key, 0, 0, 0);
end;

procedure SimulateKeyUp(Key : byte);
begin
keybd_event(Key, 0, KEYEVENTF_KEYUP, 0);
end;

procedure SimulateKeystroke(Key : byte; extra : DWORD);
begin
keybd_event(Key,extra,0,0);
keybd_event(Key,extra,KEYEVENTF_KEYUP,0);
end;

procedure SendKeys(s : string);
i
i : integer;
flag : bool;
w : word;
begin
{Get the state of the caps lock key}
flag :=not GetKeyState(VK_CAPITAL) and 1=0;
{If the caps lock key is on then turn it off}
if flag then
  SimulateKeystroke(VK_CAPITAL, 0);
for i :=1 to Length(s) do
  begin
  w :=VkKeyScan(s[i]);
  {If there is not an error in the key translation}
  if ((HiByte(w) <> $FF) and (LoByte(w) <> $FF)) then
begin
  {If the key requires the shift key down - hold it down}
  if HiByte(w) and 1=1 then
  SimulateKeyDown(VK_SHIFT);
  {Send the VK_KEY}
  SimulateKeystroke(LoByte(w), 0);
  {If the key required the shift key down - release it}
  if HiByte(w) and 1=1 then
  SimulateKeyUp(VK_SHIFT);
end;
  end;
{if the caps lock key was on at start, turn it back on}
if flag then
SimulateKeystroke(VK_CAPITAL, 0);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
{Toggle the cap lock}
SimulateKeystroke(VK_CAPITAL, 0);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
{Capture the entire screen to the clipboard}
{by simulating pressing the PrintScreen key}
SimulateKeystroke(VK_SNAPSHOT, 0);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
{Capture the active window to the clipboard}
{by simulating pressing the PrintScreen key}
SimulateKeystroke(VK_SNAPSHOT, 1);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
{Set the focus to a window (edit control) and send it a string}
Application.ProcessMessages;
Edit1.SetFocus;
SendKeys('Delphi Is RAD!');
end;
 

Наверх к содержанию

  Как получить список
модемов
Stas Malinovski 3.1.1999

Предлагаю следующий модуль для этих целей:
unit PortInfo;

interface

uses
  Windows, SysUtils, Classes, Registry;

function EnumModems : TStrings;

implementation

function EnumModems : TStrings;
var
  R : TRegistry;
  S : ShortString;
  N : TStringList;
  I : Integer;
  J : Integer;
begin
  Result :=TStringList.Create;
  R :=TRegistry.Create;
  try
with R do
begin
  RootKey :=HKEY_LOCAL_MACHINE;
  if OpenKey('\System\CurrentControlSet\Services\Class\Modem', False)
  then
if HasSubKeys then
begin
  N :=TStringList.Create;
  try
  GetKeyNames(N);
for I :=0to N.Count - 1do
begin
OpenKey(N[I], False);
S :=ReadString('AttachedTo');
for J :=1to4do
if Pos(Chr(J + Ord('0')), S) > 0then Break;
Result.AddObject(ReadString('DriverDesc'), TObject(J));
CloseKey;
end;
  finally
  N.Free;
  end;
end;
end;
  finally
R.Free;
  end;
end;

end.

Работа с принтером.
Delphi имеет стандартный объект для доступа к принтеру - TPRINTER,
находящийся в модуле PRINTERS. В этом модуле имеется переменная Printer:Tpinter,
что избавляет от необходимости описывать свою. Он позволяет выводить данные
на печать и управлять процессом печати. Правда, в некоторых версиях Delphi
1 он имеет "глюк" - не работают функции Draw и StrethDraw. Но эта проблема
поправима - можно использовать функции API. Далее приведены основные поля
и методы объекта Printers :
PROPERTY
Aborted:boolean - Показывает, что процесс печати прерван
Canvas:Tcanvas - Стандартный Canvas, как у любого графического объекта.
Он позволяет рисовать на листе бумаге графику, выводить текст ... . Тут
есть несколько особенностей, они описаны после описания объекта.
Fonts:Tstrings - Возвращает список шрифтов, поддерживаемых принтером
Handle:HDS - Получить Handle на принтер для использования функций API
(см. Далее)
Orientation:TprinterOrientation - Ориентация листа при печати : (poPortrait,
poLandscape)
PageHeight:integer - Высота листа в пикселах
PageNumber:integer - Номер страницы, увеличивается на 1 при каждом
NewPage
PageWidth:integer - Ширина листа в пикселах
PrinterIndex:integer - Номер используемого принтера по списку доступных
принтеров Printers
Printers:Tstrings - Список доступных принтеров
Printing:boolean - Флаг, показывающий, что сейчас идет процесс печати
Title:string - Имя документа или приложения. Под этим именем задание
на печать регистрируется в диспетчере печати
METODS
AssignPrn(f:TextFile) - Связать текстовый файл с принтером. Далее вывод
информации в этот файл приводит к ее печати. Удобно в простейших случаях.
Abort - Сбросить печать
BeginDoc - Начать печать
NewPage - Начать новую страницу
EndDoc - Завершить печать.
Пример :

Procedure TForm1.Button1Click(Sender: TObject);
Begin
 With Printer do Begin
  BeginDoc; { Начало печати }
  Canvas.Font:=label1.font; { Задали шрифт }
  Canvas.TextOut(100,100,'Это тест принтера !!!'); { Печатаем текст }
  EndDoc; { Конец печати }
 end;
end;

Особенности работы с TPrinter
1. После команды BeginDoc шрифт у Canvas принтера сбрасывается и его
необходимо задавать заново
2. Все координаты даны в пикселах, а для нормальной работы необходимы
миллиметры (по двум очевидным причинам: очень трудно произвести разметку
страницы в пикселах (особенно если необходима точность), и , главное, при
изменении разрешающей способности принтера будет изменяться число точек
на дюйм, и все координаты "поедут".
3. У TPrinter информация о принтере, по видимому, определяются один
раз - в момент запуска программы (или смены принтера). Поэтому изменение
настроек принтера в процессе работы программы может привести к некорректной
работе, например, неправильной печать шрифтов True Type.
Определение параметров принтера через API
Для определения информации о принтере (плоттере, экране) необходимо
знать Handle этого принтера, а его можно узнать объекта TPrinter - Printer.Handle.
Далее вызывается функция API (unit WinProcs) : GetDevice(Handle:HDC; Index:integer):integer;
Index - код параметра, который необходимо вернуть. Для Index существует
ряд констант :
DriverVersion - вернуть версию драйвера
Texnology - Технология вывода, их много, основные
 dt_Plotter - плоттер
 dt_RasPrinter - растровый принтер
 dt_Display - дисплей
HorzSize - Горизонтальный размер листа (в мм)
VertSize - Вертикальный размер листа (в мм)
HorzRes - Горизонтальный размер листа (в пикселах)
VertRes - Вертикальный размер листа (в пикселах)
LogPixelX - Разрешение по оси Х в dpi (пиксел /дюйм)
LogPixelY - Разрешение по оси Y в dpi (пиксел /дюйм)
Кроме перечисленных еще около сотни, они позволяют узнать о принтере
практически все.
Параметры, возвращаемые по LogPixelX и LogPixelY очень важны - они
позволяют произвести пересчет координат из миллиметров в пиксели для текущего
разрешения принтера. Пример таких функций:

Procedure TForm1.GetPrinterInfo; { Получить информацию о принтере }
begin
  PixelsX:=GetDeviceCaps(printer.Handle,LogPixelsX);
  PixelsY:=GetDeviceCaps(printer.Handle,LogPixelsY);
end;
Function TForm1.PrinterCoordX(x:integer):integer; { переводит координаты из мм в пиксели }
begin
 PrinterCoordX:=round(PixelsX/25.4*x);
end;
Function TForm1.PrinterCoordY(Y:integer):integer; { переводит координаты из мм в пиксели }
begin
 PrinterCoordY:=round(PixelsY/25.4*Y);
end;
---------------------------------
GetPrinterInfo;
Printer.Canvas.TextOut(PrinterCoordX(30), PrinterCoordY(55),
 'Этот текст печатается с отступом 30 мм от левого края и '+
 '55 мм от верха при любом разрешении принтера');

Данную методику можно с успехом применять для печати картинок - зная размер
картинки можно пересчитать ее размеры в пикселах для текущего разрешения
принтера, масштабировать, и затем уже распечатать. Иначе на матричном принтере
(180 dpi) картинка будет огромной, а на качественном струйнике (720 dpi)
- микроскопической.

Наверх

Иногда может возникнуть необходимость в выключении на время устройств ввода - клавиатуры и мыши. Например, это неплохо сделать на время выполнения кода системы защиты от копирования, в играх, или в качестве "наказания" при запуске программы по истечению срока ее бесплатного использования ... . Однако наилучшее ее применение - отключение клавиатуры и мыши на время работы демонстрационки, основанной на воспроизведении записанных заранее перемещений мышки и клавиатурного ввода (см. об этом отдельный раздел этой книги). Это элементарно сделать при помощи API:
EnableHadwareInput(Enable:boolean): boolean; Enable - требуемое состояние устройств ввода (True - включены, false - выключены). Если ввод заблокирован, то его можно разблокировать вручную - нажать Ctrl + Alt + Del, при появлении меню "Завершение работы программы" ввод разблокируется.
Наверх

Управление питанием из программы
на Delphi
При написании разнообразны программ типа заставок, менеджеров управления
компьютером ... возникает необходимость переводить компьютер в режим "спячки".
Для включения этого режима в Windows 95 (и только в ней !!) предусмотрена
команда API:
SetSystemPowerState(Suspended, Mode: Boolean):boolean;
Suspended должно быть TRUE для ухода в спячку.
Mode - режим входа в спячку. Если TRUE, то всем программам и драйверам
посылается Message PBT_APMSUSPEND, по которому они должны немедленно прекратить
работу. Если FALSE, то посылается Message PBT_APMQUERYSUSPEND запроса на
спячку, и драйвера в ответ могут дать отказ на включение режима спячки.
Возврат функции SetSystemPowerState: TRUE - режим включен.

Наверх к содержанию

Ivanuts V.A.
31.10.2001

Если эта задача стоит в процессе вывода на печать документов из QuickReport, то достаточно изменить значение свойства PrinterSettings.Copies, например:

procedure TMyForm.PrintBtnClick(Sender : TObject);
begin QuickReport1.PrinterSettings.Copies :=StrToInt(Edit1.Text);
end;

Если же печать документа производится путем функциональных возможностей модуля Printers, то необходимо организовать цикл повторения печати, например:

procedure TMyForm.PrintBtnClick(Sender : TObject);

var

I : Integer;

begin

 for I :=0to StrToInt(Edit1.Text) do

  begin

  Printer.BeginDoc;

  . . .

  Printer.EndDoc;

  end;

end;

Наверх к содержанию

---

Как определить видеокарту
Первая форма имеет кнопку. Создайте другую форму с memo

//=======================================================
procedure TForm1.button1click(Sender: TObject);
i
lpDisplayDevice: TDisplayDevice;
dwFlags: DWORD;
cc: DWORD;
begin
form2.memo1.Clear;
lpDisplayDevice.cb :=sizeof(lpDisplayDevice);
dwFlags :=0;
cc:=0;
while EnumDisplayDevices(nil, cc, lpDisplayDevice , dwFlags) do
begin
Inc(cc);
form2.memo1.lines.add(lpDisplayDevice.DeviceString);
{Так же мы увидим дополнительную информацию в lpDisplayDevice}
form2.show;
end;
end;