QtX11Extras: modified to use the macro RINT

Modified:
source/QtX11Extras/QX11Info.prg

/*

  Qt5xHb - bibliotecas de ligao entre Harbour/xHarbour e Qt Framework 5

  Copyright (C) 2012-2017 Marcos Antonio Gambeta <marcosgambeta@uol.com.br>

*/

#include "hbclass.ch"

#ifndef QT5XHB_NO_REQUESTS
REQUEST QBYTEARRAY
#endif

CLASS QX11Info

   DATA pointer
   DATA self_destruction INIT .F.

   METHOD delete
   METHOD isPlatformX11
   METHOD appDpiX
   METHOD appDpiY
   METHOD appRootWindow
   METHOD appScreen
   METHOD appTime
   METHOD appUserTime
   METHOD setAppTime
   METHOD setAppUserTime
   METHOD getTimestamp
   METHOD display
   METHOD connection
   METHOD nextStartupId
   METHOD setNextStartupId

   METHOD newFrom
   METHOD newFromObject
   METHOD newFromPointer
   METHOD selfDestruction
   METHOD setSelfDestruction

   DESTRUCTOR destroyObject

END CLASS

PROCEDURE destroyObject () CLASS QX11Info
   IF ::self_destruction
      ::delete()
   ENDIF
RETURN

#pragma BEGINDUMP

#include <Qt>

#ifndef __XHARBOUR__
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
#include <QX11Info>
#endif
#endif

#include "qt5xhb_common.h"
#include "qt5xhb_macros.h"
#include "qt5xhb_utils.h"

#ifdef __XHARBOUR__
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
#include <QX11Info>
#endif
#endif

HB_FUNC_STATIC( QX11INFO_DELETE )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  QX11Info * obj = (QX11Info *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );
  if( obj )
  {
    delete obj;
    obj = NULL;
    PHB_ITEM self = hb_stackSelfItem();
    PHB_ITEM ptr = hb_itemPutPtr( NULL, NULL );
    hb_objSendMsg( self, "_pointer", 1, ptr );
    hb_itemRelease( ptr );
  }
  hb_itemReturn( hb_stackSelfItem() );
#endif
}

/*
static bool isPlatformX11()
*/
HB_FUNC_STATIC( QX11INFO_ISPLATFORMX11 )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  RBOOL( QX11Info::isPlatformX11 () );
#endif
}

/*
static int appDpiX(int screen=-1)
*/
HB_FUNC_STATIC( QX11INFO_APPDPIX )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  RINT( QX11Info::appDpiX ( OPINT(1,-1) ) );
#endif
}

/*
static int appDpiY(int screen=-1)
*/
HB_FUNC_STATIC( QX11INFO_APPDPIY )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  RINT( QX11Info::appDpiY ( OPINT(1,-1) ) );
#endif
}

/*
static unsigned long appRootWindow(int screen=-1)
*/
HB_FUNC_STATIC( QX11INFO_APPROOTWINDOW )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retnl( QX11Info::appRootWindow ( OPINT(1,-1) ) );
#endif
}

/*
static int appScreen()
*/
HB_FUNC_STATIC( QX11INFO_APPSCREEN )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  RINT( QX11Info::appScreen () );
#endif
}

/*
static unsigned long appTime()
*/
HB_FUNC_STATIC( QX11INFO_APPTIME )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retnl( QX11Info::appTime () );
#endif
}

/*
static unsigned long appUserTime()
*/
HB_FUNC_STATIC( QX11INFO_APPUSERTIME )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retnl( QX11Info::appUserTime () );
#endif
}

/*
static void setAppTime(unsigned long time)
*/
HB_FUNC_STATIC( QX11INFO_SETAPPTIME )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  unsigned long par1 = hb_parnl(1);
  QX11Info::setAppTime ( par1 );
  hb_itemReturn( hb_stackSelfItem() );
#endif
}

/*
static void setAppUserTime(unsigned long time)
*/
HB_FUNC_STATIC( QX11INFO_SETAPPUSERTIME )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  unsigned long par1 = hb_parnl(1);
  QX11Info::setAppUserTime ( par1 );
  hb_itemReturn( hb_stackSelfItem() );
#endif
}

/*
static unsigned long getTimestamp()
*/
HB_FUNC_STATIC( QX11INFO_GETTIMESTAMP )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retnl( QX11Info::getTimestamp () );
#endif
}

/*
static Display *display()
*/
HB_FUNC_STATIC( QX11INFO_DISPLAY )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retptr( (Display *) QX11Info::display () );
#endif
}

/*
static xcb_connection_t *connection()
*/
HB_FUNC_STATIC( QX11INFO_CONNECTION )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retptr( (xcb_connection_t *) QX11Info::connection () );
#endif
}

/*
static QByteArray nextStartupId()
*/
HB_FUNC_STATIC( QX11INFO_NEXTSTARTUPID )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  QByteArray * ptr = new QByteArray( QX11Info::nextStartupId () );
  _qt5xhb_createReturnClass ( ptr, "QBYTEARRAY" );
#endif
}

/*
static void setNextStartupId(const QByteArray &id)
*/
HB_FUNC_STATIC( QX11INFO_SETNEXTSTARTUPID )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  QX11Info::setNextStartupId ( *PQBYTEARRAY(1) );
  hb_itemReturn( hb_stackSelfItem() );
#endif
}

HB_FUNC_STATIC( QX11INFO_NEWFROM )
{
  PHB_ITEM self = hb_stackSelfItem();
  if( hb_pcount() == 1 && ISOBJECT(1) )
  {
    PHB_ITEM ptr = hb_itemPutPtr( NULL, (void *) hb_itemGetPtr( hb_objSendMsg( hb_param(1, HB_IT_OBJECT ), "POINTER", 0 ) ) );
    hb_objSendMsg( self, "_pointer", 1, ptr );
    hb_itemRelease( ptr );
    PHB_ITEM des = hb_itemPutL( NULL, false );
    hb_objSendMsg( self, "_self_destruction", 1, des );
    hb_itemRelease( des );
  }
  else if( hb_pcount() == 1 && ISPOINTER(1) )
  {
    PHB_ITEM ptr = hb_itemPutPtr( NULL, (void *) hb_itemGetPtr( hb_param(1, HB_IT_POINTER ) ) );
    hb_objSendMsg( self, "_pointer", 1, ptr );
    hb_itemRelease( ptr );
    PHB_ITEM des = hb_itemPutL( NULL, false );
    hb_objSendMsg( self, "_self_destruction", 1, des );
    hb_itemRelease( des );
  }
  hb_itemReturn( self );
}

HB_FUNC_STATIC( QX11INFO_NEWFROMOBJECT )
{
  HB_FUNC_EXEC( QX11INFO_NEWFROM );
}

HB_FUNC_STATIC( QX11INFO_NEWFROMPOINTER )
{
  HB_FUNC_EXEC( QX11INFO_NEWFROM );
}

HB_FUNC_STATIC( QX11INFO_SELFDESTRUCTION )
{
  hb_retl( (bool) hb_itemGetL( hb_objSendMsg( hb_stackSelfItem(), "SELF_DESTRUCTION", 0 ) ) );
}

HB_FUNC_STATIC( QX11INFO_SETSELFDESTRUCTION )
{
  PHB_ITEM self = hb_stackSelfItem();
  if( hb_pcount() == 1 && ISLOG(1) )
  {
    PHB_ITEM des = hb_itemPutL( NULL, hb_parl(1) );
    hb_objSendMsg( self, "_self_destruction", 1, des );
    hb_itemRelease( des );
  }
  hb_itemReturn( self );
}

#pragma ENDDUMP

/*

  Qt5xHb - bibliotecas de ligao entre Harbour/xHarbour e Qt Framework 5

  Copyright (C) 2012-2017 Marcos Antonio Gambeta <marcosgambeta@uol.com.br>

*/

#include "hbclass.ch"

#ifndef QT5XHB_NO_REQUESTS
REQUEST QBYTEARRAY
#endif

CLASS QX11Info

   DATA pointer
   DATA self_destruction INIT .F.

   METHOD delete
   METHOD isPlatformX11
   METHOD appDpiX
   METHOD appDpiY
   METHOD appRootWindow
   METHOD appScreen
   METHOD appTime
   METHOD appUserTime
   METHOD setAppTime
   METHOD setAppUserTime
   METHOD getTimestamp
   METHOD display
   METHOD connection
   METHOD nextStartupId
   METHOD setNextStartupId

   METHOD newFrom
   METHOD newFromObject
   METHOD newFromPointer
   METHOD selfDestruction
   METHOD setSelfDestruction

   DESTRUCTOR destroyObject

END CLASS

PROCEDURE destroyObject () CLASS QX11Info
   IF ::self_destruction
      ::delete()
   ENDIF
RETURN

#pragma BEGINDUMP

#include <Qt>

#ifndef __XHARBOUR__
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
#include <QX11Info>
#endif
#endif

#include "qt5xhb_common.h"
#include "qt5xhb_macros.h"
#include "qt5xhb_utils.h"

#ifdef __XHARBOUR__
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
#include <QX11Info>
#endif
#endif

HB_FUNC_STATIC( QX11INFO_DELETE )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  QX11Info * obj = (QX11Info *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );
  if( obj )
  {
    delete obj;
    obj = NULL;
    PHB_ITEM self = hb_stackSelfItem();
    PHB_ITEM ptr = hb_itemPutPtr( NULL, NULL );
    hb_objSendMsg( self, "_pointer", 1, ptr );
    hb_itemRelease( ptr );
  }
  hb_itemReturn( hb_stackSelfItem() );
#endif
}

/*
static bool isPlatformX11()
*/
HB_FUNC_STATIC( QX11INFO_ISPLATFORMX11 )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  RBOOL( QX11Info::isPlatformX11 () );
#endif
}

/*
static int appDpiX(int screen=-1)
*/
HB_FUNC_STATIC( QX11INFO_APPDPIX )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retni( QX11Info::appDpiX ( OPINT(1,-1) ) );
#endif
}

/*
static int appDpiY(int screen=-1)
*/
HB_FUNC_STATIC( QX11INFO_APPDPIY )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retni( QX11Info::appDpiY ( OPINT(1,-1) ) );
#endif
}

/*
static unsigned long appRootWindow(int screen=-1)
*/
HB_FUNC_STATIC( QX11INFO_APPROOTWINDOW )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retnl( QX11Info::appRootWindow ( OPINT(1,-1) ) );
#endif
}

/*
static int appScreen()
*/
HB_FUNC_STATIC( QX11INFO_APPSCREEN )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retni( QX11Info::appScreen () );
#endif
}

/*
static unsigned long appTime()
*/
HB_FUNC_STATIC( QX11INFO_APPTIME )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retnl( QX11Info::appTime () );
#endif
}

/*
static unsigned long appUserTime()
*/
HB_FUNC_STATIC( QX11INFO_APPUSERTIME )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retnl( QX11Info::appUserTime () );
#endif
}

/*
static void setAppTime(unsigned long time)
*/
HB_FUNC_STATIC( QX11INFO_SETAPPTIME )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  unsigned long par1 = hb_parnl(1);
  QX11Info::setAppTime ( par1 );
  hb_itemReturn( hb_stackSelfItem() );
#endif
}

/*
static void setAppUserTime(unsigned long time)
*/
HB_FUNC_STATIC( QX11INFO_SETAPPUSERTIME )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  unsigned long par1 = hb_parnl(1);
  QX11Info::setAppUserTime ( par1 );
  hb_itemReturn( hb_stackSelfItem() );
#endif
}

/*
static unsigned long getTimestamp()
*/
HB_FUNC_STATIC( QX11INFO_GETTIMESTAMP )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retnl( QX11Info::getTimestamp () );
#endif
}

/*
static Display *display()
*/
HB_FUNC_STATIC( QX11INFO_DISPLAY )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retptr( (Display *) QX11Info::display () );
#endif
}

/*
static xcb_connection_t *connection()
*/
HB_FUNC_STATIC( QX11INFO_CONNECTION )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retptr( (xcb_connection_t *) QX11Info::connection () );
#endif
}

/*
static QByteArray nextStartupId()
*/
HB_FUNC_STATIC( QX11INFO_NEXTSTARTUPID )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  QByteArray * ptr = new QByteArray( QX11Info::nextStartupId () );
  _qt5xhb_createReturnClass ( ptr, "QBYTEARRAY" );
#endif
}

/*
static void setNextStartupId(const QByteArray &id)
*/
HB_FUNC_STATIC( QX11INFO_SETNEXTSTARTUPID )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  QX11Info::setNextStartupId ( *PQBYTEARRAY(1) );
  hb_itemReturn( hb_stackSelfItem() );
#endif
}

HB_FUNC_STATIC( QX11INFO_NEWFROM )
{
  PHB_ITEM self = hb_stackSelfItem();
  if( hb_pcount() == 1 && ISOBJECT(1) )
  {
    PHB_ITEM ptr = hb_itemPutPtr( NULL, (void *) hb_itemGetPtr( hb_objSendMsg( hb_param(1, HB_IT_OBJECT ), "POINTER", 0 ) ) );
    hb_objSendMsg( self, "_pointer", 1, ptr );
    hb_itemRelease( ptr );
    PHB_ITEM des = hb_itemPutL( NULL, false );
    hb_objSendMsg( self, "_self_destruction", 1, des );
    hb_itemRelease( des );
  }
  else if( hb_pcount() == 1 && ISPOINTER(1) )
  {
    PHB_ITEM ptr = hb_itemPutPtr( NULL, (void *) hb_itemGetPtr( hb_param(1, HB_IT_POINTER ) ) );
    hb_objSendMsg( self, "_pointer", 1, ptr );
    hb_itemRelease( ptr );
    PHB_ITEM des = hb_itemPutL( NULL, false );
    hb_objSendMsg( self, "_self_destruction", 1, des );
    hb_itemRelease( des );
  }
  hb_itemReturn( self );
}

HB_FUNC_STATIC( QX11INFO_NEWFROMOBJECT )
{
  HB_FUNC_EXEC( QX11INFO_NEWFROM );
}

HB_FUNC_STATIC( QX11INFO_NEWFROMPOINTER )
{
  HB_FUNC_EXEC( QX11INFO_NEWFROM );
}

HB_FUNC_STATIC( QX11INFO_SELFDESTRUCTION )
{
  hb_retl( (bool) hb_itemGetL( hb_objSendMsg( hb_stackSelfItem(), "SELF_DESTRUCTION", 0 ) ) );
}

