uselkeyform.pas

搞笑俄罗斯方块这个程序由delphi制作而成。

{   键盘设定窗体单元   }
unit USelKeyForm;

interface

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

type
  TSelectKeyForm = class(TForm)
    GroupBox: TGroupBox;
    ButtonOk: TButton;
    ButtonCancel: TButton;
    LabelDown: TLabel;
    LabelLeft: TLabel;
    LabelRight: TLabel;
    LabelChange: TLabel;
    LabelSpeed: TLabel;
    EditDown: TEdit;
    EditLeft: TEdit;
    EditRight: TEdit;
    EditChange: TEdit;
    EditSpeed: TEdit;
    procedure EditDownKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure EditLeftKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure EditRightKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure EditChangeKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure EditSpeedKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormShow(Sender: TObject);
    procedure ButtonOkClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
    function SetEditKey(Editor: TEdit; Key: Word):boolean;
  public
    { Public declarations }
  end;


var
   SelectKeyForm: TSelectKeyForm;
   ALeftKey,
   ARightKey,
   ADownKey,
   AChangeKey,
   ADirectDownKey : Word;
implementation

{$R *.DFM}

function TSelectKeyForm.SetEditKey(Editor: TEdit; Key: Word):boolean;
begin
   Result := true;
   if Chr(Key) in ['0'..'9','a'..'z','A'..'Z'] then
      Editor.Text := UpCase(Chr(Key)) + '键'
   else
      case Key of
         VK_SPACE:
               Editor.Text := '空格键';
         VK_LEFT:
               Editor.Text := '左方向键';
         VK_RIGHT:
               Editor.Text := '右方向键';
         VK_DOWN:
               Editor.Text := '下方向键';
         VK_UP:
               Editor.Text := '上方向键';
         VK_CONTROL:
               Editor.Text := 'Ctrl键';
         VK_SHIFT:
               Editor.Text := 'Shift键';
         else
         begin
            Result := false;
            Editor.Text := '无效键';
         end
      end;
   Editor.SelStart := Length(Editor.Text);
end;

procedure TSelectKeyForm.EditDownKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
   if SetEditKey(EditDown,Key) then
      ADownKey := Key;
end;

procedure TSelectKeyForm.EditLeftKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
   if SetEditKey(EditLeft,Key) then
      ALeftKey := Key;
end;

procedure TSelectKeyForm.EditRightKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
   if SetEditKey(EditRight,Key) then
      ARightKey := Key;
end;

procedure TSelectKeyForm.EditChangeKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
   if SetEditKey(EditChange,Key) then
      AChangeKey := Key;
end;

procedure TSelectKeyForm.EditSpeedKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
   if SetEditKey(EditSpeed,Key) then
      ADirectDownKey := Key;
end;

procedure TSelectKeyForm.FormShow(Sender: TObject);
begin
   SetEditKey(EditDown,DownKey);
   SetEditKey(EditLeft,LeftKey);
   SetEditKey(EditRight,RightKey);
   SetEditKey(EditChange,ChangeKey);
   SetEditKey(EditSpeed,DirectDownKey);
   ADownKey := DownKey;
   ALeftKey := LeftKey;
   ARightKey := RightKey;
   AChangeKey := ChangeKey;
   ADirectDownKey := DirectDownKey;
end;

procedure TSelectKeyForm.ButtonOkClick(Sender: TObject);
begin
   DownKey := ADownKey;
   LeftKey := ALeftKey;
   RightKey := ARightKey;
   ChangeKey := AChangeKey;
   DirectDownKey := ADirectDownKey;
end;

procedure TSelectKeyForm.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
   if (EditDown.Text = '无效键') or
      (EditLeft.Text = '无效键') or
      (EditRight.Text = '无效键') or
      (EditSpeed.Text = '无效键') or
      (EditChange.Text = '无效键') then
      begin
         MessageBox(Handle,'您设置了无效键，请重新设置！','提示',48);
         CanClose := false;
      end;
end;

end.