txtform.frm

图像处理

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form txtForm 
   AutoRedraw      =   -1  'True
   Caption         =   "                   ENTER TEXT"
   ClientHeight    =   4140
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7350
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   276
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   490
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdCancel 
      BackColor       =   &H008080FF&
      Caption         =   "Cancel"
      Height          =   360
      Left            =   5670
      Style           =   1  'Graphical
      TabIndex        =   5
      Top             =   1110
      Width           =   915
   End
   Begin VB.PictureBox Picture2 
      AutoRedraw      =   -1  'True
      Height          =   315
      Left            =   6210
      ScaleHeight     =   17
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   71
      TabIndex        =   4
      Top             =   3195
      Visible         =   0   'False
      Width           =   1125
   End
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BackColor       =   &H00FFFFFF&
      Height          =   435
      Left            =   255
      ScaleHeight     =   375
      ScaleWidth      =   435
      TabIndex        =   3
      Top             =   1845
      Width           =   495
   End
   Begin VB.TextBox Text1 
      Height          =   285
      Left            =   255
      TabIndex        =   2
      Text            =   "Text1"
      Top             =   1500
      Width           =   6405
   End
   Begin VB.CommandButton cmdReturn 
      BackColor       =   &H00C0E0FF&
      Caption         =   "Return"
      Height          =   375
      Left            =   255
      Style           =   1  'Graphical
      TabIndex        =   1
      Top             =   1080
      Width           =   1170
   End
   Begin VB.CommandButton cmdFont 
      BackColor       =   &H00C0E0FF&
      Caption         =   "&Font"
      Height          =   375
      Left            =   2925
      Style           =   1  'Graphical
      TabIndex        =   0
      Top             =   1095
      Width           =   1290
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   6840
      Top             =   135
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      Caption         =   "On Return Drag Text to position wanted then Right Click to Merge with Picture."
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   735
      Left            =   180
      TabIndex        =   6
      Top             =   75
      Width           =   6465
   End
End
Attribute VB_Name = "txtForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'txtForm.frm    12/11/01

'Public TEXT$

DefLng A-W
DefSng X-Z

Dim A$

Private Sub cmdCancel_Click()
Unload txtForm
TEXT$ = ""
End Sub

Private Sub cmdReturn_Click()

Form1.PICTEMP.FontName = Picture1.FontName
Form1.PICTEMP.FontSize = Picture1.FontSize
Form1.PICTEMP.Height = Picture1.Height
Form1.PICTEMP.Width = Picture1.Width
Form1.PICTEMP.BackColor = RGB(255, 255, 255)
Form1.PICTEMP.ForeColor = RGB(QBRed, QBGreen, QBBlue)
Form1.PICTEMP.Cls
Form1.PICTEMP.Print A$;
TEXT$ = A$
Unload txtForm

End Sub

Private Sub Form_Load()

Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2

Picture1.FontName = Text1.FontName
Picture1.FontSize = Text1.FontSize
Picture1.Height = 1.5 * Picture1.FontSize
Picture1.Width = 10
Picture1.BackColor = RGB(255, 255, 255)
Picture1.ForeColor = RGB(QBRed, QBGreen, QBBlue)

Picture1.Cls

MaxWidth = 400
If PICW <> 0 Then
   If MaxWidth > PICW Then MaxWidth = PICW
End If
Text1.MaxLength = (MaxWidth - 1) * 15 / Picture1.TextWidth("i")
StrWidth = Text1.MaxLength * Picture1.TextWidth("a") \ 15

A$ = ""
Text1.TEXT = ""

End Sub

Private Sub cmdFont_Click()
CommonDialog1.CancelError = True
CommonDialog1.DialogTitle = "Select font"
CommonDialog1.Flags = &H103
If CommonDialog1.FontName = "" Then
   CommonDialog1.FontName = "Arial"
End If
On Error GoTo FontError
CommonDialog1.ShowFont

Picture1.FontName = CommonDialog1.FontName
Picture1.FontSize = CommonDialog1.FontSize
Picture1.Height = 1.5 * Picture1.FontSize
Picture1.Width = 10
Picture1.Cls

MaxWidth = 400
If PICW <> 0 Then
   If MaxWidth > PICW Then MaxWidth = PICW
End If
Text1.MaxLength = (MaxWidth - 1) * 15 / Picture1.TextWidth("i")
StrWidth = Text1.MaxLength * Picture1.TextWidth("a") \ 15

A$ = ""
Text1.TEXT = ""

Exit Sub
FontError:
End Sub


Private Sub Text1_Change()

A$ = Text1.TEXT

If Len(A$) = 0 Then
   Picture1.Cls
   Exit Sub
End If

Picture1.Cls
StrWidth = 0
MaxCharHt = 0
For i = 1 To Len(A$)
   c$ = Mid$(A$, i, 1)
   StrWidth = StrWidth + Picture1.TextWidth(c$) \ 15
   CharHt = Picture1.TextHeight(c$) \ 15
   If CharHt > MaxCharHt Then MaxCharHt = CharHt
Next i

If StrWidth <= 0 Then StrWidth = 10

If StrWidth > 400 Then
   A$ = Left$(A$, Len(A$) - 1)
   Text1.TEXT = A$
   Text1.SelStart = Len(A$)
   StrWidth = 0
   For i = 1 To Len(A$)
      c$ = Mid$(A$, i, 1)
      StrWidth = StrWidth + Picture1.TextWidth(c$) \ 15
   Next i
End If
   
Picture1.Width = StrWidth + 4
Picture1.Height = MaxCharHt + 4
Picture1.Print A$;
Picture2.Cls
Picture2.Print StrWidth

End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
   KeyAscii = 0
   A$ = Text1.TEXT
End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If UnloadMode = 0 Then    'Close on Form1 pressed
   
   resp = MsgBox("", 4 + 32, "Quit Application ?")
   If resp = 7 Then       'NO pressed
      Cancel = True
   Else  'resp=6          'YES pressed
      Cancel = False
      Unload txtForm
      End
   End If
End If

End Sub