dxinput.pas

传奇源代码的delphi版本

    end;
    Inc(FEnumIndex);
  end;
end;

procedure TJoystick.Initialize;
var
  i, j: Integer;
  devcaps: TDIDevCaps;
begin        
  Finalize;

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

  try
    try
      if FDXInput.FDInput<>nil then
      begin
        {  Device search.  }
        FEnumFlag := False;
        FEnumIndex := 0;

        FDXInput.FDInput.EnumDevices({DIDEVTYPE_JOYSTICK}4, @TJoystick_EnumJoysticksCallback,
          Self, DIEDFL_ATTACHEDONLY);

        if not FEnumFlag then Exit;

        {  Device making.  }
        if FDXInput.FDInput.CreateDevice(FDeviceGUID, FDevice, nil)<>DI_OK then Exit;

        devcaps.dwSize := SizeOf(devcaps);
        if FDevice.GetCapabilities(devcaps)=DI_OK then
        begin
          FButtonCount := devcaps.dwButtons;
          if devcaps.dwFlags and DIDC_FORCEFEEDBACK<>0 then
            FForceFeedbackDevice := True;
        end;

        //if FDXInput.FDInput.CreateDevice(GUID_Joystick, FDevice, nil)<>DI_OK then Exit;   get out by Paul van Dinther

        {  Device data format (TDIDataFormat) making.  }

        with FDataFormat do
        begin
          dwFlags := DIDF_ABSAXIS;
          dwDataSize := SizeOf(Fdijs);
        end;            

        if not SetDataFormat then
        begin
          FDevice := nil;
          Exit;
        end;
         
        AutoCenter := FAutoCenter;

        for i:=Low(FDeadZone) to High(FDeadZone) do
          SetDeadZone(i, FDeadZone[i]);

        for i:=Low(FRange) to High(FRange) do
          SetRange(i, FRange[i]);

        FDevice2 := FDevice as IDirectInputDevice2;
      end;
    except
      Finalize;
      raise;
    end;
  finally
    if FDevice=nil then
    begin
      {  Because DirectInput cannot be used,  the GetJoyPosEx function is used.  }
      FID2 := -1;

      j := 0;
      for i:=0 to 255 do
      begin
        FillChar(FJoyCaps, SizeOf(FJoyCaps), 0);
        if joyGetDevCaps(i, @FJoyCaps, SizeOf(FJoyCaps))=JOYERR_NOERROR then
        begin
          if FID=j then
          begin
            FID2 := i;
            Break;
          end;
          Inc(j);
        end;
      end;

      if FID2<>-1 then
      begin
        if joyGetDevCaps(FID2, @FJoyCaps, SizeOf(FJoyCaps))=JOYERR_NOERROR then
        begin
          FButtonCount := FJoyCaps.wNumButtons;
        end else
        begin
          FID2 := -1;
        end;
      end;
    end;
  end;

  inherited Initialize;
end;

procedure TJoystick.SetAutoCenter(Value: Boolean);
begin
  FAutoCenter := Value;

  if FDevice<>nil then
    SetDWORDProperty(FDevice, DIPROP_AUTOCENTER, 0, DIPH_DEVICE, Ord(Value));
end;

procedure TJoystick.SetID(Value: Integer);
begin
  if Value<>FID then
  begin
    FID := Value;
    Initialize;
  end;
end;

function TJoystick.GetDeadZone(Obj: Integer): Integer;
begin
  Result := 0;
  if (Obj>=Low(FDeadZone)) and (Obj<High(FDeadZone)) then
    Result := FDeadZone[Obj];
end;

function TJoystick.GetRange(Obj: Integer): Integer;
begin
  Result := 0;
  if (Obj>=Low(FRange)) and (Obj<High(FRange)) then
    Result := FRange[Obj];
end;

procedure TJoystick.SetDeadZone(Obj: Integer; Value: Integer);
begin
  if (Obj<Low(FDeadZone)) or (Obj>=High(FDeadZone)) then Exit;

  if Value<0 then Value := 0;
  if Value>100 then Value := 100;

  if Obj=Integer(@PDIJoyState2(nil).rgdwPOV[0]) then
  begin
    FDeadZone[Obj] := -1;
    Exit;
  end;

  FDeadZone[Obj] := Value;

  if FDevice<>nil then
  begin
    if SetDWORDProperty(FDevice, DIPROP_DEADZONE, Obj, DIPH_BYOFFSET, Value*100)<>DI_OK then
      FDeadZone[Obj] := -1;
  end;
