// FiveWin VBX Visual Basic Controls support !!!

#pragma option -WDE

#include <WinTen.h>
#include <Windows.h>
#include <dos.h>
#include <ClipApi.h>
#include <VbApi.h>

typedef BOOL ( far pascal * VBINIT )( WORD, BOOL );

extern HANDLE  __hInstance;
extern FARPROC VbxServer;

static LPSTR Properties[] = { "CtlName", "Index", "BackColor", "ForeColor",
                              "Left", "Top", "Width", "Height", "Enabled",
                              "Visible", "MousePointer", "Caption", "FontName",
                              "FontBold", "FontItalic", "FontStrike",
                              "FontUnder", "FontSize", "TabIndex", "Parent",
                              "DragMode", "DragIcon", "BorderStyleOff",
                              "TabStop", "Tag", "Text", "BorderStyleOn" };

static LPSTR Methods[] =    { "Click", "DblClick", "DragDrop", "DragOver",
                              "GotFocus", "KeyDown", "KeyPress", "KeyUp",
                              "LostFocus", "MouseDown", "MouseMove", "MouseUp" };

static FARPROC VbxFuncs[] = { ( FARPROC ) VBRegisterModel,
                              ( FARPROC ) VBDerefControl,
                              ( FARPROC ) VBDefControlProc,
                              ( FARPROC ) VBFireEvent,
                              ( FARPROC ) VBSetControlProperty,
                              ( FARPROC ) VBGetControlProperty,
                              ( FARPROC ) VBCreateHsz,
                              ( FARPROC ) VBDestroyHsz,
                              ( FARPROC ) VBDerefHsz,
                              ( FARPROC ) VBLockHsz,
                              ( FARPROC ) VBUnlockHsz,
                              ( FARPROC ) VBGetControlHwnd,
                              ( FARPROC ) VBRecreateControlHwnd,
                              ( FARPROC ) VBGetControlModel,
                              ( FARPROC ) VBSendControlMsg,
                              ( FARPROC ) VBReadFormFile,
                              ( FARPROC ) VBWriteFormFile,
                              ( FARPROC ) VBSuperControlProc,
                              ( FARPROC ) VBGetMode,
                              ( FARPROC ) VBGetHInstance,
                              ( FARPROC ) VBCreateHlstr,
                              ( FARPROC ) VBSetHlstr,
                              ( FARPROC ) VBDestroyHlstr,
                              ( FARPROC ) VBDerefHlstr,
                              ( FARPROC ) VBGetHlstrLen,
                              ( FARPROC ) VBGetHwndControl,
                              ( FARPROC ) VBXPixelsToTwips,
                              ( FARPROC ) VBYPixelsToTwips,
                              ( FARPROC ) VBXTwipsToPixels,
                              ( FARPROC ) VBYTwipsToPixels,
                              ( FARPROC ) VBReadBasicFile,
                              ( FARPROC ) VBWriteBasicFile,
                              ( FARPROC ) VBAllocPic,
                              ( FARPROC ) VBFreePic,
                              ( FARPROC ) VBGetPic,
                              ( FARPROC ) VBRefPic,
                              ( FARPROC ) VBPicFromCF,
                              ( FARPROC ) VBSetErrorMessage,
                              ( FARPROC ) VBGetAppTitle,
                              ( FARPROC ) VBDialogBoxParam,
                              ( FARPROC ) VBSeekFormFile,
                              ( FARPROC ) VBRelSeekFormFile,
                              ( FARPROC ) VBGetControlName };

typedef struct
{
   LPMODEL lpModel;
   HWND    hWnd;
   FARPROC VbxProc;
} CTL;

// Ojo tiene que ser far
// porque la vamos a manipular con el DS cambiado por el de la DLL

static far LPMODEL lpModel;

//----------------------------------------------------------------------------//

BOOL FAR PASCAL VBRegisterModel( HANDLE hmod, LPMODEL lpmodel )
{
   lpModel = lpmodel;

   return TRUE;
}

//----------------------------------------------------------------------------//

LPVOID  FAR PASCAL VBDerefControl(HCTL hctl)
{
   return 0;
}

//----------------------------------------------------------------------------//