HB_FUNC_STATIC( QX11INFO_SETSELFDESTRUCTION )
{
  PHB_ITEM self = hb_stackSelfItem();
  if( hb_pcount() == 1 && ISLOG(1) )
  {
    PHB_ITEM des = hb_itemPutL( NULL, hb_parl(1) );
    hb_objSendMsg( self, "_self_destruction", 1, des );
    hb_itemRelease( des );
  }
  hb_itemReturn( self );
}

#pragma ENDDUMP


Added __VarGet() and __VarPut(). Changed types for __FieldGet(), __FieldSet() from USUAL to OBJECT to make things easier in the RDD system

//
// Copyright (c) XSharp B.V.  All Rights Reserved.
// Licensed under the Apache License, Version 2.0.
// See License.txt in the project root for license information.
//
// functions used by the compiler

// <summary>
// Compare 2 strings. This function is used by the compiler for string comparisons
// </summary>
// <param name="strLHS">The first string .</param>
// <param name="strRHS">The second string.</param>
// <returns>
// -1 strLHS precedes strRHS in the sort order.
//  0 strLHS occurs in the same position as strRHS in the sort order.
//  1 strLHS follows strRHS in the sort order.
// Note this this function respects SetCollation() and SetExact()
// </returns>
/// <exclude />
FUNCTION __StringCompare(strLHS AS STRING, strRHS AS STRING) AS INT
    LOCAL ret AS INT
    // Only when vo13 is off and SetExact = TRUE
    IF !RuntimeState.CompilerOptionVO13 .AND. RuntimeState.Exact
        RETURN String.Compare( strLHS,  strRHS)
    ENDIF
    IF Object.ReferenceEquals(strLHS, strRHS)
        ret := 0
    ELSEIF strLHS == NULL
        IF strRHS == NULL			// null and null are equal
            ret := 0
        ELSE
            ret := -1				// null precedes a string
        ENDIF
    ELSEIF strRHS == NULL			// a string comes after null
        ret := 1
    ELSE							// both not null
        // With Not Exact comparison we only compare the length of the RHS string
        // and we always use the unicode comparison because that is what vulcan does
        // This is done to make sure that >= and <= will also return TRUE when the LHS is longer than the RHS
        // The ordinal comparison can be done here because when both strings start with the same characters
        // then equality is guaranteed regardless of collations or other rules.
        // collations and other rules are really only relevant when both strings are different
        IF  !RuntimeState.Exact
            LOCAL lengthRHS AS INT
            lengthRHS := strRHS:Length
            IF lengthRHS == 0 .OR. lengthRHS <= strLHS:Length  .AND. String.Compare( strLHS, 0, strRHS, 0, lengthRHS , StringComparison.Ordinal ) == 0
                RETURN 0
            ENDIF
        ENDIF
        // either exact or RHS longer than LHS
        VAR mode := RuntimeState.CollationMode
        SWITCH mode
        CASE CollationMode.Windows
            ret := XSharp.StringHelpers.CompareWindows(strLHS, strRHS)
        CASE CollationMode.Clipper
            ret := XSharp.StringHelpers.CompareClipper(strLHS, strRHS)
        CASE CollationMode.Unicode
            ret := String.Compare(strLHS, strRHS)
        OTHERWISE
            ret := String.CompareOrdinal(strLHS, strRHS)
        END SWITCH
    ENDIF
    RETURN ret

    /// <summary>
    /// Compare 2 strings. This function is used by the compiler for string comparisons
    /// </summary>
    /// <param name="strLHS">The first string .</param>
    /// <param name="strRHS">The second string.</param>
    /// <returns>
    /// TRUE when the strings are equal, FALSE when they are not equal
    /// This function respects SetExact()
    /// </returns>
FUNCTION  __StringEquals(strLHS AS STRING, strRHS AS STRING) AS LOGIC
    LOCAL IsEqual:= FALSE AS LOGIC
    LOCAL lengthRHS AS INT
    IF Object.ReferenceEquals(strLHS, strRHS)
        IsEqual := TRUE
    ELSEIF RuntimeState.Exact
        IsEqual := String.Equals(strLHS , strRHS)
    ELSEIF strLHS != NULL .AND. strRHS != NULL
        lengthRHS := strRHS:Length
        IF lengthRHS == 0
            IsEqual := TRUE        // With SetExact(FALSE) then "aaa" = "" returns TRUE
        ELSEIF lengthRHS <= strLHS:Length

            IsEqual := String.Compare( strLHS, 0, strRHS, 0, lengthRHS, StringComparison.Ordinal ) == 0
        ENDIF
    ELSEIF strLHS == NULL .AND. strRHS == NULL
        IsEqual := TRUE
    ENDIF
    RETURN IsEqual

    /// <summary>
    /// Compare 2 strings. This function is used by the compiler for string comparisons
    /// </summary>
    /// <param name="strLHS">The first string .</param>
    /// <param name="strRHS">The second string.</param>
    /// <returns>
    /// TRUE when the strings are not equal, FALSE when they are equal
    /// This function respects SetExact()
    /// </returns>
FUNCTION  __StringNotEquals(strLHS AS STRING, strRHS AS STRING) AS LOGIC
    LOCAL notEquals := FALSE AS LOGIC
    LOCAL lengthRHS AS INT
    IF Object.ReferenceEquals(strLHS, strRHS)
        notEquals := FALSE
    ELSEIF RuntimeState.Exact
        notEquals := !String.Equals(strLHS , strRHS)
    ELSEIF strLHS != NULL .AND. strRHS != NULL
        // shortcut: chec first char
        lengthRHS := strRHS:Length
        IF lengthRHS == 0
            notEquals := FALSE        // With SetExact(FALSE) then "aaa" = "" returns TRUE
        ELSEIF lengthRHS <= strLHS:Length
            notEquals := String.Compare( strLHS, 0, strRHS, 0, lengthRHS, StringComparison.Ordinal ) != 0
        ELSE
            notEquals := TRUE
        ENDIF
    ELSEIF strLHS == NULL .AND. strRHS == NULL
        notEquals := FALSE
    ELSE
        notEquals := TRUE
    ENDIF
    RETURN notEquals

    /// <summary>
    /// Remove leading and trailing spaces from a string.
    /// </summary>
    /// <param name="c">The string to be trimmed.</param>
    /// <returns>
    /// The original string without leading and trailing spaces
    /// </returns>
    // _FIELD->Name

FUNCTION __FieldGet( fieldName AS STRING ) AS OBJECT
    LOCAL fieldpos := FieldPos( fieldName ) AS DWORD
    LOCAL ret := NULL AS OBJECT
    IF fieldpos == 0
        THROW Error.VODBError( EG_ARG, EDB_FIELDNAME, __FUNCTION__,  fieldName  )
    ELSE
         _DbThrowErrorOnFailure(__FUNCTION__, CoreDb.FieldGet( fieldpos, REF ret ))
    ENDIF
    RETURN ret

    // CUSTOMER->NAME
/// <exclude/>
FUNCTION __FieldGetWa( alias AS STRING, fieldName AS STRING ) AS OBJECT
    LOCAL ret AS OBJECT
    LOCAL newArea := SELECT( alias ) AS DWORD
    LOCAL curArea := RuntimeState.CurrentWorkarea AS DWORD
    IF newArea > 0
        RuntimeState.CurrentWorkarea := newArea
        TRY
            ret := __FieldGet( fieldName )
        FINALLY
            RuntimeState.CurrentWorkarea := curArea
        END TRY
    ELSE
        THROW Error.VODBError( EG_ARG, EDB_BADALIAS, __FUNCTION__, alias  )
    ENDIF
    RETURN ret

    // _FIELD->Name := "Foo"
/// <exclude/>
FUNCTION __FieldSet( fieldName AS STRING, oValue AS OBJECT ) AS OBJECT
    LOCAL fieldpos := FieldPos( fieldName ) AS DWORD
    IF fieldpos == 0
        THROW Error.VODBError( EG_ARG, EDB_FIELDNAME, __FUNCTION__,  fieldName  )
    ELSE
        _DbThrowErrorOnFailure(__FUNCTION__, CoreDb.FieldPut( fieldpos, oValue))
    ENDIF
    // We return the original value to allow chained expressions
    RETURN oValue

    // CUSTOMER->Name := "Foo"
/// <exclude/>
FUNCTION __FieldSetWa( alias AS STRING, fieldName AS STRING, uValue AS USUAL ) AS USUAL
    LOCAL newArea := SELECT( alias ) AS DWORD
    LOCAL curArea := RuntimeState.CurrentWorkarea AS DWORD
    IF newArea > 0
        RuntimeState.CurrentWorkarea := newArea

        TRY
            __FieldSet( fieldName, uValue )
        FINALLY
            RuntimeState.CurrentWorkarea := curArea
        END TRY
    ELSE
        THROW Error.VODBError( EG_ARG, EDB_BADALIAS, __FUNCTION__, alias  )
    ENDIF
    // Note: must return the same value passed in, to allow chained assignment expressions
    RETURN uValue

    // MEMVAR myName
    // ? MyName
/// <exclude/>
FUNCTION __MemVarGet(cName AS STRING) AS USUAL
    RETURN NIL

    // MEMVAR myName
    // MyName := "NewValue"
/// <exclude/>
FUNCTION __MemVarPut(cName AS STRING, uValue AS USUAL) AS USUAL
    RETURN uValue

/// <exclude/>
FUNCTION __VarGet(cName AS STRING) AS OBJECT
    IF FieldPos(cName) > 0
        RETURN __FieldGet(cName)
    ENDIF
    RETURN __MemVarGet(cName)

/// <exclude/>
FUNCTION __VarPut(cName AS STRING, uValue AS OBJECT) AS OBJECT
    IF FieldPos(cName) > 0
        RETURN __FieldSet(cName, uValue)
    ENDIF
    RETURN __MemVarPut(cName, uValue)

    // ALIAS->(DoSomething())
    // is translated to
    // __pushWorkarea( alias ) ; DoSomething() ; __popWorkArea()

/// <exclude/>
FUNCTION __pushWorkarea( alias AS USUAL ) AS VOID
    LOCAL newArea := SELECT( alias ) AS DWORD
    IF newArea > 0
        RuntimeState.PushCurrentWorkarea( newArea )
    ELSE
        THROW Error.VODBError( EG_ARG, EDB_BADALIAS, { alias } )
    ENDIF
    RETURN

    // This is used by the -> operator to restore the previous workarea
/// <exclude/>
FUNCTION __popWorkarea() AS VOID
    RuntimeState.PopCurrentWorkarea()
    RETURN

//
// Copyright (c) XSharp B.V.  All Rights Reserved.
// Licensed under the Apache License, Version 2.0.
// See License.txt in the project root for license information.
//
// functions used by the compiler

// <summary>
// Compare 2 strings. This function is used by the compiler for string comparisons
// </summary>
// <param name="strLHS">The first string .</param>
// <param name="strRHS">The second string.</param>
// <returns>
// -1 strLHS precedes strRHS in the sort order.
//  0 strLHS occurs in the same position as strRHS in the sort order.
//  1 strLHS follows strRHS in the sort order.
// Note this this function respects SetCollation() and SetExact()
// </returns>
/// <exclude />
FUNCTION __StringCompare(strLHS AS STRING, strRHS AS STRING) AS INT
    LOCAL ret AS INT
    // Only when vo13 is off and SetExact = TRUE
    IF !RuntimeState.CompilerOptionVO13 .AND. RuntimeState.Exact
        RETURN String.Compare( strLHS,  strRHS)
    ENDIF
    IF Object.ReferenceEquals(strLHS, strRHS)
        ret := 0
    ELSEIF strLHS == NULL
        IF strRHS == NULL			// null and null are equal
            ret := 0
        ELSE
            ret := -1				// null precedes a string
        ENDIF
    ELSEIF strRHS == NULL			// a string comes after null
        ret := 1
    ELSE							// both not null
        // With Not Exact comparison we only compare the length of the RHS string
        // and we always use the unicode comparison because that is what vulcan does
        // This is done to make sure that >= and <= will also return TRUE when the LHS is longer than the RHS
        // The ordinal comparison can be done here because when both strings start with the same characters
        // then equality is guaranteed regardless of collations or other rules.
        // collations and other rules are really only relevant when both strings are different
        IF  !RuntimeState.Exact
            LOCAL lengthRHS AS INT
            lengthRHS := strRHS:Length
            IF lengthRHS == 0 .OR. lengthRHS <= strLHS:Length  .AND. String.Compare( strLHS, 0, strRHS, 0, lengthRHS , StringComparison.Ordinal ) == 0
                RETURN 0
            ENDIF
        ENDIF
        // either exact or RHS longer than LHS
        VAR mode := RuntimeState.CollationMode
        SWITCH mode
        CASE CollationMode.Windows
            ret := XSharp.StringHelpers.CompareWindows(strLHS, strRHS)
        CASE CollationMode.Clipper
            ret := XSharp.StringHelpers.CompareClipper(strLHS, strRHS)
        CASE CollationMode.Unicode
            ret := String.Compare(strLHS, strRHS)
        OTHERWISE
            ret := String.CompareOrdinal(strLHS, strRHS)
        END SWITCH
    ENDIF
    RETURN ret

    /// <summary>
    /// Compare 2 strings. This function is used by the compiler for string comparisons
    /// </summary>
    /// <param name="strLHS">The first string .</param>
    /// <param name="strRHS">The second string.</param>
    /// <returns>
    /// TRUE when the strings are equal, FALSE when they are not equal
    /// This function respects SetExact()
    /// </returns>
FUNCTION  __StringEquals(strLHS AS STRING, strRHS AS STRING) AS LOGIC
    LOCAL IsEqual:= FALSE AS LOGIC
    LOCAL lengthRHS AS INT
    IF Object.ReferenceEquals(strLHS, strRHS)
        IsEqual := TRUE
    ELSEIF RuntimeState.Exact
        IsEqual := String.Equals(strLHS , strRHS)
    ELSEIF strLHS != NULL .AND. strRHS != NULL
        lengthRHS := strRHS:Length
        IF lengthRHS == 0
            IsEqual := TRUE        // With SetExact(FALSE) then "aaa" = "" returns TRUE
        ELSEIF lengthRHS <= strLHS:Length

            IsEqual := String.Compare( strLHS, 0, strRHS, 0, lengthRHS, StringComparison.Ordinal ) == 0
        ENDIF
    ELSEIF strLHS == NULL .AND. strRHS == NULL
        IsEqual := TRUE
    ENDIF
    RETURN IsEqual

    /// <summary>
    /// Compare 2 strings. This function is used by the compiler for string comparisons
    /// </summary>
    /// <param name="strLHS">The first string .</param>
    /// <param name="strRHS">The second string.</param>
    /// <returns>
    /// TRUE when the strings are not equal, FALSE when they are equal
    /// This function respects SetExact()
    /// </returns>