end;

procedure TJoystick.SetRange(Obj: Integer; Value: Integer);
begin
  if (Obj<Low(FRange)) or (Obj>=High(FRange)) then Exit;

  if Value<0 then Value := 0;

  if Obj=Integer(@PDIJoyState2(nil).rgdwPOV[0]) then
  begin
    FRange[Obj] := -1;
    Exit;
  end;

  FRange[Obj] := Value;

  if FDevice<>nil then
  begin
    if SetRangeProperty(FDevice, DIPROP_RANGE, Obj, DIPH_BYOFFSET, Value)<>DI_OK then
      FRange[Obj] := -1;
  end;
end;

procedure TJoystick.Update;

  function ConvertValue(Value, wXmax, wXmin, DeadZone, Range: Integer): Integer;
  var
    c, w: Integer;
  begin
    Result := 0;

    c := (wXmax - wXmin) div 2;
    Value := Value-c;

    w := c*DeadZone div 100;
    c := c - w;

    if c=0 then Exit;

    if Abs(Value)>w then
    begin
      if Value>0 then
        Result := MulDiv(Value-w, Range, c)
      else
        Result := MulDiv(Value+w, Range, c);
    end;
  end;

var
  i: Integer;
  JoyInfo: TJoyInfoEx;
begin
  FillChar(Fdijs, SizeOf(Fdijs), 0);
  FStates := [];

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

  if FDevice<>nil then
  begin
    FDevice2.Poll;
    GetDeviceState(SizeOf(Fdijs), Fdijs);
  end else
  begin
    if FID2<>-1 then
    begin
      JoyInfo.dwSize := SizeOf(JoyInfo);
      JoyInfo.dwFlags := JOY_RETURNX or JOY_RETURNY or JOY_RETURNZ or JOY_RETURNPOV or
        JOY_RETURNBUTTONS or JOY_RETURNCENTERED;

      joyGetPosEx(FID2, @JoyInfo);

      with FJoyCaps do
        Fdijs.lX := ConvertValue(JoyInfo.wXpos, wXmax, wXmin, FDeadZone[DIJOFS_X], FRange[DIJOFS_X]);

      with FJoyCaps do
        Fdijs.lY := ConvertValue(JoyInfo.wYpos, wYmax, wYmin, FDeadZone[DIJOFS_Y], FRange[DIJOFS_Y]);

      with FJoyCaps do
        Fdijs.lZ := ConvertValue(JoyInfo.wZpos, wZmax, wZmin, FDeadZone[DIJOFS_Z], FRange[DIJOFS_Z]);

      Fdijs.rgdwPOV[0] := JoyInfo.dwPOV;

      for i:=0 to FJoyCaps.wNumButtons-1 do
        if JoyInfo.wButtons and (1 shl i)<>0 then
          Fdijs.rgbButtons[i] := $80;
    end;
  end;

  for i:=0 to 31 do
    if Fdijs.rgbButtons[i] and $80<>0 then
      FStates := FStates + [TDXInputState(Ord(isButton1)+i)];

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

{  TCustomDXInput  }

var
  FDirectInput: IDirectInput;
  FDirectInputCount: Integer;

procedure InitDirectInput(out DI: IDirectInput);
type
  TDirectInputCreate = function(hinst: THandle; dwVersion: DWORD;
    out ppDI: IDirectInputA; punkOuter: IUnknown): HRESULT; stdcall;
begin
  if FDirectInput=nil then
  begin
    try
      TDirectInputCreate(DXLoadLibrary('DInput.dll', 'DirectInputCreateA'))
        (HInstance, DIRECTINPUT_VERSION, FDirectInput, nil);
    except
      FDirectInput := nil;
    end;
  end;

  DI := FDirectInput;
  if FDirectInput<>nil then
    Inc(FDirectInputCount);
end;

procedure FinDirectInput(var DI: IDirectInput);
begin
  if DI<>nil then
  begin
    DI := nil;
    Dec(FDirectInputCount);
    if FDirectInputCount<=0 then
    begin
      FDirectInputCount := 0;
      FDirectInput := nil;
    end;
  end;
end;

constructor TCustomDXInput.Create(AOwner: TComponent);
var
  Component: TComponent;
