home *** CD-ROM | disk | FTP | other *** search
/ Media Share 13 / mediashare_13.zip / mediashare_13 / ZIPPED / PROGRAM / WTJ9403.ZIP / FOLEY / DLLWIN.PAS < prev    next >
Pascal/Delphi Source File  |  1993-04-07  |  12KB  |  375 lines
  1. {$S-,R-,V-,I-,B-,F-,W-,A-,G+,X+}
  2. {$C MOVEABLE,DEMANDLOAD,DISCARDABLE}
  3.  
  4. {*********************************************************}
  5. {*                   DLLWIN.PAS 1.00                     *}
  6. {*           Copyright (c) Brian Foley 1993.             *}
  7. {*                 All rights reserved.                  *}
  8. {*********************************************************}
  9.  
  10. unit DllWin;
  11.   {-Implements TDllWin object}
  12.  
  13. interface
  14.  
  15. uses
  16.   Strings, WinTypes, WinProcs;
  17.  
  18. const
  19.   wm_First    = $0000; { $0000-$7FFF window messages }
  20.   id_First    = $8000; { $8000-$8FFF child id messages }
  21.   id_Internal = $8F00; { $8F00-$8FFF reserved for internal use }
  22.   nf_First    = $9000; { $9000-$9FFF notification messages }
  23.   nf_Internal = $9F00; { $9F00-$9FFF reserved for internal use }
  24.   cm_First    = $A000; { $A000-$FFFF command messages }
  25.   cm_Internal = $FF00; { $FF00-$FFFF reserved for internal use }
  26.   wm_Count    = $8000; { Number of window messages }
  27.   id_Count    = $1000; { Number of child ID messages }
  28.   nf_Count    = $1000; { Number of notification messages }
  29.   cm_Count    = $6000; { Number of command messages }
  30. type
  31.   PMessage = ^TMessage;
  32.   TMessage = record
  33.     Receiver : hWnd;
  34.     Message : Word;
  35.     case Integer of
  36.       0: (wParam : Word; lParam : Longint; Result : Longint);
  37.       1: (wParamLo, wParamHi : Byte;
  38.           lParamLo, lParamHi : Word;
  39.           ResultLo, ResultHi : Word);
  40.   end;
  41.  
  42.   TWindowProc =
  43.     function(HW : hWnd; Message, wParam: Word; lParam : Longint) : Longint;
  44.  
  45.   TObject = object
  46.     destructor Done; virtual;
  47.   end;
  48.  
  49.   PDllWin = ^TDllWin;
  50.   TDllWin = object(TObject)
  51.     hWindow : hWnd;             {window handle}
  52.     hParent : hWnd;             {parent's window handle}
  53.     DefaultProc : TWindowProc;  {called by DefWndProc}
  54.  
  55.     constructor Init(HW : hWnd; PCS : PCreateStruct);
  56.     destructor Done; virtual;
  57.     procedure DefWndProc(var Msg : TMessage); virtual;
  58.     procedure Free;
  59.     procedure ProcessMessage(var Msg : TMessage);
  60.     procedure wmCommand(var Msg : TMessage); virtual wm_First+wm_Command;
  61.     procedure wmCreate(var Msg : TMessage); virtual wm_First+wm_Create;
  62.     procedure wmClose(var Msg : TMessage); virtual wm_First+wm_Close;
  63.     procedure wmNCDestroy(var Msg : TMessage); virtual wm_First+wm_NCDestroy;
  64.     procedure wmPaint(var Msg : TMessage); virtual wm_First+wm_Paint;
  65.     procedure Paint(PaintDC : HDC; var PaintInfo : TPaintStruct); virtual;
  66.     procedure SetupWindow; virtual;
  67.     procedure CloseWindow;
  68.     function  CanClose : Boolean; virtual;
  69.   end;
  70.  
  71. type
  72.   PClassRec = ^TClassRec;
  73.   TClassRec = record
  74.     ClassName : PChar;    {points to class name}
  75.     VmtLink : Word;       {= 'Ofs(TypeOf(ObjectName)^)'}
  76.     Init : Pointer;       {= '@ObjectName.Init'}
  77.     Next : PClassRec;     {set to nil initially}
  78.   end;
  79.  
  80.   procedure AddWindowClass(var TCR : TClassRec);
  81.     {-Add a window class to be managed by DLLWIN}
  82.  
  83.   function TDllWndFunc(hWindow : hWnd; Msg, wParam : Word;
  84.                        lParam : Longint) : Longint; export;
  85.     {-Window function for classes based on TDllWin}
  86.  
  87.   {======================================================================}
  88.  
  89. implementation
  90.  
  91. const
  92.   gwl_DllWin = 0;
  93.  
  94.   function GetWindowPtr(HW : hWnd) : PDllWin;
  95.     {-Get the pointer to the corresponding window object}
  96.   begin
  97.     GetWindowPtr := PDllWin(GetWindowLong(HW, gwl_DllWin));
  98.   end;
  99.  
  100.   procedure SetWindowPtr(HW : hWnd; PDW : PDllWin);
  101.     {-Set the pointer to the corresponding window object}
  102.   begin
  103.     SetWindowLong(HW, gwl_DllWin, Longint(PDW));
  104.   end;
  105.  
  106. {Message dispatching}
  107.  
  108. type
  109.   {Virtual method table}
  110.   TVMT = record
  111.     InstSize : Word;          {size of the object}
  112.     NegCheckSum : Word;       {check sum (-InstSize)}
  113.     DMTPtr : Word;            {offset in data segment for DMT}
  114.     Reserved : Word;
  115.     EntryTable: record end;   {the table of method addresses}
  116.   end;
  117.  
  118.   {Dynamic method table}
  119.   TDMT = record
  120.     Parent : Word;            {offset of parent DMT}
  121.     CacheIndex : Word;        {cached index value}
  122.     CacheEntry : Word;        {cached method offset}
  123.     EntryCount : Word;        {number of entries in table}
  124.     EntryTable : record end;  {the table of method addresses}
  125.   end;
  126.  
  127. const
  128.   __DefWndProc = SizeOf(TVMT)+4;
  129.  
  130.   procedure DMTLookup; near; assembler;
  131.     {-Lookup a dynamic method call
  132.       In  AX = Dynamic method index
  133.           BX = DS-based VMT offset
  134.           DX = Default method VMT offset
  135.       Out DS:DI = Location of the method's address}
  136.   asm
  137.     MOV     SI,TVMT([BX]).DMTPtr      {DS:SI is address of the DMT}
  138.     OR      SI,SI                     {if offset is 0, no DMT
  139.     JE      @3
  140.     CMP     AX,TDMT([SI]).CacheIndex  {does AX = cached index value?}
  141.     JNE     @1                        {if not scan the table}
  142.     MOV     DI,TDMT([SI]).CacheEntry  {else return the cached entry}
  143.     JMP     @5                        {and exit}
  144. @1: MOV     DI,DS                     {ES = DS}
  145.     MOV     ES,DI
  146.     CLD                               {go forward}
  147. @2: MOV     CX,TDMT([SI]).EntryCount  {CX has # of entries in table}
  148.     LEA     DI,TDMT([SI]).EntryTable  {ES:DI points to table}
  149.     REPNE   SCASW                     {search for index in AX}
  150.     JE      @4                        {if found, save value and return}
  151.     MOV     SI,TDMT([SI]).Parent      {is there a parent DMT?}
  152.     OR      SI,SI                     {if SI <> 0, search the parent DMT}
  153.     JNZ     @2
  154. @3: ADD     BX,DX                     {BX gets VMT offset of def method}
  155.     MOV     DI,BX                     {put it in DI and return}
  156.     JMP     @5
  157. @4: MOV     DX,TDMT([SI]).EntryCount  {compute offset in entry table}
  158.     DEC     DX
  159.     SHL     DX,1
  160.     SUB     DX,CX
  161.     SHL     DX,1
  162.     ADD     DI,DX                     {add computed offset to base offset}
  163.     MOV     SI,TVMT([BX]).DMTPtr      {SI has offset of original DMT}
  164.     MOV     TDMT([SI]).CacheIndex,AX  {cache the index}
  165.     MOV     TDMT([SI]).CacheEntry,DI  {cache the offset of the method}
  166. @5:
  167.   end;
  168.  
  169.   procedure MsgPerform(PDW : PDllWin; var Msg : TMessage;
  170.                        DVMTIndex, DefVMethod : Word); assembler;
  171.   asm
  172.     MOV DX,DefVMethod     {DX has VMT offset of default virtual method}
  173.     MOV AX,DVMTIndex      {AX has dynamic method index (WM_FIRST+n)}
  174.     LES DI,Msg            {ES:DI points to Msg}
  175.     PUSH ES               {push pointer to Msg on the stack}
  176.     PUSH DI
  177.     LES BX,PDW            {ES:BX points to the window object}
  178.     PUSH ES               {push PDW on the stack}
  179.     PUSH BX
  180.     MOV BX,ES:[BX]        {BX has the offset of the object's VMT}
  181.     CALL DMTLookup        {lookup the method to call}
  182.     CALL DWORD PTR [DI]   {call the method whose address is at DS:[DI]}
  183.   end;
  184.  
  185.   destructor TObject.Done;
  186.   begin
  187.   end;
  188.  
  189. {TDllWin}
  190.  
  191.   constructor TDllWin.Init(HW : hWnd; PCS : PCreateStruct);
  192.   begin
  193.     SetWindowPtr(HW, @Self);
  194.     hWindow := HW;
  195.     hParent := PCS^.hwndParent;
  196.     DefaultProc := DefWindowProc;
  197.   end;
  198.  
  199.   destructor TDllWin.Done;
  200.   begin
  201.     if hWindow <> 0 then
  202.       DestroyWindow(hWindow);
  203.   end;
  204.  
  205.   procedure TDllWin.Free;
  206.   begin
  207.     Dispose(PDllWin(@Self), Done);
  208.   end;
  209.  
  210.   procedure TDllWin.ProcessMessage(var Msg : TMessage);
  211.   begin
  212.     MsgPerform(@Self, Msg, wm_First+Msg.Message, __DefWndProc);
  213.   end;
  214.  
  215.   procedure TDllWin.DefWndProc(var Msg : TMessage); assembler;
  216.   asm
  217.     LES  DI,Self
  218.     PUSH TDllWin(ES:[DI]).DefaultProc.Word[2]
  219.     PUSH TDllWin(ES:[DI]).DefaultProc.Word[0]
  220.     PUSH TDllWin(ES:[DI]).hWindow
  221.     LES  DI,Msg
  222.     PUSH TMessage(ES:[DI]).Message
  223.     PUSH TMessage(ES:[DI]).WParam
  224.     PUSH TMessage(ES:[DI]).LParamHi
  225.     PUSH TMessage(ES:[DI]).LParamLo
  226.     CALL CallWindowProc
  227.     LES  DI,Msg
  228.     MOV  TMessage(ES:[DI]).ResultLo,AX
  229.     MOV  TMessage(ES:[DI]).ResultHi,DX
  230.   end;
  231.  
  232.   procedure TDllWin.wmCommand(var Msg : TMessage);
  233.   begin
  234.     if (Msg.wParam < cm_Count) then
  235.       MsgPerform(@Self, Msg, cm_First+Msg.wParam, __DefWndProc)
  236.     else if (Msg.lParamHi < nf_Count) then
  237.       MsgPerform(@Self, Msg, nf_First+Msg.lParamHi, __DefWndProc)
  238.     else if Msg.wParam < id_Count then
  239.       MsgPerform(@Self, Msg, id_First+Msg.wParam, __DefWndProc)
  240.     else
  241.       DefWndProc(Msg);
  242.   end;
  243.  
  244.   procedure TDllWin.wmCreate(var Msg : TMessage);
  245.   begin
  246.     SetupWindow;
  247.     DefWndProc(Msg);
  248.   end;
  249.  
  250.   procedure TDllWin.wmClose(var Msg : TMessage);
  251.   begin
  252.     CloseWindow;
  253.   end;
  254.  
  255.   procedure TDllWin.wmNCDestroy(var Msg : TMessage);
  256.   begin
  257.     SetWindowPtr(hWindow, nil);
  258.     DefWndProc(Msg);
  259.     hWindow := 0;
  260.   end;
  261.  
  262.   procedure TDllWin.wmPaint(var Msg: TMessage);
  263.   var
  264.     PaintInfo : TPaintStruct;
  265.   begin
  266.     BeginPaint(hWindow, PaintInfo);
  267.     Paint(PaintInfo.HDC, PaintInfo);
  268.     EndPaint(hWindow, PaintInfo);
  269.   end;
  270.  
  271.   procedure TDllWin.Paint(PaintDC : HDC; var PaintInfo : TPaintStruct);
  272.   begin
  273.   end;
  274.  
  275.   procedure TDllWin.SetupWindow;
  276.   begin
  277.   end;
  278.  
  279.   procedure TDllWin.CloseWindow;
  280.   begin
  281.     if CanClose then
  282.       Free;
  283.   end;
  284.  
  285.   function TDllWin.CanClose : Boolean;
  286.   begin
  287.     CanClose := True;
  288.   end;
  289.  
  290. {support functions}
  291.  
  292. const
  293.   FirstClass : PClassRec = nil;
  294.   LastClass : PClassRec = nil;
  295.  
  296.   procedure AddWindowClass(var TCR : TClassRec);
  297.   begin
  298.     if FirstClass = nil then
  299.       FirstClass := @TCR
  300.     else
  301.       LastClass^.Next := @TCR;
  302.     TCR.Next := nil;
  303.     LastClass := @TCR;
  304.   end;
  305.  
  306.   function FindClassByName(Name : PChar) : PClassRec;
  307.   var
  308.     PCR : PClassRec;
  309.   begin
  310.     PCR := FirstClass;
  311.     while PCR <> nil do
  312.       if StrIComp(Name, PCR^.ClassName) = 0 then begin
  313.         FindClassByName := PCR;
  314.         Exit;
  315.       end
  316.       else
  317.         PCR := PCR^.Next;
  318.     FindClassByName := nil;
  319.   end;
  320.  
  321.   function CreateWindowObject(Name : PChar; HW : hWnd;
  322.                               PCS : PCreateStruct) : PDllWin; assembler;
  323.   asm
  324.     LES DI,Name                     {ES:DI points to Name}
  325.     PUSH ES
  326.     PUSH DI
  327.     CALL FindClassByName            {see if the name is registered}
  328.     MOV BX,DX
  329.     OR BX,AX
  330.     JZ @1                           {not found if DX:AX = 0}
  331.     MOV ES,DX
  332.     MOV DI,AX
  333.     PUSH HW                         {push HW and PCS onto the stack}
  334.     PUSH PCS.Word[2]
  335.     PUSH PCS.Word[0]
  336.     PUSH TClassRec(ES:[DI]).VmtLink {push the VMT link on the stack}
  337.     XOR AX,AX                       {push a nil pointer on the stack}
  338.     PUSH AX
  339.     PUSH AX
  340.     CALL TClassRec(ES:[DI]).Init    {call the constructor}
  341. @1:
  342.   end;
  343.  
  344.   function TDllWndFunc(hWindow : hWnd;
  345.                        Msg     : Word;
  346.                        wParam  : Word;
  347.                        lParam  : Longint) : Longint;
  348.   var
  349.     PDW : PDllWin;
  350.     PCreate : PCreateStruct absolute lParam;
  351.     Message : TMessage;
  352.   begin
  353.     if Msg = wm_Create then
  354.       PDW := CreateWindowObject(PCreate^.lpszClass, hWindow, PCreate)
  355.     else
  356.       PDW := GetWindowPtr(hWindow);
  357.  
  358.     if PDW = nil then
  359.       TDllWndFunc := DefWindowProc(hWindow, Msg, wParam, lParam)
  360.     else begin
  361.       Message.Receiver := hWindow;
  362.       Message.Message := Msg;
  363.       Message.wParam := wParam;
  364.       Message.lParam := lParam;
  365.       Message.Result := 1;
  366.       if Msg = wm_Command then
  367.         PDW^.wmCommand(Message)
  368.       else
  369.         PDW^.ProcessMessage(Message);
  370.       TDllWndFunc := Message.Result;
  371.     end;
  372.   end;
  373.  
  374. end.
  375.