PERTEMUAN 8 / Lab D (TK)
Dwonload Aplikasinya di sini !! |
Dalam kesempatan ini saya mencoba share sedikit tentang Program Delphi 7....Nach aplikasi yang sengaja saya praktekan ini adalah Aplikasi Konfigurasi Perangkat Keras dimana aplikasi display monitor dalam aplikasi ini kita bisa mematikan dan menghidupkan monitor dan mengatur resolusi layar dapat dilakukan secara langsung melalui kode program Delphi sehingga anda tidak perlu menyentuh tombol on /off pada perangkat monitor.
Pengguna Mouse
Mouse merupakan perangkat input yang dipergunakan untuk mengendalikan pergerakan kursor pada layar monitor.Seperti halnya perangkat lainnya mouse juga bisa dikendalikan dengan source code Delphi
Dan perlu di ingat ketika akan setting pengaturan resolusi layar jangan sampai salah memasukan ukuran lebar dan tinggi layar karena akan berpengaruh pada tampilan layar apa lagi kita sampai tidak tahu ukuran resolusi layar...seperti pengalaman saya sendiri tampilan layar menjadi kebalik miring karena salah masukin resolusinya.....hehehe..
Untuk pembuatan Listing Programnya Lihat Di bawah ini !!
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
baktifkan: TButton;
Edit1: TEdit;
Edit2: TEdit;
bmatikan: TButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
batur: TButton;
Label4: TLabel;
Label5: TLabel;
procedure baktifkanClick(Sender: TObject);
procedure bmatikanClick(Sender: TObject);
procedure baturClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
procedure SetRes(XRes,YRes:DWORD);
var
IpDevMode:TDeviceMode;
begin
EnumDisplaySettings(nil,0,IpDevMode);
IpDevMode.dmFields:=DM_PELSWIDTH or DM_PELSHEIGHT;
IpDevMode.dmPelsWidth:=XRes;
IpDevMode.dmPelsHeight:=YRes;
changeDisplaySettings(IpDevMode,0);
end;
Function deteksi(LibName,FuncName:String;var Libpointer:Pointer):Boolean;
var LibHandle:tHandle;
begin
result:=false;
LibPointer:=Nil;
if loadlibrary(PChar(LibName))=0 then exit;
LibHandle:=GetModuleHandle(PChar(LibName));
if LibHandle<>0 then
begin
LibPointer:=GetProcAddress(LibHandle,PChar(FuncName));
if LibPointer<> NIL then Result:=true;
end
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
baktifkan: TButton;
Edit1: TEdit;
Edit2: TEdit;
bmatikan: TButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
batur: TButton;
Label4: TLabel;
Label5: TLabel;
procedure baktifkanClick(Sender: TObject);
procedure bmatikanClick(Sender: TObject);
procedure baturClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
procedure SetRes(XRes,YRes:DWORD);
var
IpDevMode:TDeviceMode;
begin
EnumDisplaySettings(nil,0,IpDevMode);
IpDevMode.dmFields:=DM_PELSWIDTH or DM_PELSHEIGHT;
IpDevMode.dmPelsWidth:=XRes;
IpDevMode.dmPelsHeight:=YRes;
changeDisplaySettings(IpDevMode,0);
end;
Function deteksi(LibName,FuncName:String;var Libpointer:Pointer):Boolean;
var LibHandle:tHandle;
begin
result:=false;
LibPointer:=Nil;
if loadlibrary(PChar(LibName))=0 then exit;
LibHandle:=GetModuleHandle(PChar(LibName));
if LibHandle<>0 then
begin
LibPointer:=GetProcAddress(LibHandle,PChar(FuncName));
if LibPointer<> NIL then Result:=true;
end
end;
{$R *.dfm}
procedure TForm1.baktifkanClick(Sender: TObject);
begin
if baktifkan.Caption='Aktifkan Monitor'then
begin
sendmessage(Application.Handle,WM_SYSCOMMAND,SC_MONITORPOWER,-1);
baktifkan.Caption:='Matikan Monitor';
Sleep(1000);
end
else
begin
sendmessage(Application.Handle,WM_SYSCOMMAND,SC_MONITORPOWER,2);
baktifkan.Caption:='Aktifkan Monitor';
end
{$R *.dfm}
procedure TForm1.baktifkanClick(Sender: TObject);
begin
if baktifkan.Caption='Aktifkan Monitor'then
begin
sendmessage(Application.Handle,WM_SYSCOMMAND,SC_MONITORPOWER,-1);
baktifkan.Caption:='Matikan Monitor';
Sleep(1000);
end
else
begin
sendmessage(Application.Handle,WM_SYSCOMMAND,SC_MONITORPOWER,2);
baktifkan.Caption:='Aktifkan Monitor';
end
end;
procedure TForm1.bmatikanClick(Sender: TObject);
var
xBlockInput:function(Block:BOOL):BOOL;stdcall;
Begin
if deteksi('USER32.DLL','BlockInput',@xBlockInput)then
Begin
xBlockInput(True);
Sleep(10000);
xBlockInput(False);
end;
end;
procedure TForm1.baturClick(Sender: TObject);
begin
SetRes(strtoint(edit1.Text),strtoint(edit2.Text));
end;
end.
procedure TForm1.bmatikanClick(Sender: TObject);
var
xBlockInput:function(Block:BOOL):BOOL;stdcall;
Begin
if deteksi('USER32.DLL','BlockInput',@xBlockInput)then
Begin
xBlockInput(True);
Sleep(10000);
xBlockInput(False);
end;
end;
procedure TForm1.baturClick(Sender: TObject);
begin
SetRes(strtoint(edit1.Text),strtoint(edit2.Text));
end;
end.
Tidak ada komentar:
Posting Komentar