home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Programmer'…arterly (Limited Edition) / Visual_Basic_Programmers_Journal_VB-CD_Quarterly_Limited_Edition_1995.iso / code / ch27code / frmstub.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-08-01  |  14.6 KB  |  334 lines
  1. VERSION 4.00
  2. Begin VB.Form frmStubborn 
  3.    Caption         =   "Handling Stubborn Apps"
  4.    ClientHeight    =   3825
  5.    ClientLeft      =   2865
  6.    ClientTop       =   5265
  7.    ClientWidth     =   7200
  8.    Height          =   4230
  9.    Icon            =   "FRMSTUB.frx":0000
  10.    Left            =   2805
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    ScaleHeight     =   255
  14.    ScaleMode       =   3  'Pixel
  15.    ScaleWidth      =   480
  16.    Top             =   4920
  17.    Width           =   7320
  18.    Begin VB.Frame Frame1 
  19.       Caption         =   "Exchange Data"
  20.       Height          =   915
  21.       Left            =   120
  22.       TabIndex        =   0
  23.       Top             =   2340
  24.       Width           =   3495
  25.       Begin VB.OptionButton opt 
  26.          Caption         =   "Send Text to a Window"
  27.          Height          =   255
  28.          Index           =   1
  29.          Left            =   120
  30.          TabIndex        =   2
  31.          Top             =   540
  32.          Width           =   3255
  33.       End
  34.       Begin VB.OptionButton opt 
  35.          Caption         =   "Get Text From a Window"
  36.          Height          =   255
  37.          Index           =   0
  38.          Left            =   120
  39.          TabIndex        =   1
  40.          Top             =   240
  41.          Width           =   3255
  42.       End
  43.    End
  44.    Begin VB.CommandButton cmd 
  45.       Caption         =   "Communicate with Notepad using SendKeys and the API"
  46.       Height          =   420
  47.       Index           =   2
  48.       Left            =   90
  49.       TabIndex        =   6
  50.       Top             =   3330
  51.       Width           =   7035
  52.    End
  53.    Begin VB.CommandButton cmd 
  54.       Caption         =   "Send Text to a Window"
  55.       Enabled         =   0   'False
  56.       Height          =   420
  57.       Index           =   1
  58.       Left            =   90
  59.       TabIndex        =   5
  60.       Top             =   2835
  61.       Width           =   7035
  62.    End
  63.    Begin VB.CommandButton cmd 
  64.       Caption         =   "Get Text from a Window"
  65.       Height          =   420
  66.       Index           =   0
  67.       Left            =   90
  68.       TabIndex        =   4
  69.       Top             =   2340
  70.       Width           =   7035
  71.    End
  72.    Begin VB.TextBox Text1 
  73.       BeginProperty Font 
  74.          name            =   "Courier New"
  75.          charset         =   1
  76.          weight          =   400
  77.          size            =   8.25
  78.          underline       =   0   'False
  79.          italic          =   0   'False
  80.          strikethrough   =   0   'False
  81.       EndProperty
  82.       Height          =   2175
  83.       Left            =   90
  84.       MultiLine       =   -1  'True
  85.       ScrollBars      =   3  'Both
  86.       TabIndex        =   3
  87.       Top             =   90
  88.       Width           =   7035
  89.    End
  90. Attribute VB_Name = "frmStubborn"
  91. Attribute VB_Creatable = False
  92. Attribute VB_Exposed = False
  93. '*********************************************************************
  94. ' FRMSTUB.FRM: This program demonstrates how to communicate with apps
  95. '              that don't respond via DDE or OLE.
  96. '*********************************************************************
  97. Option Explicit
  98. '*********************************************************************
  99. ' Form-level 16 & 32-bit API declarations.
  100. '*********************************************************************
  101. #If Win32 Then
  102. Private Const PROCESS_QUERY_INFORMATION = &H400
  103. Private Const STILL_ACTIVE = &H103
  104. Private Declare Function OpenProcess& Lib "kernel32" (ByVal _
  105.     dwDesiredAccess&, ByVal bInheritHandle&, ByVal dwProcessId&)
  106. Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal _
  107.     hProcess As Long, lpExitCode As Long) As Long
  108. Private Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" _
  109.     (ByVal hInstance&, ByVal lpCursor&) As Long
  110. Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, _
  111.     ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
  112. Private Const IDC_UPARROW = 32516&
  113. #Else
  114. Private Declare Function GetModuleUsage% Lib "Kernel" (ByVal hModule%)
  115. #End If
  116. '*********************************************************************
  117. ' Form-level variables.
  118. '*********************************************************************
  119. Private SendIt As Boolean, PointMode As Boolean
  120. '*********************************************************************
  121. ' Process command button clicks.
  122. '*********************************************************************
  123. Private Sub cmd_Click(Index As Integer)
  124. Dim hNotepad&, Source%, FileName$, msg$, Handle&, ExitCode&
  125.     Select Case Index
  126.         Case 0 ' Get
  127.             SendIt = False
  128.             PointMode = True
  129.             CaptureWindows "Start", Me, 0, 0, ""
  130.         Case 1 ' Send
  131.             SendIt = True
  132.             PointMode = True
  133.             CaptureWindows "Start", Me, 0, 0, ""
  134.         Case 2 ' Use SendKeys
  135.             '*********************************************************
  136.             ' Build a temporary filename. Kill it if it already exists.
  137.             '*********************************************************
  138.             FileName = App.Path & "\~test~.txt"
  139.             If FileExists(FileName) Then Kill FileName
  140.             '*********************************************************
  141.             ' Run Notepad maximized with the new file, and store its
  142.             ' task handle into a variable for later use.
  143.             '*********************************************************
  144.             hNotepad = Shell("notepad.exe " & FileName, vbNormalFocus)
  145.             '*********************************************************
  146.             ' This statement hits enter to create the new file.
  147.             '*********************************************************
  148.             SendKeys "~", True
  149.             '*********************************************************
  150.             ' Build an instruction screen, and insert it into Notepad.
  151.             '*********************************************************
  152.             msg = "Enter your text in here." & vbCrLf
  153.             msg = msg & "When you are done, quit "
  154.             msg = msg & "Notepad and save your changes."
  155.             SendKeys msg, True
  156.             '*********************************************************
  157.             ' Finally, highlight the instructions so the user can
  158.             ' easily delete them.
  159.             '*********************************************************
  160.             SendKeys "^+{Home}", True
  161.             '*********************************************************
  162.             ' Wait while Notepad is still open.
  163.             '*********************************************************
  164.         #If Win32 Then
  165.             Handle = OpenProcess(PROCESS_QUERY_INFORMATION, False, _
  166.                                  hNotepad)
  167.             Do
  168.                 GetExitCodeProcess Handle, ExitCode
  169.                 DoEvents
  170.             Loop While ExitCode = STILL_ACTIVE
  171.         #Else
  172.             Do While GetModuleUsage(hNotepad)
  173.                 DoEvents
  174.             Loop
  175.         #End If
  176.             '*********************************************************
  177.             ' Once Notepad is unloaded, open the file and insert it
  178.             ' into Text1.
  179.             '*********************************************************
  180.             Source = FreeFile
  181.             Open FileName For Input As Source
  182.                 Text1 = Input(LOF(Source), Source)
  183.             Close Source
  184.             '*********************************************************
  185.             ' Kill the temporary file.
  186.             '*********************************************************
  187.             Kill FileName
  188.     End Select
  189. End Sub
  190. '*********************************************************************
  191. ' Form Inialization.
  192. '*********************************************************************
  193. Private Sub Form_Load()
  194. '*********************************************************************
  195. ' Exchanging data is totally different in Win32, so re-adjust the
  196. ' visual appearance of the form for it.  Win16 uses the default
  197. ' configuration set at design time.
  198. '*********************************************************************
  199. #If Win32 Then
  200. Dim iX%, iY%, iDrawX%
  201.     '*****************************************************************
  202.     ' Change the ScaleMode to pixels and turn on AutoRedraw
  203.     '*****************************************************************
  204.     ScaleMode = vbPixels
  205.     AutoRedraw = True
  206.     '*****************************************************************
  207.     ' Hide controls for use with Win16, and display Win32 controls.
  208.     '*****************************************************************
  209.     cmd(0).Visible = False
  210.     cmd(1).Visible = False
  211.     Frame1.Visible = True
  212.     '*****************************************************************
  213.     ' Build positioning variables and set CurrentX & CurrentY
  214.     '*****************************************************************
  215.     iX = Frame1.Left + Frame1.Width
  216.     CurrentX = iX
  217.     iDrawX = iX + ((ScaleWidth - iX) / 2) + 10
  218.     iY = Text1.Top + Text1.Height
  219.     iY = iY + ((ScaleHeight - (Frame1.Top + Frame1.Height)) / 2) + 5
  220.     CurrentY = iY
  221.     '*****************************************************************
  222.     ' Draw MousePointer vbUpArrow into the form's persistant bitmap.
  223.     '*****************************************************************
  224.     DrawIcon hdc, iDrawX, iY, LoadCursor(0, IDC_UPARROW)
  225.     '*****************************************************************
  226.     ' Give the user some instructions about why the arrow is painted
  227.     ' on the form.
  228.     '*****************************************************************
  229.     Print "  Click & drag this arrow ->"
  230.     CurrentX = iX
  231.     Print "  to exhange data."
  232. #End If
  233.     '*****************************************************************
  234.     ' Hide controls for use with Win32, and display Win16 controls.
  235.     '*****************************************************************
  236.     cmd(0).Visible = True
  237.     cmd(1).Visible = True
  238.     Frame1.Visible = False
  239.     '*****************************************************************
  240.     ' Centers the form to the screen
  241.     '*****************************************************************
  242.     Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 2
  243. End Sub
  244. '*********************************************************************
  245. ' Win32 version of SetCapture requires the left mouse button to be
  246. ' depressed in order to capture data from other processes and the
  247. ' MouseUp event automatically does a ReleaseCapture.  This difference
  248. ' requires totally different code (and a different UI).
  249. '*********************************************************************
  250. #If Win32 Then
  251.     Private Sub Form_MouseDown(Button As Integer, Shift%, x!, y!)
  252.         '*************************************************************
  253.         ' If opt(0) is checked, then send the text from Text1 using
  254.         ' the code already in cmd(0)'s click event.  Otherwise, get
  255.         ' text from another window using cmd(1)'s code.
  256.         '*************************************************************
  257.         If opt(0) Then
  258.             cmd_Click 0
  259.         Else
  260.             cmd_Click 1
  261.         End If
  262.     End Sub
  263.     '*****************************************************************
  264.     ' Stop capturing and exchange the text on the Form_MouseUp event.
  265.     '*****************************************************************
  266.     Private Sub Form_MouseUp(Button As Integer, Shift%, x!, y!)
  267.         HandleMouse Button, Shift, x, y
  268.     End Sub
  269. '*********************************************************************
  270. ' 16-bit version of MouseDown. MouseUp is ignored.
  271. '*********************************************************************
  272. #Else
  273.     '*****************************************************************
  274.     ' Stop capturing and exchange the text on the Form_MouseDown event
  275.     '*****************************************************************
  276.     Private Sub Form_MouseDown(Button As Integer, Shift%, x!, y!)
  277.         HandleMouse Button, Shift, x, y
  278.     End Sub
  279. #End If
  280. '*********************************************************************
  281. ' During the PointMode, this window receives a mouse move for the
  282. ' entire desktop. This function causes a new highlight to be drawn.
  283. '*********************************************************************
  284. Private Sub Form_MouseMove(Button As Integer, Shift%, x!, y!)
  285.     If GetCapture() Then CaptureWindows "Move", Me, x, y, ""
  286. End Sub
  287. '*********************************************************************
  288. ' Only enable cmd(1) when it contains text.
  289. '*********************************************************************
  290. Private Sub Text1_Change()
  291.     cmd(1).Enabled = IIf(Text1 = "", False, True)
  292. End Sub
  293. '*********************************************************************
  294. ' This function checks to see if a file exists.
  295. '*********************************************************************
  296. Private Function FileExists(FileName$) As Boolean
  297.     On Error Resume Next
  298.     FileExists = IIf(Dir(FileName) <> "", True, False)
  299. End Function
  300. '*********************************************************************
  301. ' Mouse code is the same for Win16 & Win32, but its called in
  302. ' different locations on the two platforms.  Rather than repeating
  303. ' code, this code is entered once and called from the appropriate
  304. ' event.
  305. '*********************************************************************
  306. Private Sub HandleMouse(Button As Integer, Shift%, x!, y!)
  307. Dim errStr$, retStr$
  308.     '*****************************************************************
  309.     ' Build a string that matchings the return error value.
  310.     '*****************************************************************
  311.     errStr = "Error:" & String(10, "~")
  312.     '*****************************************************************
  313.     ' Get text from a window.
  314.     '*****************************************************************
  315.     If PointMode And SendIt = False Then
  316.         retStr = CaptureWindows("End", Me, x, y, "")
  317.         If retStr = errStr Then
  318.             MsgBox "Sorry, but that control didn't respond!", 48
  319.         Else
  320.             Text1 = retStr
  321.         End If
  322.         PointMode = False
  323.     '*****************************************************************
  324.     ' Send text to a window.
  325.     '*****************************************************************
  326.     ElseIf PointMode And SendIt Then
  327.         retStr = CaptureWindows("End", Me, x, y, Text1)
  328.         If retStr = "0" Or retStr = errStr Then
  329.             MsgBox "Sorry, but that control will not accept text!", 48
  330.         End If
  331.         PointMode = False
  332.     End If
  333. End Sub
  334.