FUNCTION  __StringNotEquals(strLHS AS STRING, strRHS AS STRING) AS LOGIC
    LOCAL notEquals := FALSE AS LOGIC
    LOCAL lengthRHS AS INT
    IF Object.ReferenceEquals(strLHS, strRHS)
        notEquals := FALSE
    ELSEIF RuntimeState.Exact
        notEquals := !String.Equals(strLHS , strRHS)
    ELSEIF strLHS != NULL .AND. strRHS != NULL
        // shortcut: chec first char
        lengthRHS := strRHS:Length
        IF lengthRHS == 0
            notEquals := FALSE        // With SetExact(FALSE) then "aaa" = "" returns TRUE
        ELSEIF lengthRHS <= strLHS:Length
            notEquals := String.Compare( strLHS, 0, strRHS, 0, lengthRHS, StringComparison.Ordinal ) != 0
        ELSE
            notEquals := TRUE
        ENDIF
    ELSEIF strLHS == NULL .AND. strRHS == NULL
        notEquals := FALSE
    ELSE
        notEquals := TRUE
    ENDIF
    RETURN notEquals

    /// <summary>
    /// Remove leading and trailing spaces from a string.
    /// </summary>
    /// <param name="c">The string to be trimmed.</param>
    /// <returns>
    /// The original string without leading and trailing spaces
    /// </returns>
    // _FIELD->Name
FUNCTION __FieldGet( fieldName AS STRING ) AS USUAL
    LOCAL fieldpos := FieldPos( fieldName ) AS DWORD
    LOCAL ret := NIL AS USUAL
    IF fieldpos == 0
        THROW Error.VODBError( EG_ARG, EDB_FIELDNAME, __FUNCTION__,  fieldName  )
    ELSE
        VoDb.FieldGet( fieldpos, REF ret )
    ENDIF
    RETURN ret

    // CUSTOMER->NAME
/// <exclude/>
FUNCTION __FieldGetWa( alias AS STRING, fieldName AS STRING ) AS USUAL
    LOCAL ret AS USUAL
    LOCAL newArea := SELECT( alias ) AS DWORD
    LOCAL curArea := RuntimeState.CurrentWorkarea AS DWORD
    IF newArea > 0
        RuntimeState.CurrentWorkarea := newArea
        TRY
            ret := __FieldGet( fieldName )
        FINALLY
            RuntimeState.CurrentWorkarea := curArea
        END TRY
    ELSE
        THROW Error.VODBError( EG_ARG, EDB_BADALIAS, __FUNCTION__, alias  )
    ENDIF
    RETURN ret

    // _FIELD->Name := "Foo"
/// <exclude/>
FUNCTION __FieldSet( fieldName AS STRING, uValue AS USUAL ) AS USUAL
    LOCAL fieldpos := FieldPos( fieldName ) AS DWORD
    IF fieldpos == 0
        THROW Error.VODBError( EG_ARG, EDB_FIELDNAME, __FUNCTION__,  fieldName  )
    ELSE
        _DbThrowErrorOnFailure(__FUNCTION__, VoDb.FieldPut( fieldpos, uValue))
    ENDIF
    // We return the original value to allow chained expressions
    RETURN uValue

    // CUSTOMER->Name := "Foo"
/// <exclude/>
FUNCTION __FieldSetWa( alias AS STRING, fieldName AS STRING, uValue AS USUAL ) AS USUAL
    LOCAL newArea := SELECT( alias ) AS DWORD
    LOCAL curArea := RuntimeState.CurrentWorkarea AS DWORD
    IF newArea > 0
        RuntimeState.CurrentWorkarea := newArea

        TRY
            __FieldSet( fieldName, uValue )
        FINALLY
            RuntimeState.CurrentWorkarea := curArea
        END TRY
    ELSE
        THROW Error.VODBError( EG_ARG, EDB_BADALIAS, __FUNCTION__, alias  )
    ENDIF
    // Note: must return the same value passed in, to allow chained assignment expressions
    RETURN uValue

    // MEMVAR myName
    // ? MyName
/// <exclude/>
FUNCTION __MemVarGet(cName AS STRING) AS USUAL
    RETURN NIL

    // MEMVAR myName
    // MyName := "NewValue"
/// <exclude/>
FUNCTION __MemVarPut(cName AS STRING, uValue AS USUAL) AS USUAL
    RETURN uValue

    // ALIAS->(DoSomething())
    // is translated to
    // __pushWorkarea( alias ) ; DoSomething() ; __popWorkArea()

/// <exclude/>
FUNCTION __pushWorkarea( alias AS USUAL ) AS VOID
    LOCAL newArea := SELECT( alias ) AS DWORD
    IF newArea > 0
        RuntimeState.PushCurrentWorkarea( newArea )
    ELSE
        THROW Error.VODBError( EG_ARG, EDB_BADALIAS, { alias } )
    ENDIF
    RETURN

    // This is used by the -> operator to restore the previous workarea
/// <exclude/>
FUNCTION __popWorkarea() AS VOID
    RuntimeState.PopCurrentWorkarea()
    RETURN


[ADS RDD} When a memo column fails to load because it contains binary data then try to read the binary data

//
// Copyright (c) XSharp B.V.  All Rights Reserved.
// Licensed under the Apache License, Version 2.0.
// See License.txt in the project root for license information.
//

USING System.IO
USING System.Collections.Generic
USING System.Linq
USING XSharp.RDD
USING XSharp.RDD.Support
USING XSharp.RDD.Enums

