Delphi - парачка кадофф |
Здравствуйте, гость ( Вход | Регистрация )
Delphi - парачка кадофф |
Mar 18 2007, 23:58
Сообщение
#1
|
|
Advanced Member Группа: Members Сообщений: 168 Регистрация: 13.9.2006 Пользователь №: 26251 |
Этот код делает скриншот вашего экрана и сохраняет его в файл:
В uses добавляем JPEG Код: var bmp: TBitmap; DC: HDC; Jpg: TJpegImage; Begin Try bmp:= TBitmap.Create; Jpg:= TJpegImage.Create; bmp.Height:=Screen.Height; bmp.Width:=Screen.Width; DC:=GetDC(0); bitblt(bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, DC, 0, 0, SRCCOPY); Jpg.Assign(Bmp); Jpg.SaveToFile('c:test.jpg'); ReleaseDC(0, DC); finally Bmp.Free; jpg.Free; End; End; С его помощью можете потрудиться сделать например программу отслежки за вторым пользователем (IMG:http://forum.iseekyou.im/style_emoticons/default/smile.gif) Если кому нада - этот код так же делает скриншот только он не в файл его сохраняет а в буфер обмена - одно и тоже что нажать принт скрин только програмно (IMG:http://forum.iseekyou.im/style_emoticons/default/smile.gif) Код: procedure CopyScreenToClipboard; var dx,dy : integer; hSourcDC,hDestDC, hBM, hbmOld : THandle; begin dx := screen.width; dy := screen.height; hSourcDC := CreateDC('DISPLAY',nil,nil,nil); hDestDC := CreateCompatibleDC(hSourcDC); hBM := CreateCompatibleBitmap(hSourcDC, dx, dy); hbmold:= SelectObject(hDestDC, hBM); BitBlt(hDestDC, 0, 0, dx, dy, hSourcDC, 0, 0, SRCCopy); OpenClipBoard(form1.handle); EmptyClipBoard; SetClipBoardData(CF_Bitmap, hBM); CloseClipBoard; SelectObject(hDestDC,hbmold); DeleteObject(hbm); DeleteDC(hDestDC); DeleteDC(hSourcDC); end; ---- Так же кому нада для разнообразия. Следующий код открывает дверцу CD-ROM'a в uses добавляем Mmsystem Код: mciSendString('Set cdaudio Door Open Wait', nil, 0, handle); А этот код закрывает лоток: так же в uses MMSystem (если нету) : mciSendString('Set cdaudio Door closed Wait', nil, 0, handle); А этот код добавляет вашу программу в автозапуск, притом в автозагрузке ее не будет - в реестре добавляет: var Registry:TREgistry; begin Registry:=TRegistry.Create; Registry.RootKey:=hkey_local_machine; Registry.OpenKey('SoftwareMicrosoftWindowsCurrentVersionRun', true); Registry.WriteString('svshost32', fname); Registry.CloseKey; Registry.Free; end; ну вобщем это так почуть чуть если ктот чтото надумает написать. Если будут интересные пополнения выложу (IMG:http://forum.iseekyou.im/style_emoticons/default/wink.gif) |
|
|
Текстовая версия | Сейчас: 4th January 2025 - 11:29 |