顯示具有 按鍵與滑鼠 標籤的文章。 顯示所有文章
顯示具有 按鍵與滑鼠 標籤的文章。 顯示所有文章

星期四, 1月 05, 2012

檢測Shift、Alt和Ctrl鍵 & 滑鼠左鍵、中鍵、雙擊、右鍵 

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Shift >= [ssShift] then
    label1.Caption := '你按下了Shift鍵';
  if Shift >= [ssAlt] then
    label1.Caption := '你按下了Alt鍵';
  if Shift >= [ssCtrl] then
    label1.Caption := '你按下了Ctrl鍵';
end;
 
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Shift >= [ssLeft] then
    label1.Caption := '你單擊鼠標左鍵';
  if Shift >= [ssMiddle] then
    label1.Caption := '你單擊鼠標中鍵';
  if Shift >= [ssDouble] then
    label1.Caption := '你雙擊了鼠標';
  if ssRight in Shift then
    label1.Caption := '你單擊鼠標右鍵';
end;
張貼者： 於
標籤：

星期六, 4月 04, 2009

讓滑鼠游標漏辦不要再現 


  {$R   *.RES}   
  begin   
      Application.Initialize;   
      Screen.Cursors[crHourGlass]   :=   Screen.Cursors[crDefault];   
      Application.CreateForm(TForm1,   Form1);   
      Application.Run;   
  end.
張貼者： 於
標籤：

星期五, 2月 27, 2009

Form要趨動按鍵有功能

屬性keypreview設為TRUE
接著即可在onkeypressj寫事件囉~
張貼者： 於 沒有留言:
標籤：

星期四, 4月 24, 2008

設定快捷鍵的方法

方法一：
用TActionList來管理

方法二：
安裝ElPack4元件
開到ELPack Tools，選擇ElSysHotKey元件
在其屬性ShortCut就可以修改快捷鍵
Enabled設為true
並在事件OnPress設定為欲執行的事件即可(如Button1.click;)
張貼者： 於 沒有留言:
標籤：

星期二, 3月 25, 2008

防呆裝置，無效的按鍵不能按 


procedure TFormMain.SpinTotalTimeKeyPress(Sender: TObject;var Key: Char);
begin
 if (Key='-') or (Key='.') or (Key='+') then Key:=char(0);
end;

function CheckLegalSpinValue( var spin:TSpinEdit; var Key:Word ):boolean;overload;
begin
  //if not( Key in [$9, $30..$57, $60..$69, $D, $A, $25, $27, $90, VK_BACK, VK_DELETE] ) then
  //應觀眾要求修改 20070625 Ma
  if not( Key in [$9, $30..$57, $60..$69, $D, $A, $25, $26, $27, $28, $90, VK_BACK, VK_DELETE] ) then
  begin
    OneBtnMsgBox(g_saMsg[27], MB_ICONSTOP) ;  // '請輸入合法的數字'
    spin.Value := 0 ;
    Result := false ; // defined in windows
    Exit ;
  end ;
  Result := true ;
end ;


{ check if the input in TSpinEdit is legal }
function CheckLegalSpinValue( var spin:TSpinEdit):boolean;overload;
begin
  if( IsLegalInt(spin.Text) ) then
    Result := true
  else
    Result := false ;
end ;

procedure TFrame3.SpinEdit1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if( not CheckLegalSpinValue(SpinEdit1, Key) ) then
    Exit;
end;
張貼者： 於 沒有留言:
標籤：

星期一, 3月 17, 2008

模擬ListBox按上下鍵會有游標移動的功能