BEGIN NAMESPACE XSharp.ADS
    /// Class for Ads Column reading / writing
    CLASS AdsColumn INHERIT RddFieldInfo
        INTERNAL RDD        AS XSharp.ADS.ADSRDD
        INTERNAL AdsType    as AdsFieldType
        INTERNAL FieldPos   as DWORD
        PROPERTY _Table as IntPtr GET RDD:_Table

        STATIC METHOD Create(oInfo AS RddFieldInfo, oRDD AS XSharp.ADS.ADSRDD,type as AdsFieldType, nPos as DWORD) AS AdsColumn
            // Commented out types are Harbour specific
            SWITCH type
            // char types
            CASE AdsFieldType.TIMESTAMP
            CASE AdsFieldType.MODTIME
            CASE AdsFieldType.TIME
            CASE AdsFieldType.MONEY
            CASE AdsFieldType.ROWVERSION
            CASE AdsFieldType.STRING
            CASE AdsFieldType.VARCHAR
            CASE AdsFieldType.CISTRING
            CASE AdsFieldType.VARCHAR_FOX
            CASE AdsFieldType.NCHAR
            CASE AdsFieldType.NVARCHAR
            CASE AdsFieldType.GUID
                RETURN AdsCharacterColumn{oInfo, oRDD, type,nPos}

            CASE AdsFieldType.MEMO
            CASE AdsFieldType.BINARY
            CASE AdsFieldType.IMAGE
            CASE AdsFieldType.NMEMO
            CASE AdsFieldType.RAW
            CASE AdsFieldType.VARBINARY_FOX
                return AdsMemoColumn{oInfo, oRDD, type,nPos}

            CASE AdsFieldType.SHORTINT
            CASE AdsFieldType.AUTOINC
            CASE AdsFieldType.INTEGER
            CASE AdsFieldType.NUMERIC
            CASE AdsFieldType.DOUBLE
            CASE AdsFieldType.CURDOUBLE
            CASE AdsFieldType.INT64
                return AdsNumericColumn{oInfo, oRDD, type,nPos}

            CASE AdsFieldType.LOGICAL
                return AdsLogicColumn{oInfo, oRDD, type,nPos}

            CASE AdsFieldType.DATE
            CASE AdsFieldType.COMPACTDATE
                return AdsDateColumn{oInfo, oRDD, type,nPos}
            OTHERWISE
                oRDD:ADSERROR(ERDD_DATATYPE, EG_DATATYPE, __ENTITY__,"Unexpected fieldtype: "+ ((int) type):ToString())
            END SWITCH
            RETURN NULL

        PROTECTED CONSTRUCTOR(oInfo AS RddFieldInfo,oRDD AS XSharp.ADS.ADSRDD, type as AdsFieldType, nPos as DWORD)
            SUPER(oInfo)
            SELF:RDD        := oRDD
            SELF:AdsType    := type
            SELF:FieldPos   := nPos
            RETURN

        VIRTUAL METHOD GetValue() AS OBJECT
            RETURN NIL

        VIRTUAL METHOD PutValue(oValue AS OBJECT) AS LOGIC
            RETURN FALSE

        PROTECTED METHOD PutNull() AS LOGIC
            SELF:RDD:ADSERROR(ACE.AdsSetEmpty(SELF:_Table, SELF:FieldPos),EG_WRITE)
            RETURN TRUE

   OVERRIDE METHOD ToString() AS STRING
        RETURN SELF:Name+" ('"+SELF:FieldTypeStr+"',"+SELF:Length:ToString()+","+SELF:Decimals:ToString()+","+SELF:AdsType:ToString()+")"

    END CLASS

    /// Class for reading / writing String Columns
    CLASS AdsCharacterColumn INHERIT AdsColumn

         CONSTRUCTOR(oInfo AS RddFieldInfo,oRDD AS XSharp.ADS.ADSRDD, type as AdsFieldType,nPos AS DWORD)
            SUPER(oInfo, oRDD,type,nPos)
            IF SELF:Decimals != 0
                SELF:Length         += SELF:Decimals * 256
                SELF:Decimals       := 0
            ENDIF
            RETURN

       OVERRIDE METHOD PutValue(oValue AS OBJECT) AS LOGIC
            IF oValue == NULL
                RETURN SELF:PutNull()
            ENDIF
            LOCAL result := 0 AS DWORD
            LOCAL slength AS DWORD
            LOCAL strValue AS STRING
            VAR tc := Type.GetTypeCode(oValue:GetType())
            SWITCH SELF:AdsType
            CASE AdsFieldType.STRING
            CASE AdsFieldType.VARCHAR
            CASE AdsFieldType.VARCHAR_FOX
            CASE AdsFieldType.CISTRING
            CASE AdsFieldType.NCHAR
            CASE AdsFieldType.NVARCHAR
            CASE AdsFieldType.GUID
                IF tc != TypeCode.String
                    SELF:RDD:ADSERROR(ERDD_DATATYPE, EG_DATATYPE, __ENTITY__,"String expected")
                ENDIF
                strValue := (STRING) oValue
                slength  := (DWORD) strValue:Length
                slength := Math.Min(slength, (DWORD) SELF:Length)
                IF slength == 0
                    result := ACE.AdsSetEmpty(SELF:_Table, SELF:FieldPos)
                ELSE
                    IF SELF:AdsType == AdsFieldType.NCHAR .or. SELF:AdsType == AdsFieldType.NVARCHAR
                        result := ACE.AdsSetStringW(SELF:_Table, SELF:FieldPos, strValue, slength)
                    ELSE
                        result := ACE.AdsSetString(SELF:_Table, SELF:FieldPos, strValue, slength)
                    ENDIF
                ENDIF
            CASE AdsFieldType.TIME
            CASE AdsFieldType.TIMESTAMP
            CASE AdsFieldType.MONEY
            CASE AdsFieldType.ROWVERSION
            CASE AdsFieldType.MODTIME
                IF tc != TypeCode.String
                    SELF:RDD:ADSERROR(ERDD_DATATYPE, EG_DATATYPE, __ENTITY__,"String expected")
                ENDIF
                strValue := (STRING) oValue
                slength  := (DWORD) strValue:Length
                result := ACE.AdsSetField(SELF:_Table, SELF:FieldPos, strValue, slength)
            OTHERWISE
                // Should never happen. We filter on the type when creating the column object
                SELF:RDD:ADSERROR(ERDD_DATATYPE, EG_DATATYPE, __ENTITY__,"Unexpected fieldtype: "+SELF:AdsType:ToString())
            END SWITCH
            IF result != 0 .AND. result != ACE.AE_DATA_TRUNCATED
                SELF:RDD:ADSERROR(result, EG_WRITE, __ENTITY__)
            ENDIF
            RETURN TRUE

        OVERRIDE METHOD Validate() AS LOGIC
            IF SELF:Length == 0  .OR. SELF:Decimals > 0  .OR. SELF:Length > System.UInt16.MaxValue
                RETURN FALSE
            ENDIF
            RETURN TRUE

        OVERRIDE METHOD GetValue() AS OBJECT
            LOCAL result    := 0 as DWORD
            LOCAL slength    := (DWORD) SELF:Length+1 AS DWORD
            LOCAL chars := CHAR[] {slength} AS CHAR[]
            SWITCH SELF:AdsType
            CASE AdsFieldType.TIME
            CASE AdsFieldType.TIMESTAMP
            CASE AdsFieldType.MONEY
            CASE AdsFieldType.ROWVERSION
            CASE AdsFieldType.MODTIME
                LOCAL isEmpty   := 0 AS WORD
                RDD:_CheckError(ACE.AdsIsEmpty(SELF:_Table,  SELF:FieldPos , OUT isEmpty),EG_READ)
                IF isEmpty == 1
                    RETURN NULL
                ENDIF
                chars := CHAR[] {slength}
                result := ACE.AdsGetField(SELF:_Table, SELF:FieldPos, chars, REF slength ,0)
            CASE AdsFieldType.STRING
            CASE AdsFieldType.VARCHAR
            CASE AdsFieldType.CISTRING
            CASE AdsFieldType.VARCHAR_FOX
            CASE AdsFieldType.NCHAR
            CASE AdsFieldType.NVARCHAR
                chars := CHAR[] {slength}
                IF SELF:AdsType == AdsFieldType.NCHAR .or. SELF:AdsType == AdsFieldType.NVARCHAR
                    result := ACE.AdsGetStringW(SELF:_Table, SELF:FieldPos, chars, REF slength ,0)
                ELSE
                    result := ACE.AdsGetString(SELF:_Table, SELF:FieldPos, chars, REF slength ,0)
                ENDIF
            OTHERWISE
                // Should never happen. We filter on the type when creating the column object
                SELF:RDD:ADSERROR(ERDD_DATATYPE, EG_DATATYPE, __ENTITY__,"Unexpected fieldtype: "+SELF:AdsType:ToString())
            END SWITCH
            SWITCH result
            CASE 0
                IF SELF:AdsType == AdsFieldType.NCHAR .OR. SELF:AdsType == AdsFieldType.NVARCHAR
                    RETURN STRING{chars, 0, (INT) SELF:Length}
                ELSE
                    RETURN SELF:RDD:_Ansi2Unicode(chars, (INT) SELF:Length)
                ENDIF
            CASE ACE.AE_NO_CURRENT_RECORD
                RETURN STRING{' ', (INT) SELF:Length}
            OTHERWISE
                SELF:RDD:_CheckError(result,EG_READ)
            END SWITCH
            RETURN String.Empty

    END CLASS
    /// Class for reading / writing Date Columns
    CLASS AdsDateColumn INHERIT AdsColumn

         CONSTRUCTOR(oInfo AS RddFieldInfo,oRDD AS XSharp.ADS.ADSRDD, type as AdsFieldType,nPos AS DWORD)
            SUPER(oInfo, oRDD,type,nPos)
            RETURN

        OVERRIDE METHOD GetValue() AS OBJECT
            LOCAL lJulian AS LONG
            VAR result := ACE.AdsGetJulian(SELF:_Table, SELF:FieldPos, OUT lJulian)
            IF result == ACE.AE_NO_CURRENT_RECORD
                RETURN DbDate{0,0,0}
            ELSEIF result != 0
                SELF:RDD:_CheckError(result,EG_READ)
            ENDIF
            TRY
                IF lJulian == 0
                    RETURN DbDate{0,0,0}
                ELSE
                    // there is a function to convert julian to string but it does not always work correctly
                    // this seems to always do the job
                    LOCAL wLength := ACE.ADS_MAX_DATEMASK+1 AS WORD
                    LOCAL chars := CHAR[] {SELF:Length+1} as CHAR[]
                    result := ACEUNPUB.AdsConvertJulianToString(lJulian, chars, ref wLength)
                    IF result != 0
                        RETURN DbDate{0,0,0}
                    ELSE
                        var cDate := String{chars, 0, wLength}
                        local year, month, day as int
                        if Int32.TryParse(cDate:Substring(0,4), out year) .and. ;
                            Int32.TryParse(cDate:Substring(4,2), out month) .and. ;
                            Int32.TryParse(cDate:Substring(6,2), out day)
                            RETURN DbDate{year, month, day}
                        else
                            RETURN DbDate{0,0,0}
                        endif
                    ENDIF
                ENDIF
            CATCH

            END TRY
            RETURN DbDate{0,0,0}

        OVERRIDE METHOD PutValue(oValue AS OBJECT) AS LOGIC
            // Note that the XSharp.__Date type also returns a typecode of DateTime
            IF oValue == NULL
                RETURN SELF:PutNull()
            ENDIF

            VAR tc := Type.GetTypeCode(oValue:GetType())
            IF oValue IS IDate VAR oDate
                tc := TypeCode.DateTime
                IF oDate:IsEmpty
                    oValue := DateTime.MinValue
                ELSE
                    oValue := DateTime{oDate:Year, oDate:Month, oDate:Day}
                ENDIF
            ELSEIF oValue IS DateTime
                tc := TypeCode.DateTime
            ENDIF
            IF tc != TypeCode.DateTime
                SELF:RDD:ADSERROR(ERDD_DATATYPE, EG_DATATYPE, __ENTITY__,"Date or DateTime value expected")
            ENDIF

            LOCAL dt := (DateTime) oValue AS DateTime
            if (dt == DateTime.MinValue)
                SELF:RDD:_CheckError(ACE.AdsSetEmpty(SELF:_Table, SELF:FieldPos),EG_WRITE)
            ELSE
                LOCAL text := dt:ToString("yyyyMMdd") AS STRING
                LOCAL r8Julian AS REAL8
                SELF:RDD:_CheckError(ACEUNPUB.AdsConvertStringToJulian(text, (WORD) text:Length, OUT r8Julian),EG_WRITE)
                SELF:RDD:_CheckError(ACE.AdsSetJulian(SELF:_Table, SELF:FieldPos, (LONG) r8Julian),EG_WRITE)
            ENDIF
            RETURN TRUE

        OVERRIDE METHOD Validate() AS LOGIC
            RETURN SELF:Length == 8  .AND.  SELF:Decimals == 0

    END CLASS

    /// Class for reading / writing Logic Columns
    CLASS AdsLogicColumn INHERIT AdsColumn

        CONSTRUCTOR(oInfo AS RddFieldInfo,oRDD AS XSharp.ADS.ADSRDD, type as AdsFieldType,nPos AS DWORD)
            SUPER(oInfo,oRDD,type,nPos)
            RETURN

        OVERRIDE METHOD GetValue() AS OBJECT
            LOCAL wValue AS WORD
            VAR result := ACE.AdsGetLogical(SELF:_Table, SELF:FieldPos, OUT wValue)
            IF result ==  ACE.AE_NO_CURRENT_RECORD
                wValue := 0
            ELSEIF ! SELF:RDD:_CheckError(result,EG_READ)
              // Exception
            ENDIF
            RETURN wValue != 0

       OVERRIDE METHOD PutValue(oValue AS OBJECT) AS LOGIC
            IF oValue == NULL
                RETURN SELF:PutNull()
            ENDIF
            VAR tc := Type.GetTypeCode(oValue:GetType())
            IF tc != TypeCode.Boolean
                SELF:RDD:ADSERROR(ERDD_DATATYPE, EG_DATATYPE, __ENTITY__,"Logic value expected")
            ENDIF
            SELF:RDD:_CheckError(ACE.AdsSetLogical(SELF:_Table, SELF:FieldPos, (WORD)  IIF( (LOGIC) oValue, 1, 0)),EG_WRITE)
            RETURN TRUE

       OVERRIDE METHOD Validate() AS LOGIC
            RETURN SELF:Length == 1  .AND.  SELF:Decimals == 0
    END CLASS

    /// Class for reading / writing Numeric Columns
    CLASS AdsNumericColumn INHERIT AdsColumn

    CONSTRUCTOR(oInfo AS RddFieldInfo,oRDD AS XSharp.ADS.ADSRDD, type as AdsFieldType,nPos AS DWORD)
            SUPER(oInfo,oRDD,type,nPos)
            RETURN

        OVERRIDE METHOD GetValue() AS OBJECT
            LOCAL result    := 0 as DWORD
            SWITCH SELF:AdsType
            CASE AdsFieldType.NUMERIC
            CASE AdsFieldType.DOUBLE
            CASE AdsFieldType.INTEGER
            CASE AdsFieldType.SHORTINT
            CASE AdsFieldType.AUTOINC
            CASE AdsFieldType.CURDOUBLE
                LOCAL r8 AS REAL8
                result := ACE.AdsGetDouble(SELF:_Table, SELF:FieldPos, OUT r8)
                IF result == ACE.AE_NO_CURRENT_RECORD
                    r8 := 0.0
                ENDIF
                IF SELF:AdsType:IsDouble()
                    VAR value := r8:ToString()
                    VAR pos := value:IndexOf('.')
                    RETURN DbFloat{r8, SELF:Length, IIF(pos > 0, SELF:Length - pos -1, 0)}
                ELSE
                    RETURN DbFloat{r8, SELF:Length, SELF:Decimals}
                ENDIF
            CASE AdsFieldType.INT64
                LOCAL i64 AS INT64
                result := ACE.AdsGetLongLong(SELF:_Table, SELF:FieldPos, OUT i64)
                RETURN i64
            OTHERWISE
                // Should never happen. We filter on the type when creating the column object
                SELF:RDD:ADSERROR(ERDD_DATATYPE, EG_DATATYPE, __ENTITY__,"Unexpected fieldtype: "+SELF:AdsType:ToString())
            END SWITCH
            RETURN NULL

      OVERRIDE METHOD PutValue(oValue AS OBJECT) AS LOGIC
        IF oValue == NULL
            RETURN SELF:PutNull()
        ENDIF
        IF oValue IS IFloat VAR floatValue
            oValue := floatValue:Value
        ENDIF
        LOCAL wType AS WORD
        SELF:RDD:_CheckError(ACE.AdsGetFieldType(SELF:_Table, SELF:FieldPos, OUT wType),EG_READ)
        IF wType != ACE.ADS_AUTOINC
            TRY
                IF SELF:AdsType == AdsFieldType.INT64
                    VAR i64 := Convert.ToInt64(oValue)
                    SELF:RDD:_CheckError(ACE.AdsSetLongLong(SELF:_Table, SELF:FieldPos,i64))
                ELSE
                    LOCAL r8 AS REAL8
                    r8 := Convert.ToDouble(oValue)
                    SELF:RDD:_CheckError(ACE.AdsSetDouble(SELF:_Table, SELF:FieldPos, r8),EG_WRITE)
                ENDIF
            CATCH
                SELF:RDD:ADSERROR(ERDD_DATATYPE, EG_DATATYPE, __ENTITY__,"Numeric value expected")
                RETURN FALSE
            END TRY
        ELSE
            NOP // Do not allow to write to AUTO INC field
        ENDIF
        RETURN TRUE

       OVERRIDE METHOD Validate() AS LOGIC
           IF SELF:Length >= 1  .AND.  SELF:Length <= 255
                IF SELF:Decimals > 0
                    // We must check that we have enough space for DOT and decimal
                    IF SELF:Length <= 2  .OR.  SELF:Decimals >= SELF:Length -1
                        RETURN FALSE
                    ENDIF
                ENDIF
            ELSE
                RETURN FALSE
            ENDIF
            RETURN TRUE

    END CLASS

    /// Class for reading / writing Memo Columns.
    CLASS AdsMemoColumn INHERIT AdsColumn
        // AdsFieldType.MEMO
        // AdsFieldType.NMEMO
        // AdsFieldType.BINARY
        // AdsFieldType.IMAGE
        // AdsFieldType.RAW
        // AdsFieldType.VARBINARY_FOX

        CONSTRUCTOR(oInfo AS RddFieldInfo,oRDD AS XSharp.ADS.ADSRDD, type as AdsFieldType,nPos AS DWORD)
            SUPER(oInfo,oRDD,type,nPos)
            RETURN

        OVERRIDE METHOD GetValue() AS OBJECT
            LOCAL isEmpty   := 0 AS WORD
            LOCAL result    := 0 as DWORD
            LOCAL mlength    := 0 AS DWORD
            LOCAL bytes     := NULL AS BYTE[]
            LOCAL chars := CHAR[] {Length} AS CHAR[]
            SWITCH SELF:AdsType
            CASE AdsFieldType.MEMO
            CASE AdsFieldType.NMEMO
            CASE AdsFieldType.BINARY
            CASE AdsFieldType.IMAGE
                result := ACE.AdsGetMemoLength(SELF:_Table, SELF:FieldPos, OUT mlength )
                SWITCH result
                CASE 0
                    IF mlength == 0
                        RETURN String.Empty
                    ENDIF
                CASE ACE.AE_NO_CURRENT_RECORD
                    IF SELF:AdsType == AdsFieldType.MEMO .OR. SELF:AdsType == AdsFieldType.NMEMO
                        RETURN String.Empty
                    ELSE    // image and binary
                        RETURN NULL
                    ENDIF
                OTHERWISE
                    SELF:RDD:_CheckError(result,EG_READ)
                END SWITCH
                SWITCH SELF:AdsType
                CASE AdsFieldType.MEMO
                    chars := CHAR[] {++mlength}
                    result := ACE.AdsGetString(SELF:_Table, SELF:FieldPos, chars, REF mlength ,0)
                    if (result == ACE.AE_INVALID_FIELD_TYPE)
                        chars := NULL
                        bytes := BYTE[] {mlength}
                        result := ACE.AdsGetBinary(SELF:_Table, SELF:FieldPos, 0, bytes, REF mlength )
                        SELF:RDD:_CheckError(result)
                        return RuntimeState:WinEncoding:GetString(bytes, 0, bytes:Length)
                    ENDIF
                    SELF:RDD:_CheckError(result,EG_READ)
                    RETURN SELF:RDD:_Ansi2Unicode(chars, (INT) mlength)
                CASE AdsFieldType.NMEMO
                    chars := CHAR[] {++mlength}
                    SELF:RDD:_CheckError(ACE.AdsGetStringW(SELF:_Table, SELF:FieldPos, chars, REF mlength ,0),EG_READ)
                    return String{chars,0, (int)mlength-1}
                CASE AdsFieldType.BINARY
                CASE AdsFieldType.IMAGE
                    bytes := BYTE[] {mlength}
                    SELF:RDD:_CheckError(ACE.AdsGetBinary(SELF:_Table, SELF:FieldPos, 0, bytes, REF mlength ),EG_READ)
                    RETURN bytes
                END SWITCH

            CASE AdsFieldType.RAW
            CASE AdsFieldType.VARBINARY_FOX
                result := ACE.AdsIsEmpty(SELF:_Table, SELF:FieldPos, OUT isEmpty)
                IF result == 0
                    IF isEmpty == 1
                        RETURN NULL
                    ENDIF
                ELSE
                    SELF:RDD:_CheckError(result,EG_READ)
                ENDIF
                mlength := (DWORD) SELF:Length
                bytes := BYTE[] {mlength}
                SELF:RDD:_CheckError(ACE.AdsGetBinary(SELF:_Table, SELF:FieldPos, 0, bytes, REF mlength ),EG_READ)
                RETURN bytes
            OTHERWISE
                // Should never happen. We filter on the type when creating the column object
                SELF:RDD:ADSERROR(ERDD_DATATYPE, EG_DATATYPE, __ENTITY__,"Unexpected fieldtype: "+SELF:AdsType:ToString())
            END SWITCH
            RETURN NULL

        OVERRIDE METHOD PutValue(oValue AS OBJECT) AS LOGIC
            IF oValue == NULL
                RETURN SELF:PutNull()
            ENDIF
            LOCAL result := 0 AS DWORD
            LOCAL slength AS DWORD
            LOCAL strValue AS STRING
            VAR tc := Type.GetTypeCode(oValue:GetType())
            SWITCH SELF:AdsType
            CASE AdsFieldType.MEMO
            CASE AdsFieldType.NMEMO
                IF tc != TypeCode.String
                    SELF:RDD:ADSERROR(ERDD_DATATYPE, EG_DATATYPE, __ENTITY__,"String expected")
                ENDIF
                strValue := (STRING) oValue
                slength  := (DWORD) strValue:Length
                IF slength == 0
                    result := ACE.AdsSetEmpty(SELF:_Table, SELF:FieldPos)
                ELSE
                    IF SELF:AdsType == AdsFieldType.NMEMO
                        result := ACE.AdsSetStringW(SELF:_Table, SELF:FieldPos, strValue, slength)
                    ELSE
                        result := ACE.AdsSetString(SELF:_Table, SELF:FieldPos, strValue, slength)
                    ENDIF
                ENDIF
            CASE AdsFieldType.BINARY
            CASE AdsFieldType.IMAGE
            CASE AdsFieldType.RAW
            CASE AdsFieldType.VARBINARY_FOX
                IF tc != TypeCode.String .AND. tc != TypeCode.Object
                    SELF:RDD:ADSERROR(ERDD_DATATYPE, EG_DATATYPE, __ENTITY__,"String or Object expected")
                ENDIF
                IF tc != TypeCode.String
                    strValue := (STRING) oValue
                    slength := (DWORD) strValue:Length
                    result := ACE.AdsSetString(SELF:_Table, SELF:FieldPos, strValue, slength)
                ELSE
                    LOCAL bytes AS BYTE[]
                    bytes   := (BYTE[]) oValue
                    slength  := (DWORD) bytes:Length
                    IF SELF:AdsType == AdsFieldType.RAW .OR. SELF:AdsType == AdsFieldType.VARBINARY_FOX
                        result := ACE.AdsSetField(SELF:_Table, SELF:FieldPos, bytes, slength)
                    ELSE
                        result := ACE.AdsSetBinary(SELF:_Table, SELF:FieldPos, SELF:AdsType, slength, 0, bytes, slength)
                    ENDIF
                ENDIF
            OTHERWISE
                // Should never happen. We filter on the type when creating the column object
                SELF:RDD:ADSERROR(ERDD_DATATYPE, EG_DATATYPE, __ENTITY__,"Unexpected fieldtype: "+SELF:AdsType:ToString())
            END SWITCH
            IF result != 0 .AND. result != ACE.AE_DATA_TRUNCATED
                SELF:RDD:ADSERROR(result, EG_WRITE, __ENTITY__)
            ENDIF
            RETURN TRUE

       OVERRIDE METHOD Validate() AS LOGIC
            RETURN SELF:Length == 10 .AND.  SELF:Decimals == 0

    END CLASS

