jvqjoystick.pas

East make Tray Icon in delphi

  joyGetThreshold(JOYSTICKID1, @Result);
end;

function TJvJoystick.GetThreshold2: MMRESULT;
begin
  joyGetThreshold(JOYSTICKID2, @Result);
end;

procedure TJvJoystick.RaiseErrorCapture(Value: MMRESULT);
begin
  case Value of
    MMSYSERR_NODRIVER:
      if Assigned(FOnError) then
        FOnError(Self, MMSYSERR_NODRIVER, RsNoJoystickDriver);
    JOYERR_NOCANDO:
      if Assigned(FOnError) then
        FOnError(Self, JOYERR_NOCANDO, RsCannotCaptureJoystick);
    JOYERR_UNPLUGGED:
      if Assigned(FOnError) then
        FOnError(Self, JOYERR_NOCANDO, RsJoystickUnplugged);
  end;
end;

procedure TJvJoystick.RaiseErrorRelease(Value: MMRESULT);
begin
  case Value of
    MMSYSERR_NODRIVER:
      if Assigned(FOnError) then
        FOnError(Self, MMSYSERR_NODRIVER, RsNoJoystickDriver);
    JOYERR_PARMS:
      if Assigned(FOnError) then
        FOnError(Self, JOYERR_PARMS, RsJoystickErrorParam);
  end;
end;

procedure TJvJoystick.SetCapture1(const Value: Boolean);
begin
  FCapture1 := Value;
  if Value then
    RaiseErrorCapture(JoySetCapture(FHandle, JOYSTICKID1, FPoll, True))
  else
    RaiseErrorRelease(joyReleaseCapture(JOYSTICKID1));
end;

procedure TJvJoystick.SetCapture2(const Value: Boolean);
begin
  FCapture2 := Value;
  if Value then
    RaiseErrorCapture(JoySetCapture(FHandle, JOYSTICKID2, FPoll, True))
  else
    RaiseErrorRelease(joyReleaseCapture(JOYSTICKID2));
end;

procedure TJvJoystick.SetThreshold1(const Value: MMRESULT);
begin
  joySetThreshold(JOYSTICKID1, Value);
end;

procedure TJvJoystick.SetThreshold2(const Value: MMRESULT);
begin
  joySetThreshold(JOYSTICKID2, Value);
end;

procedure TJvJoystick.WndProc(var Msg: TMessage);
var
  X, Y: Byte;
  I: Integer;
  B1, B2, B3, B4: Boolean;

  procedure TestButtonDown(Value: TJoyButtonDown);
  begin
    if Assigned(Value) then
    begin
      X := Msg.LParamLo;
      Y := Msg.LParamHi;
      if (Msg.WParam and JOY_BUTTON1CHG) = JOY_BUTTON1CHG then
        I := 1
      else
      if (Msg.WParam and JOY_BUTTON2CHG) = JOY_BUTTON2CHG then
        I := 2
      else
      if (Msg.WParam and JOY_BUTTON3CHG) = JOY_BUTTON3CHG then
        I := 3
      else
      if (Msg.WParam and JOY_BUTTON4CHG) = JOY_BUTTON4CHG then
        I := 4
      else
        I := 0;
      B1 := (Msg.WParam and JOY_BUTTON1) = JOY_BUTTON1;
      B2 := (Msg.WParam and JOY_BUTTON2) = JOY_BUTTON2;
      B3 := (Msg.WParam and JOY_BUTTON3) = JOY_BUTTON3;
      B4 := (Msg.WParam and JOY_BUTTON4) = JOY_BUTTON4;
      Value(Self, X, Y, I, B1, B2, B3, B4);
    end;
  end;

  procedure TestButtonMove(Value: TJoyMove);
  begin
    if Assigned(Value) then
    begin
      X := Msg.LParamLo;
      Y := Msg.LParamHi;
      B1 := (Msg.WParam and JOY_BUTTON1) = JOY_BUTTON1;
      B2 := (Msg.WParam and JOY_BUTTON2) = JOY_BUTTON2;
      B3 := (Msg.WParam and JOY_BUTTON3) = JOY_BUTTON3;
      B4 := (Msg.WParam and JOY_BUTTON4) = JOY_BUTTON4;
      Value(Self, X, Y, B1, B2, B3, B4);
    end;
  end;

  procedure TestButtonZMove(Value: TJoyZMove);
  begin
    if Assigned(Value) then
    begin
      X := Msg.LParamLo;
      B1 := (Msg.WParam and JOY_BUTTON1) = JOY_BUTTON1;
      B2 := (Msg.WParam and JOY_BUTTON2) = JOY_BUTTON2;
      B3 := (Msg.WParam and JOY_BUTTON3) = JOY_BUTTON3;
      B4 := (Msg.WParam and JOY_BUTTON4) = JOY_BUTTON4;
      Value(Self, X, B1, B2, B3, B4);
    end;
  end;

