keyinput.pas

3D GameStudio 的Delphi开发包

//////////////////////////////////////////////////////////////////////
//
// Delphi InKey Function for the A6_5x Engine (acknex.dll) done by
// Michal Messerschmidt aka LazyDog of Lazy Dog Software
// (www.LazyDogSoftware.com)
// (c) Lazy Dog Software / Michael Messerschmidt 2006
//
// SDK Version 6.50.6
//
// tested on Delphi 5,6,7,2005 & 2006
//////////////////////////////////////////////////////////////////////

unit keyinput;

interface
uses A6Engine;

Type TInKeyResult = (InKeyNotDone,InKeyAbort,InKeyDone);

var InKeyResult : TInKeyResult = InKeyNotDone;

procedure InKey(AString : PString; TheText : PText);
procedure ProcessInKey;

implementation
uses Engine_Library, Windows, Messages, Classes;

Type TInKeyState = (None,NeedInit,Working,NeedClose);

     PSaveKey = ^TSaveKey;
     TSaveKey = Record
                  addr : Pointer; //address to the key event on_enter, on_esc etc
                  func : Pointer; //address to the function assigned to the key event
                end;


Var KeyEvents : TList;
    InKeyVisible : Boolean = False;
    InKeyActive : Boolean = False;
    InKeyState : TInKeyState = None;
    InKeyCurrKey,
    InKeyStr : PString;
    InKeyText: PText;
    InKeySave : String;
    InKeyWork : String;
    InKeyPos : Integer = 1;
    InKeyMax : Integer = 0;


procedure SaveKeyEvents;

var I : Integer;
    MainAddr,
    fAddr : Pointer;
    KeyRec : PSaveKey;
begin
  InKeyWork := InKeyStr.char;
  InKeySave := InKeyWork;
  InKeyState := Working;
  KeyEvents := TList.Create;
  MainAddr := @ev.on_bksp;                  // point to the first key event

  for I := 0 to 87 do                       // on_bksp to on_pause
  begin
    fAddr := PPEvent(PPEvent(MainAddr)^)^;  // get the address of the function stored in the event

    if fAddr <> Nil then
    begin
      New(KeyRec);
      KeyRec^.addr := MainAddr;
      KeyRec^.func := fAddr;
      KeyEvents.Add(KeyRec);
      PPEvent(PPEvent(MainAddr)^)^ := Nil;  // remove all on key events
    end;

    Inc(PPEvent(MainAddr));                 // increment the pointer to the next key event
  end;

  if InKeyText <> Nil then                  // if the string we're working on is visible show caret
    if FlagIsOn(InKeyText.flags,_VISIBLE) then
      if CreateCaret(ev.hWndMain,0,InKeyText.font.dx,0) then
        if ShowCaret(ev.hWndMain) then
        begin
          InKeyVisible := True;
          SetCaretPos(_INT(InKeyText.pos_x),_INT(InKeyText.pos_y)+InKeyText.font.dy);
        end;
end;

procedure RestoreKeyEvents;

var I : Integer;
    MainAddr : Pointer;
    KeyRec : PSaveKey;
begin
  for I := KeyEvents.Count -1 downto 0 do
  begin
    KeyRec := KeyEvents.Items[I];
    MainAddr := KeyRec^.addr;                    // get the pointer to a key event
    PPEvent(PPEvent(MainAddr)^)^ := KeyRec.func; // restore what was in the key event
    Dispose(KeyRec);                             // remove memory allocated
    KeyEvents.Delete(I);                         // remove from the list
  end;

  KeyEvents.Free;
  InKeyState := None;
  InKeyActive := False;
  ev.inkey_active^ := OFF;

  if InKeyVisible then                           // if we created caret destroy it now
  begin
    InKeyVisible := False;
    HideCaret(ev.hWndMain);
    DestroyCaret;
  end;
end;

procedure MoveCaret(Amt : Integer);

var p : TPoint;
begin
  //-1 = Home 0 = backwards 1 = forward >1 = end
  if not InKeyVisible then Exit;

  GetCaretPos(p);

  Case Amt of
    -1 : p.X := _INT(InKeyText.pos_x);
     0 : Dec(p.X,InKeyText.font.dx);
     1 : Inc(p.X,InKeyText.font.dx);
    else Inc(p.X,Amt*InKeyText.font.dx);
  end;

  SetCaretPos(p.X,p.Y);
end;

procedure InKey(AString : PString; TheText : PText);

var Msg : TMsg;
    HasMsg : Boolean;
begin
  if InKeyActive then Exit;

  InKeyActive := True;
  InKeyState := NeedInit;
  InKeyResult := InKeyNotDone;

  SetString(InKeyWork,AString.char,AString.length);
  InKeyText:= TheText;
  InKeyStr := AString;
  InKeyPos := 1;
  InKeyMax := AString.length - 1;

  //clear out the keyboard buffer
  repeat
    HasMsg := PeekMessage(Msg,ev.hWndMain,WM_KEYFIRST,WM_KEYLAST,PM_REMOVE);
  until not HasMsg;

  ev.inkey_active^ := ON;
end;

function ReplaceNoShiftedKey(Code : Integer) : Char;

const FirstRowReplace  = '`-=';   // value to replace a shifted number key
      SecondRowReplace = '[]\';               //
      ThirdRowReplace  = ';''';
      FourthRowReplace = ',./';
begin
  case Code of
       41 : Result := FirstRowReplace[1];
    12,13 : Result := FirstRowReplace[Code-11];
    26,27 : Result := SecondRowReplace[Code-25];
    43    : Result := SecondRowReplace[Code-40];
    39,40 : Result := ThirdRowReplace[Code-38];
   51..53 : Result := FourthRowReplace[Code-50];
       57 : Result := ' ';
       else Result := ' ';
  end;