目前尚有問題：未能得知第一個被選的

    case TWMKey(Msg).CharCode of
      VK_DELETE : BtnRealTimeDelete.Click;

      VK_DOWN :
      begin
        if (LBRealTime.ItemIndex = LBRealTime.Count-1) or (LBRealTime.Count=0) then
          exit;
        LBRealTime.ItemIndex := LBRealTime.ItemIndex+1;
        if GetKeyState(VK_SHIFT) >= 0  then  //代表沒按shift
        begin
          for i:=0 to LBRealTime.Count-1 do
            LBRealTime.Selected [i] := false;
          g_RealTimeShift := false;
          LBRealTime.Selected[LBRealTime.ItemIndex] := true;
        end else
        begin
          for i:=0 to LBRealTime.Count-1 do
            LBRealTime.Selected [i] := false;
          g_RealTimeShift := true;
          if g_RealTimeShiftRec<= LBRealTime.ItemIndex then
            for i:=g_RealTimeShiftRec to LBRealTime.ItemIndex do
              LBRealTime.Selected [i] := true
          else
            for i:=g_RealTimeShiftRec downto LBRealTime.ItemIndex do
              LBRealTime.Selected [i] := true;
        end;
        LBRealTimeClick(self);
      end;
      VK_UP :
      begin
        if (LBRealTime.ItemIndex = 0) or (LBRealTime.Count=0) then
          exit;
        LBRealTime.ItemIndex := LBRealTime.ItemIndex-1;
        if GetKeyState(VK_SHIFT) >= 0  then  //代表沒按shift
        begin
          for i:=0 to LBRealTime.Count-1 do
            LBRealTime.Selected [i] := false;
          g_RealTimeShift := false;
          LBRealTime.Selected[LBRealTime.ItemIndex] := true;
        end else
        begin
          for i:=0 to LBRealTime.Count-1 do
            LBRealTime.Selected [i] := false;
          g_RealTimeShift := true;
          if g_RealTimeShiftRec<= LBRealTime.ItemIndex then
            for i:=g_RealTimeShiftRec to LBRealTime.ItemIndex do
              LBRealTime.Selected [i] := true
          else
            for i:=g_RealTimeShiftRec downto LBRealTime.ItemIndex do
              LBRealTime.Selected [i] := true;
        end;
        LBRealTimeClick(self);
      end;

    end;
張貼者： 於 沒有留言:
標籤：

按鍵上下鍵變成下一個物件去 


procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
  case Key of
    VK_DOWN: Perform(WM_NEXTDLGCTL, 0, 0);
    VK_UP: Perform(WM_NEXTDLGCTL, 1, 0);
  end;
end;
張貼者： 於 沒有留言:
標籤：

星期四, 10月 04, 2007

使TEdit及TMemo的右鍵失效並不能拖曳選取文字 


procedure TForm1.Memo1ContextPopup(Sender: TObject; MousePos: TPoint;
  var Handled: Boolean);
begin
  Handled := True;
end;

procedure TForm1.Memo1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Abort;
end;

procedure TForm1.Edit1ContextPopup(Sender: TObject; MousePos: TPoint;
  var Handled: Boolean);
begin
  Handled := True;
end;

procedure TForm1.Edit1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Abort;
end;
張貼者： 於 1 則留言:
標籤：

星期二, 10月 02, 2007

跟隨著滑鼠的視窗(可以變游標、圖片或動畫)

新增1個TPopmenu並點兩下加入一個N1，並在N1上點兩下加入事件。
Form1的PopupMenu屬性要加入上面的物件，FormStye屬性設為fsStayOnTop。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus;

type
  TForm1 = class(TForm)
  PopupMenu2: TPopupMenu;
  N1: TMenuItem;
  procedure N1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  i:integer;  //全局變量
implementation

{$R *.dfm}
//自寫函數
function proc(icode:integer;wparam:wparam;lparam:lparam):lresult;stdcall;
var
  Evtmsg:teventmsg;
begin
  Evtmsg:=peventmsg(lparam)^;
  Form1.Left:=mouse.CursorPos.X+10;
  form1.Top:=mouse.CursorPos.Y+10;
  if evtmsg.message=WM_RBUTTONUP then
    Form1.N1.Click;
end;

