home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / bp_4_94 / vbwin / pasvbx / quickhlp.pas next >
Pascal/Delphi Source File  |  1994-10-23  |  13KB  |  418 lines
  1. { (c) by Kai Oliver Marohn }
  2. {        Stormstra▀e 19    }
  3. {        44651 Herne       }
  4. {$F+,N+,C FIXED MOVEABLE DISCARDABLE}
  5. {$R QUICKHLP}
  6. {DEFINE SHAREWARE}
  7. {$DEFINE RUNTIME}
  8. Library QUICK;
  9. Uses WinTypes,WinProcs,VBAPI_,Strings,Win31,Objects;
  10.  
  11. Const QDISPLAY:PCHAR = 'QuickDisplay';
  12.       ControlSEG     = 'QHCTRLSEG';
  13.       ControlOFS     = 'QHCTRLOFS';
  14.  
  15. Type PQUICK = ^TQUICK;
  16.      TQUICK = Record
  17.                 LinkedCTL : hCTL;
  18.                 Quick     : hWnd;
  19.                 hFont     : hFont;
  20.                 HLPWnd    : hWnd;
  21.                 Status    : Boolean; {False = Nix; True = Hilfemodus}
  22.                 CNT       : Byte;
  23.               End;
  24.  
  25. Var Gen               : TQUICK;         {}
  26.     DLLUSE            : Integer;
  27.  
  28. {zusΣtzliche Properties ! begin}
  29. {zusΣtzliche Properties ! end}
  30.  
  31. Const   IDBMP_QUICK        =8000; {Resourceid fuer die Bitmaps im Toolbar}
  32.         IDBMP_QUICKDOWN    =8001;
  33.         IDBMP_QUICKMONO    =8003;
  34.         IDBMP_QUICKEGA     =8006;
  35.  
  36.  
  37. Const   VBX_COMPANYNAME        ='Oliver Marohn';
  38.         VBX_FILEDESCRIPTION       ='Visual Basic Custom Control Beisiel';
  39.         VBX_INTERNALNAME       ='QUICK';
  40.         VBX_LEGALCOPYRIGHT       ='Copyright \251 Oliver Marohn 94';
  41.         VBX_LEGALTRADEMARKS       ='Microsoft\256 is a registered trademark of Microsoft Corporation';
  42.         VBX_ORIGINALFILENAME       ='G.VBX';
  43.         VBX_PRODUCTNAME        ='Microsoft\256 Visual Basic\231 for Windows\231\0';
  44.  
  45.         VBX_VERSION           ='3,00,0,00';
  46.         VBX_VERSION_STR        ='3.00.000\0';
  47.  
  48.  
  49. Const IPROP_QUICK_CTLNAME          =    0;  {fⁿr den Zugriff auf die einzelnen Prporties}
  50.       IPROP_QUICK_LEFT             =    1;
  51.       IPROP_QUICK_TOP              =    2;
  52.       IPROP_QUICK_PARENT           =    3;
  53.       IPROP_QUICK_TAG              =    4;
  54.       IPROP_QUICK_HWND             =    5;
  55.       IPROP_QUICK_ALIGN            =    6;
  56.       IPROP_QUICK_FONTNAME         =    7;
  57.       IPROP_QUICK_FONTBOLD         =    8;
  58.       IPROP_QUICK_FONTITALIC       =    9;
  59.       IPROP_QUICK_FONTSTRIKE       =   10;
  60.       IPROP_QUICK_FONTUNDER        =   11;
  61.       IPROP_QUICK_FONTSIZE         =   12;
  62.  
  63. Const numPR =  13; {Anzahl der Properties}
  64. Type TPR = Array[0..numPR] of OfsPPROPINFO;
  65. Const
  66.  QUICK_Properties:TPR =
  67.     (
  68.     PPROPINFO_STD_CTLNAME,
  69.     PPROPINFO_STD_LEFT,
  70.     PPROPINFO_STD_TOP,
  71.     PPROPINFO_STD_PARENT,
  72.     PPROPINFO_STD_TAG,
  73.     PPROPINFO_STD_HWND,
  74.     PPROPINFO_STD_ALIGN,
  75.     PPROPINFO_STD_FONTNAME,
  76.     PPROPINFO_STD_FONTBOLD,
  77.     PPROPINFO_STD_FONTITALIC,
  78.     PPROPINFO_STD_FONTSTRIKE,
  79.     PPROPINFO_STD_FONTUNDER,
  80.     PPROPINFO_STD_FONTSIZE,
  81.     0
  82.     );
  83.  
  84. Const numEV = 0; {Anzahl der Events}
  85. Type TEV = Array[0..numEV] of OfsPEVENTINFO;
  86.  
  87. Const
  88.  QUICK_Events:TEV=
  89.     (
  90.     0
  91.     );
  92.  
  93. Const DCN  : Array[0..9] of Char = 'QuickHELP';    {Der Contol Name}
  94.  
  95. Var EV : TEV;
  96.     PR : TPR;
  97.  
  98. Const
  99.   cmodelQUICK:TMODEL =
  100.     (
  101.     usVersion : VB_VERSION;                { VB version being used}
  102.     fl:MODEL_fInVisAtRun or MODEL_fInitMsg;                       { Model Flags}
  103.     ctlproc:Nil;                        { Control procedure in INIT einsetzen}
  104.     fsClassStyle:0;                            { Class style}
  105.     flWndStyle:0;                    { Default Windows style}
  106.     cbCtlExtra:SizeOf(TQUICK);                   { Size of QUICK structure}
  107.     idBMPPalette:IDBMP_QUICK;            { Palette bitmap ID}
  108.     DefCtlName:Ofs(DCN);            { Default control name in INIT einsetzen}
  109.     ClassName:Ofs(DCN);                { Visual Basic class name in INIT einsetzen}
  110.     ParentClassName:0;                { Parent class name}
  111.     propList:0;                            { Property information table in INIT einsetzen}
  112.     eventlist:0;                    { Event information table in INIT einsetzen}
  113.     nDefProp:IPROP_QUICK_CTLNAME;               { Default property}
  114.     nDefEvent:Byte(-1);                            { Default event}
  115.     nValueProp:Byte(IPROP_QUICK_CTLNAME)        { Property representing value of ctl}
  116.     );
  117.  
  118.  
  119. {Hilfsfunktionen in C als Makro}
  120. Function lpQUICKDEREF(hCtl:hCtl):PQUICK;
  121. Begin;
  122.   lpQUICKDEREF:=PQUICK(VBDerefControl(hCtl));
  123. End;
  124.  
  125. Function GetSTDPropIndex(Ctl:hCtl;Prop:ofsPPROPINFO;Modell:lpModel):Integer;
  126. Type PropArray = Array[0..100] of OfsPPROPINFO;
  127.      PPropList = ^PropArray;
  128.  
  129. Var  lpPropList : PPROPLIST;
  130.      i          : Integer;
  131.  
  132. Begin;
  133.   GetSTDPropIndex:=-1;
  134.   lpPropList:=PPropList(MakeLong(Modell^.PropList,Seg(Modell^)));
  135.   i:=0;
  136.   While (lpPropList^[i]<>0)  do
  137.   begin;
  138.     If lpPropList^[i]=Prop Then
  139.     Begin;
  140.       GetSTDPropIndex:=i;
  141.       Exit;
  142.     End;
  143.     Inc(i);
  144.   End;
  145. End;
  146.  
  147. Function QUICKCtlProc(MyCtl:HCTL;Wnd:HWnd;msg,wp:USHORT;lp:LongInt):LongInt; export;
  148. Var WFromPT   : hWnd;
  149.     MPos      : TPoint;
  150.     CTLFromPt : hCtl;
  151.     TMPHSZ    : HSZ;
  152.     iTag      : Integer;
  153.     l         : LongInt;
  154.     CTLMod    : lpModel;
  155.     lpStr     : PChar;
  156.     RetStr    : Array[0..255] of Char;
  157.     DumStr    : Array[0..255] of Char;
  158.     e,d       : Integer;
  159.  
  160.   Procedure ShowHelp;
  161.   Begin;
  162.     StrCopy(RetStr,'');
  163.     If isWindow(WFromPt) And
  164.        isWindowVisible(WFromPt) And
  165.        isWindowEnabled(WFromPt) Then
  166.     Begin;
  167.       CTLFromPt:=VBGetHWNDControl(WFromPt);
  168.       If CTLFromPt<>Nil Then
  169.       Begin;
  170.         CTLMod:=VBGetControlModel(CTLFromPt);
  171.         If CTLMod<>Nil Then
  172.         Begin;
  173.           iTag:=GetSTDPropIndex(CTLFromPt,ppropinfo_Std_TAG,CTLMod);
  174.           If iTag<>-1 Then
  175.           Begin;
  176.             l:=VBGetControlProperty(CTLFromPt,iTag,@TMPHsz);
  177.             If l=0 then
  178.             Begin;
  179.               lpStr:=VBLockHSZ(TMPHsz);
  180.               If (lpStr<>Nil) And (StrLIComp(lpStr,'@',1)=0) Then
  181.               Begin;
  182.                 StrCopy(RetStr,lpStr+1);
  183.                 VBUnLockHSZ(TMPHsz);
  184.                 VBDestroyHsz(TMPHsz);
  185.               End;
  186.             End;
  187.           End;
  188.         End;
  189.       End;
  190.     End;
  191.     SendMessage(lpQUICKDEREF(MyCtl)^.Quick,WM_SETTEXT,0,LongInt(@RetStr));
  192.   End;
  193.  
  194. Begin
  195.   Case msg of
  196.     WM_NCCREATE :
  197.       Begin;
  198.         lpQUICKDEREF(MyCtl)^.HLPWnd:=0;
  199.         lpQUICKDEREF(MyCtl)^.Status:=False;
  200.         lpQUICKDEREF(MyCtl)^.CNT:=0;
  201.       End;
  202.     WM_SETFONT :
  203.       Begin;
  204.         lpQUICKDEREF(MyCtl)^.hFont:=wp;
  205.         QUICKCtlProc:=0;
  206.         Exit;
  207.       End;
  208.     WM_GETFONT :
  209.       Begin;
  210.         QUICKCtlProc:=lpQUICKDEREF(MyCtl)^.hFont;
  211.         Exit;
  212.       End;
  213.     WM_CREATE :
  214.       If (VBGetMode=MODE_RUN) Then
  215.       Begin;
  216.         lpQUICKDEREF(MyCtl)^.Quick:=CreateWindow(QDISPLAY,
  217.                  Nil,
  218.                  WS_BORDER or WS_POPUP {or WS_VISIBLE},
  219.                  10,10,100,50,Wnd,0,HINSTANCE,Nil);;
  220.         SetProp(lpQUICKDEREF(MyCtl)^.Quick,ControlSEG,LongRec(MyCtl).Hi);
  221.         SetProp(lpQUICKDEREF(MyCtl)^.Quick,ControlOFS,LongRec(MyCtl).Lo);
  222.         SetTimer(WND,4711,100,Nil);
  223.       End;
  224.     WM_DESTROY:
  225.       Begin;
  226.         If (VBGetMode=MODE_RUN) Then
  227.         Begin;
  228.           KillTimer(WND,4711);
  229.           RemoveProp(lpQUICKDEREF(MyCtl)^.Quick,ControlSEG);
  230.           RemoveProp(lpQUICKDEREF(MyCtl)^.Quick,ControlOFS);
  231.           DestroyWindow(lpQUICKDEREF(MyCtl)^.Quick);
  232.         End;
  233.       End;
  234.     WM_TIMER:
  235.       Begin;
  236.         If (VBGetMode=MODE_RUN) Then
  237.         Begin;
  238.           If (Hi(GetKeyState(VK_LBUTTON)) And 128 = 128) or
  239.              (Hi(GetKeyState(VK_RBUTTON)) And 128 = 128) or
  240.              (Hi(GetKeyState(VK_MBUTTON)) And 128 = 128) Then
  241.           Begin;
  242.             ShowWindow(lpQUICKDEREF(MyCtl)^.Quick,SW_HIDE);
  243.             lpQUICKDEREF(MyCtl)^.CNT:=0;
  244.             lpQUICKDEREF(MyCtl)^.HLPWnd:=0;
  245.             lpQUICKDEREF(MyCtl)^.Status:=False;
  246.             Exit;
  247.           End;
  248.           GetCursorPos(MPos);
  249.           WFromPt:=WindowFromPoint(MPos);
  250.           If WFromPt=lpQUICKDEREF(MyCtl)^.Quick then
  251.           Begin;
  252.             ShowWindow(lpQUICKDEREF(MyCtl)^.Quick,SW_HIDE);
  253.             lpQUICKDEREF(MyCtl)^.CNT:=0;
  254.             lpQUICKDEREF(MyCtl)^.HLPWnd:=0;
  255.             lpQUICKDEREF(MyCtl)^.Status:=False;
  256.             Exit;
  257.           End;
  258.           If lpQUICKDEREF(MyCtl)^.Status Then
  259.           Begin;
  260.             If (WFromPt<>lpQUICKDEREF(MyCtl)^.HLPWnd) And
  261.                (lpQUICKDEREF(MyCtl)^.CNT<=10) Then  {Neues Fenster}
  262.             Begin;
  263.               lpQUICKDEREF(MyCtl)^.CNT:=0;
  264.               lpQUICKDEREF(MyCtl)^.HLPWnd:=WFromPt;
  265.               ShowHelp;
  266.             End;
  267.           End Else
  268.           Begin;  {Hilfe noch nicht angezeigt}
  269.             Inc(lpQUICKDEREF(MyCtl)^.CNT);
  270.             If lpQUICKDEREF(MyCtl)^.CNT>=40 Then
  271.             Begin;
  272.               lpQUICKDEREF(MyCtl)^.CNT:=0;
  273.               lpQUICKDEREF(MyCtl)^.HLPWnd:=WFromPt;
  274.               ShowHelp;
  275.             End;
  276.           End;
  277.         End;
  278.       End;
  279.   End;
  280.   QUICKCtlProc:=VBDefControlProc(MyCtl, Wnd, msg, wp, lp);
  281. End;
  282.  
  283. Var modelQUICK    : TModel;
  284.  
  285. Function QDISPLAYFN(MyWnd: HWnd; Message, WParam: Word;LParam: Longint): LongInt; export;
  286. Var MyDC   : hDC;
  287.     R      : TRect;
  288.     MPos,
  289.     WPos   : TPoint;
  290.     MyCtl  : hCtl;
  291.     OldFont: hFont;
  292.     WndR   : TRect;
  293.  
  294.  
  295. Begin;
  296.   Case Message of
  297.     WM_SETTEXT :
  298.        Begin;
  299.          LongRec(MyCtl).Hi:=GetProp(MyWnd,ControlSEG);
  300.          LongRec(MyCtl).Lo:=GetProp(MyWnd,ControlOFS);
  301.          ShowWindow(MyWnd,SW_HIDE);
  302.          If StrLen(PCHAR(lParam))<>0 Then
  303.          Begin;
  304.            lpQUICKDEREF(MyCtl)^.Status:=True;
  305.            GetCursorPos(MPos);
  306.            MyDC:=GetDC(MyWnd);
  307.            If lpQUICKDEREF(MyCtl)^.hFont<>0
  308.              then OldFont:=SelectObject(MyDc,lpQUICKDEREF(MyCtl)^.hFont)
  309.              else OldFont:=SelectObject(MyDc,GetStockObject(SYSTEM_FONT));
  310.            DrawText(MyDC,PCHAR(LParam),-1,R,DT_CENTER or DT_SINGLELINE or DT_CALCRECT);
  311.            InflateRect(R,5,1);
  312.            GetWindowRect(lpQUICKDEREF(MyCtl)^.HLPWnd,WndR);
  313.  
  314.            WPos.Y:=MPos.Y+GetSystemMetrics(SM_CYCURSOR)-10;
  315.            WPos.X:=MPos.X-2;
  316.            If WPos.Y+(R.Bottom-R.Top)>GetSystemMetrics(SM_CYSCREEN)
  317.              then WPos.Y:=MPos.Y-(R.Bottom-R.Top) -10;
  318.  
  319.            If WPos.X+(R.Right-R.Left)>GetSystemMetrics(SM_CXSCREEN)
  320.              then WPos.X:=GetSystemMetrics(SM_CXSCREEN)-(R.Right-R.Left);
  321.  
  322.            SetWindowPos(MyWnd,0,
  323.              WPos.X,
  324.              WPos.Y,
  325.              (R.Right-R.Left),
  326.              (R.Bottom-R.Top),
  327.               SWP_NOZORDER or SWP_NOACTIVATE);
  328.  
  329.            ShowWindow(MyWnd,SW_SHOWNOACTIVATE);
  330.            SetBKMode(MyDC,TRANSPARENT);
  331.            GetClientRect(MyWnd,R);
  332.            DrawText(MyDC,PCHAR(LParam),-1,R,DT_CENTER or DT_SINGLELINE or DT_VCENTER);
  333.            SelectObject(MyDC,OldFont);
  334.            ReleaseDC(MyWnd,MyDC);
  335.          End Else
  336.            Begin;
  337.              If lpQUICKDEREF(MyCtl)^.CNT>10 Then
  338.              Begin;
  339.                lpQUICKDEREF(MyCtl)^.Status:=False;
  340.                lpQUICKDEREF(MyCtl)^.CNT:=0;
  341.              End Else
  342.              Begin;
  343.                lpQUICKDEREF(MyCtl)^.Status:=False;
  344.                Inc(lpQUICKDEREF(MyCtl)^.CNT);
  345.              End;
  346.            End;
  347.        End;
  348.     Else QDISPLAYFN:=DefWindowProc(MyWnd,Message,wParam,lParam);
  349.   End;
  350. End;
  351.  
  352. Function VBINITCC(usVersion:UShort;fRuntime:Bool):Bool; export;
  353. Var ClassInfo : TWndClass;
  354. Const SmallAbout : PChar =
  355.                         'Dies ist die VBX Runtimeversion!'#10#13#10#13#9+
  356.                         'Oliver Marohn'#10#13#9+
  357.                         'Stormstrasse 19'#10#13#10#13#9+
  358.                         '44651 Herne';
  359. Begin;
  360. {$IFDEF RUNTIME}
  361.   If Not(fRuntime) then
  362.   Begin;
  363.     MessageBox(Getfocus,SmallAbout,'ACHTUNG !',MB_OK or MB_ICONSTOP);
  364.     Exit;
  365.   End;
  366. {$ENDIF}
  367.   Inc(DLLUSE);
  368.   If DLLUSE=1 Then
  369.   Begin;
  370.     With ClassInfo do
  371.     Begin;
  372.       Style:=CS_SAVEBITS or CS_VREDRAW or CS_HREDRAW;
  373.       lpfnWndProc:=@QDISPLAYFN;
  374.       cbClsExtra:=0;
  375.       cbWndExtra:=0;
  376.       hIcon:=0;
  377.       hCursor:=LoadCursor(0,IDC_ARROW);
  378.       hBrBackGround:=CreateSolidBrush(RGB(255,255,$80));
  379.       lpszMenuName:=Nil;
  380.       lpszClassName:=QDISPLAY;
  381.     End;
  382.     ClassInfo.hInstance:=HINSTANCE;
  383.     If Not RegisterClass(ClassInfo) then
  384.     Begin;
  385.       MessageBox(Getfocus,'ERROR !','',MB_OK);
  386.     End
  387.   End;
  388.   VBINITCC:= VBRegisterModel(HINSTANCE, modelQUICK);
  389. End;
  390.  
  391. Procedure VBTERMCC; export;
  392. Begin;
  393.   Dec(DLLUSE);
  394.   If DLLUSE=1 Then
  395.   Begin;
  396.     UnRegisterClass(QDISPLAY,HINSTANCE);
  397.   End;
  398. End;
  399.  
  400. exports
  401.  VBINITCC           index 1,
  402.  QUICKCtlProc       index 2,
  403.  VBTERMCC           Index 3,
  404.  QDISPLAYFN         Index 4;
  405.  
  406. Begin;
  407.   DLLUSE:=0;
  408.   modelQUICK:=cModelQUICK;                     {defaults setzen}
  409.   ModelQUICK.ctlProc:=@QUICKCtlProc;           {und die die nicht in Pascalsyntax defenierbaren}
  410.                                                  {hier einsetzen}
  411.   EV:=QUICK_EVENTS;
  412.  
  413.   PR:=QUICK_Properties;
  414.  
  415.   ModelQUICK.PropList:=Ofs(PR);
  416.   ModelQUICK.EventList:=Ofs(EV);
  417. End.
  418.