end;

function ReplaceShiftedKey(Code : Integer) : Char;

const FirstRowReplace  = '!@#$%^&*()_+{}|';   // value to replace a shifted number key
      SecondRowReplace = '{}|';               //
      ThirdRowReplace  = ':"';
      FourthRowReplace = '<>?';
begin
  case Code of
    2..13 : Result := FirstRowReplace[Code-1];
    26,27 : Result := SecondRowReplace[Code-25];
    43    : Result := SecondRowReplace[Code-40];
    39,40 : Result := ThirdRowReplace[Code-38];
   51..53 : Result := FourthRowReplace[Code-50];
       else Result := ' ';   
  end;
end;

procedure ProcessInKey;

type TIntSet = set of 0..255;

const NumKeys  : TIntSet = [2..11];        // 1-9,0
      ShiftSpecialProcess : TIntSet = [2..13,26,27,39,40,51..53];
      NoShiftSpecialProcess : TIntSet = [41,12,13,26,27,39,40,43,51..53,57];

var Temp : Integer;
    Msg : TMsg;
    ScanCode : Integer;
    Caps : TKeyboardState;
    ShiftedKey,
    CapsLock : Boolean;
begin
  if not InKeyActive then Exit;

  if InKeyState = NeedInit then
    SaveKeyEvents;

  if InKeyState = Working then
  begin
    if ev.inkey_active^ = OFF then   // the user wants to abort
    begin
      Msg.message := WM_KEYDOWN;     // force a message value that
      Msg.wParam  := VK_ESCAPE;      // will execute the abort code
    end
    else                             // get keystrokes
    if not PeekMessage(Msg,ev.hWndMain,WM_KEYFIRST,WM_KEYLAST,PM_REMOVE) then Exit;

    if Msg.message = WM_KEYDOWN then // prevent processing same code on Key up event
    case Msg.wParam  of
      VK_TAB,
      VK_PRIOR,
      VK_NEXT,
      VK_UP,
      VK_DOWN,
      VK_INSERT,
      VK_SHIFT,
      VK_CONTROL,
      VK_CAPITAL,
      VK_LWIN,
      VK_RWIN,
      VK_APPS,
      VK_F1..VK_F24,
      VK_NUMLOCK : Exit;

      VK_ESCAPE : begin
                    str_cpy(InKeyStr,PChar(InKeySave));
                    InKeyState := NeedClose;
                    InKeyResult := InKeyAbort;
                  end;

      VK_BACK : begin
                  if InKeyPos = 1 then Exit;

                  Dec(InKeyPos);
                  Delete(InKeyWork,InKeyPos,1);
                  str_cpy(InKeyStr,PChar(InKeyWork));
                  MoveCaret(0);
                end;

     VK_RETURN: begin
                  InKeyState := NeedClose;
                  InKeyResult := InKeyDone;
                end;

     VK_HOME : begin
                 InKeyPos := 1;
                 MoveCaret(-1);
               end;

     VK_LEFT : if InKeyPos > 1 then
               begin
                 Dec(InKeyPos);
                 MoveCaret(0);
               end;

     VK_RIGHT : if InKeyPos < InKeyStr.length-1 then
                begin
                  Inc(InKeyPos);
                  MoveCaret(1);
                end;

     VK_END : begin
                Temp := InKeyStr.length-1 - InKeyPos;

                if Temp > 0 then
                begin
                  Inc(InKeyPos,Temp);
                  MoveCaret(Temp);
                end;
              end;

     VK_DELETE : begin
                   if InKeyStr.length < 2 then Exit;

                   Delete(InKeyWork,InKeyPos,1);
                   str_cpy(InKeyStr,PChar(InKeyWork));
                 end;

      else
      begin
        // get the scancode of the key pressed (bits 16-23 zero based)
        ScanCode := (Msg.lParam and $00FF0000) shr 16;

        // find out if shift key is down
        ShiftedKey := GetKeyState(VK_SHIFT) < 0;

        // find out if caps lock key is down
        GetKeyboardState(Caps);
        CapsLock := Caps[VK_CAPITAL] > 0;

        // process the key
        if (ShiftedKey and (ScanCode in ShiftSpecialProcess)) then
          InKeyCurrKey.char[0] := ReplaceShiftedKey(ScanCode)
        else
        if (not ShiftedKey and (ScanCode in NoShiftSpecialProcess)) then
          InKeyCurrKey.char[0] := ReplaceNoShiftedKey(ScanCode)
        else
        begin
          str_for_key(InKeyCurrKey,_VAR(ScanCode));

          if ShiftedKey or CapsLock then       // shift or caps lock key down
            if not (ScanCode in NumKeys) then  // not a shifted number key
              str_upr(InKeyCurrKey);           // upper case the letter
        end;

        if InKeyStr.length < 2 then            // started with an empty string
          InKeyWork := InKeyCurrKey.char[0]
        else
        if InKeyStr.length-1 < InKeyPos then   // adding to our string
          InKeyWork := InKeyWork + InKeyCurrKey.char[0]
        else
          InKeyWork[InKeyPos] := InKeyCurrKey.Char[0]; // replacing a character

        // place the character into the string the user passed
        str_cpy(InKeyStr,PChar(InKeyWork));

        // if we are not at the max length of the string move the caret forward
        if InKeyPos < InKeyMax then
        begin
          MoveCaret(1);
          Inc(InKeyPos);
        end;
      end;
    end;
  end;

  if InKeyState = NeedClose then
    RestoreKeyEvents;
end;

initialization
  InKeyCurrKey := str_create(' ');

end.