GFTransparentTextBox/Mfrm.frm

VERSION 5.00
Begin VB.Form Form1
   Caption         =   "Mfrm"
   ClientHeight    =   3045
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3045
   ScaleWidth      =   4680
   StartUpPosition =   3 'Windows‑Standard
   Begin VB.Timer GFTransparentTextBoxTimer
      Enabled         =   0 'False
      Interval        =   100
      Left            =   60
      Top             =   60
   End
   Begin VB.TextBox Text1
      Height          =   285
      Left            =   420
      TabIndex        =   0
      Text            =   "Text1"
      Top             =   2400
      Width           =   3855
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'(c)2001 by Louis. Note that this project is not finished yet.
'GFTransparentTextBox
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As LongByVal x As LongByVal y As LongByVal nWidth As LongByVal nHeight As LongByVal hSrcDC As LongByVal xSrc As LongByVal ySrc As LongByVal dwRop As Long) As Long
'GFTransparentTextBox
Dim GFTransparentTextBox As TextBox
Dim GFTransparentTextBoxTargethDC As Long
Dim GFTransparentTextBoxTargetXPos As Long
Dim GFTransparentTextBoxTargetYPos As Long

'DEBUG CODE

Private Sub Form_Load()
    'on error resume next
    Call GFTransparentTextBox_Enable(Text1, Form1.hDC, 100, 100)
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer) 'make fit to target project
    'on error resume next

End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer) 'make fit to target project
    'on error resume next 'make fit to target project
    Call GFTransparentTextBoxTimer_Timer
End Sub

'END OF DEBUG CODE

Private Sub GFTransparentTextBox_Enable(ByRef GFTransparentTextBoxPassed As TextBox, ByVal GFTransparentTextBoxTargethDCPassed As LongByVal GFTransparentTextBoxTargetXPosPassed As LongByVal GFTransparentTextBoxTargetYPosPassed As Long)
    'on error resume next
    Set GFTransparentTextBox = GFTransparentTextBoxPassed
    GFTransparentTextBoxTargetXPos = GFTransparentTextBoxTargetXPosPassed
    GFTransparentTextBoxTargetYPos = GFTransparentTextBoxTargetYPosPassed
    GFTransparentTextBoxTargethDC = GFTransparentTextBoxTargethDCPassed
    GFTransparentTextBoxTimer.Interval = 100
    GFTransparentTextBoxTimer.Enabled = True
End Sub

Private Sub GFTransparentTextBox_Disable()
    'on error resume next
    GFTransparentTextBoxTimer.Enabled = False
End Sub

Private Sub GFTransparentTextBoxTimer_Timer()
    'on error resume next
    Dim TextBoxhDC As Long
    If GFTransparentTextBoxTimer.Enabled = True Then
        TextBoxhDC = GetDC(GFTransparentTextBox.hwnd)
        If TextBoxhDC = 0 Then Exit Sub 'verify
        Call BitBlt(GFTransparentTextBoxTargethDC, GFTransparentTextBoxTargetXPos, GFTransparentTextBoxTargetYPos, GFTransparentTextBox.Width / Screen.TwipsPerPixelX, GFTransparentTextBox.Height / Screen.TwipsPerPixelY, _
            TextBoxhDC, 0, 0, vbSrcCopy)
    Else
        'do nothing
    End If
End Sub


[END OF FILE]