home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / tpascal / hotmap / hotmap.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-27  |  6.3 KB  |  166 lines
  1. {********************************************}
  2. {*                                          *}
  3. {*   HOTMAP.PAS generated from HOTMAP.VBX   *}
  4. {*                                          *}
  5. {********************************************}
  6.  
  7. unit Hotmap;
  8.  
  9. interface
  10.  
  11. uses SysUtils, Classes, Graphics, Forms, Controls, VBXCtrl, BIVBX;
  12.  
  13. { $DEFINE InitTHotMap}
  14. {^- Remove space to enable default init data -- See documentation. }
  15.  
  16. type
  17.   THotMapLinkErrorEvent = procedure (Sender: TObject; var LinkErr: Integer)
  18.     of object;
  19.   THotMapLinkCloseEvent = procedure (Sender: TObject) of object;
  20.   THotMapLinkOpenEvent = procedure (Sender: TObject; var Cancel: Integer) of
  21.     object;
  22.   THotMapLinkChangeEvent = procedure (Sender: TObject) of object;
  23.   THotMapRegionMouseDownEvent = procedure (Sender: TObject; var RegionNum:
  24.     Single; var Button: Integer) of object;
  25.   THotMapRegionMouseUpEvent = procedure (Sender: TObject; var RegionNum:
  26.     Single; var Button: Integer) of object;
  27.   THotMapRegionMouseOverEvent = procedure (Sender: TObject; var RegionNum:
  28.     Single) of object;
  29.  
  30.   { THotMap }
  31.  
  32.   THotMap = class(TVBXControl)
  33.   protected
  34.     FOnLinkError: THotMapLinkErrorEvent;
  35.     FOnLinkClose: THotMapLinkCloseEvent;
  36.     FOnLinkOpen: THotMapLinkOpenEvent;
  37.     FOnLinkChange: THotMapLinkChangeEvent;
  38.     FOnRegionMouseDown: THotMapRegionMouseDownEvent;
  39.     FOnRegionMouseUp: THotMapRegionMouseUpEvent;
  40.     FOnRegionMouseOver: THotMapRegionMouseOverEvent;
  41.     { Event handler }
  42.     procedure HandleVBXEvent(var Message: TWMVBXFireEvent); override;
  43.     procedure DefineProperties(Filer: TFiler); override;
  44.   public
  45.     constructor Create(AOwner: TComponent); override;
  46.  
  47.     property Index: TVBInteger index 1 read GetIntProp;
  48.     property RegionString[Index: Integer]: TVBString index 12 read
  49.       GetStringArrayProp write SetStringArrayProp;
  50.     property MyTag: TVBString index 14 read GetBStringProp write
  51.       SetBStringProp;
  52.     property MyTagMsg: TVBString index 19 read GetBStringProp write
  53.       SetBStringProp;
  54.     property NumOfRgns: TVBInteger index 21 read GetIntProp write SetIntProp;
  55.     property RegionColor[Index: Integer]: TColor index 28 read
  56.       GetColorArrayProp write SetColorArrayProp;
  57.   published
  58.     property BackColor: TColor index 2 read GetColorProp write SetColorProp
  59.       default -2147483633;
  60.     property Visible;
  61.     property DragMode;
  62.     property DragCursor;
  63.     property MouseCursor: TVBPic index 13 read GetPictureProp write
  64.       SetPictureProp stored False;
  65.     property LinkTopic: TVBString index 15 read GetStringProp write
  66.       SetStringProp;
  67.     property LinkItem: TVBString index 16 read GetStringProp write
  68.       SetStringProp;
  69.     property LinkTimeOut: TVBInteger index 17 read GetIntProp write
  70.       SetIntProp default 50;
  71.     property LinkMode: TVBEnum index 18 read GetEnumProp write SetEnumProp
  72.       default 0;
  73.     property BmpName: TVBString index 20 read GetStringProp write
  74.       SetStringProp;
  75.     property FillType: TVBEnum index 22 read GetEnumProp write SetEnumProp;
  76.     property Stretch: Boolean index 23 read GetBoolProp write SetBoolProp;
  77.     property CurrentRgn: TVBInteger index 24 read GetIntProp write SetIntProp;
  78.     property Action: TVBEnum index 25 read GetEnumProp write SetEnumProp
  79.       stored False;
  80.     property About: TVBEnum index 26 read GetEnumProp write SetEnumProp
  81.       stored False;
  82.     property DataFile: TVBString index 27 read GetStringProp write
  83.       SetStringProp;
  84.     property ColorMode: Boolean index 29 read GetBoolProp write SetBoolProp;
  85.     property DragAllowed: Boolean index 30 read GetBoolProp write SetBoolProp;
  86.     property MouseHotX: TVBInteger index 31 read GetIntProp write SetIntProp;
  87.     property MouseHotY: TVBInteger index 32 read GetIntProp write SetIntProp;
  88.     property OnClick;
  89.     property OnDragDrop;
  90.     property OnEndDrag;
  91.     property OnDragOver;
  92.     property OnLinkError: THotMapLinkErrorEvent read FOnLinkError write
  93.       FOnLinkError;
  94.     property OnLinkClose: THotMapLinkCloseEvent read FOnLinkClose write
  95.       FOnLinkClose;
  96.     property OnLinkOpen: THotMapLinkOpenEvent read FOnLinkOpen write
  97.       FOnLinkOpen;
  98.     property OnLinkChange: THotMapLinkChangeEvent read FOnLinkChange write
  99.       FOnLinkChange;
  100.     property OnRegionMouseDown: THotMapRegionMouseDownEvent read
  101.       FOnRegionMouseDown write FOnRegionMouseDown;
  102.     property OnRegionMouseUp: THotMapRegionMouseUpEvent read FOnRegionMouseUp
  103.       write FOnRegionMouseUp;
  104.     property OnRegionMouseOver: THotMapRegionMouseOverEvent read
  105.       FOnRegionMouseOver write FOnRegionMouseOver;
  106.     property OnMouseDown;
  107.     property OnMouseMove;
  108.     property OnMouseUp;
  109.   end;
  110.  
  111. procedure Register;
  112.  
  113. implementation
  114.  
  115. { THotMap }
  116.  
  117. constructor THotMap.Create(AOwner: TComponent);
  118. begin
  119.   FVBXFile := StrNew('HOTMAP.VBX');
  120.   FVBXClass := StrNew('HotMap');
  121.   SetBounds(0, 0, 80, 32);
  122.   inherited Create(AOwner);
  123.   ControlStyle := ControlStyle - [csCaptureMouse, csClickEvents];
  124.   FVBXFlags := [vfArrows, vfLoadMessage];
  125.   {$IFDEF InitTHotMap}
  126.   FHForm := VBXCreateFormFile(THotMapInitLen, @THotMapInitData);
  127.   {$ENDIF}
  128. end;
  129.  
  130. procedure THotMap.HandleVBXEvent(var Message: TWMVBXFireEvent);
  131. begin
  132.   case Message.VBXEvent^.EventIndex of
  133.     0: DispatchNotifyEvent(OnClick);
  134.     1: begin end; { VCL Handles OnDragDrop }
  135.     2: begin end; { VCL Handles OnDragOver }
  136.     3: DispatchCustomEvent(FOnLinkError, Message, 3);
  137.     4: DispatchCustomEvent(FOnLinkClose, Message, 4);
  138.     5: DispatchCustomEvent(FOnLinkOpen, Message, 5);
  139.     6: DispatchCustomEvent(FOnLinkChange, Message, 6);
  140.     7: DispatchCustomEvent(FOnRegionMouseDown, Message, 7);
  141.     8: DispatchCustomEvent(FOnRegionMouseUp, Message, 8);
  142.     9: DispatchCustomEvent(FOnRegionMouseOver, Message, 9);
  143.     10: DispatchMouseEvent(OnMouseDown, Message);
  144.     11: DispatchMouseMoveEvent(OnMouseMove, Message);
  145.     12: DispatchMouseEvent(OnMouseUp, Message);
  146.   end;
  147. end;
  148.  
  149. procedure THotMap.DefineProperties(Filer: TFiler);
  150. begin
  151.   inherited DefineProperties(Filer);
  152.   HandleBinaryProperty('MouseCursor_Data', Filer, 13);
  153.   HandleProperty('MyTag', Filer, 14);
  154.   HandleProperty('MyTagMsg', Filer, 19);
  155.   HandleBinaryProperty('NumOfRgns', Filer, 21);
  156. end;
  157.  
  158. { Designer registration }
  159. procedure Register;
  160. begin
  161.   RegisterComponents('VBX', [
  162.     THotMap]);
  163. end;
  164.  
  165. end.
  166.