LONG FAR PASCAL VBDefControlProc( HCTL hctl, HWND hwnd, USHORT msg, USHORT wp, LONG lp)
{
   MessageBeep( 1 );

   return DefWindowProc( hwnd, msg, wp, lp );
}

//----------------------------------------------------------------------------//

HWND    FAR PASCAL VBGetControlHwnd(HCTL hctl)
{
   return 0;
}

HANDLE  FAR PASCAL VBGetHInstance(VOID)
{
   return 0;
}

LPMODEL FAR PASCAL VBGetControlModel(HCTL hctl)
{
   return 0;
}

LPSTR   FAR PASCAL VBGetControlName(HCTL hctl, LPSTR lpszName)
{
   return 0;
}

HCTL    FAR PASCAL VBGetHwndControl( HWND hwnd )
{
   return 0;
}

LONG    FAR PASCAL VBSendControlMsg(HCTL hctl, USHORT msg, USHORT wp, LONG lp)
{
   return 0;
}

LONG    FAR PASCAL VBSuperControlProc(HCTL hctl, USHORT msg, USHORT wp, LONG lp)
{
   return 0;
}

USHORT  FAR PASCAL VBGetMode (VOID)
{
   return 1;
}

ERR     FAR PASCAL VBRecreateControlHwnd(HCTL hctl)
{
   return 0;
}

VOID    FAR PASCAL VBDirtyForm(HCTL hctl)
{
   return 0;
}

ERR     FAR PASCAL VBSetErrorMessage(ERR err, LPSTR lpstr)
{
   return 0;
}

VOID    FAR PASCAL VBGetAppTitle(LPSTR lpstr, USHORT cbMax)
{
   return 0;
}

int     FAR PASCAL VBDialogBoxParam(HANDLE hinst, LPSTR pszTemplateName, FARPROC lpDialogFunc, LONG lp)
{
   return 0;
}

// Management of dynamically allocated strings

HSZ     FAR PASCAL VBCreateHsz(HANDLE seg, LPSTR lpszString)
{
   return 0;
}

HSZ     FAR PASCAL VBDestroyHsz(HSZ hsz)
{
   return 0;
}

LPSTR   FAR PASCAL VBDerefHsz(HSZ hsz)
{
   return 0;
}

LPSTR   FAR PASCAL VBLockHsz(HSZ hsz)
{
   return 0;
}

LPSTR   FAR PASCAL VBUnlockHsz(HSZ hsz)
{
   return 0;
}

// Management of language strings

HLSTR   FAR PASCAL VBCreateHlstr(LPVOID pb, USHORT cbLen)
{
   return 0;
}

VOID    FAR PASCAL VBDestroyHlstr(HLSTR hlstr)
{
   return 0;
}

LPSTR   FAR PASCAL VBDerefHlstr(HLSTR hlstr)
{
   return 0;
}

USHORT  FAR PASCAL VBGetHlstrLen(HLSTR hlstr)
{
   return 0;
}

ERR FAR PASCAL VBSetHlstr(HLSTR far *phlstr, LPVOID pb, USHORT cbLen)
{
   return 0;
}

// Firing Basic event procedures

ERR FAR PASCAL VBFireEvent(HCTL hctl, USHORT idEvent, LPVOID lpparams)
{
   return 0;
}

// Control property access

ERR FAR PASCAL VBGetControlProperty(HCTL hctl, USHORT idProp, LPVOID pdata)
{
   return 0;
}

ERR FAR PASCAL VBSetControlProperty(HCTL hctl, USHORT idProp, LONG data)
{
   return 0;
}

// Picture management functions

HPIC  FAR PASCAL VBAllocPic(LPPIC lppic)
{
   return 0;
}

VOID  FAR PASCAL VBFreePic(HPIC hpic)
{
   return 0;
}

HPIC  FAR PASCAL VBGetPic(HPIC hpic, LPPIC lppic)
{
   return 0;
}

ERR   FAR PASCAL VBPicFromCF(HPIC FAR *lphpic, HANDLE hData, WORD wFormat)
{
   return 0;
}

HPIC  FAR PASCAL VBRefPic(HPIC hpic)
{
   return 0;
}

// File IO functions

