 ::  |
| Autor |
Poruka |
himzo
Banovan!
Odomaćeni član
 |
Godine: 42
Datum registracije: 24 Okt 2005
Poruke: 1390
Mesto: Vojvoda Stepa
|
|
Ukoliko želite da dozvolite Vašoj aplikaciji da kontroliše Num Lock, Caps Lock i Scroll Lock status to možete uraditi na prikazan način. Konstante ktCapsLock, ktScrollLock i ktNumLock predstavljaju odgovarajuće led diode tj odgovarajuća stanja funkcije Caps, Lock i Num. Sledeći kod prikazuje kako se to radi:
| Code: |
type
TKeyType = (ktCapsLock, ktNumLock, ktScrollLock);
procedure SetLedState(KeyCode: TKeyType; bOn: Boolean);
var
KBState: TKeyboardState;
Cod: Byte;
begin
case KeyCode of
ktScrollLock: Cod := VK_SCROLL;
ktCapsLock: Cod := VK_CAPITAL;
ktNumLock: Cod := VK_NUMLOCK;
end;
GetKeyboardState(KBState);
if (Win32Platform = VER_PLATFORM_WIN32_NT) then
begin
if Boolean(KBState[Cod]) <> bOn then
begin
keybd_event(Cod,
MapVirtualKey(Cod, 0),
KEYEVENTF_EXTENDEDKEY,
0);
keybd_event(Cod,
MapVirtualKey(Cod, 0),
KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP,
0);
end;
end
else
begin
KBState[Cod] := Ord(bOn);
SetKeyboardState(KBState);
end;
end;
|
Primer korišćenja:
| Code: |
procedure TForm1.Button1Click(Sender: TObject);
begin
SetLedState(ktCapsLock, True); // Uključuje Caps Lock
SetLedState(ktNumLock, False); // Isključuje Num Lock
SetLedState(ktScrollLock, True); // Uključuje Scroll Lock
end;
|
|
|
|
| |
|
 |
Doktor
~Sanjicino*slculence~
 |
Godine: 38
Datum registracije: 17 Nov 2005
Poruke: 4264
Mesto: Novi Sad
|
|
Jeli ovo moze da se iskoristi, npr. za pravljenje light show-a. Razmisljao sam da napravim program recimo da mi pali i gasi lampice na tastaturi odredjenim redosledom i u vremenskim intervalima koje ja odredim pomocu ScrollBar-a.
Mozes li da mi kazes kako to da izvedem (ako je u opste moguce)?
|
_________________
~*~Vojim svoje srculence najvise na svetu ~*~ :322:
 |