begin
  inherited Create(AOwner);

  FDevice := TList.Create;

  FActiveOnly := True;
  FJoystick := TJoystick.Create(Self);
  FKeyboard := TKeyboard.Create(Self);
  FMouse := TMouse.Create(Self);
  FUseDirectInput := True;

  Component := Owner;
  while (Component<>nil) and (not (Component is TCustomForm)) do
    Component := Component.Owner;
  if Component=nil then
    raise EDXInputError.CreateFmt(SNoForm, ['Owner']);
  FForm := TCustomForm(Component);

  FSubClass := TControlSubClass.Create(FForm, FormWndProc);
end;

destructor TCustomDXInput.Destroy;
begin
  Finalize;
  FJoystick.Free;
  FKeyboard.Free;
  FMouse.Free;
  FSubClass.Free;
  while FDevice.Count>0 do
    TCustomInput(FDevice[FDevice.Count-1]).Free;
  FDevice.Free;
  inherited Destroy;
end;

procedure TCustomDXInput.FormWndProc(var Message: TMessage; DefWindowProc: TWndMethod);

  procedure AcquireDevice;
  var
    i: Integer;
  begin
    for i:=0 to FDevice.Count-1 do
      TCustomInput(FDevice[i]).Acquire;
  end;

begin
  case Message.Msg of
    WM_CREATE:
        begin
          {  Window handle of Form changed.  }
          DefWindowProc(Message);
          SetWindowHandle;
          Exit;
        end;
    WM_ACTIVATEAPP:
        begin
          DefWindowProc(Message);
          if TWMActivateApp(Message).Active then
            AcquireDevice;
          Exit;
        end;
    WM_ACTIVATE:
        begin
          DefWindowProc(Message);
          if TWMActivate(Message).Active<>WA_INACTIVE then
            AcquireDevice;
          Exit;
        end;
  end;
  DefWindowProc(Message);
end;

procedure TCustomDXInput.Finalize;
var
  i: Integer;
begin
  for i:=0 to FDevice.Count-1 do
    TCustomInput(FDevice[i]).Finalize;
  FinDirectInput(FDInput);
end;

procedure TCustomDXInput.Loaded;
begin
  Initialize;
end;

procedure TCustomDXInput.Initialize;
var
  i: Integer;
begin
  Finalize;
  if not (csDesigning in ComponentState) then
  begin
    if FUseDirectInput then InitDirectInput(FDInput);

    for i:=0 to FDevice.Count-1 do
      TCustomInput(FDevice[i]).Initialize;

    SetWindowHandle;

    Update;
  end;
end;

procedure TCustomDXInput.SetActiveOnly(Value: Boolean);
begin
  if Value<>FActiveOnly then
  begin
    FActiveOnly := Value;
    if [csLoading, csReading]*ComponentState=[] then SetWindowHandle;
  end;
end;

procedure TCustomDXInput.SetJoystick(Value: TJoystick);
begin
  FJoystick.Assign(Value);
end;

procedure TCustomDXInput.SetKeyboard(Value: TKeyboard);
begin
  FKeyboard.Assign(Value);
end;

procedure TCustomDXInput.SetMouse(Value: TMouse);
begin
  FMouse.Assign(Value);
end;

procedure TCustomDXInput.SetUseDirectInput(Value: Boolean);
begin
  if FUseDirectInput<>Value then
  begin
    FUseDirectInput := Value;
    Initialize;
  end;
end;

procedure TCustomDXInput.SetWindowHandle;
var
  i: Integer;
begin
  for i:=0 to FDevice.Count-1 do
    TCustomInput(FDevice[i]).SetWindowHandle(FForm.Handle);
end;

procedure TCustomDXInput.Update;
var
  j: Integer;
  i: TDXInputState;
  s: TDXInputStates;
begin
  s := [];

  for j:=0 to FDevice.Count-1 do
  begin
    TCustomInput(FDevice[j]).Update;
    if TCustomInput(FDevice[j]).FBindInputStates then
      s := s + TCustomInput(FDevice[j]).States;
  end;

  for i:=Low(TDXInputState) to High(TDXInputState) do
  begin
    if (i in s) and (not (i in FOldStates)) then
      FStates := FStates + [i];
    if (not (i in s)) and (i in FOldStates) then
      FStates := FStates - [i];
  end;

  FOldStates := s;
end;

end.