END NAMESPACE

//
// Copyright (c) XSharp B.V.  All Rights Reserved.
// Licensed under the Apache License, Version 2.0.
// See License.txt in the project root for license information.
//

USING System.IO
USING System.Collections.Generic
USING System.Linq
USING XSharp.RDD
USING XSharp.RDD.Support
USING XSharp.RDD.Enums

BEGIN NAMESPACE XSharp.ADS
    /// Class for Ads Column reading / writing
    CLASS AdsColumn INHERIT RddFieldInfo
        INTERNAL RDD        AS XSharp.ADS.ADSRDD
        INTERNAL AdsType    as AdsFieldType
        INTERNAL FieldPos   as DWORD
        PROPERTY _Table as IntPtr GET RDD:_Table

        STATIC METHOD Create(oInfo AS RddFieldInfo, oRDD AS XSharp.ADS.ADSRDD,type as AdsFieldType, nPos as DWORD) AS AdsColumn
            // Commented out types are Harbour specific
            SWITCH type
            // char types
            CASE AdsFieldType.TIMESTAMP
            CASE AdsFieldType.MODTIME
            CASE AdsFieldType.TIME
            CASE AdsFieldType.MONEY
            CASE AdsFieldType.ROWVERSION
            CASE AdsFieldType.STRING
            CASE AdsFieldType.VARCHAR
            CASE AdsFieldType.CISTRING
            CASE AdsFieldType.VARCHAR_FOX
            CASE AdsFieldType.NCHAR
            CASE AdsFieldType.NVARCHAR
            CASE AdsFieldType.GUID
                RETURN AdsCharacterColumn{oInfo, oRDD, type,nPos}

            CASE AdsFieldType.MEMO
            CASE AdsFieldType.BINARY
            CASE AdsFieldType.IMAGE
            CASE AdsFieldType.NMEMO
            CASE AdsFieldType.RAW
            CASE AdsFieldType.VARBINARY_FOX
                return AdsMemoColumn{oInfo, oRDD, type,nPos}

            CASE AdsFieldType.SHORTINT
            CASE AdsFieldType.AUTOINC
            CASE AdsFieldType.INTEGER
            CASE AdsFieldType.NUMERIC
            CASE AdsFieldType.DOUBLE
            CASE AdsFieldType.CURDOUBLE
            CASE AdsFieldType.INT64
                return AdsNumericColumn{oInfo, oRDD, type,nPos}

            CASE AdsFieldType.LOGICAL
                return AdsLogicColumn{oInfo, oRDD, type,nPos}

            CASE AdsFieldType.DATE
            CASE AdsFieldType.COMPACTDATE
                return AdsDateColumn{oInfo, oRDD, type,nPos}
            OTHERWISE
                oRDD:ADSERROR(ERDD_DATATYPE, EG_DATATYPE, __ENTITY__,"Unexpected fieldtype: "+ ((int) type):ToString())
            END SWITCH
            RETURN NULL

        PROTECTED CONSTRUCTOR(oInfo AS RddFieldInfo,oRDD AS XSharp.ADS.ADSRDD, type as AdsFieldType, nPos as DWORD)
            SUPER(oInfo)
            SELF:RDD        := oRDD
            SELF:AdsType    := type
            SELF:FieldPos   := nPos
            RETURN

        VIRTUAL METHOD GetValue() AS OBJECT
            RETURN NIL

        VIRTUAL METHOD PutValue(oValue AS OBJECT) AS LOGIC
            RETURN FALSE

        PROTECTED METHOD PutNull() AS LOGIC
            SELF:RDD:ADSERROR(ACE.AdsSetEmpty(SELF:_Table, SELF:FieldPos),EG_WRITE)
            RETURN TRUE

   OVERRIDE METHOD ToString() AS STRING
        RETURN SELF:Name+" ('"+SELF:FieldTypeStr+"',"+SELF:Length:ToString()+","+SELF:Decimals:ToString()+","+SELF:AdsType:ToString()+")"

    END CLASS

    /// Class for reading / writing String Columns
    CLASS AdsCharacterColumn INHERIT AdsColumn

         CONSTRUCTOR(oInfo AS RddFieldInfo,oRDD AS XSharp.ADS.ADSRDD, type as AdsFieldType,nPos AS DWORD)
            SUPER(oInfo, oRDD,type,nPos)
            IF SELF:Decimals != 0
                SELF:Length         += SELF:Decimals * 256
                SELF:Decimals       := 0
            ENDIF
            RETURN

       OVERRIDE METHOD PutValue(oValue AS OBJECT) AS LOGIC
            IF oValue == NULL
                RETURN SELF:PutNull()
            ENDIF
            LOCAL result := 0 AS DWORD
            LOCAL slength AS DWORD
            LOCAL strValue AS STRING
            VAR tc := Type.GetTypeCode(oValue:GetType())
            SWITCH SELF:AdsType
            CASE AdsFieldType.STRING
            CASE AdsFieldType.VARCHAR
            CASE AdsFieldType.VARCHAR_FOX
            CASE AdsFieldType.CISTRING
            CASE AdsFieldType.NCHAR
            CASE AdsFieldType.NVARCHAR
            CASE AdsFieldType.GUID
                IF tc != TypeCode.String
                    SELF:RDD:ADSERROR(ERDD_DATATYPE, EG_DATATYPE, __ENTITY__,"String expected")
                ENDIF
                strValue := (STRING) oValue
                slength  := (DWORD) strValue:Length
                slength := Math.Min(slength, (DWORD) SELF:Length)
                IF slength == 0
                    result := ACE.AdsSetEmpty(SELF:_Table, SELF:FieldPos)
                ELSE
                    IF SELF:AdsType == AdsFieldType.NCHAR .or. SELF:AdsType == AdsFieldType.NVARCHAR
                        result := ACE.AdsSetStringW(SELF:_Table, SELF:FieldPos, strValue, slength)
                    ELSE
                        result := ACE.AdsSetString(SELF:_Table, SELF:FieldPos, strValue, slength)
                    ENDIF
                ENDIF
            CASE AdsFieldType.TIME
            CASE AdsFieldType.TIMESTAMP
            CASE AdsFieldType.MONEY
            CASE AdsFieldType.ROWVERSION
            CASE AdsFieldType.MODTIME
                IF tc != TypeCode.String
                    SELF:RDD:ADSERROR(ERDD_DATATYPE, EG_DATATYPE, __ENTITY__,"String expected")
                ENDIF
                strValue := (STRING) oValue
                slength  := (DWORD) strValue:Length
                result := ACE.AdsSetField(SELF:_Table, SELF:FieldPos, strValue, slength)
            OTHERWISE
                // Should never happen. We filter on the type when creating the column object
                SELF:RDD:ADSERROR(ERDD_DATATYPE, EG_DATATYPE, __ENTITY__,"Unexpected fieldtype: "+SELF:AdsType:ToString())
            END SWITCH
            IF result != 0 .AND. result != ACE.AE_DATA_TRUNCATED
                SELF:RDD:ADSERROR(result, EG_WRITE, __ENTITY__)
            ENDIF
            RETURN TRUE

        OVERRIDE METHOD Validate() AS LOGIC
            IF SELF:Length == 0  .OR. SELF:Decimals > 0  .OR. SELF:Length > System.UInt16.MaxValue
                RETURN FALSE
            ENDIF
            RETURN TRUE

        OVERRIDE METHOD GetValue() AS OBJECT
            LOCAL result    := 0 as DWORD
            LOCAL slength    := (DWORD) SELF:Length+1 AS DWORD
            LOCAL chars := CHAR[] {slength} AS CHAR[]
            SWITCH SELF:AdsType
            CASE AdsFieldType.TIME
            CASE AdsFieldType.TIMESTAMP
            CASE AdsFieldType.MONEY
            CASE AdsFieldType.ROWVERSION
            CASE AdsFieldType.MODTIME
                LOCAL isEmpty   := 0 AS WORD
                RDD:_CheckError(ACE.AdsIsEmpty(SELF:_Table,  SELF:FieldPos , OUT isEmpty),EG_READ)
                IF isEmpty == 1
                    RETURN NULL
                ENDIF
                chars := CHAR[] {slength}
                result := ACE.AdsGetField(SELF:_Table, SELF:FieldPos, chars, REF slength ,0)
            CASE AdsFieldType.STRING
            CASE AdsFieldType.VARCHAR
            CASE AdsFieldType.CISTRING
            CASE AdsFieldType.VARCHAR_FOX
            CASE AdsFieldType.NCHAR
            CASE AdsFieldType.NVARCHAR
                chars := CHAR[] {slength}
                IF SELF:AdsType == AdsFieldType.NCHAR .or. SELF:AdsType == AdsFieldType.NVARCHAR
                    result := ACE.AdsGetStringW(SELF:_Table, SELF:FieldPos, chars, REF slength ,0)
                ELSE
                    result := ACE.AdsGetString(SELF:_Table, SELF:FieldPos, chars, REF slength ,0)
                ENDIF
            OTHERWISE
                // Should never happen. We filter on the type when creating the column object
                SELF:RDD:ADSERROR(ERDD_DATATYPE, EG_DATATYPE, __ENTITY__,"Unexpected fieldtype: "+SELF:AdsType:ToString())
            END SWITCH
            SWITCH result
            CASE 0
                IF SELF:AdsType == AdsFieldType.NCHAR .OR. SELF:AdsType == AdsFieldType.NVARCHAR
                    RETURN STRING{chars, 0, (INT) SELF:Length}
                ELSE
                    RETURN SELF:RDD:_Ansi2Unicode(chars, (INT) SELF:Length)
                ENDIF
            CASE ACE.AE_NO_CURRENT_RECORD
                RETURN STRING{' ', (INT) SELF:Length}
            OTHERWISE
                SELF:RDD:_CheckError(result,EG_READ)
            END SWITCH
            RETURN String.Empty

    END CLASS
    /// Class for reading / writing Date Columns
    CLASS AdsDateColumn INHERIT AdsColumn

         CONSTRUCTOR(oInfo AS RddFieldInfo,oRDD AS XSharp.ADS.ADSRDD, type as AdsFieldType,nPos AS DWORD)
            SUPER(oInfo, oRDD,type,nPos)
            RETURN

        OVERRIDE METHOD GetValue() AS OBJECT
            LOCAL lJulian AS LONG
            VAR result := ACE.AdsGetJulian(SELF:_Table, SELF:FieldPos, OUT lJulian)
            IF result == ACE.AE_NO_CURRENT_RECORD
                RETURN DbDate{0,0,0}
            ELSEIF result != 0
                SELF:RDD:_CheckError(result,EG_READ)
            ENDIF
            TRY
                IF lJulian == 0
                    RETURN DbDate{0,0,0}
                ELSE
                    // there is a function to convert julian to string but it does not always work correctly
                    // this seems to always do the job
                    LOCAL wLength := ACE.ADS_MAX_DATEMASK+1 AS WORD
                    LOCAL chars := CHAR[] {SELF:Length+1} as CHAR[]
                    result := ACEUNPUB.AdsConvertJulianToString(lJulian, chars, ref wLength)
                    IF result != 0
                        RETURN DbDate{0,0,0}
                    ELSE
                        var cDate := String{chars, 0, wLength}
                        local year, month, day as int
                        if Int32.TryParse(cDate:Substring(0,4), out year) .and. ;
                            Int32.TryParse(cDate:Substring(4,2), out month) .and. ;
                            Int32.TryParse(cDate:Substring(6,2), out day)
                            RETURN DbDate{year, month, day}
                        else
                            RETURN DbDate{0,0,0}
                        endif
                    ENDIF
                ENDIF
            CATCH

            END TRY
            RETURN DbDate{0,0,0}

        OVERRIDE METHOD PutValue(oValue AS OBJECT) AS LOGIC
            // Note that the XSharp.__Date type also returns a typecode of DateTime
            IF oValue == NULL
                RETURN SELF:PutNull()
            ENDIF

            VAR tc := Type.GetTypeCode(oValue:GetType())
            IF oValue IS IDate VAR oDate
                tc := TypeCode.DateTime
                IF oDate:IsEmpty
                    oValue := DateTime.MinValue
                ELSE
                    oValue := DateTime{oDate:Year, oDate:Month, oDate:Day}
                ENDIF
            ELSEIF oValue IS DateTime
                tc := TypeCode.DateTime
            ENDIF
            IF tc != TypeCode.DateTime
                SELF:RDD:ADSERROR(ERDD_DATATYPE, EG_DATATYPE, __ENTITY__,"Date or DateTime value expected")
            ENDIF

            LOCAL dt := (DateTime) oValue AS DateTime
            if (dt == DateTime.MinValue)
                SELF:RDD:_CheckError(ACE.AdsSetEmpty(SELF:_Table, SELF:FieldPos),EG_WRITE)
            ELSE
                LOCAL text := dt:ToString("yyyyMMdd") AS STRING
                LOCAL r8Julian AS REAL8
                SELF:RDD:_CheckError(ACEUNPUB.AdsConvertStringToJulian(text, (WORD) text:Length, OUT r8Julian),EG_WRITE)
                SELF:RDD:_CheckError(ACE.AdsSetJulian(SELF:_Table, SELF:FieldPos, (LONG) r8Julian),EG_WRITE)
            ENDIF
            RETURN TRUE

        OVERRIDE METHOD Validate() AS LOGIC
            RETURN SELF:Length == 8  .AND.  SELF:Decimals == 0

    END CLASS

    /// Class for reading / writing Logic Columns
    CLASS AdsLogicColumn INHERIT AdsColumn

        CONSTRUCTOR(oInfo AS RddFieldInfo,oRDD AS XSharp.ADS.ADSRDD, type as AdsFieldType,nPos AS DWORD)
            SUPER(oInfo,oRDD,type,nPos)
            RETURN

        OVERRIDE METHOD GetValue() AS OBJECT
            LOCAL wValue AS WORD
            VAR result := ACE.AdsGetLogical(SELF:_Table, SELF:FieldPos, OUT wValue)
            IF result ==  ACE.AE_NO_CURRENT_RECORD
                wValue := 0
            ELSEIF ! SELF:RDD:_CheckError(result,EG_READ)
              // Exception
            ENDIF
            RETURN wValue != 0

       OVERRIDE METHOD PutValue(oValue AS OBJECT) AS LOGIC
            IF oValue == NULL
                RETURN SELF:PutNull()
            ENDIF
            VAR tc := Type.GetTypeCode(oValue:GetType())
            IF tc != TypeCode.Boolean
                SELF:RDD:ADSERROR(ERDD_DATATYPE, EG_DATATYPE, __ENTITY__,"Logic value expected")
            ENDIF
            SELF:RDD:_CheckError(ACE.AdsSetLogical(SELF:_Table, SELF:FieldPos, (WORD)  IIF( (LOGIC) oValue, 1, 0)),EG_WRITE)
            RETURN TRUE

       OVERRIDE METHOD Validate() AS LOGIC
            RETURN SELF:Length == 1  .AND.  SELF:Decimals == 0
    END CLASS

    /// Class for reading / writing Numeric Columns
    CLASS AdsNumericColumn INHERIT AdsColumn

    CONSTRUCTOR(oInfo AS RddFieldInfo,oRDD AS XSharp.ADS.ADSRDD, type as AdsFieldType,nPos AS DWORD)
            SUPER(oInfo,oRDD,type,nPos)
            RETURN

        OVERRIDE METHOD GetValue() AS OBJECT
            LOCAL result    := 0 as DWORD
            SWITCH SELF:AdsType
            CASE AdsFieldType.NUMERIC
            CASE AdsFieldType.DOUBLE
            CASE AdsFieldType.INTEGER
            CASE AdsFieldType.SHORTINT
            CASE AdsFieldType.AUTOINC
            CASE AdsFieldType.CURDOUBLE
                LOCAL r8 AS REAL8
                result := ACE.AdsGetDouble(SELF:_Table, SELF:FieldPos, OUT r8)
                IF result == ACE.AE_NO_CURRENT_RECORD
                    r8 := 0.0
                ENDIF
                IF SELF:AdsType:IsDouble()
                    VAR value := r8:ToString()
                    VAR pos := value:IndexOf('.')
                    RETURN DbFloat{r8, SELF:Length, IIF(pos > 0, SELF:Length - pos -1, 0)}
                ELSE
                    RETURN DbFloat{r8, SELF:Length, SELF:Decimals}
                ENDIF
            CASE AdsFieldType.INT64
                LOCAL i64 AS INT64
                result := ACE.AdsGetLongLong(SELF:_Table, SELF:FieldPos, OUT i64)
                RETURN i64
            OTHERWISE
                // Should never happen. We filter on the type when creating the column object
                SELF:RDD:ADSERROR(ERDD_DATATYPE, EG_DATATYPE, __ENTITY__,"Unexpected fieldtype: "+SELF:AdsType:ToString())
            END SWITCH
            RETURN NULL

      OVERRIDE METHOD PutValue(oValue AS OBJECT) AS LOGIC
        IF oValue == NULL
            RETURN SELF:PutNull()
        ENDIF
        IF oValue IS IFloat VAR floatValue
            oValue := floatValue:Value
        ENDIF
        LOCAL wType AS WORD
        SELF:RDD:_CheckError(ACE.AdsGetFieldType(SELF:_Table, SELF:FieldPos, OUT wType),EG_READ)
        IF wType != ACE.ADS_AUTOINC
            TRY
                IF SELF:AdsType == AdsFieldType.INT64
                    VAR i64 := Convert.ToInt64(oValue)
                    SELF:RDD:_CheckError(ACE.AdsSetLongLong(SELF:_Table, SELF:FieldPos,i64))
                ELSE
                    LOCAL r8 AS REAL8
                    r8 := Convert.ToDouble(oValue)
                    SELF:RDD:_CheckError(ACE.AdsSetDouble(SELF:_Table, SELF:FieldPos, r8),EG_WRITE)
                ENDIF
            CATCH
                SELF:RDD:ADSERROR(ERDD_DATATYPE, EG_DATATYPE, __ENTITY__,"Numeric value expected")
                RETURN FALSE
            END TRY
        ELSE
            NOP // Do not allow to write to AUTO INC field
        ENDIF
        RETURN TRUE

       OVERRIDE METHOD Validate() AS LOGIC
           IF SELF:Length >= 1  .AND.  SELF:Length <= 255
                IF SELF:Decimals > 0
                    // We must check that we have enough space for DOT and decimal
                    IF SELF:Length <= 2  .OR.  SELF:Decimals >= SELF:Length -1
                        RETURN FALSE
                    ENDIF
                ENDIF
            ELSE
                RETURN FALSE
            ENDIF
            RETURN TRUE

    END CLASS

    /// Class for reading / writing Memo Columns.
    CLASS AdsMemoColumn INHERIT AdsColumn
        // AdsFieldType.MEMO
        // AdsFieldType.NMEMO
        // AdsFieldType.BINARY
        // AdsFieldType.IMAGE
        // AdsFieldType.RAW
        // AdsFieldType.VARBINARY_FOX

        CONSTRUCTOR(oInfo AS RddFieldInfo,oRDD AS XSharp.ADS.ADSRDD, type as AdsFieldType,nPos AS DWORD)
            SUPER(oInfo,oRDD,type,nPos)
            RETURN

        OVERRIDE METHOD GetValue() AS OBJECT
            LOCAL isEmpty   := 0 AS WORD
            LOCAL result    := 0 as DWORD
            LOCAL mlength    := 0 AS DWORD
            LOCAL bytes     := NULL AS BYTE[]
            LOCAL chars := CHAR[] {Length} AS CHAR[]
            SWITCH SELF:AdsType
            CASE AdsFieldType.MEMO
            CASE AdsFieldType.NMEMO
            CASE AdsFieldType.BINARY
            CASE AdsFieldType.IMAGE
                result := ACE.AdsGetMemoLength(SELF:_Table, SELF:FieldPos, OUT mlength )
                SWITCH result
                CASE 0
                    IF mlength == 0
                        RETURN String.Empty
                    ENDIF
                CASE ACE.AE_NO_CURRENT_RECORD
                    IF SELF:AdsType == AdsFieldType.MEMO .OR. SELF:AdsType == AdsFieldType.NMEMO
                        RETURN String.Empty
                    ELSE    // image and binary
                        RETURN NULL
                    ENDIF
                OTHERWISE
                    SELF:RDD:_CheckError(result,EG_READ)
                END SWITCH
                SWITCH SELF:AdsType
                CASE AdsFieldType.MEMO
                    chars := CHAR[] {++mlength}
                    SELF:RDD:_CheckError(ACE.AdsGetString(SELF:_Table, SELF:FieldPos, chars, REF mlength ,0),EG_READ)
                    RETURN SELF:RDD:_Ansi2Unicode(chars, (INT) mlength)
                CASE AdsFieldType.NMEMO
                    chars := CHAR[] {++mlength}
                    SELF:RDD:_CheckError(ACE.AdsGetStringW(SELF:_Table, SELF:FieldPos, chars, REF mlength ,0),EG_READ)
                    return String{chars,0, (int)mlength-1}
                CASE AdsFieldType.BINARY
                CASE AdsFieldType.IMAGE
                    bytes := BYTE[] {mlength}
                    SELF:RDD:_CheckError(ACE.AdsGetBinary(SELF:_Table, SELF:FieldPos, 0, bytes, REF mlength ),EG_READ)
                    RETURN bytes
                END SWITCH

            CASE AdsFieldType.RAW
            CASE AdsFieldType.VARBINARY_FOX
                result := ACE.AdsIsEmpty(SELF:_Table, SELF:FieldPos, OUT isEmpty)
                IF result == 0
                    IF isEmpty == 1
                        RETURN NULL
                    ENDIF
                ELSE
                    SELF:RDD:_CheckError(result,EG_READ)
                ENDIF
                mlength := (DWORD) SELF:Length
                bytes := BYTE[] {mlength}
                SELF:RDD:_CheckError(ACE.AdsGetBinary(SELF:_Table, SELF:FieldPos, 0, bytes, REF mlength ),EG_READ)
                RETURN bytes
            OTHERWISE
                // Should never happen. We filter on the type when creating the column object
                SELF:RDD:ADSERROR(ERDD_DATATYPE, EG_DATATYPE, __ENTITY__,"Unexpected fieldtype: "+SELF:AdsType:ToString())
            END SWITCH
            RETURN NULL

        OVERRIDE METHOD PutValue(oValue AS OBJECT) AS LOGIC
            IF oValue == NULL
                RETURN SELF:PutNull()
            ENDIF
            LOCAL result := 0 AS DWORD
            LOCAL slength AS DWORD
            LOCAL strValue AS STRING
            VAR tc := Type.GetTypeCode(oValue:GetType())
            SWITCH SELF:AdsType
            CASE AdsFieldType.MEMO
            CASE AdsFieldType.NMEMO
                IF tc != TypeCode.String
                    SELF:RDD:ADSERROR(ERDD_DATATYPE, EG_DATATYPE, __ENTITY__,"String expected")
                ENDIF
                strValue := (STRING) oValue
                slength  := (DWORD) strValue:Length
                IF slength == 0
                    result := ACE.AdsSetEmpty(SELF:_Table, SELF:FieldPos)
                ELSE
                    IF SELF:AdsType == AdsFieldType.NMEMO
                        result := ACE.AdsSetStringW(SELF:_Table, SELF:FieldPos, strValue, slength)
                    ELSE
                        result := ACE.AdsSetString(SELF:_Table, SELF:FieldPos, strValue, slength)
                    ENDIF
                ENDIF
            CASE AdsFieldType.BINARY
            CASE AdsFieldType.IMAGE
            CASE AdsFieldType.RAW
            CASE AdsFieldType.VARBINARY_FOX
                IF tc != TypeCode.String .AND. tc != TypeCode.Object
                    SELF:RDD:ADSERROR(ERDD_DATATYPE, EG_DATATYPE, __ENTITY__,"String or Object expected")
                ENDIF
                IF tc != TypeCode.String
                    strValue := (STRING) oValue
                    slength := (DWORD) strValue:Length
                    result := ACE.AdsSetString(SELF:_Table, SELF:FieldPos, strValue, slength)
                ELSE
                    LOCAL bytes AS BYTE[]
                    bytes   := (BYTE[]) oValue
                    slength  := (DWORD) bytes:Length
                    IF SELF:AdsType == AdsFieldType.RAW .OR. SELF:AdsType == AdsFieldType.VARBINARY_FOX
                        result := ACE.AdsSetField(SELF:_Table, SELF:FieldPos, bytes, slength)
                    ELSE
                        result := ACE.AdsSetBinary(SELF:_Table, SELF:FieldPos, SELF:AdsType, slength, 0, bytes, slength)
                    ENDIF
                ENDIF
            OTHERWISE
                // Should never happen. We filter on the type when creating the column object
                SELF:RDD:ADSERROR(ERDD_DATATYPE, EG_DATATYPE, __ENTITY__,"Unexpected fieldtype: "+SELF:AdsType:ToString())
            END SWITCH
            IF result != 0 .AND. result != ACE.AE_DATA_TRUNCATED
                SELF:RDD:ADSERROR(result, EG_WRITE, __ENTITY__)
            ENDIF
            RETURN TRUE

       OVERRIDE METHOD Validate() AS LOGIC
            RETURN SELF:Length == 10 .AND.  SELF:Decimals == 0

    END CLASS

