home *** CD-ROM | disk | FTP | other *** search
/ Prima Shareware 3 / DuCom_Prima-Shareware-3_cd1.bin / PROGRAMO / PASCAL / JANUSW / VBX.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-05-15  |  34.5 KB  |  1,041 lines
  1. { Unit:      Vbx
  2.   Version:   1.00
  3.   Purpose:   DYNAMIC link to Borlands BIVBX10
  4.  
  5.   Developer: Peter Sawatzki (ps)
  6.              Buchenhof 3, 58091 Hagen, Germany
  7.  CompuServe: 100031,3002
  8.  
  9.  Contributing:
  10.    Ron Loewy (rl) [100274,162]
  11.    Frank Lee Lees (fl) [71532,2133]
  12.  
  13.   Date:    Author:
  14.   02/14/94 ps     initial release by ps
  15.   02/24/94 rl/ps  added tVbxControl object
  16.   02/25/94 ps     fix the Ss:[0020] issue
  17.   02/26/94 ps     add VBX event routing
  18.   02/28/94 rl     add tVbxControl needed set/get prop.
  19.   02/28/94 ps     add more methods to tVbxControl
  20.   03/12/94 ps     add tVbxControl.SetPropStr/Data
  21.   03/16/94 fl/ps  add tVbxWindow, correct tPicture, add LoadPicture
  22.   03/20/94 fl/ps  add Set/GetArrayProp
  23.   03/31/94 sfs    add ....
  24.  
  25.   (c) 1994 Peter Sawatzki
  26.  
  27.   based in part on Borland's BIVBX.H.
  28.  
  29. }
  30. {$A+,B-,F-,G+,I-,K+,P-,Q-,R-,S-,T-,V-,X+}
  31. Unit Vbx;
  32. Interface
  33. Uses
  34.   Objects,
  35.   WinTypes,
  36.   WinProcs,
  37.   Strings,
  38.   oWindows,
  39.   oDialogs,
  40. {$IfDef Debug} Debug, {$EndIf}
  41.   DynLink;
  42. Const
  43.   BIVBX10 = 'BIVBX10.DLL';
  44.   rt_DlgInit      = pChar(240);
  45.   wm_VbxFireEvent = $0360;
  46.   PType_CString   = $01; { HSZ }
  47.   PType_Short     = $02; { short }
  48.   PType_Long      = $03; { LONG }
  49.   PType_Bool      = $04; { BOOL }
  50.   PType_Color     = $05; { COLORREF or DWORD }
  51.   PType_Enum      = $06; { BYTE }
  52.   PType_Real      = $07; { float }
  53.   PType_XPos      = $08; { LONG (twips) }
  54.   PType_XSize     = $09; { LONG (twips) }
  55.   PType_YPos      = $0A; { LONG (twips) }
  56.   PType_YSize     = $0B; { LONG (twips) }
  57.   PType_Picture   = $0C; { HPIC }
  58.   PType_BString   = $0D; { HLSTR }
  59.  
  60. { color properties }
  61.   Color_SysColor = $80000000;
  62.  
  63.   Function MakeSysColor (iColor: tColorRef): tColorRef;
  64.   Inline($58 {Pop Ax} / $5A {Pop Dx} / $80/$CE/$80 {Or Dh, $80});
  65.  
  66. Type
  67.   Err =  Bool;
  68.   hCtl = Pointer;
  69.   hPic = Word;
  70.   hSz  = pChar;
  71.   hLStr = Pointer;
  72.   hFormFile = tHandle;
  73.  
  74. {-VBX event structure}
  75.   pVbxEvent = ^tVbxEvent;
  76.   tVbxEvent = Record
  77.     Control: hCtl;
  78.     Window: hWnd;
  79.     Id,
  80.     EventIndex: Integer;
  81.     EventName: pChar;
  82.     NumParams: Integer;
  83.     ParamList: Pointer
  84.   End;
  85.  
  86. { pictures }
  87.   tPicType = (PicType_None, PicType_Bitmap, PicType_MetaFile, PicType_Icon);
  88.   pPicture = ^tPicture;
  89.   tPicture = Record
  90.     picType: tPicType;
  91.     PicData: Record Case tpicType Of
  92.       PicType_None: ();
  93.       PicType_Bitmap:   (Bitmap: hBitmap;            {bitmap}
  94.                          Palette: hPalette);         {accompanying palette}
  95.       PicType_MetaFile: (Metafile: tHandle;          {Metafile}
  96.                          xExtent, yExtent: Integer); {extent}
  97.       PicType_Icon:     (Icon: hIcon)                {Icon}
  98.     End;
  99.     unused0, unused1, unused2, unused3: Byte
  100.   End;
  101.  
  102. { array property structure }
  103.   pElementStruct = ^tElementStruct;
  104.   tElementStruct = Record
  105.     Value: LongInt;             { Data for Get/Set }
  106.     NumElems: Word;             { Number of indecies }
  107.     Element: Array[0..0] Of Record
  108.       ElementType: Word;        { Type of nth element }
  109.       Index: LongInt;           { Index of nth element }
  110.     End
  111.   End;
  112.  
  113.   pVbx = ^tVbx;
  114.   tVBX = Object(tDll)
  115.     Development: Boolean;
  116.     {Initialization}
  117.     VBXInit:                    Function (Instance: tHandle; classPrefix: pChar): Bool;
  118.     VBXTerm:                    Procedure;
  119.     VBXEnableDLL:               Function (instApp, instDLL: tHandle): Bool;
  120.     VBXLoadVbx:                 Function (Name: pChar): Bool;
  121.     VBXInitHost:                Function (Instance: tHandle; classPrefix: pChar; Mode: Integer;
  122.                                           Application: pChar; p1, p2: Pointer): Bool;
  123.     {Controls}
  124.     VBXGetHctl:                 Function (window: hWnd): hCtl;
  125.     VBXGetHwnd:                 Function (control: hCtl): hWnd;
  126.     VBXCreate:                  Function (windowParent: hWnd; id: Integer;
  127.                                           lib, cls, title: pChar; style: LongInt;
  128.                                           x, y, w, h: Integer; aFile: hFormFile): hCtl;
  129.     {Dialogs}
  130.     VBXInitDialog:              Function (window: hWnd; instance: tHandle; id: pChar): Bool;
  131.     {Properties}
  132.     VBXGetNumProps:             Function (control: hCtl): Integer;
  133.     VBXGetProp:                 Function (control: hCtl; index: Integer; Var Value): Bool;
  134.     VBXGetPropByName:           Function (control: hCtl; name: pChar; Var Value): ERR;
  135.     VBXGetPropIndex:            Function (control: hCtl; name: pChar): Integer;
  136.     VBXGetPropName:             Function (control: hCtl; index: Integer): pChar;
  137.     VBXGetPropType:             Function (control: hCtl; index: Integer): Word;
  138.     VBXIsArrayProp:             Function (control: hCtl; index: Integer): Bool;
  139.     VBXSetProp:                 Function (control: hCtl; index: Integer; Value: LongInt): Bool;
  140.     VBXSetPropByName:           Function (control: hCtl; name: pChar; value: LongInt): Err;
  141.     VBXGetModelPropInfo:        Function (control: hCtl; index: Integer): Pointer;
  142.     {Events}
  143.     VBXGetEventIndex:           Function (control: hCtl; name: pChar): Integer;
  144.     VBXGetEventName:            Function (control: hCtl; index: Integer): pChar;
  145.     VBXGetNumEvents:            Function (control: hCtl): Integer;
  146.     VBXGetModelEventInfo:       Function (control: hCtl; Index: Integer): Pointer;
  147.     {methods}
  148.     VBXMethod:                  Function (control: hCtl; Method: Integer; Var Args): Bool;
  149.     VBXMethodAddItem:           Function (control: hCtl; Index: Integer; Item: pChar): Bool;
  150.     VBXMethodDrag:              Function (control: hCtl; Action: Integer): Bool;
  151.     VBXMethodMove:              Function (control: hCtl; x,y,w,h: LongInt): Bool;
  152.     VBXMethodRefresh:           Function (control: hCtl): Bool;
  153.     VBXMethodRemoveItem:        Function (control: hCtl; item: Integer): Bool;
  154.     {pixel/twips conversions}
  155.     VBXTwp2PixY:                Function (twips: LongInt): Integer;
  156.     VBXTwp2PixX:                Function (twips: LongInt): Integer;
  157.     VBXPix2TwpY:                Function (pixels: Integer): LongInt;
  158.     VBXPix2TwpX:                Function (pixels: Integer): LongInt;
  159.     {dynamic strings}
  160.     VBXCreateCString:           Function (segment: tHandle; str: pChar): hSz;
  161.     VBXGetCStringPtr:           Function (str: hSz): pChar;
  162.     VBXDestroyCString:          Function (str: hSz): hSz;
  163.     VBXLockCString:             Function (str: hSz): pChar;
  164.     VBXUnlockCString:           Procedure (str: hSz);
  165.     {pictures}
  166.     VBXCreatePicture:           Function (picture: pPicture): hPic;
  167.     VBXDestroyPicture:          Procedure (pic: hPic);
  168.     VBXGetPicture:              Function (pic: hPic; picture: pPicture): hPic;
  169.     VBXGetPictureFromClipboard: Function (Var pic: hPic; data: tHandle; format: Word): Err;
  170.     VBXReferencePicture:        Function (pic: hPic): hPic;
  171.     {Basic language strings}
  172.     VBXCreateBasicString:       Function (buffer: Pointer; len: Word): hLStr;
  173.     VBXGetBasicStringPtr:       Function (str: hLStr): pChar;
  174.     VBXDestroyBasicString:      Procedure (str: hLStr);
  175.     VBXGetBasicStringLength:    Function (str: hLStr): Word;
  176.     VBXSetBasicString:          Function (Var str: hLStr; buffer: Pointer; len: Word): ERR;
  177.     {form files}
  178.     VBXCreateFormFile:          Function (len: LongInt; data: Pointer): hFormFile;
  179.     VBXDeleteFormFile:          Function (aFile: hFormFile): Bool;
  180.     VBXSaveProperties:          Function (control: hCtl): hFormFile;
  181.     VbxGetFormFileLength:       Function (aFile: hFormFile): LongInt;
  182.  
  183.     {class functions}
  184.     VBXGetFirstClass:           Function: Pointer;
  185.     VBXGetNextClass:            Function (aClass: Pointer): Pointer;
  186.  
  187.     Constructor Init (ForDevelopment: Boolean);
  188.     Procedure InitProcs; Virtual;
  189.     Function LibLink: Bool; Virtual;
  190.     Procedure LibUnLink; Virtual;
  191.  
  192.     Function CreateControl (WindowParent: hWnd; wId: Integer; LibClsTitle: pChar; dwStyle: LongInt;
  193.                             x, y, w, h: Integer; InitInfo: Pointer): hWnd;
  194.     Function LoadPicture (Name: pChar; aPicType: tPicType): hPic;
  195.   End;
  196.  
  197. Var
  198.   dVBX: tVBX;
  199.  
  200. Const
  201.   ev_First          = nf_First;
  202.   ev_Std_Last       = $FFF;
  203.  
  204. Type
  205.   pVbxControl = ^tVbxControl;
  206.   tVbxControl = Object(tControl)
  207.     Ctl: hCtl;
  208.     VbxName,
  209.     VbxClass: pChar;
  210.     InitData: tHandle;
  211.  
  212.     Constructor Init(aParent: pWindowsObject; anId: Integer;
  213.                      aVbxName, aVbxClass, aTitle: pChar;
  214.                      x, y, w, h: Integer;
  215.                      Len: LongInt; Data: Pointer);
  216.     Constructor InitResource(aParent: pWindowsObject; anId: Integer);
  217.     Destructor Done; Virtual;
  218.     Function Create: Boolean; Virtual;
  219.     Procedure wmVbxFireEvent (Var Msg: tMessage); Virtual wm_First+wm_VbxFireEvent;
  220.     Procedure DefaultEventProc (Var Event: tVbxEvent); Virtual;
  221.     Function GetHCtl: hCtl;
  222.   {properties}
  223.     Function GetNumProps: Integer;
  224.     Function GetPropIndex (Name: pChar): Integer;
  225.     Function GetPropName (Index: Integer): pChar;
  226.     Function GetPropType (Index: Integer): Integer;
  227.     Function IsArrayProp (Index: Integer): Bool;
  228.     Function GetPropByName (Name: pChar; Var Value): Bool;
  229.     Function GetProp (Index: Integer; Var Value): Bool;
  230.     Function GetPropStr (Index: Integer; Dst: pChar): Bool;
  231.     Function GetPropBStr (Index: Integer; Dst: pChar): Bool;
  232.     Function GetPropInt (Index: Integer; Var Value: Integer): Bool;
  233.     Function GetPropByte (Index: Integer; Var Value: Byte): Bool;
  234.     Function GetPropSingle (Index: Integer; Var Value: Single): Bool;
  235.     Function GetArrayProp (Index, ArrayIndex: Integer; Var Value: LongInt): Bool;
  236.     Function GetArrayPropStr (Index, ArrayIndex: Integer; Dst: pChar): Bool;
  237.     Function GetArrayPropBStr (Index, ArrayIndex: Integer; Dst: pChar): Bool;
  238.     Function GetArrayPropInt (Index, ArrayIndex: Integer; Var Value: Integer): Bool;
  239.     Function GetArrayPropByte (Index, ArrayIndex: Integer; Var Value: Byte): Bool;
  240.     Function GetArrayPropSingle (Index, ArrayIndex: Integer; Var Value: Single): Bool;
  241.     {SetProp}
  242.     Function SetPropByName (Name: pChar; Value: LongInt): Bool;
  243.     Function SetProp (Index: Integer; Value: LongInt): Bool;
  244.     Function SetPropInt (Index: Integer; Value: Integer): Bool;
  245.     Function SetPropByte (Index: Integer; Value: Byte): Bool;
  246.     Function SetPropSingle (Index: Integer; Value: Single): Bool;
  247.     Function SetPropStr (Index: Integer; aStr: pChar): Bool;
  248.     Function SetPropBStr (Index: Integer; aStr: pChar): Bool;
  249.     Function SetPropData (Index: Integer; Const Value): Bool;
  250.     Function SetArrayProp (Index, ArrayIndex: Integer; Value: LongInt): Bool;
  251.     Function SetArrayPropInt (Index, ArrayIndex: Integer; Value: Integer): Bool;
  252.     Function SetArrayPropByte (Index, ArrayIndex: Integer; Value: Byte): Bool;
  253.     Function SetArrayPropSingle (Index, ArrayIndex: Integer; Value: Single): Bool;
  254.     Function SetArrayPropStr (Index, ArrayIndex: Integer; aStr: pChar): Bool;
  255.     Function SetArrayPropBStr (Index, ArrayIndex: Integer; aStr: pChar): Bool;
  256.   {events}
  257.     Function GetNumEvents: Integer;
  258.     Function GetEventIndex (Name: pChar): Integer;
  259.     Function GetEventName (Index: Integer): pChar;
  260.   {methods}
  261.     Function Method (aMethod: Integer; Var Args): Bool;
  262.     Function AddItem (Index: Integer; Const Item: pChar): Bool;
  263.     Function Drag (Action: Integer): Bool;
  264.     Function Move (x, y, w, h: LongInt): Bool;
  265.     Function Refresh: Bool;
  266.     Function RemoveItem (Index: Integer): Bool;
  267.   End;
  268.  
  269.   pVbxDialog = ^tVbxDialog;
  270.   tVbxDialog = Object(tDialog)
  271.     Constructor Init (aParent: pWindowsObject; aName: pChar);
  272.     Procedure SetupWindow; Virtual;
  273.     Procedure wmVbxFireEvent (Var Msg: tMessage);      Virtual wm_First+wm_VbxFireEvent;
  274.     Procedure DefaultEventProc (Var Event: tVbxEvent); Virtual;
  275.   End;
  276.  
  277.   pVbxDlgWindow = ^tVbxDlgWindow;
  278.   tVbxDlgWindow = Object(tDlgWindow)
  279.     Constructor Init (aParent: pWindowsObject; aName: pChar);
  280.     Procedure SetupWindow; Virtual;
  281.     Procedure wmVbxFireEvent (Var Msg: tMessage);      Virtual wm_First+wm_VbxFireEvent;
  282.     Procedure DefaultEventProc (Var Event: tVbxEvent); Virtual;
  283.   End;
  284.  
  285.   pVbxWindow = ^tVbxWindow;
  286.   tVbxWindow = Object(tWindow)
  287.     Procedure wmVbxFireEvent (Var Msg: tMessage);      Virtual wm_First+wm_VbxFireEvent;
  288.     Procedure DefaultEventProc (Var Event: tVbxEvent); Virtual;
  289.   End;
  290.  
  291. Function EventPerform (W: pVbxControl; Var Event: tVbxEvent; DVMTIndex: Word): Boolean;
  292. Function GetEventArg (Var Event: tVbxEvent; Index: Integer): Pointer;
  293.  
  294. {- define the Vbx ctl jump vector for Borland Pascal 7.0:
  295.    Every program that uses VBX controls must have a jump vector at
  296.    address SS:20h installed: it is absolutely neccessary to add the following
  297.    definition as the first typed constant statement to your main program:
  298.    Const
  299.      VbxValidation: tVbxValidation = cVbxValidation;
  300.  
  301.    And to ensure that BP7's smartlinker does not remove this info,
  302.    one must 'use' the ValidationInfo at least once via a
  303.    RegisterVBX(VbxValidation) call.
  304.  
  305.    The above makes sure that BIVBX10.DLL does not overwrite data at DS:20h
  306.    when the VBX jump vector gets installed. Consequently the dVBX object refuses
  307.    to link to BIVBX10 if the above conditions are not met!
  308. }
  309. Type
  310.   tVbxValidation = Array[$00..$13] Of Char;
  311. Const
  312.   cVbxValidation = 'BIVBX10.DLL'#0' ps XXXX'; { 'XXXX' goes to adr SS:20h}
  313.  
  314.   {dummy procedure for Validation Info registration}
  315.   Procedure RegisterVBX (Var ValidationInfo);
  316.  
  317. Implementation
  318. Uses
  319.   Win31;
  320.  
  321. Function GetEventArg (Var Event: tVbxEvent; Index: Integer): Pointer;
  322. Var
  323.   aPtr: Pointer;
  324. Begin
  325.   If (Index<1) Or (Index>Event.NumParams) Then
  326.     Index:= 1;
  327.   aPtr:= Event.ParamList;
  328.   Inc(Word(aPtr), (Event.NumParams-Index) Shl 2);
  329.   GetEventArg:= Pointer(aPtr^)
  330. End;
  331.  
  332. Constructor tVBX.Init (ForDevelopment: Boolean);
  333. Begin
  334.   Inherited Init(BIVBX10);
  335.   Development:= ForDevelopment
  336. End;
  337.  
  338. Procedure tVBX.InitProcs;
  339. Begin
  340.   AddFunction(@@VBXCreate,                  pChar( 71));
  341.   AddFunction(@@VBXCreateBasicString,       pChar( 93));
  342.   AddFunction(@@VBXCreateCString,           pChar( 88));
  343.   AddFunction(@@VBXCreateFormFile,          pChar( 54));
  344.   AddFunction(@@VbxGetFormFileLength,       pChar( 55));
  345.   AddFunction(@@VBXSaveProperties,          pChar( 56));
  346.   AddFunction(@@VBXCreatePicture,           pChar(102));
  347.   AddFunction(@@VBXDeleteFormFile,          pChar( 57));
  348.   AddFunction(@@VBXDestroyBasicString,      pChar( 95));
  349.   AddFunction(@@VBXDestroyCString,          pChar( 90));
  350.   AddFunction(@@VBXDestroyPicture,          pChar(103));
  351.   AddFunction(@@VBXEnableDLL,               pChar(110));
  352.   AddFunction(@@VBXGetBasicStringLength,    pChar( 96));
  353.   AddFunction(@@VBXGetBasicStringPtr,       pChar( 94));
  354.   AddFunction(@@VBXGetCStringPtr,           pChar( 89));
  355.   AddFunction(@@VBXGetEventIndex,           pChar( 35));
  356.   AddFunction(@@VBXGetEventName,            pChar( 34));
  357.   AddFunction(@@VBXGetModelEventInfo,       pChar( 11));
  358.   AddFunction(@@VBXGetHctl,                 pChar( 13));
  359.   AddFunction(@@VBXGetHwnd,                 pChar( 12));
  360.   AddFunction(@@VBXGetNumEvents,            pChar( 37));
  361.   AddFunction(@@VBXGetNumProps,             pChar( 39));
  362.   AddFunction(@@VBXGetPicture,              pChar(104));
  363.   AddFunction(@@VBXGetPictureFromClipboard, pChar(105));
  364.   AddFunction(@@VBXGetProp,                 pChar( 17));
  365.   AddFunction(@@VBXGetPropByName,           pChar( 85));
  366.   AddFunction(@@VBXGetPropIndex,            pChar( 42));
  367.   AddFunction(@@VBXGetPropName,             pChar( 44));
  368.   AddFunction(@@VBXGetPropType,             pChar( 45));
  369.   AddFunction(@@VBXGetModelPropInfo,        pChar( 10));
  370.   AddFunction(@@VBXInit,                    pChar( 14));
  371.   AddFunction(@@VBXInitHost,                pChar( 19));
  372.   AddFunction(@@VBXInitDialog,              pChar( 51));
  373.   AddFunction(@@VBXLoadVbx,                 pChar( 20));
  374.   AddFunction(@@VBXIsArrayProp,             pChar( 87));
  375.   AddFunction(@@VBXLockCString,             pChar( 91));
  376.   AddFunction(@@VBXMethod,                  pChar(  5));
  377.   AddFunction(@@VBXMethodAddItem,           pChar(  6));
  378.   AddFunction(@@VBXMethodDrag,              pChar( 69));
  379.   AddFunction(@@VBXMethodMove,              pChar(  7));
  380.   AddFunction(@@VBXMethodRefresh,           pChar(  8));
  381.   AddFunction(@@VBXMethodRemoveItem,        pChar(  9));
  382.   AddFunction(@@VBXPix2TwpX,                pChar(101));
  383.   AddFunction(@@VBXPix2TwpY,                pChar(100));
  384.   AddFunction(@@VBXReferencePicture,        pChar(106));
  385.   AddFunction(@@VBXSetBasicString,          pChar( 97));
  386.   AddFunction(@@VBXSetProp,                 pChar( 16));
  387.   AddFunction(@@VBXSetPropByName,           pChar( 82));
  388.   AddFunction(@@VBXTerm,                    pChar( 15));
  389.   AddFunction(@@VBXTwp2PixX,                pChar( 99));
  390.   AddFunction(@@VBXTwp2PixY,                pChar( 98));
  391.   AddFunction(@@VBXUnlockCString,           pChar( 92));
  392.   AddFunction(@@VBXGetFirstClass,           pChar( 24));
  393.   AddFunction(@@VBXGetNextClass,            pChar( 25));
  394. End;
  395.  
  396. Function tVBX.LibLink: Bool;
  397. Begin
  398.   {-check if the VBX jump vector is at SS:20h}
  399.   If StrComp(Ptr(DSeg, $10), ModuleName)<>0 Then Begin
  400.     MessageBox(0, 'No VBX ctl jump vector found', 'Fatal Error', mb_IconExclamation+mb_Ok);
  401.     Halt
  402.   End;
  403.   If Inherited LibLink Then
  404.     If Development Then
  405.       LibLink:= VbxInitHost(System.hInstance,'Thunder',1,'JanusW',Nil,Nil)
  406.     Else
  407.       LibLink:= VBXInit(System.hInstance, 'Thunder')
  408.   Else
  409.     LibLink:= False
  410. End;
  411.  
  412. Procedure tVBX.LibUnLink;
  413. Begin
  414.   If ModuleHandle<>0 Then
  415.     VBXTerm;
  416.   Inherited LibUnLink
  417. End;
  418.  
  419. Function VBReadFormFile (hForm: tHandle; Data: Pointer; cb: Word): Word;
  420. Inline($BB/$3C/$00/ $36/$FF/$2E/$20/$00); {Mov Bx,$3C; Jmp [SS:20]}
  421.  
  422. Function VBSeekFormFile (hForm: tHandle; Offset: LongInt): LongInt;
  423. Inline($BB/$A0/$00/ $36/$FF/$2E/$20/$00); {Mov Bx,$A0; Jmp [SS:20]}
  424.  
  425. Function IncPtrMac (aPtr: Pointer; anOffset: Word): Pointer;
  426. Inline(
  427.   $5B/                   {  Pop Bx    ; anOffset}
  428.   $58/                   {  Pop Ax    ; Word(aPtr)}
  429.   $5A/                   {  Pop Dx    ; Word(aPtr+2)}
  430.   $01/$D8/               {  Add Ax,Bx}
  431.   $73/$04/               {  Jnc @@1}
  432.   $03/$16/>SelectorInc); {  Add Dx,[>SelectorInc]}
  433.                          {@@1:}
  434.  
  435. Function tVBX.CreateControl (WindowParent: hWnd; wId: Integer;
  436.                              LibClsTitle: pChar; dwStyle: LongInt;
  437.                              x, y, w, h: Integer; InitInfo: Pointer): hWnd;
  438. Type
  439.   {-structure of the rt_DlgInit data}
  440.   pDlgInitInfo = ^tDlgInitInfo;
  441.   tDlgInitInfo = Record
  442.     Id,
  443.     Version: Word;
  444.     Len: LongInt;
  445.     Data: Array[0..0{Len-1}] Of Byte
  446.   End;
  447. Var
  448.   VbCtl: hCtl;
  449.   Combi: Array[0..77] Of Char;
  450.   Cls, Title: pChar;
  451.   Form: hFormFile;
  452.   prevMode: Word;
  453. Begin
  454.   StrCopy(Combi, LibClsTitle);
  455.   Title:= Nil;
  456.   Cls:= StrScan(Combi, ';');
  457.   If Assigned(Cls) Then Begin
  458.     Cls[0]:= #0;
  459.     Inc(Cls);
  460.     Title:= StrScan(Cls, ';');
  461.     If Assigned(Title) Then Begin
  462.       Title[0]:= #0;
  463.       Inc(Title)
  464.     End
  465.   End;
  466.   Form:= 0;
  467.   If Assigned(InitInfo) Then Begin
  468.     While pDlgInitInfo(InitInfo)^.Id<>0 Do With pDlgInitInfo(InitInfo)^ Do Begin
  469.       If Id=wId Then Begin
  470.         Form:= dVbx.VbxCreateFormFile(Len, @Data);
  471.         If Integer(Form)=-1 Then
  472.           Form:= 0;
  473.         Break
  474.       End;
  475.       InitInfo:= IncPtrMac(InitInfo, SizeOf(tDlgInitInfo)+Len-1)
  476.     End
  477.   End;
  478.   prevMode:= SetErrorMode($8000); {SEM_NoOpenFileErrorBox}
  479.   VbCtl:= VBXCreate(WindowParent, wId, Combi, Cls, Title, dwStyle, x, y, w, h, Form);
  480.   SetErrorMode(prevMode);
  481.   If Form<>0 Then
  482.     VbxDeleteFormFile(Form);
  483.   CreateControl:= VBXGetHwnd(VbCtl)
  484. End;
  485.  
  486. Function tVbx.LoadPicture (Name: pChar; aPicType: tPicType): hPic;
  487. { Load Graphic resource and return VB HPic}
  488. {-Returns 0 if Resource not found }
  489. Var
  490.   aPicture: tPicture;
  491. Begin
  492.   LoadPicture:= 0;
  493.   aPicture.picType:= aPicType;
  494.   With aPicture, picData Do Case picType Of
  495.     PicType_Bitmap: Begin
  496.       Bitmap:=LoadBitmap(System.hInstance, Name);
  497.       If Bitmap=0 Then Begin
  498.         {$IfDef Debug} WriteLn('Could not find BITMAP Resource', StrPasEx(Name)); {$EndIf}
  499.         Exit
  500.       End Else Begin
  501.         Palette:=GetStockObject(Default_Palette);
  502.         LoadPicture:=dVbx.VBXCreatePicture(@aPicture)
  503.       End
  504.     End; {BITMAP}
  505.     PicType_MetaFile: ; { not yet implemented }
  506.     PicType_Icon: Begin
  507.       Icon:=LoadIcon(System.hInstance,Name);
  508.       If Icon=0 Then Begin
  509.         {$IfDef Debug} WriteLn('Could not find ICON Resource', StrPasEx(Name)); {$EndIf}
  510.         Exit
  511.       End Else
  512.         LoadPicture:=dVbx.VBXCreatePicture(@aPicture)
  513.     End {ICON}
  514.   End
  515. End;
  516.  
  517. {-tVbxControl}
  518.  
  519. Constructor tVbxControl.Init(aParent: pWindowsObject; anId: Integer;
  520.                              aVbxName, aVbxClass, aTitle: pChar;
  521.                              x, y, w, h: Integer;
  522.                              Len: LongInt; Data: Pointer);
  523. Begin
  524.   Inherited Init (aParent, anId, aTitle, x, y, w, h);
  525.   VbxName:= StrNew(aVbxName);
  526.   If PtrRec(aVbxClass).Seg=0 Then
  527.     VbxClass:= aVbxClass
  528.   Else
  529.     VbxClass:= StrNew(aVbxClass);
  530.   Ctl:= Nil;
  531.   If (Len>0) And Assigned(Data) Then Begin
  532.     InitData:= GlobalAlloc(gMem_Fixed, Len);
  533.     If InitData<>0 Then Begin
  534.       hMemCpy(GlobalLock(InitData), Data, Len);
  535.       GlobalUnLock(InitData)
  536.     End
  537.   End Else
  538.     InitData:= 0;
  539.   Attr.Style:= 0
  540. End;
  541.  
  542. Destructor tVbxControl.Done;
  543. Begin
  544.   StrDispose(VbxName);
  545.   If PtrRec(VbxClass).Seg<>0 Then
  546.     StrDispose(VbxClass);
  547.   If InitData<>0 Then
  548.     GlobalFree(InitData);
  549.   Inherited Done
  550. End;
  551.  
  552. Constructor tVbxControl.InitResource(aParent: pWindowsObject; anId: Integer);
  553. Begin
  554.    Inherited InitResource(aParent, anId);
  555.    DisableTransfer; {as long as we don't know what to do with it <g>}
  556.    VbxName:= Nil;
  557.    VbxClass:= Nil;
  558.    Ctl:= Nil;
  559.    InitData:= 0
  560. End;
  561.  
  562. Function tVbxControl.Create: Boolean;
  563. Var
  564.   hParent: hWnd;
  565.   Form: hFormFile;
  566.   p: Pointer;
  567. Begin
  568.   If Status=0 Then Begin
  569.     DisableAutoCreate;
  570.     If Assigned(Parent) Then hParent:= Parent^.hWindow Else hParent:= 0;
  571.     If IsFlagSet(wb_FromResource) Then Begin { Windows already created window }
  572.       hWindow:= GetDlgItem(hParent, Attr.Id);
  573.       Ctl:= dVbx.VBXGetHCtl(hWindow)
  574.     End Else Begin
  575.       If InitData=0 Then
  576.         Form:= 0
  577.       Else Begin
  578.         Form:= dVbx.VbxCreateFormFile(GlobalSize(InitData), GlobalLock(InitData));
  579.         GlobalUnlock(InitData);
  580.         GlobalFree(InitData);
  581.         InitData:= 0
  582.       End;
  583.       If Integer(Form)<>-1 Then Begin
  584.         With Attr Do
  585.           Ctl:= dVbx.VBXCreate(hParent, Id, VbxName, VbxClass, Title, Style, x, y, w, h, Form);
  586.         If Form<>0 Then
  587.           dVbx.VbxDeleteFormFile(Form);
  588.         hWindow:= dVbx.VbxGetHWnd(Ctl)
  589.       End
  590.     End;
  591.     If Assigned(Ctl) Then Begin
  592.       If GetObjectPtr(hWindow)=Nil Then Begin
  593.         p:= @Self;
  594.         With PtrRec(p) Do Begin {attach standard OWL properties}
  595.           WinProcs.SetProp(hWindow, 'OW1', Seg);
  596.           WinProcs.SetProp(hWindow, 'OW2', Ofs)
  597.         End;
  598.         DefaultProc:= tFarProc(SetWindowLong(hWindow, gwl_WndProc, LongInt(Instance)));
  599.         SetupWindow
  600.       End
  601.     End Else
  602.       Status:= em_InvalidWindow
  603.   End;
  604.   Create:= Status=0
  605. End;
  606.  
  607. Type
  608. { Virtual method table }
  609.   tVMT = Record
  610.     InstSize: Word;
  611.     NegCheckSum: Word;
  612.     DMTPtr: Word;
  613.     Reserved: Word;
  614.     EntryTable: Record End
  615.   End;
  616.  
  617. { Dynamic method table }
  618.   tDMT = Record
  619.     Parent: Word;
  620.     CacheIndex: Word;
  621.     CacheEntry: Word;
  622.     EntryCount: Word;
  623.     EntryTable: Record End
  624.   End;
  625.  
  626. { search the pVbxControl's DVMT if a method for the passed event exists. Call the
  627.   method if found and return TRUE. Return FALSE if no method found.}
  628. Function EventPerform (W: pVbxControl; Var Event: tVbxEvent; DVMTIndex: Word): Boolean;
  629. Assembler;
  630. Asm
  631.   Mov Ax, DVMTIndex
  632.   Les Bx, W
  633.   Mov Bx, Es:[Bx]
  634.   Mov Si, [Bx].tVMT.DMTPtr
  635.   Or Si, Si; Je @@NotFound
  636.   Cmp Ax, [Si].tDMT.CacheIndex; Jne @@Start
  637.   Mov Di, [Si].tDMT.CacheEntry; Jmp @@Found
  638. @@Start:
  639.   Mov Di, Ds
  640.   Mov Es, Di
  641.   Cld
  642. @@Continue:
  643.   Mov Cx, [Si].tDMT.EntryCount
  644.   Lea Di, [Si].tDMT.EntryTable
  645.   RepNE ScasW
  646.   Je @@Calculate
  647.   Mov Si, Es:[Si].tDMT.Parent
  648.   Or Si,Si; Jne @@Continue
  649. @@NotFound:
  650.   Mov Ax, False
  651.   Jmp @@Done
  652. @@Calculate:
  653.   Mov Dx, [Si].tDMT.EntryCount
  654.   Dec Dx; Shl Dx,1; Sub Dx,Cx; Shl Dx,1; Add Di, Dx
  655.   Mov Si, [Bx].tVMT.DMTPtr
  656.   Mov [Si].tDMT.CacheIndex,Ax
  657.   Mov [Si].tDMT.CacheEntry,Di
  658. @@Found:
  659.   Les Bx, Event; Push Es; Push Bx  {Event}
  660.   Les Bx, W;     Push Es; Push Bx  {Self}
  661.   Call DWord Ptr [Di]
  662.   Mov Ax, True
  663. @@Done:
  664. End;
  665.  
  666. Procedure tVbxControl.wmVbxFireEvent (Var Msg: tMessage);
  667. Var
  668.   Event: tVbxEvent;
  669. Begin
  670.  Event:= pVbxEvent(Msg.lParam)^;
  671.  If Not EventPerform(@Self, Event, ev_First+Event.EventIndex) Then
  672.    DefaultEventProc(Event);
  673.  Msg.Result:= 0
  674. End;
  675.  
  676. {the default Event proc is called if no event method is defined for
  677.  the incoming event}
  678. Procedure tVbxControl.DefaultEventProc (Var Event: tVbxEvent);
  679. Begin
  680. End;
  681.  
  682. Function tVbxControl.GetHCtl: hCtl;
  683. Begin
  684.   GetHCtl:= Ctl
  685. End;
  686.  
  687. {-properties}
  688. Function tVbxControl.GetNumProps: Integer;
  689. Begin
  690.   GetNumProps:= dVbx.VbxGetNumProps(Ctl)
  691. End;
  692.  
  693. Function tVbxControl.GetPropIndex (Name: pChar): Integer;
  694. Begin
  695.   GetPropIndex:= dVbx.VbxGetPropIndex(Ctl, Name)
  696. End;
  697.  
  698. Function tVbxControl.GetPropName (Index: Integer): pChar;
  699. Begin
  700.   GetPropName:= dVbx.VbxGetPropName(Ctl, Index)
  701. End;
  702.  
  703. Function tVbxControl.GetPropType (Index: Integer): Integer;
  704. Begin
  705.   GetPropType:= dVbx.VbxGetPropType(Ctl, Index)
  706. End;
  707.  
  708. Function tVbxControl.IsArrayProp (Index: Integer): Bool;
  709. Begin
  710.   IsArrayProp:= dVbx.VbxIsArrayProp(Ctl, Index)
  711. End;
  712.  
  713. Function tVbxControl.GetPropByName (Name: pChar; Var Value): Bool;
  714. Begin
  715.   GetPropByName:= dVbx.VbxGetPropByName(Ctl, Name, Value)
  716. End;
  717.  
  718. Function tVbxControl.GetProp (Index: Integer; Var Value): Bool;
  719. Begin
  720.   GetProp:= dVbx.VbxGetProp(Ctl, Index, Value)
  721. End;
  722.  
  723. Function tVbxControl.GetPropStr (Index: Integer; Dst: pChar): Bool;
  724. Var
  725.   strHandle: LongInt;
  726. Begin
  727.   If dVbx.VbxGetProp(Ctl, Index, strHandle) Then Begin
  728.     StrCopy(Dst, dVbx.VbxGetCStringPtr(hSz(strHandle)));
  729.     dVbx.VbxDestroyCString(hSz(strHandle));
  730.     GetPropStr:= True
  731.   End Else
  732.     GetPropStr:= False
  733. End;
  734.  
  735. Function tVbxControl.GetPropBStr (Index: Integer; Dst: pChar): Bool;
  736. Var
  737.   aStr: hLStr;
  738.   i, Len: Integer;
  739.   p: pChar;
  740. Begin
  741.   GetPropBStr:= dVbx.VbxGetProp(Ctl, Index, aStr);
  742.   Len:= dVbx.VBXGetBasicStringLength(aStr);
  743.   p:= dVbx.VBXGetBasicStringPtr(aStr);
  744.   For i:= 0 To Len-1 Do
  745.     Dst[i]:= p[i];
  746.   Dst[Len]:= #0;
  747.   dVbx.VBXDestroyBasicString(HLSTR(aStr))
  748. End;
  749.  
  750. Function tVbxControl.GetPropInt (Index: Integer; Var Value: Integer): Bool;
  751. Var
  752.   aLong: LongInt;
  753. Begin
  754.   GetPropInt:= dVbx.VbxGetProp(Ctl, Index, aLong);
  755.   Value:= Integer(aLong)
  756. End;
  757.  
  758. Function tVbxControl.GetPropByte (Index: Integer; Var Value: Byte): Bool;
  759. Var
  760.   aLong: LongInt;
  761. Begin
  762.   GetPropByte:= dVbx.VbxGetProp(Ctl, Index, aLong);
  763.   Value:= Byte(aLong)
  764. End;
  765.  
  766. Function tVbxControl.GetPropSingle (Index: Integer; Var Value: Single): Bool;
  767. Begin
  768.   GetPropSingle:= dVbx.VbxGetProp(Ctl, Index, LongInt(Value))
  769. End;
  770.  
  771. Function tVbxControl.GetArrayProp (Index, ArrayIndex: Integer; Var Value: LongInt): Bool;
  772. Var
  773.   anElement: tElementStruct;
  774. Begin
  775.   anElement.NumElems:= 1;
  776.   anElement.Element[0].ElementType:= PType_Short;
  777.   anElement.Element[0].Index:= ArrayIndex;
  778.   GetArrayProp:= dVbx.VbxGetProp(Ctl, Index, anElement);
  779.   Value:= anElement.Value
  780. End;
  781.  
  782. Function tVbxControl.GetArrayPropStr (Index, ArrayIndex: Integer; Dst: pChar): Bool;
  783. Var
  784.   strHandle: LongInt;
  785. Begin
  786.   If GetArrayProp(Index, ArrayIndex, strHandle) Then Begin
  787.     StrCopy(Dst, dVbx.VbxGetCStringPtr(hSz(strHandle)));
  788.     dVbx.VbxDestroyCString(hSz(strHandle));
  789.     GetArrayPropStr:= True
  790.   End Else
  791.     GetArrayPropStr:= False
  792. End;
  793.  
  794. Function tVbxControl.GetArrayPropBStr (Index, ArrayIndex: Integer; Dst: pChar): Bool;
  795. Var
  796.   aStr: hLStr;
  797.   i, Len: Integer;
  798.   p: pChar;
  799. Begin
  800.   GetArrayPropBStr:= GetArrayProp(Index, ArrayIndex, LongInt(aStr));
  801.   Len:= dVbx.VBXGetBasicStringLength(aStr);
  802.   p:= dVbx.VBXGetBasicStringPtr(aStr);
  803.   For i:= 0 To Len-1 Do
  804.     Dst[i]:= p[i];
  805.   Dst[Len]:= #0;
  806.   dVbx.VBXDestroyBasicString(HLSTR(aStr))
  807. End;
  808.  
  809. Function tVbxControl.GetArrayPropInt (Index, ArrayIndex: Integer; Var Value: Integer): Bool;
  810. Var
  811.   aLong: LongInt;
  812. Begin
  813.   GetArrayPropInt:= GetArrayProp(Index, ArrayIndex, aLong);
  814.   Value:= Integer(aLong)
  815. End;
  816.  
  817. Function tVbxControl.GetArrayPropByte (Index, ArrayIndex: Integer; Var Value: Byte): Bool;
  818. Var
  819.   aLong: LongInt;
  820. Begin
  821.   GetArrayPropByte:= GetArrayProp(Index, ArrayIndex, aLong);
  822.   Value:= Byte(aLong)
  823. End;
  824.  
  825. Function tVbxControl.GetArrayPropSingle (Index, ArrayIndex: Integer; Var Value: Single): Bool;
  826. Begin
  827.   GetArrayPropSingle:= GetArrayProp(Index, ArrayIndex, LongInt(Value))
  828. End;
  829.  
  830. Function tVbxControl.SetProp (Index: Integer; Value: LongInt): Bool;
  831. Begin
  832.   SetProp:= dVbx.VbxSetProp(Ctl, Index, Value)
  833. End;
  834.  
  835. Function tVbxControl.SetPropByName (Name: pChar; Value: LongInt): Bool;
  836. Begin
  837.   SetPropByName:= dVbx.VbxSetPropByName(Ctl, Name, Value)
  838. End;
  839.  
  840. Function tVbxControl.SetPropInt (Index: Integer; Value: Integer): Bool;
  841. Begin
  842.   SetPropInt:= dVbx.VbxSetProp(Ctl, Index, Value)
  843. End;
  844.  
  845. Function tVbxControl.SetPropByte (Index: Integer; Value: Byte): Bool;
  846. Begin
  847.   SetPropByte:= dVbx.VbxSetProp(Ctl, Index, Value)
  848. End;
  849.  
  850. Function tVbxControl.SetPropSingle (Index: Integer; Value: Single): Bool;
  851. Begin
  852.   SetPropSingle:= dVbx.VbxSetProp(Ctl, Index, LongInt(Value))
  853. End;
  854.  
  855. Function tVbxControl.SetPropStr (Index: Integer; aStr: pChar): Bool;
  856. Begin
  857.   SetPropStr:= dVbx.VbxSetProp(Ctl, Index, LongInt(aStr))
  858. End;
  859.  
  860. Function tVbxControl.SetPropBStr (Index: Integer; aStr: pChar): Bool;
  861. Var
  862.   aBStr: hLStr;
  863. Begin
  864.   aBStr:= dVbx.VBXCreateBasicString(aStr, StrLen(aStr));
  865.   SetPropBStr:= dVbx.VbxSetProp(Ctl, Index, LongInt(@aBStr));
  866.   dVbx.VBXDestroyBasicString(aBStr)
  867. End;
  868.  
  869. Function tVbxControl.SetPropData (Index: Integer; Const Value): Bool;
  870. Begin
  871.   SetPropData:= dVbx.VbxSetProp(Ctl, Index, LongInt(@Value))
  872. End;
  873.  
  874. Function tVbxControl.SetArrayProp (Index, ArrayIndex: Integer; Value: LongInt): Bool;
  875. Var
  876.   anElement: tElementStruct;
  877. Begin
  878.   anElement.Value:= Value;
  879.   anElement.NumElems:= 1;
  880.   anElement.Element[0].ElementType:= PType_Short;
  881.   anElement.Element[0].Index:= ArrayIndex;
  882.   SetArrayProp:= SetPropData(Index, anElement)
  883. End;
  884.  
  885. Function tVbxControl.SetArrayPropInt (Index, ArrayIndex: Integer; Value: Integer): Bool;
  886. Begin
  887.   SetArrayPropInt:= SetArrayProp(Index, ArrayIndex, Value)
  888. End;
  889.  
  890. Function tVbxControl.SetArrayPropByte (Index, ArrayIndex: Integer; Value: Byte): Bool;
  891. Begin
  892.   SetArrayPropByte:= SetArrayProp(Index, ArrayIndex, Value)
  893. End;
  894.  
  895. Function tVbxControl.SetArrayPropSingle (Index, ArrayIndex: Integer; Value: Single): Bool;
  896. Begin
  897.   SetArrayPropSingle:= SetArrayProp(Index, ArrayIndex, LongInt(Value))
  898. End;
  899.  
  900. Function tVbxControl.SetArrayPropStr (Index, ArrayIndex: Integer; aStr: pChar): Bool;
  901. Begin
  902.   SetArrayPropStr:= SetArrayProp(Index, ArrayIndex, LongInt(aStr))
  903. End;
  904.  
  905. Function tVbxControl.SetArrayPropBStr (Index, ArrayIndex: Integer; aStr: pChar): Bool;
  906. Var
  907.   aBStr: hLStr;
  908. Begin
  909.   aBStr:= dVbx.VBXCreateBasicString(aStr, StrLen(aStr));
  910.   SetArrayPropBStr:= SetArrayProp(Index, ArrayIndex, LongInt(@aBStr));
  911.   dVbx.VBXDestroyBasicString(aBStr)
  912. End;
  913.  
  914. {events}
  915. Function tVbxControl.GetNumEvents: Integer;
  916. Begin
  917.   GetNumEvents:= dVbx.VbxGetNumEvents(Ctl)
  918. End;
  919.  
  920. Function tVbxControl.GetEventIndex (Name: pChar): Integer;
  921. Begin
  922.   GetEventIndex:= dVbx.VbxGetEventIndex(Ctl, Name)
  923. End;
  924.  
  925. Function tVbxControl.GetEventName (Index: Integer): pChar;
  926. Begin
  927.   GetEventName:= dVbx.VbxGetEventName(Ctl, Index)
  928. End;
  929.  
  930. {methods}
  931. Function tVbxControl.Method (aMethod: Integer; Var Args): Bool;
  932. Begin
  933.   Method:= dVbx.VbxMethod(Ctl, aMethod, Args)
  934. End;
  935.  
  936. Function tVbxControl.AddItem (Index: Integer; Const Item: pChar): Bool;
  937. Begin
  938.   AddItem:= dVbx.VbxMethodAddItem (Ctl, Index, @Item)
  939. End;
  940.  
  941. Function tVbxControl.Drag (Action: Integer): Bool;
  942. Begin
  943.   Drag:= dVbx.VbxMethodDrag(Ctl, Action)
  944. End;
  945.  
  946. Function tVbxControl.Move (x, y, w, h: LongInt): Bool;
  947. Begin
  948.   Move:= dVbx.VbxMethodMove(Ctl, x, y, w, h)
  949. End;
  950.  
  951. Function tVbxControl.Refresh: Bool;
  952. Begin
  953.   Refresh:= dVbx.VbxMethodRefresh(Ctl)
  954. End;
  955.  
  956. Function tVbxControl.RemoveItem (Index: Integer): Bool;
  957. Begin
  958.   RemoveItem:= dVbx.VbxMethodRemoveItem(Ctl, Index)
  959. End;
  960.  
  961. Constructor tVbxDialog.Init (aParent: pWindowsObject; aName: pChar);
  962. Begin
  963.   If Not dVbx.LibLink Then Fail;
  964.   Inherited Init(aParent, aName);
  965. End;
  966.  
  967. Procedure tVbxDialog.SetupWindow;
  968. Begin
  969.   dVbx.VbxInitDialog(hWindow, System.hInstance, Attr.Name);
  970.   Inherited SetupWindow
  971. End;
  972.  
  973. Procedure tVbxDialog.wmVbxFireEvent (Var Msg: tMessage);
  974. Begin
  975.   If Not EventPerform(@Self, pVbxEvent(Msg.lParam)^, id_First+pVbxEvent(Msg.lParam)^.Id) Then
  976.     DefaultEventProc(pVbxEvent(Msg.lParam)^);
  977.   Msg.Result:= 0
  978. End;
  979.  
  980. Procedure tVbxDialog.DefaultEventProc (Var Event: tVbxEvent);
  981. Begin
  982.   With Event Do If GetObjectPtr(Window)<>Nil Then {route to object}
  983.     SendMessage(Window, wm_VbxFireEvent, 0, LongInt(@Event))
  984. End;
  985.  
  986. Constructor tVbxDlgWindow.Init (aParent: pWindowsObject; aName: pChar);
  987. Begin
  988.   If Not dVbx.LibLink Then Fail;
  989.   Inherited Init(aParent, aName);
  990. End;
  991.  
  992. Procedure tVbxDlgWindow.SetupWindow;
  993. Begin
  994.   dVbx.VbxInitDialog(hWindow, System.hInstance, Attr.Name);
  995.   Inherited SetupWindow
  996. End;
  997.  
  998. Procedure tVbxDlgWindow.wmVbxFireEvent (Var Msg: tMessage);
  999. Begin
  1000.   If Not EventPerform(@Self, pVbxEvent(Msg.lParam)^, id_First+pVbxEvent(Msg.lParam)^.Id) Then
  1001.     DefaultEventProc(pVbxEvent(Msg.lParam)^);
  1002.   Msg.Result:= 0
  1003. End;
  1004.  
  1005. Procedure tVbxDlgWindow.DefaultEventProc (Var Event: tVbxEvent);
  1006. Begin
  1007.   With Event Do If GetObjectPtr(Window)<>Nil Then {route to object}
  1008.     SendMessage(Window, wm_VbxFireEvent, 0, LongInt(@Event))
  1009. End;
  1010.  
  1011. Procedure tVbxWindow.wmVbxFireEvent (Var Msg: tMessage);
  1012. Begin
  1013.   If Not EventPerform(@Self, pVbxEvent(Msg.lParam)^, id_First+pVbxEvent(Msg.lParam)^.Id) Then
  1014.     DefaultEventProc(pVbxEvent(Msg.lParam)^);
  1015.   Msg.Result:= 0
  1016. End;
  1017.  
  1018. Procedure tVbxWindow.DefaultEventProc (Var Event: tVbxEvent);
  1019. Begin
  1020.   With Event Do If GetObjectPtr(Window)<>Nil Then {route to object}
  1021.     SendMessage(Window, wm_VbxFireEvent, 0, LongInt(@Event))
  1022. End;
  1023.  
  1024. {-just a wrapper procedure for Validation Info registration}
  1025. Procedure RegisterVBX (Var ValidationInfo);
  1026. Assembler; Asm End;
  1027.  
  1028. Var
  1029.   PrevExit: Pointer;
  1030. Procedure VbxExit; Far;
  1031. Begin
  1032.   ExitProc:= PrevExit;
  1033.   dVBX.Done
  1034. End;
  1035.  
  1036. Begin
  1037.   PrevExit:= ExitProc;
  1038.   ExitProc:= @VbxExit;
  1039.   dVbx.Init(False)
  1040. End.
  1041.