home *** CD-ROM | disk | FTP | other *** search
/ PC Format Collection 48 / SENT14D.ISO / tech / delphi / disk15 / inttab.pak / VBXCTRL.INT < prev   
Encoding:
Text File  |  1995-08-24  |  7.3 KB  |  169 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {       Delphi Visual Component Library                 }
  4. {                                                       }
  5. {       Copyright (c) 1995 Borland International        }
  6. {                                                       }
  7. {*******************************************************}
  8.  
  9. {$N+}
  10.  
  11. unit VBXCtrl;
  12.  
  13. interface
  14.  
  15. uses Classes, Controls, Forms, Messages, Graphics, WinTypes, BIVBX,
  16.   SysUtils;
  17.  
  18. const
  19.   VBXUpdateMsg: Word = 0;
  20.  
  21. type
  22.   EVBXError = class(Exception);
  23.  
  24.   TVBEnum = 0..255;
  25.   TVBString = string[255];
  26.   TBasicString = ^Word;
  27.   TCString = ^Char;
  28.   TVBControlRef = ^Byte;
  29.   TVBInteger = -32768..32767;
  30.   TVBLongint = $80000000..$7FFFFFFF;
  31.   TVBPic = HPic;
  32.   TVBXFlag = (vfProcessMnemonic, vfArrows, vfLoadMessage);
  33.   TVBXFlags = set of TVBXFlag;
  34.  
  35.   TVBXControl = class(TWinControl)
  36.   protected
  37.     FVBXFile: PChar;
  38.     FVBXClass: PChar;
  39.     FVBXFlags: TVBXFlags;
  40.  
  41.     { Low-level property access }
  42.     procedure GetArrayProp(aIndex, pIndex: Integer;
  43.       var ElementStruct: TElementStruct);
  44.     function GetBoolArrayProp(aIndex, pIndex: Integer): Boolean;
  45.     function GetBoolProp(pIndex: Integer): Boolean;
  46.     function GetBStringArrayProp(aIndex, pIndex: Integer): TVBString;
  47.     function GetBStringProp(pIndex: Integer): TVBString;
  48.     function GetColorArrayProp(aIndex, pIndex: Integer): TColor;
  49.     function GetColorProp(pIndex: Integer): TColor;
  50.     function GetEnumArrayProp(aIndex, pIndex: Integer): TVBEnum;
  51.     function GetEnumProp(pIndex: Integer): TVBEnum;
  52.     function GetIntArrayProp(aIndex, pIndex: Integer): TVBInteger;
  53.     function GetIntProp(pIndex: Integer): TVBInteger;
  54.     function GetLongArrayProp(aIndex, pIndex: Integer): TVBLongint;
  55.     function GetLongProp(pIndex: Integer): TVBLongint;
  56.     function GetPictureArrayProp(aIndex, pIndex: Integer): TVBPic;
  57.     function GetPictureProp(pIndex: Integer): TVBPic;
  58.     procedure GetProp(pIndex: Integer; var Value);
  59.     function GetSingleArrayProp(aIndex, pIndex: Integer): Single;
  60.     function GetSingleProp(pIndex: Integer): Single;
  61.     function GetStringArrayProp(aIndex, pIndex: Integer): TVBString;
  62.     function GetStringProp(pIndex: Integer): TVBString;
  63.     procedure SetArrayProp(aIndex, pIndex: Integer;
  64.       var ElementStruct: TElementStruct);
  65.     procedure SetBoolArrayProp(aIndex, pIndex: Integer; Value: Boolean);
  66.     procedure SetBoolProp(pIndex: Integer; Value: Boolean);
  67.     procedure SetBStringArrayProp(aIndex, pIndex: Integer; const Value: TVBString);
  68.     procedure SetBStringProp(pIndex: Integer; const Value: TVBString);
  69.     procedure SetColorArrayProp(aIndex, pIndex: Integer; AColor: TColor);
  70.     procedure SetColorProp(pIndex: Integer; AColor: TColor);
  71.     procedure SetEnumArrayProp(aIndex, pIndex: Integer; Value: TVBEnum);
  72.     procedure SetEnumProp(pIndex: Integer; Value: TVBEnum);
  73.     procedure SetIntArrayProp(aIndex, pIndex: Integer; Value: TVBInteger);
  74.     procedure SetIntProp(pIndex: Integer; Value: TVBInteger);
  75.     procedure SetLongArrayProp(aIndex, pIndex: Integer; Value: TVBLongint);
  76.     procedure SetPictureArrayProp(aIndex, pIndex: Integer; Value: TVBPic);
  77.     procedure SetPictureProp(pIndex: Integer; Value: TVBPic);
  78.     procedure SetProp(pIndex: Integer; Value: TVBLongint);
  79.     procedure SetSingleArrayProp(aIndex, pIndex: Integer; Value: Single);
  80.     procedure SetSingleProp(pIndex: Integer; Value: Single);
  81.     procedure SetStringArrayProp(aIndex, pIndex: Integer; const Value: TVBString);
  82.     procedure SetStringProp(pIndex: Integer; const Value: TVBString);
  83.  
  84.     { Low-level event method pointer dispatchers }
  85.     procedure DispatchCustomEvent(const Event;
  86.       var VBXEvent: TWMVBXFireEvent; eIndex: Integer);
  87.     procedure DispatchKeyEvent(const Event: TKeyEvent;
  88.       var VBXEvent: TWMVBXFireEvent);
  89.     procedure DispatchKeyPressedEvent(const Event: TKeyPressEvent;
  90.       var VBXEvent: TWMVBXFireEvent);
  91.     procedure DispatchMouseEvent(const Event: TMouseEvent;
  92.       var VBXEvent: TWMVBXFireEvent);
  93.     procedure DispatchMouseMoveEvent(const Event: TMouseMoveEvent;
  94.       var VBXEvent: TWMVBXFireEvent);
  95.     procedure DispatchNotifyEvent(const Event: TNotifyEvent);
  96.  
  97.     { Event handler }
  98.     procedure HandleVBXEvent(var Message: TWMVBXFireEvent); virtual;
  99.  
  100.     { Control updating }
  101.     procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED;
  102.     procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
  103.     procedure SetName(const NewName: TComponentName); override;
  104.  
  105.     { VBX control streaming }
  106.     procedure DefineProperties(Filer: TFiler); override;
  107.     procedure HandleBinaryProperty(const Name: string; Filer: TFiler; pIndex: Integer);
  108.     procedure HandleProperty(const Name: string; Filer: TFiler; pIndex: Integer);
  109.     procedure ReadHForm(Stream: TStream);
  110.     procedure ReadState(Reader: TReader); override;
  111.     procedure WriteHForm(Stream: TStream);
  112.     procedure Loaded; override;
  113.  
  114.     { VBX Handle control }
  115.     procedure AllocateControl;
  116.     function VBXCreated: Boolean;
  117.     procedure CreateWnd; override;
  118.     procedure DestroyWindowHandle; override;
  119.     procedure WndProc(var Message: TMessage); override;
  120.  
  121.     { Squelch VCL's processing of these events }
  122.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  123.       X, Y: Integer); override;
  124.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  125.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  126.       X, Y: Integer); override;
  127.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  128.     procedure KeyUp(var Key: Word; Shift: TShiftState); override;
  129.     procedure KeyPress(var Key: Char); override;
  130.  
  131.     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  132.     procedure CMWantSpecialKey(var Message: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
  133.     procedure CNCtlColor(var Message: TWMCtlColor); message CN_CTLCOLOR;
  134.     procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  135.     procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
  136.     procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  137.   public
  138.     constructor Create(AOwner: TComponent); override;
  139.     destructor Destroy; override;
  140.  
  141.     { List access methods - These will raise an exception if the underlying
  142.       VBX control does not support them.
  143.  
  144.       AddItem    - same as "form.control.AddItem item" in VB
  145.       InsertItem - same as "form.control.AddItem item, index" in VB
  146.       RemoveItem - same as "form.control.RemoveItem item" in VB
  147.       Clear      - same as "form.control.Clear" in VB
  148.     }
  149.     procedure AddItem(const Item: string);
  150.     procedure InsertItem(Index: Integer; const Item: string);
  151.     procedure RemoveItem(Index: Integer);
  152.     procedure Clear;
  153.  
  154.     property Ctl: HCTL;
  155.     property VBXFile: PChar;
  156.     property VBXClass: PChar;
  157.   end;
  158.  
  159. procedure InitBIVBX;
  160. procedure TermBIVBX;
  161. function VBXButtonShiftToShift(VBXShift, VBXButton: Integer): TShiftState;
  162. function VBXButtonToButton(VBXButton: Integer): TMouseButton;
  163. function BStrPas(BasicStr: TBasicString): string;
  164. function BStrPCopy(const Str: string): TBasicString;
  165. procedure SetBStr(var BasicStr: TBasicString; const Str: string);
  166. function CStrPas(CStr: TCString): string;
  167.  
  168. implementation
  169.