dxinput.pas

传奇源代码的delphi版本

  Levels2: array[Boolean] of Integer = (DISCL_BACKGROUND, DISCL_FOREGROUND);
begin
  Result := Levels[FForceFeedbackDevice and FForceFeedback] or Levels2[FDXInput.ActiveOnly];
end;

function TCustomInput.GetDeviceState(dwSize: Integer; var Data): Boolean;
var
  hr: HRESULT;
begin
  FillChar(Data, dwSize, 0);

  if FDevice<>nil then
  begin
    hr := FDevice.GetDeviceState(dwSize, @Data);
    if (hr=DIERR_INPUTLOST) or (hr=DIERR_NOTACQUIRED) then
    begin
      FDevice.Acquire;
      hr := FDevice.GetDeviceState(dwSize, @Data);
    end;
    Result := hr=DI_OK;
  end else
    Result := False;
end;

function TCustomInput.SetDataFormat: Boolean;

  function DIEnumDeviceObjectsProc(const peff: TDIDeviceObjectInstanceA;
    pvRef: Pointer): HRESULT; stdcall;
  begin
    Result := Integer(DIENUM_CONTINUE);

    if CompareMem(@peff.guidType, @GUID_Unknown, SizeOf(TGUID)) then Exit;

    with TCustomInput(pvRef) do
    begin
      if peff.dwOfs<FDataFormat.dwDataSize then
      begin
        FDataFormatGUIDs[FDataFormat.dwNumObjs] := peff.guidType;

        with FDataFormatObjects[FDataFormat.dwNumObjs] do
        begin
          pguid := @FDataFormatGUIDs[FDataFormat.dwNumObjs];
          dwOfs := peff.dwOfs;
          dwType := peff.dwType;
          dwFlags := 0;
        end;
        Inc(FDataFormat.dwNumObjs);
      end;
    end;
  end;

begin
  Result := False;
  if FDevice<>nil then
  begin
    with FDataFormat do
    begin
      dwSize := SizeOf(FDataFormat);
      dwObjSize := SizeOf(TDIObjectDataFormat);
      dwNumObjs := 0;
      rgodf := @FDataFormatObjects;
    end;

    FDevice.EnumObjects(@DIEnumDeviceObjectsProc, Self, DIDFT_ALL);
    if FDevice.SetDataFormat(FDataFormat)<>DI_OK then Exit;
  end;
  Result := True;
end;

procedure TCustomInput.SetEffects(Value: TForceFeedbackEffects);
begin
  FEffects.Assign(Value);
end;

procedure TCustomInput.SetEnabled(Value: Boolean);
begin
  if FEnabled<>Value then
  begin
    FEnabled := Value;
    if FDXInput.ComponentState*[csLoading, csReading]=[] then
      Initialize;
  end;
end;

procedure TCustomInput.SetForceFeedback(Value: Boolean);
begin
  if FForceFeedback<>Value then
  begin
    FForceFeedback := Value;
    if FDXInput.ComponentState*[csLoading, csReading]=[] then
      Initialize;
  end;
end;

procedure TCustomInput.SetWindowHandle(Value: Integer);
begin
  if FDevice<>nil then
    FDevice.SetCooperativeLevel(Value, GetCooperativeLevel);
end;

{  TKeyboard  }

constructor TKeyboard.Create(DXInput: TCustomDXInput);
begin
  inherited Create(DXInput);
  KeyAssigns := DefKeyAssign;
end;

procedure TKeyboard.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineBinaryProperty('Aissgns', ReadAssigns, WriteAssigns, False);
  Filer.DefineBinaryProperty('Assigns', ReadAssigns, WriteAssigns, True);
end;

function TKeyboard.GetKey(Key: Integer): Boolean;
begin
  if Key in [1..255] then
    Result := FKeyStates[Key] and $80<>0
  else
    Result := False;
end;

procedure TKeyboard.Finalize;
begin
  FillChar(FKeyStates, SizeOf(FKeyStates), 0);
  inherited Finalize;
end;