END NAMESPACE


use the 'Wagon' terminology from the paper

-- item notation

-- basic: http://www.cedar-forest.org/forest/talks/talks2001/talkPPDP2001.ps
-- extended: http://www.cedar-forest.org/forest/talks/talks2001/microsoft.ps

import "LabeledDeBruijn.prg"

data Itm :: Inventory Tag ~> * where
  -- applicator wagon
  AppW :: Itm inv -> Itm inv -> Itm inv
  -- abstractor wagon
  AbsW :: Label n -> Itm [inv; n]i -> Itm inv
  -- argument access
  IArg :: Itm [ups; t]i
  IUp :: Itm [ups; t]i -> Itm [ups; t, t']i
 deriving syntax (it) Nat(IArg, IUp)

iota :: Tm inv -> Itm inv
iota Arg = IArg
iota (Up m) = IUp (iota m)
iota (Up m) = IUp (iota m)
iota (Lm n b) = AbsW n (iota b)
iota (App f a) = AppW (iota a) (iota f)

slide1 = iota (Lm `x (Lm `y (1tm,0tm)tm), 0tm)tm  -- assuming `z = 0tm

-- ok now, lets drift to thrists

data Wagon :: Inventory Tag ~> Inventory Tag ~> * where
  AppI :: Wagon inv inv -> Wagon inv inv
  AbsI :: Label n -> Wagon [inv; n]i inv
  ArgI :: Wagon [ups; t]i [ups; t]i
  UpI :: Wagon [ups; t]i [ups; t]i -> Wagon [ups; t, t']i [ups; t, t']i
 deriving syntax (w) Nat(ArgI, UpI) Item(AppI)

data Thrist :: forall (l :: *1) . (l ~> l ~> *)  ~> l ~> l ~> * where
  Nil :: Thrist k a a
  Cons :: k a b -> Thrist k b c -> Thrist k a c
 deriving List(l)


[RDD} Delim now no longer deleted comma's from text field. It does deleted embedded quotes

//
// Copyright (c) XSharp B.V.  All Rights Reserved.
// Licensed under the Apache License, Version 2.0.
// See License.txt in the project root for license information.
//
using System.Collections.Generic
using System.Text
USING XSharp.RDD.Support
USING XSharp.RDD.Enums
BEGIN NAMESPACE XSharp.RDD
    /// TSV RDD. For reading and writing tab delimited files.
    CLASS TSV INHERIT CSV
        CONSTRUCTOR
            SUPER()
            SELF:_Separator := Chr(9)
    END CLASS

    /// CSV RDD. For reading and writing semicolon delimited files.
    CLASS CSV INHERIT DELIM
        CONSTRUCTOR
            SUPER()
            SELF:_Separator := ";"

    METHOD Create(info AS DbOpenInfo) AS LOGIC
        local lOk as LOGIC
        LOCAL oSb as StringBuilder
        lOk := SUPER:Create(info)
        IF lOk
            // Write field headers to CSV file.
            oSb := StringBuilder{}
            FOREACH var fld in SELF:_Fields
                if String.IsNullOrEmpty(fld:Alias)
                    oSb:Append(fld:Name)
                else
                    oSb:Append(fld:Alias)
                endif
                oSb:Append(SELF:_Separator)
            NEXT
            var result := oSb:ToString()
            result := result:Substring(0, result:Length-1) +SELF:_RecordSeparator
            SELF:_WriteString(result)
        ENDIF
        RETURN lOk
    END CLASS

/// DELIM RDD. For reading and writing delimited files.
    CLASS DELIM INHERIT TEXTRDD
        CONSTRUCTOR
            SUPER()

        VIRTUAL PROPERTY Driver AS STRING GET "DELIM"

        PROTECTED METHOD _WriteRecord() AS LOGIC STRICT
            LOCAL oSb as StringBuilder
            LOCAL nIndex as LONG
            LOCAL hasDelimiter as LOGIC
            oSb := StringBuilder{}
            nIndex := 0
            hasDelimiter := ! String.IsNullOrEmpty(SELF:_Delimiter)
            FOREACH var oField in SELF:_Fields
                var oValue := SELF:_fieldData[nIndex]
                var sValue := SELF:_GetFieldValue(oField, oValue)
                if nIndex > 0
                    oSb:Append(SELF:_Separator)
                endif
                SWITCH oField:FieldType
                CASE DbFieldType.Character   // C
                CASE DbFieldType.VarChar     // 'V'
                CASE DbFieldType.VarBinary   // 'Q'
                    if hasDelimiter
                        oSb:Append(_Delimiter)
                    endif
                    oSb:Append(sValue:Replace(_Delimiter,""))
                    if hasDelimiter
                        oSb:Append(_Delimiter)
                    endif
                CASE DbFieldType.Number         // 'N'
                CASE DbFieldType.Float          // 'F'
                CASE DbFieldType.Double         // 'B'
                CASE DbFieldType.Currency		// 'Y'
                CASE DbFieldType.Integer        // 'I'
                    oSb:Append(sValue:Trim())
                Otherwise
                    oSb:Append(sValue:Replace(_Separator,""))
                END SWITCH
                nIndex += 1
            NEXT
            oSb:Append(SELF:_RecordSeparator)
            SELF:_WriteString(oSb:ToString())
            RETURN TRUE

        PROTECTED METHOD _GetLastRec AS LONG
            LOCAL dwPos     AS DWORD
            LOCAL nCount := 0 AS LONG
            dwPos := FTell(SELF:_hFile)
            FSeek3(SELF:_hFile, 0, FS_SET)
            DO WHILE ! FEof(SELF:_hFile)
                nCount++
                FReadLine(SELF:_hFile, 4096)
            ENDDO
            FSeek3(SELF:_hFile, (LONG) dwPos, FS_SET)
            RETURN nCount

    END CLASS
END NAMESPACE

//
// Copyright (c) XSharp B.V.  All Rights Reserved.
// Licensed under the Apache License, Version 2.0.
// See License.txt in the project root for license information.
//
using System.Collections.Generic
using System.Text
USING XSharp.RDD.Support
USING XSharp.RDD.Enums
BEGIN NAMESPACE XSharp.RDD
    /// TSV RDD. For reading and writing tab delimited files.
    CLASS TSV INHERIT CSV
        CONSTRUCTOR
            SUPER()
            SELF:_Separator := Chr(9)
    END CLASS

    /// CSV RDD. For reading and writing semicolon delimited files.
    CLASS CSV INHERIT DELIM
        CONSTRUCTOR
            SUPER()
            SELF:_Separator := ";"

    METHOD Create(info AS DbOpenInfo) AS LOGIC
        local lOk as LOGIC
        LOCAL oSb as StringBuilder
        lOk := SUPER:Create(info)
        IF lOk
            // Write field headers to CSV file.
            oSb := StringBuilder{}
            FOREACH var fld in SELF:_Fields
                if String.IsNullOrEmpty(fld:Alias)
                    oSb:Append(fld:Name)
                else
                    oSb:Append(fld:Alias)
                endif
                oSb:Append(SELF:_Separator)
            NEXT
            var result := oSb:ToString()
            result := result:Substring(0, result:Length-1) +SELF:_RecordSeparator
            SELF:_WriteString(result)
        ENDIF
        RETURN lOk
    END CLASS

/// DELIM RDD. For reading and writing delimited files.
    CLASS DELIM INHERIT TEXTRDD
        CONSTRUCTOR
            SUPER()

        VIRTUAL PROPERTY Driver AS STRING GET "DELIM"

        PROTECTED METHOD _WriteRecord() AS LOGIC STRICT
            LOCAL oSb as StringBuilder
            LOCAL nIndex as LONG
            LOCAL hasDelimiter as LOGIC
            oSb := StringBuilder{}
            nIndex := 0
            hasDelimiter := ! String.IsNullOrEmpty(SELF:_Delimiter)
            FOREACH var oField in SELF:_Fields
                var oValue := SELF:_fieldData[nIndex]
                var sValue := SELF:_GetFieldValue(oField, oValue)
                if nIndex > 0
                    oSb:Append(SELF:_Separator)
                endif
                SWITCH oField:FieldType
                CASE DbFieldType.Character   // C
                CASE DbFieldType.VarChar     // 'V'
                CASE DbFieldType.VarBinary   // 'Q'
                    if hasDelimiter
                        oSb:Append(_Delimiter)
                    endif
                    oSb:Append(sValue:Replace(_Separator,""))
                    if hasDelimiter
                        oSb:Append(_Delimiter)
                    endif
                CASE DbFieldType.Number         // 'N'
                CASE DbFieldType.Float          // 'F'
                CASE DbFieldType.Double         // 'B'
                CASE DbFieldType.Currency		// 'Y'
                CASE DbFieldType.Integer        // 'I'
                    oSb:Append(sValue:Trim())
                Otherwise
                    oSb:Append(sValue:Replace(_Separator,""))
                END SWITCH
                nIndex += 1
            NEXT
            oSb:Append(SELF:_RecordSeparator)
            SELF:_WriteString(oSb:ToString())
            RETURN TRUE

        PROTECTED METHOD _GetLastRec AS LONG
            LOCAL dwPos     AS DWORD
            LOCAL nCount := 0 AS LONG
            dwPos := FTell(SELF:_hFile)
            FSeek3(SELF:_hFile, 0, FS_SET)
            DO WHILE ! FEof(SELF:_hFile)
                nCount++
                FReadLine(SELF:_hFile, 4096)
            ENDDO
            FSeek3(SELF:_hFile, (LONG) dwPos, FS_SET)
            RETURN nCount

    END CLASS
END NAMESPACE


codegen/QtX11Extras: updated

codegen/QtX11Extras: updated

Modified:
codegen/QtX11Extras/QX11Info.prg

%%
%% Qt5xHb - Bindings libraries for Harbour/xHarbour and Qt Framework 5
%%
%% Copyright (C) 2018 Marcos Antonio Gambeta <marcosgambeta AT outlook DOT com>
%%

$header

#include "hbclass.ch"

$addRequests

$beginClassFrom=

$addMethods

$endClass

$destructor

#pragma BEGINDUMP

$includes=5,1,0

$deleteMethod=5,1,0

$prototype=static bool isPlatformX11()
$staticMethod=5,1,0|bool|isPlatformX11|

$prototype=static int appDpiX(int screen=-1)
$staticMethod=5,1,0|int|appDpiX|int=-1

$prototype=static int appDpiY(int screen=-1)
$staticMethod=5,1,0|int|appDpiY|int=-1

$prototype=static unsigned long appRootWindow(int screen=-1)
$staticMethod=5,1,0|unsigned long|appRootWindow|int=-1

$prototype=static int appScreen()
$staticMethod=5,1,0|int|appScreen|

$prototype=static unsigned long appTime()
$staticMethod=5,1,0|unsigned long|appTime|

$prototype=static unsigned long appUserTime()
$staticMethod=5,1,0|unsigned long|appUserTime|

$prototype=static void setAppTime(unsigned long time)
$staticMethod=5,1,0|void|setAppTime|unsigned long

$prototype=static void setAppUserTime(unsigned long time)
$staticMethod=5,1,0|void|setAppUserTime|unsigned long

$prototype=static unsigned long getTimestamp()
$staticMethod=5,1,0|unsigned long|getTimestamp|

$prototype=static Display *display()
$staticMethod=5,1,0|Display *|display|

$prototype=static xcb_connection_t *connection()
$staticMethod=5,1,0|xcb_connection_t *|connection|

$prototype=static QByteArray nextStartupId()
$staticMethod=5,1,0|QByteArray|nextStartupId|

$prototype=static void setNextStartupId(const QByteArray &id)
$staticMethod=5,1,0|void|setNextStartupId|const QByteArray &

$extraMethods

#pragma ENDDUMP

%%
%% Qt5xHb - Bindings libraries for Harbour/xHarbour and Qt Framework 5
%%
%% Copyright (C) 2018 Marcos Antonio Gambeta <marcosgambeta AT outlook DOT com>
%%

$header

#include "hbclass.ch"

$addRequests

$beginClassFrom=

$addMethods

$endClass

$destructor

#pragma BEGINDUMP

$includes=5,1,0

$deleteMethod=5,1,0

$prototype=static bool isPlatformX11()
HB_FUNC_STATIC( QX11INFO_ISPLATFORMX11 )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  RBOOL( QX11Info::isPlatformX11 () );
#endif
}

$prototype=static int appDpiX(int screen=-1)
HB_FUNC_STATIC( QX11INFO_APPDPIX )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  RINT( QX11Info::appDpiX ( OPINT(1,-1) ) );
#endif
}

$prototype=static int appDpiY(int screen=-1)
HB_FUNC_STATIC( QX11INFO_APPDPIY )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  RINT( QX11Info::appDpiY ( OPINT(1,-1) ) );
#endif
}

$prototype=static unsigned long appRootWindow(int screen=-1)
HB_FUNC_STATIC( QX11INFO_APPROOTWINDOW )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retnl( QX11Info::appRootWindow ( OPINT(1,-1) ) );
#endif
}

$prototype=static int appScreen()
HB_FUNC_STATIC( QX11INFO_APPSCREEN )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  RINT( QX11Info::appScreen () );
#endif
}

$prototype=static unsigned long appTime()
HB_FUNC_STATIC( QX11INFO_APPTIME )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retnl( QX11Info::appTime () );
#endif
}

$prototype=static unsigned long appUserTime()
HB_FUNC_STATIC( QX11INFO_APPUSERTIME )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retnl( QX11Info::appUserTime () );
#endif
}

$prototype=static void setAppTime(unsigned long time)
HB_FUNC_STATIC( QX11INFO_SETAPPTIME )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  unsigned long par1 = hb_parnl(1);
  QX11Info::setAppTime ( par1 );
  hb_itemReturn( hb_stackSelfItem() );
#endif
}

$prototype=static void setAppUserTime(unsigned long time)
HB_FUNC_STATIC( QX11INFO_SETAPPUSERTIME )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  unsigned long par1 = hb_parnl(1);
  QX11Info::setAppUserTime ( par1 );
  hb_itemReturn( hb_stackSelfItem() );
#endif
}

$prototype=static unsigned long getTimestamp()
HB_FUNC_STATIC( QX11INFO_GETTIMESTAMP )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retnl( QX11Info::getTimestamp () );
#endif
}

$prototype=static Display *display()
HB_FUNC_STATIC( QX11INFO_DISPLAY )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retptr( (Display *) QX11Info::display () );
#endif
}

$prototype=static xcb_connection_t *connection()
HB_FUNC_STATIC( QX11INFO_CONNECTION )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  hb_retptr( (xcb_connection_t *) QX11Info::connection () );
#endif
}

$prototype=static QByteArray nextStartupId()
HB_FUNC_STATIC( QX11INFO_NEXTSTARTUPID )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  QByteArray * ptr = new QByteArray( QX11Info::nextStartupId () );
  _qt5xhb_createReturnClass ( ptr, "QBYTEARRAY" );
#endif
}

$prototype=static void setNextStartupId(const QByteArray &id)
HB_FUNC_STATIC( QX11INFO_SETNEXTSTARTUPID )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,1,0))
  QX11Info::setNextStartupId ( *PQBYTEARRAY(1) );
  hb_itemReturn( hb_stackSelfItem() );
#endif
}

$extraMethods

#pragma ENDDUMP


QtPositioning: module updated to use ISOPTNUM

/*

  Qt5xHb - bibliotecas de ligao entre Harbour/xHarbour e Qt Framework 5

  Copyright (C) 2012-2017 Marcos Antonio Gambeta <marcosgambeta@uol.com.br>

*/

#include "hbclass.ch"
#include "qt5xhb_clsid.ch"

#ifndef QT5XHB_NO_REQUESTS
REQUEST QGEOCOORDINATE
#endif

CLASS QGeoCircle INHERIT QGeoShape

   DATA class_id INIT Class_Id_QGeoCircle
   DATA class_flags INIT 0
   DATA self_destruction INIT .F.

   METHOD new1
   METHOD new2
   METHOD new3
   METHOD new4
   METHOD new
   METHOD delete
   METHOD setCenter
   METHOD center
   METHOD setRadius
   METHOD radius
   METHOD translate
   METHOD translated

   DESTRUCTOR destroyObject

END CLASS

PROCEDURE destroyObject () CLASS QGeoCircle
   IF ::self_destruction
      ::delete()
   ENDIF
RETURN

#pragma BEGINDUMP

#include <Qt>

#ifndef __XHARBOUR__
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
#include <QGeoCircle>
#endif
#endif

#include "qt5xhb_common.h"
#include "qt5xhb_clsid.h"
#include "qt5xhb_utils.h"

#ifdef __XHARBOUR__
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
#include <QGeoCircle>
#endif
#endif

/*
QGeoCircle()
*/
HB_FUNC_STATIC( QGEOCIRCLE_NEW1 )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QGeoCircle * o = new QGeoCircle (  );
  _qt5xhb_storePointerAndFlag( o, true );
#endif
}

/*
QGeoCircle(const QGeoCoordinate &center, qreal radius = -1.0)
*/
HB_FUNC_STATIC( QGEOCIRCLE_NEW2 )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QGeoCoordinate * par1 = (QGeoCoordinate *) _qt5xhb_itemGetPtr(1);
  qreal par2 = ISNIL(2)? -1.0 : hb_parnd(2);
  QGeoCircle * o = new QGeoCircle ( *par1, par2 );
  _qt5xhb_storePointerAndFlag( o, true );
#endif
}

/*
QGeoCircle(const QGeoCircle &other)
*/
HB_FUNC_STATIC( QGEOCIRCLE_NEW3 )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QGeoCircle * par1 = (QGeoCircle *) _qt5xhb_itemGetPtr(1);
  QGeoCircle * o = new QGeoCircle ( *par1 );
  _qt5xhb_storePointerAndFlag( o, true );
#endif
}

/*
QGeoCircle(const QGeoShape &other)
*/
HB_FUNC_STATIC( QGEOCIRCLE_NEW4 )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QGeoShape * par1 = (QGeoShape *) _qt5xhb_itemGetPtr(1);
  QGeoCircle * o = new QGeoCircle ( *par1 );
  _qt5xhb_storePointerAndFlag( o, true );
#endif
}

//[1]QGeoCircle()
//[2]QGeoCircle(const QGeoCoordinate &center, qreal radius = -1.0)
//[3]QGeoCircle(const QGeoCircle &other)
//[4]QGeoCircle(const QGeoShape &other)

HB_FUNC_STATIC( QGEOCIRCLE_NEW )
{
  if( ISNUMPAR(0) )
  {
    HB_FUNC_EXEC( QGEOCIRCLE_NEW1 );
  }
  else if( ISBETWEEN(1,2) && ISQGEOCOORDINATE(1) && ISOPTNUM(2) )
  {
    HB_FUNC_EXEC( QGEOCIRCLE_NEW2 );
  }
  else if( ISNUMPAR(1) && ISQGEOCIRCLE(1) )
  {
    HB_FUNC_EXEC( QGEOCIRCLE_NEW3 );
  }
  else if( ISNUMPAR(1) && ISQGEOSHAPE(1) )
  {
    HB_FUNC_EXEC( QGEOCIRCLE_NEW4 );
  }
  else
  {
    hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
  }
}

HB_FUNC_STATIC( QGEOCIRCLE_DELETE )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QGeoCircle * obj = (QGeoCircle *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );
  if( obj )
  {
    delete obj;
    obj = NULL;
    PHB_ITEM self = hb_stackSelfItem();
    PHB_ITEM ptr = hb_itemPutPtr( NULL, NULL );
    hb_objSendMsg( self, "_pointer", 1, ptr );
    hb_itemRelease( ptr );
  }
  hb_itemReturn( hb_stackSelfItem() );
#endif
}

/*
void setCenter(const QGeoCoordinate &center)
*/
HB_FUNC_STATIC( QGEOCIRCLE_SETCENTER )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QGeoCircle * obj = (QGeoCircle *) _qt5xhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    QGeoCoordinate * par1 = (QGeoCoordinate *) _qt5xhb_itemGetPtr(1);
    obj->setCenter ( *par1 );
  }
  hb_itemReturn( hb_stackSelfItem() );
#endif
}

/*
QGeoCoordinate center() const
*/
HB_FUNC_STATIC( QGEOCIRCLE_CENTER )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QGeoCircle * obj = (QGeoCircle *) _qt5xhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    QGeoCoordinate * ptr = new QGeoCoordinate( obj->center (  ) );
    _qt5xhb_createReturnClass ( ptr, "QGEOCOORDINATE", true );
  }
#endif
}

/*
void setRadius(qreal radius)
*/
HB_FUNC_STATIC( QGEOCIRCLE_SETRADIUS )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QGeoCircle * obj = (QGeoCircle *) _qt5xhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    qreal par1 = hb_parnd(1);
    obj->setRadius ( par1 );
  }
  hb_itemReturn( hb_stackSelfItem() );
#endif
}

/*
qreal radius() const
*/
HB_FUNC_STATIC( QGEOCIRCLE_RADIUS )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QGeoCircle * obj = (QGeoCircle *) _qt5xhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    hb_retnd( obj->radius (  ) );
  }
#endif
}

/*
void translate(double degreesLatitude, double degreesLongitude)
*/
HB_FUNC_STATIC( QGEOCIRCLE_TRANSLATE )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QGeoCircle * obj = (QGeoCircle *) _qt5xhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    double par1 = hb_parnd(1);
    double par2 = hb_parnd(2);
    obj->translate ( par1, par2 );
  }
  hb_itemReturn( hb_stackSelfItem() );
#endif
}

/*
QGeoCircle translated(double degreesLatitude, double degreesLongitude) const
*/
HB_FUNC_STATIC( QGEOCIRCLE_TRANSLATED )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QGeoCircle * obj = (QGeoCircle *) _qt5xhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    double par1 = hb_parnd(1);
    double par2 = hb_parnd(2);
    QGeoCircle * ptr = new QGeoCircle( obj->translated ( par1, par2 ) );
    _qt5xhb_createReturnClass ( ptr, "QGEOCIRCLE", true );
  }
#endif
}

#pragma ENDDUMP

/*

  Qt5xHb - bibliotecas de ligao entre Harbour/xHarbour e Qt Framework 5

  Copyright (C) 2012-2017 Marcos Antonio Gambeta <marcosgambeta@uol.com.br>

*/

#include "hbclass.ch"
#include "qt5xhb_clsid.ch"

#ifndef QT5XHB_NO_REQUESTS
REQUEST QGEOCOORDINATE
#endif

CLASS QGeoCircle INHERIT QGeoShape

   DATA class_id INIT Class_Id_QGeoCircle
   DATA class_flags INIT 0
   DATA self_destruction INIT .F.

   METHOD new1
   METHOD new2
   METHOD new3
   METHOD new4
   METHOD new
   METHOD delete
   METHOD setCenter
   METHOD center
   METHOD setRadius
   METHOD radius
   METHOD translate
   METHOD translated

   DESTRUCTOR destroyObject

END CLASS

PROCEDURE destroyObject () CLASS QGeoCircle
   IF ::self_destruction
      ::delete()
   ENDIF
RETURN

#pragma BEGINDUMP

#include <Qt>

#ifndef __XHARBOUR__
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
#include <QGeoCircle>
#endif
#endif

#include "qt5xhb_common.h"
#include "qt5xhb_clsid.h"
#include "qt5xhb_utils.h"

#ifdef __XHARBOUR__
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
#include <QGeoCircle>
#endif
#endif

/*
QGeoCircle()
*/
HB_FUNC_STATIC( QGEOCIRCLE_NEW1 )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QGeoCircle * o = new QGeoCircle (  );
  _qt5xhb_storePointerAndFlag( o, true );
#endif
}

/*
QGeoCircle(const QGeoCoordinate &center, qreal radius = -1.0)
*/
HB_FUNC_STATIC( QGEOCIRCLE_NEW2 )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QGeoCoordinate * par1 = (QGeoCoordinate *) _qt5xhb_itemGetPtr(1);
  qreal par2 = ISNIL(2)? -1.0 : hb_parnd(2);
  QGeoCircle * o = new QGeoCircle ( *par1, par2 );
  _qt5xhb_storePointerAndFlag( o, true );
#endif
}

/*
QGeoCircle(const QGeoCircle &other)
*/
HB_FUNC_STATIC( QGEOCIRCLE_NEW3 )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QGeoCircle * par1 = (QGeoCircle *) _qt5xhb_itemGetPtr(1);
  QGeoCircle * o = new QGeoCircle ( *par1 );
  _qt5xhb_storePointerAndFlag( o, true );
#endif
}

/*
QGeoCircle(const QGeoShape &other)
*/
HB_FUNC_STATIC( QGEOCIRCLE_NEW4 )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QGeoShape * par1 = (QGeoShape *) _qt5xhb_itemGetPtr(1);
  QGeoCircle * o = new QGeoCircle ( *par1 );
  _qt5xhb_storePointerAndFlag( o, true );
#endif
}

//[1]QGeoCircle()
//[2]QGeoCircle(const QGeoCoordinate &center, qreal radius = -1.0)
//[3]QGeoCircle(const QGeoCircle &other)
//[4]QGeoCircle(const QGeoShape &other)

HB_FUNC_STATIC( QGEOCIRCLE_NEW )
{
  if( ISNUMPAR(0) )
  {
    HB_FUNC_EXEC( QGEOCIRCLE_NEW1 );
  }
  else if( ISBETWEEN(1,2) && ISQGEOCOORDINATE(1) && (ISNUM(2)||ISNIL(2)) )
  {
    HB_FUNC_EXEC( QGEOCIRCLE_NEW2 );
  }
  else if( ISNUMPAR(1) && ISQGEOCIRCLE(1) )
  {
    HB_FUNC_EXEC( QGEOCIRCLE_NEW3 );
  }
  else if( ISNUMPAR(1) && ISQGEOSHAPE(1) )
  {
    HB_FUNC_EXEC( QGEOCIRCLE_NEW4 );
  }
  else
  {
    hb_errRT_BASE( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
  }
}

HB_FUNC_STATIC( QGEOCIRCLE_DELETE )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QGeoCircle * obj = (QGeoCircle *) hb_itemGetPtr( hb_objSendMsg( hb_stackSelfItem(), "POINTER", 0 ) );
  if( obj )
  {
    delete obj;
    obj = NULL;
    PHB_ITEM self = hb_stackSelfItem();
    PHB_ITEM ptr = hb_itemPutPtr( NULL, NULL );
    hb_objSendMsg( self, "_pointer", 1, ptr );
    hb_itemRelease( ptr );
  }
  hb_itemReturn( hb_stackSelfItem() );
#endif
}

/*
void setCenter(const QGeoCoordinate &center)
*/
HB_FUNC_STATIC( QGEOCIRCLE_SETCENTER )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QGeoCircle * obj = (QGeoCircle *) _qt5xhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    QGeoCoordinate * par1 = (QGeoCoordinate *) _qt5xhb_itemGetPtr(1);
    obj->setCenter ( *par1 );
  }
  hb_itemReturn( hb_stackSelfItem() );
#endif
}

/*
QGeoCoordinate center() const
*/
HB_FUNC_STATIC( QGEOCIRCLE_CENTER )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QGeoCircle * obj = (QGeoCircle *) _qt5xhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    QGeoCoordinate * ptr = new QGeoCoordinate( obj->center (  ) );
    _qt5xhb_createReturnClass ( ptr, "QGEOCOORDINATE", true );
  }
#endif
}

/*
void setRadius(qreal radius)
*/
HB_FUNC_STATIC( QGEOCIRCLE_SETRADIUS )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QGeoCircle * obj = (QGeoCircle *) _qt5xhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    qreal par1 = hb_parnd(1);
    obj->setRadius ( par1 );
  }
  hb_itemReturn( hb_stackSelfItem() );
#endif
}

/*
qreal radius() const
*/
HB_FUNC_STATIC( QGEOCIRCLE_RADIUS )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QGeoCircle * obj = (QGeoCircle *) _qt5xhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    hb_retnd( obj->radius (  ) );
  }
#endif
}

/*
void translate(double degreesLatitude, double degreesLongitude)
*/
HB_FUNC_STATIC( QGEOCIRCLE_TRANSLATE )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QGeoCircle * obj = (QGeoCircle *) _qt5xhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    double par1 = hb_parnd(1);
    double par2 = hb_parnd(2);
    obj->translate ( par1, par2 );
  }
  hb_itemReturn( hb_stackSelfItem() );
#endif
}

/*
QGeoCircle translated(double degreesLatitude, double degreesLongitude) const
*/
HB_FUNC_STATIC( QGEOCIRCLE_TRANSLATED )
{
#if (QT_VERSION >= QT_VERSION_CHECK(5,2,0))
  QGeoCircle * obj = (QGeoCircle *) _qt5xhb_itemGetPtrStackSelfItem();
  if( obj )
  {
    double par1 = hb_parnd(1);
    double par2 = hb_parnd(2);
    QGeoCircle * ptr = new QGeoCircle( obj->translated ( par1, par2 ) );
    _qt5xhb_createReturnClass ( ptr, "QGEOCIRCLE", true );
  }
#endif
}

#pragma ENDDUMP