begin
  case Msg.Msg of
    MM_JOY1BUTTONDOWN:
      TestButtonDown(FJoy1ButtonDown);
    MM_JOY1BUTTONUP:
      TestButtonDown(FJoy1ButtonUp);
    MM_JOY1MOVE:
      TestButtonMove(FJoy1Move);
    MM_JOY1ZMOVE:
      TestButtonZMove(FJoy1ZMove);
    MM_JOY2BUTTONDOWN:
      TestButtonDown(FJoy2ButtonDown);
    MM_JOY2BUTTONUP:
      TestButtonDown(FJoy1ButtonUp);
    MM_JOY2MOVE:
      TestButtonMove(FJoy1Move);
    MM_JOY2ZMOVE:
      TestButtonZMove(FJoy1ZMove);
  else
    Msg.Result := DefWindowProc(FHandle, Msg.Msg, Msg.WParam, Msg.LParam);
  end;
end;

//=== { TJoystick } ==========================================================

constructor TJoystick.CreateJoy(AOwner: TComponent; Joy: Integer);
begin
  FJoyNumber := Joy;
  if joyGetDevCaps(Joy, @FJoy, SizeOf(FJoy)) = MMSYSERR_NODRIVER then
    raise EJVCLException.CreateRes(@RsEJoystickError);
  FCapabilities := [];
  if (JOYCAPS_HASZ and FJoy.wCaps) = JOYCAPS_HASZ then
    FCapabilities := FCapabilities + [joHasZCoordinate];
  if (JOYCAPS_HASR and FJoy.wCaps) = JOYCAPS_HASR then
    FCapabilities := FCapabilities + [joHasRudder];
  if (JOYCAPS_HASU and FJoy.wCaps) = JOYCAPS_HASU then
    FCapabilities := FCapabilities + [joHasUCoordinate];
  if (JOYCAPS_HASV and FJoy.wCaps) = JOYCAPS_HASV then
    FCapabilities := FCapabilities + [joHasVCoordinate];
  if (JOYCAPS_HASPOV and FJoy.wCaps) = JOYCAPS_HASPOV then
    FCapabilities := FCapabilities + [joHasPointOfVue];
  if (JOYCAPS_POV4DIR and FJoy.wCaps) = JOYCAPS_POV4DIR then
    FCapabilities := FCapabilities + [joHasPointOfVDiscrete];
  if (JOYCAPS_POVCTS and FJoy.wCaps) = JOYCAPS_POVCTS then
    FCapabilities := FCapabilities + [joHasPointOfVContinuous];
  FRegKey := FJoy.szRegKey;
  FOEMVxD := FJoy.szOEMVxD;
  FProductName := FJoy.szPName;
end;

function TJoystick.GetButton1: Boolean;
begin
  RefreshJoy;
  Result := (FJoyInfo.wButtons and JOY_BUTTON1) = JOY_BUTTON1;
end;

function TJoystick.GetButton2: Boolean;
begin
  RefreshJoy;
  Result := (FJoyInfo.wButtons and JOY_BUTTON2) = JOY_BUTTON2;
end;

function TJoystick.GetButton3: Boolean;
begin
  RefreshJoy;
  Result := (FJoyInfo.wButtons and JOY_BUTTON3) = JOY_BUTTON3;
end;

function TJoystick.GetButton4: Boolean;
begin
  RefreshJoy;
  Result := (FJoyInfo.wButtons and JOY_BUTTON4) = JOY_BUTTON4;
end;

function TJoystick.GetXPosition: Integer;
begin
  RefreshJoy;
  Result := FJoyInfo.wXpos;
end;

function TJoystick.GetYPosition: Integer;
begin
  RefreshJoy;
  Result := FJoyInfo.wYpos;
end;

function TJoystick.GetZPosition: Integer;
begin
  RefreshJoy;
  Result := FJoyInfo.wZpos;
end;

procedure TJoystick.RefreshJoy;
begin
  joyGetPos(FJoyNumber, @FJoyInfo);
end;

end.