procedure TKeyboard.Initialize;
begin
  Finalize;

  if (not FEnabled) or (csDesigning in FDXInput.ComponentState) then Exit;

  if FDXInput.FDInput<>nil then
  begin
    if FDXInput.FDInput.CreateDevice(GUID_SysKeyboard, FDevice, nil)<>DI_OK then Exit;
    FDevice.SetDataFormat(c_dfDIKeyboard);
  end;

  FButtonCount := 32;

  inherited Initialize;
end;

procedure TKeyboard.Update;

  function DIKEYtoVK(Key: Byte): Integer;
  begin
    Result := 0;
    case Key of
      DIK_ESCAPE       : Result := VK_ESCAPE;
      DIK_1            : Result := Ord('1');
      DIK_2            : Result := Ord('2');
      DIK_3            : Result := Ord('3');
      DIK_4            : Result := Ord('4');
      DIK_5            : Result := Ord('5');
      DIK_6            : Result := Ord('6');
      DIK_7            : Result := Ord('7');
      DIK_8            : Result := Ord('8');
      DIK_9            : Result := Ord('9');
      DIK_0            : Result := Ord('0');
      DIK_EQUALS       : Result := Ord('=');
      DIK_BACK         : Result := VK_BACK;
      DIK_TAB          : Result := VK_TAB;
      DIK_Q            : Result := Ord('Q');
      DIK_W            : Result := Ord('W');
      DIK_E            : Result := Ord('E');
      DIK_R            : Result := Ord('R');
      DIK_T            : Result := Ord('T');
      DIK_Y            : Result := Ord('Y');
      DIK_U            : Result := Ord('U');
      DIK_I            : Result := Ord('I');
      DIK_O            : Result := Ord('O');
      DIK_P            : Result := Ord('P');
      DIK_LBRACKET     : Result := Ord('[');
      DIK_RBRACKET     : Result := Ord(']');
      DIK_RETURN       : Result := VK_RETURN;
      DIK_LCONTROL     : Result := VK_CONTROL;
      DIK_A            : Result := Ord('A');
      DIK_S            : Result := Ord('S');
      DIK_D            : Result := Ord('D');
      DIK_F            : Result := Ord('F');
      DIK_G            : Result := Ord('G');
      DIK_H            : Result := Ord('H');
      DIK_J            : Result := Ord('J');
      DIK_K            : Result := Ord('K');
      DIK_L            : Result := Ord('L');
      DIK_SEMICOLON    : Result := Ord(';');
      DIK_APOSTROPHE   : Result := Ord('''');
      DIK_LSHIFT       : Result := VK_SHIFT;
      DIK_BACKSLASH    : Result := Ord('\');
      DIK_Z            : Result := Ord('Z');
      DIK_X            : Result := Ord('X');
      DIK_C            : Result := Ord('C');
      DIK_V            : Result := Ord('V');
      DIK_B            : Result := Ord('B');
      DIK_N            : Result := Ord('N');
      DIK_M            : Result := Ord('M');
      DIK_COMMA        : Result := Ord(',');
      DIK_PERIOD       : Result := Ord('.');
      DIK_SLASH        : Result := Ord('/');
      DIK_RSHIFT       : Result := VK_SHIFT;
      DIK_MULTIPLY     : Result := Ord('*');
      DIK_LMENU        : Result := VK_MENU;
      DIK_SPACE        : Result := VK_SPACE;
      DIK_CAPITAL      : Result := VK_CAPITAL;
      DIK_F1           : Result := VK_F1;
      DIK_F2           : Result := VK_F2;
      DIK_F3           : Result := VK_F3;
      DIK_F4           : Result := VK_F4;
      DIK_F5           : Result := VK_F5;
      DIK_F6           : Result := VK_F6;
      DIK_F7           : Result := VK_F7;
      DIK_F8           : Result := VK_F8;
      DIK_F9           : Result := VK_F9;
      DIK_F10          : Result := VK_F10;
      DIK_NUMLOCK      : Result := VK_NUMLOCK;
      DIK_SCROLL       : Result := VK_SCROLL;
      DIK_NUMPAD7      : Result := VK_NUMPAD7;
      DIK_NUMPAD8      : Result := VK_NUMPAD8;
      DIK_NUMPAD9      : Result := VK_NUMPAD9;
      DIK_SUBTRACT     : Result := VK_SUBTRACT;
      DIK_NUMPAD4      : Result := VK_NUMPAD4;
      DIK_NUMPAD5      : Result := VK_NUMPAD5;
      DIK_NUMPAD6      : Result := VK_NUMPAD6;
      DIK_ADD          : Result := VK_ADD;
      DIK_NUMPAD1      : Result := VK_NUMPAD1;
      DIK_NUMPAD2      : Result := VK_NUMPAD2;
      DIK_NUMPAD3      : Result := VK_NUMPAD3;
      DIK_NUMPAD0      : Result := VK_NUMPAD0;
      DIK_DECIMAL      : Result := VK_DECIMAL;
      DIK_F11          : Result := VK_F11;
      DIK_F12          : Result := VK_F12;
      DIK_NUMPADENTER  : Result := VK_RETURN;
      DIK_RCONTROL     : Result := VK_CONTROL;
      DIK_DIVIDE       : Result := VK_DIVIDE;
      DIK_RMENU        : Result := VK_MENU;
      DIK_HOME         : Result := VK_HOME;
      DIK_UP           : Result := VK_UP;
      DIK_PRIOR        : Result := VK_PRIOR;
      DIK_LEFT         : Result := VK_LEFT;
      DIK_RIGHT        : Result := VK_RIGHT;
      DIK_END          : Result := VK_END;
      DIK_DOWN         : Result := VK_DOWN;
      DIK_NEXT         : Result := VK_NEXT;
      DIK_INSERT       : Result := VK_INSERT;
      DIK_DELETE       : Result := VK_DELETE;
      DIK_LWIN         : Result := VK_LWIN;
      DIK_RWIN         : Result := VK_RWIN;
      DIK_APPS         : Result := VK_APPS;
    end;
  end;
{$IfDef DX9}
type
  TDIKeyboardState = array[0..255] of Byte;
{$EndIf}
var
  j: Integer;
  i: TDXInputState;
  dikb: TDIKeyboardState;
begin
  FillChar(FKeyStates, SizeOf(FKeyStates), 0);
  FStates := [];

  if (not FInitialized) or FDXInput.FActiveOnly and (GetForegroundWindow<>FDXInput.FForm.Handle) then
    Exit;

  if FDevice<>nil then
  begin
    FillChar(dikb, SizeOf(dikb), 0);

    if GetDeviceState(SizeOf(dikb), dikb) then
    begin
      {  The DirectInput key code is converted into the Windows virtual key code.  }
      for j:=Low(dikb) to High(dikb) do
        if dikb[j] and $80<>0 then
          FKeyStates[Byte(DIKEYtoVK(j))] := $80;
    end;
  end else
  begin           
    GetKeyboardState(FKeyStates);
  end;

  for i:=LOW(TDXInputState) to HIGH(TDXInputState) do
  begin
    for j:=0 to 2 do
      if Keys[KeyAssigns[i, j]] then
      begin
        FStates := FStates + [i];
        Break;
      end;
  end;
end;

procedure TKeyboard.ReadAssigns(Stream: TStream);
begin
  Stream.ReadBuffer(KeyAssigns, SizeOf(KeyAssigns));
end;

procedure TKeyboard.WriteAssigns(Stream: TStream);
begin
  Stream.WriteBuffer(KeyAssigns, SizeOf(KeyAssigns));
end;

{  TMouse  }

constructor TMouse.Create(DXInput: TCustomDXInput);
begin
  inherited Create(DXInput);
  BindInputStates := False;
  Enabled := False;
end;               

function TMouse.GetX: Integer;
begin
  Result := Fdims.lX;
end;

function TMouse.GetY: Integer;
begin
  Result := Fdims.lY;
end;

function TMouse.GetZ: Integer;
begin
  Result := Fdims.lZ;
end;

procedure TMouse.Finalize;
begin
  FillChar(Fdims, SizeOf(Fdims), 0);
  inherited Finalize;
end;

procedure TMouse.Initialize;
begin
  Finalize;

  if (not FEnabled) or (csDesigning in FDXInput.ComponentState) then Exit;

  if FDXInput.FDInput<>nil then
  begin
    if FDXInput.FDInput.CreateDevice(GUID_SysMouse, FDevice, nil)<>DI_OK then Exit;
    FDevice.SetDataFormat(c_dfDIMouse);
  end else
    raise EDXInputError.Create(SNecessaryDirectInputUseMouse);

  FButtonCount := 3;

  inherited Initialize;
end;

procedure TMouse.Update;
begin
  FillChar(Fdims, SizeOf(Fdims), 0);
  FStates := [];

  if (not FInitialized) or FDXInput.FActiveOnly and (GetForegroundWindow<>FDXInput.FForm.Handle) then
    Exit;

  if FDevice<>nil then
  begin
    FillChar(Fdims, SizeOf(Fdims), 0);
    GetDeviceState(SizeOf(Fdims), Fdims);
  end;

  if Fdims.lX<0 then FStates := FStates + [isLeft];
  if Fdims.lX>0 then FStates := FStates + [isRight];
  if Fdims.lY<0 then FStates := FStates + [isUp];
  if Fdims.lY>0 then FStates := FStates + [isDown];

  if Fdims.rgbButtons[0] and $80<>0 then FStates := FStates + [isButton1];
  if Fdims.rgbButtons[1] and $80<>0 then FStates := FStates + [isButton2];
  if Fdims.rgbButtons[2] and $80<>0 then FStates := FStates + [isButton3];
end;

{  TJoystick  }

function SetDWORDProperty(pdev: IDirectInputDevice; guidProperty: PGUID;
  dwObject, dwHow, dwValue: DWORD): HResult;
var
  dipdw: TDIPropDWORD;
begin
  dipdw.diph.dwSize       := SizeOf(dipdw);
  dipdw.diph.dwHeaderSize := SizeOf(dipdw.diph);
  dipdw.diph.dwObj        := dwObject;
  dipdw.diph.dwHow        := dwHow;
  dipdw.dwData            := dwValue;

  Result := pdev.SetProperty(guidProperty, dipdw.diph);
end;

function SetRangeProperty(pdev: IDirectInputDevice; guidProperty: PGUID;
  dwObject, dwHow, Value: DWORD): HResult;
var
  diprg: TDIPropRange;
begin
  diprg.diph.dwSize       := SizeOf(diprg);
  diprg.diph.dwHeaderSize := SizeOf(diprg.diph);
  diprg.diph.dwObj        := dwObject;
  diprg.diph.dwHow        := dwHow;
  diprg.lMin              := -Value;
  diprg.lMax              := +Value;

  Result := pdev.SetProperty(guidProperty, diprg.diph);
end;

constructor TJoystick.Create(DXInput: TCustomDXInput);
begin
  inherited Create(DXInput);
  FAutoCenter := True;

  FID := 0;

  DeadZoneX := 50;
  DeadZoneY := 50;
  DeadZoneZ := 50;

  RangeX := 1000;
  RangeY := 1000;
  RangeZ := 1000;
end;

function TJoystick.GetX: Integer;
begin
  Result := Fdijs.lX;
end;

function TJoystick.GetY: Integer;
begin
  Result := Fdijs.lY;
end;

function TJoystick.GetZ: Integer;
begin
  Result := Fdijs.lZ;
end;

procedure TJoystick.Finalize;
begin
  FID2 := -1;
  FillChar(Fdijs, SizeOf(Fdijs), 0);
  FillChar(FJoyCaps, SizeOf(FJoyCaps), 0);
  inherited Finalize;
end;

function TJoystick.GetCooperativeLevel: Integer;
begin
  if not FAutoCenter then
    Result := DISCL_EXCLUSIVE or DISCL_FOREGROUND
  else
    Result := inherited GetCooperativeLevel;
end;
                                                        
function TJoystick_EnumJoysticksCallback(const lpddi: TDIDeviceInstanceA;
  pvRef: Pointer): HRESULT; stdcall;
begin
  Result := Integer(DIENUM_CONTINUE);

  with TJoystick(pvRef) do
  begin
    if FEnumIndex=FID then
    begin
      FDeviceGUID := lpddi.guidInstance;
      FEnumFlag := True;
      Result := Integer(DIENUM_STOP);
      Exit;