ERR  FAR PASCAL VBReadFormFile(HFORMFILE hformfile, LPVOID pb, WORD cb)
{
   return 0;
}

ERR  FAR PASCAL VBWriteFormFile(HFORMFILE hformfile, LPVOID pb, WORD cb)
{
   return 0;
}

LONG FAR PASCAL VBSeekFormFile(HFORMFILE hformfile, LONG offset)
{
   return 0;
}

LONG FAR PASCAL VBRelSeekFormFile(HFORMFILE hformfile, LONG offset)
{
   return 0;
}

ERR  FAR PASCAL VBReadBasicFile(USHORT usFileNo, LPVOID pb, WORD cb)
{
   return 0;
}

ERR  FAR PASCAL VBWriteBasicFile(USHORT usFileNo, LPVOID pb, WORD cb)
{
   return 0;
}

// Conversion functions

LONG  FAR PASCAL VBYPixelsToTwips(SHORT Pixels)
{
   return 0;
}

LONG  FAR PASCAL VBXPixelsToTwips(SHORT Pixels)
{
   return 0;
}

SHORT FAR PASCAL VBYTwipsToPixels(LONG Twips)
{
   return 0;
}

SHORT FAR PASCAL VBXTwipsToPixels(LONG Twips)
{
   return 0;
}

//----------------------------------------------------------------------------//

static void __VbxServer( void )
{
   asm jmp dword ptr [ss:VbxFuncs + bx];
}

//----------------------------------------------------------------------------//

CLIPPER LoadVbx()
{
   HANDLE hDll = _parni( 1 );
   FARPROC VbInitCC;

   VbxServer = __VbxServer;
   lpModel   = 0;

   VbInitCC = GetProcAddress( hDll, "VBINITCC" );
   ( ( VBINIT ) VbInitCC )( 0, TRUE );

   _retnl( lpModel );
}

//----------------------------------------------------------------------------//

CLIPPER VbxClassNa()   // me()
{
   LPMODEL lpModel = _parnl( 1 );

   _retc( MK_FP( FP_SEG( lpModel ), lpModel->npszClassName ) );
}

//----------------------------------------------------------------------------//

CLIPPER VbxDataNam()   // e()
{
   LPMODEL lpModel   = _parnl( 1 );
   LPPROPLIST lpList = MK_FP( FP_SEG( lpModel ), lpModel->npproplist );
   LPPROPINFO lpInfo = MK_FP( FP_SEG( lpModel ), lpList[ _parni( 2 ) - 1 ] );

   if( ( int ) lpInfo < 0 )
      _retc( Properties[ ~( ( WORD ) lpInfo ) ] );
   else if( lpInfo > 0 )
      _retc( MK_FP( FP_SEG( lpModel ), lpInfo->npszName ) );
   else
      _retc( "" );
}

//----------------------------------------------------------------------------//

CLIPPER VbxMethNam()   // e()
{
   LPMODEL lpModel   = _parnl( 1 );
   LPPROPLIST lpList = MK_FP( FP_SEG( lpModel ), lpModel->npeventlist );
   LPPROPINFO lpInfo = MK_FP( FP_SEG( lpModel ), lpList[ _parni( 2 ) - 1 ] );

   if( ( int ) lpInfo < 0 )
      _retc( Methods[ ~( ( WORD ) lpInfo ) ] );
   else if( lpInfo > 0 )
      _retc( MK_FP( FP_SEG( lpModel ), lpInfo->npszName ) );
   else
      _retc( "" );
}

//----------------------------------------------------------------------------//

CLIPPER __VBXINIT()
{
   LPSTR  szClassName = _parc( 2 );
   WNDCLASS cls;

   lpModel = _parnl( 1 );

   cls.lpszClassName = szClassName;
   cls.style         = lpModel->fsClassStyle;
   cls.cbClsExtra    = 0;
   cls.cbWndExtra    = 0;
   cls.hInstance     = __hInstance;
   cls.hIcon         = 0;
   cls.hCursor       = 0;
   cls.hbrBackground = GetStockObject( GRAY_BRUSH );
   cls.lpszMenuName  = 0;
   cls.lpfnWndProc   = ( FARPROC ) DefWindowProc;

   RegisterClass( &cls );
}

//----------------------------------------------------------------------------//