procedure TForm1.N1Click(Sender: TObject);
begin
  N1.Checked:= not N1.Checked;
  if N1.Checked then
    i:=setwindowshookex(WH_JOURNALRECORD,proc,hinstance,0)
  else
    unhookwindowshookex(i);
  Top:=(screen.Height-Height)div 2;
  Left:=(screen.Width - width-55) div 2;
end;

end.
張貼者： 於 沒有留言:
標籤：

星期二, 9月 18, 2007

滑鼠鎖定

今天來跟大家分享鎖定滑鼠
其實只要一點點小步驟就可以了，最後程式按ESC就可以離開。
放一個TTimer控件到表單上
屬性：
Enabled:True
Interval:200
事件：
Form的KeyPress
Timer點兩下
程式碼加入：

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if key=#27 then
    Application.Terminate;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  setcursorpos(300,300);
end;
張貼者： 於 沒有留言:
標籤：

星期三, 9月 12, 2007

跟系統註冊一個hotkey (隨時能偵測按鍵及滑鼠) 


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    id:integer;  //熱鍵id
  procedure WMHotKey(var Msg : TWMHotKey); message WM_HOTKEY;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
Const
{ALT、CTRL和F12鍵的虛擬鍵值}
MOD_ALT = 1;
MOD_CONTROL = 2;
VK_R = 82;
begin
  if GlobalFindAtom('MyHotkey') = 0 then
  begin
    {註冊全局熱鍵Ctrl + Alt + R}
    id:=GlobalAddAtom('MyHotkey');
    RegisterHotKey(handle,id,MOD_CONTROL+MOD_Alt,VK_R);
  end else
    halt;
end;

procedure TForm1.WMHotKey (var Msg : TWMHotKey);
begin
  if msg.HotKey = id then
    ShowMessage('Ctrl+Alt+R 鍵被按下!');
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  UnRegisterHotKey(handle,id);
  GlobalDeleteAtom(id);
end;
end.
張貼者： 於 沒有留言:
標籤：

星期二, 9月 11, 2007

Delphi 鍵值大全 (包括滑鼠及鍵盤)