|
| |
|
|
himzo
Banovan!
Odomaćeni član
|
Godine: 42
Datum registracije: 24 Okt 2005
Poruke: 1390
Mesto: Vojvoda Stepa
|
|
E ovako…
Za Light Show, kako si ga ti nazvao moraš prvo da odrediš redosled LED indikatora na svojoj tastaturi. Kod mene je, na primer prva LED dioda Num Lock, druga Caps Lock i poslednja Scroll Lock. Ovo je slučaj kod najvećeg broja tastatura ali sam sretao i izuzetke. Dakle primer će slediti navedeni raspored.
Otvori nov projekat i na praznu formu (default: form1) postavi tajmer (Timer1), skrol (ScrollBar1) i jedan Edit (Edit1).
Edit1 ima osobinu Text = ‘200 ms’
ScrollBar1 ima osobine Min = 10, Max = 2000 i Possition = 200
Timer1 ima osobinu Interval = 200
Button1 ima osobinu Caption = ‘Start / Stop’
Ovaj primer će raditi na sledeći način. Kad pokreneš aplikaciju LED diode na tvojoj tastaturi će se paliti i gasiti naizmenično sleva na desno. Efekat je kao da se svetla kreću na levu stranu i tako u krug. Brzina kojom se vrši paljenje dioda je 200 ms, tj. na svakih 200 ms pali se odredjena LED dioda.
ScrollBar služi za štelovanje brzine “kretanja” LED dioda. Najveća brzina se postiže kada je ScrollBar u krajnjem levom položaju (10 ms) a najveća pauza je od dve sekunde (kada je ScrollBar pozicioniran u krajnji desni položaj). Pomeranjem skrolera menja se brzina kretanja LED dioda.
U Edit boxu piše trenutna brzina, tj. vremenski interval (pauza) za paljenje i gašenje lampica.
Dugme Button1 služi za zaustavljanje / startovanje algoritma za „Light Show“.
Program (unit1.pas) treba da izgleda ovako:
| Code: |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
Timer1: TTimer;
Button1: TButton;
ScrollBar1: TScrollBar;
Edit1: TEdit;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure ScrollBar1Change(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
TKeyType = (ktCapsLock, ktNumLock, ktScrollLock);
var
Form1: TForm1;
b: Byte = 1;
IDGO: Boolean;
implementation
{$R *.dfm}
procedure SetLedState(KeyCode: TKeyType; bOn: Boolean);
var
KBState: TKeyboardState;
Cod: Byte;
begin
case KeyCode of
ktScrollLock: Cod := VK_SCROLL;
ktCapsLock: Cod := VK_CAPITAL;
ktNumLock: Cod := VK_NUMLOCK;
end;
GetKeyboardState(KBState);
if (Win32Platform = VER_PLATFORM_WIN32_NT) then
begin
if Boolean(KBState[Cod]) <> bOn then
begin
keybd_event(Cod,
MapVirtualKey(Cod, 0),
KEYEVENTF_EXTENDEDKEY,
0);
keybd_event(Cod,
MapVirtualKey(Cod, 0),
KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP,
0);
end;
end
else
begin
KBState[Cod] := Ord(bOn);
SetKeyboardState(KBState);
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
If IDGO Then
BEGIN
Case b Of
1: Begin
SetLedState(ktNumLock, True);
SetLedState(ktCapsLock, False);
SetLedState(ktScrollLock, False);
End;
2: Begin
SetLedState(ktNumLock, False);
SetLedState(ktCapsLock, True);
SetLedState(ktScrollLock, False);
End;
3: Begin
SetLedState(ktNumLock, False);
SetLedState(ktCapsLock, False);
SetLedState(ktScrollLock, True);
End;
End; {Case}
b := b + 1;
If b > 3 Then b := 1;
END;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
IDGO := True;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
IDGO := Not IDGO;
end;
procedure TForm1.ScrollBar1Change(Sender: TObject);
begin
Timer1.Interval := ScrollBar1.Position;
Edit1.Text := IntToStr(ScrollBar1.Position) + ' ms';
Edit1.SetFocus;
end;
end. |
Naravno, svako može štelovati i podešavati parametre kako mu odgovara i time dobije željeni efekat. Ovo ne spada u grupu korisnog softvera već je zabavnog karaktera i služi samo za zezanje...
Ako te mrzi da prekucavaš kod onda skini gotov projekat koji sam ovde postavio na download a vidiš i ScreenShot.
Nadam se da sam ti pomogao i ne ustručavaj se da pitaš šta te zanima.
|
|
|
| |
|
|
Doktor
~Sanjicino*slculence~
|
Godine: 38
Datum registracije: 17 Nov 2005
Poruke: 4264
Mesto: Novi Sad
|
|
E to mi je bas trebalo.
Hvala. 
|
_________________
~*~Vojim svoje srculence najvise na svetu ~*~ :322:
|
|
| |
|
|
|
|
Vi ne možete otvarati nove teme u ovom forumu
Vi ne možete odgovarati na teme u ovom forumu
Vi ne možete menjati Vaše poruke u ovom forumu
Vi ne možete brisati Vaše poruke u ovom forumu
Vi ne možete glasati u anketama u ovom forumu
Vi ne možete postavljati fajlove u ovom forumu
Vi ne možete preuzeti fajlove sa ovog foruma
|
|