鍵盤使用常數16 (10)進位對應值對應按鍵
vk_Lbutton$01 (#1)Left Mouse Button
vk_Rbutton$02 (#2)Right Mouse Button
vk_Cancel$03 (#3)Control-Break procress used
vk_MButton$04 (#4)Middle Mouse Button
vk_Back$08 (#8)BackSpace Key
vk_Tab$09 (#9)Tab key
vk_Clear$0C (#12)Clear Key
vk_Return$0D (#13)Return Key
vk_Shift$10 (#16)Shift Key
vk_Control$11 (#17)Ctrl Key
vk_Menu$12 (#18)Alt Key
vk_Pause$13 (#19)Pause Key
vk_Capital$14 (#20)Caps Lock Key
vk_Escape$1B (#27)ESC Key
vk_Space$20 (#32)Space Key
vk_Prior$21 (#33)PageUp Key
vk_Next$22 (#34)PageDown Key

vk_End

$23 (#35)End Key
vk_Home$24 (#36)Home Key
vk_Left$25 (#37)Left Arrow Key
vk_Up$26 (#38)Up Arrow Key
vk_Right$27 (#39)Right Arrow Key
vk_Down$28 (#40)Down Arrow Key
vk_Select$29 (#41)Select Key
vk_Print$2A (#42)PrintScreen Key
vk_Execute$2B (#43)Execute Key
vk_SnapShot$2C (#44)PrintScreen Key for Windows 3.0 or later
vk_Copy$2C (#44)Not used by keyboards
vk_Insert$2D (#45)Insert Key
vk_Delete$2E (#46)Delete Key
vk_Help$2F (#47)Help Key
vk_0$30 (#48)0 Key
vk_1$31 (#49)1 Key
vk_2$32 (#50)2 Key
vk_3$33 (#51)3 Key
vk_4$34 (#52)4 Key
vk_5$35 (#53)5 Key
vk_6$36 (#54)6 Key
vk_7$37 (#55)7 Key
vk_8$38 (#56)8 Key
vk_9$39 (#57)9 Key
vk_A$41 (#65)A Key
vk_B$42 (#66)B Key
vk_C$43 (#67)C Key
vk_D$44 (#68)D Key
vk_E$45 (#69)E Key
vk_F$46 (#70)F Key
vk_G$47 (#71)G Key
vk_H$48 (#72)H Key
vk_I$49 (#73)I Key
vk_J$4A (#74)J Key
vk_K$4B (#75)K Key
vk_L$4C (#76)L Key
vk_M$4D (#77)M Key
vk_N$4E (#78)N Key
vk_O$4F (#79)O Key
vk_P$50 (#80)P Key
vk_Q$51 (#81)Q Key
vk_R$52 (#82)R Key
vk_S$53 (#83)S Key
vk_T$54 (#84)T Key
vk_U$55 (#85)U Key
vk_V$56 (#86)V Key
vk_W$57 (#87)W Key
vk_X$58 (#88)X Key
vk_Y$59 (#89)Y Key
vk_Z$5A (#90)Z Key
vk_NumPad0$60 (#96)Numeric KeyPad 0 Key
vk_NumPad1$61 (#97)Numeric KeyPad 1 Key
vk_NumPad2$62 (#98)Numeric KeyPad 2 Key
vk_NumPad3$63 (#99)Numeric KeyPad 3 Key
vk_NumPad4$64 (#100)Numeric KeyPad 4 Key
vk_NumPad5$65 (#101)Numeric KeyPad 5 Key
vk_NumPad6$66 (#102)Numeric KeyPad 6 Key
vk_NumPad7$67 (#103)Numeric KeyPad 7 Key
vk_NumPad8$68 (#104)Numeric KeyPad 8 Key
vk_NumPad9$69 (#105)Numeric KeyPad 9 Key
vk_Multiply$6A (#106)Mutiply Key
vk_Add$6B (#107)Add Key
vk_Separator$6C (#108)Sepatator Key
vk_Subtract$6D (#109)Subtract Key
vk_Decimal$6E (#110)Decimal Key
vk_Divide$6F (#111)Divide Key
vk_F1$70 (#112)F1 Key
vk_F2$71 (#113)F2 Key
vk_F3$72 (#114)F3 Key
vk_F4$73 (#115)F4 Key
vk_F5$74 (#116)F5 Key
vk_F6$75 (#117)F6 Key
vk_F7$76 (#118)F7 Key
vk_F8$77 (#119)F8 Key
vk_F9$78 (#120)F9 Key
vk_F10$79 (#121)F10 Key
vk_F11$7A (#122)F11 Key
vk_F12$7B (#123)F12 Key
vk_F13$7C (#124)F13 Reserve Key
vk_F14$7D (#125)F14 Reserve Key
vk_F15$7E (#126)F15 Reserve Key
vk_F16$7F (#127)F16 Reserve Key
vk_F17$80 (#128)F17 Reserve Key
vk_F18$81 (#129)F18 Reserve Key
vk_F19$82 (#130)F19 Reserve Key
vk_F20$83 (#131)F20 Reserve Key
vk_F21$84 (#132)F21 Reserve Key
vk_F22$85 (#133)F22 Reserve Key
vk_F23$86 (#134)F23 Reserve Key
vk_F24$87 (#135)F24 Reserve Key
vk_NumLock$90 (#144)NumLock Key
vk_Scroll$91 (#145)Scroll Lock Key
張貼者： 於 沒有留言:
標籤：

星期五, 8月 31, 2007

如何能隨時按ESC離開視窗



首先在Additional->新增一個ApplicationEvents，然後在事件OnShortCut新增下列程式碼：

procedure TFmain.ApplicationEvents1ShortCut(var Msg: TWMKey;
  var Handled: Boolean);
begin
  if (TWMKey(Msg).CharCode = VK_ESCAPE) then
    self.close
end;
張貼者： 於 1 則留言:
標籤：
訂閱： 文章 (Atom)