home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / Easy_Ballo18282312112004.psc / frmCodeGen.frm < prev    next >
Text File  |  2004-12-01  |  14KB  |  466 lines

  1. VERSION 5.00
  2. Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
  3. Begin VB.Form frmCodeGen 
  4.    Caption         =   "Easy Tool Tips Class - Custom Tool Tip Code"
  5.    ClientHeight    =   6975
  6.    ClientLeft      =   60
  7.    ClientTop       =   630
  8.    ClientWidth     =   8415
  9.    Icon            =   "frmCodeGen.frx":0000
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    ScaleHeight     =   6975
  13.    ScaleWidth      =   8415
  14.    StartUpPosition =   2  'CenterScreen
  15.    Begin VB.CommandButton Command2 
  16.       BackColor       =   &H00C0C0C0&
  17.       Caption         =   "Cancel"
  18.       BeginProperty Font 
  19.          Name            =   "MS Sans Serif"
  20.          Size            =   9.75
  21.          Charset         =   0
  22.          Weight          =   700
  23.          Underline       =   0   'False
  24.          Italic          =   0   'False
  25.          Strikethrough   =   0   'False
  26.       EndProperty
  27.       Height          =   855
  28.       Left            =   6720
  29.       MouseIcon       =   "frmCodeGen.frx":0442
  30.       MousePointer    =   99  'Custom
  31.       Picture         =   "frmCodeGen.frx":074C
  32.       Style           =   1  'Graphical
  33.       TabIndex        =   9
  34.       Top             =   480
  35.       Width           =   1455
  36.    End
  37.    Begin VB.Frame Frame1 
  38.       Caption         =   "Customize Your Tool Tip"
  39.       ForeColor       =   &H00000080&
  40.       Height          =   1455
  41.       Left            =   120
  42.       TabIndex        =   1
  43.       Top             =   0
  44.       Width           =   8175
  45.       Begin VB.PictureBox Picture1 
  46.          Appearance      =   0  'Flat
  47.          BorderStyle     =   0  'None
  48.          ForeColor       =   &H80000008&
  49.          Height          =   495
  50.          Left            =   240
  51.          MouseIcon       =   "frmCodeGen.frx":0A56
  52.          MousePointer    =   99  'Custom
  53.          Picture         =   "frmCodeGen.frx":0D60
  54.          ScaleHeight     =   495
  55.          ScaleWidth      =   495
  56.          TabIndex        =   8
  57.          Top             =   600
  58.          Width           =   495
  59.       End
  60.       Begin VB.CommandButton Command1 
  61.          BackColor       =   &H00C0C0C0&
  62.          Caption         =   "Customize !"
  63.          BeginProperty Font 
  64.             Name            =   "Microsoft Sans Serif"
  65.             Size            =   9.75
  66.             Charset         =   0
  67.             Weight          =   700
  68.             Underline       =   0   'False
  69.             Italic          =   0   'False
  70.             Strikethrough   =   0   'False
  71.          EndProperty
  72.          Height          =   855
  73.          Left            =   4940
  74.          MouseIcon       =   "frmCodeGen.frx":11A2
  75.          MousePointer    =   99  'Custom
  76.          Picture         =   "frmCodeGen.frx":14AC
  77.          Style           =   1  'Graphical
  78.          TabIndex        =   7
  79.          Top             =   480
  80.          Width           =   1455
  81.       End
  82.       Begin VB.TextBox Text2 
  83.          Height          =   285
  84.          Left            =   2400
  85.          TabIndex        =   6
  86.          Top             =   990
  87.          Width           =   2400
  88.       End
  89.       Begin VB.TextBox Text1 
  90.          Height          =   285
  91.          Left            =   2400
  92.          TabIndex        =   3
  93.          Top             =   530
  94.          Width           =   2400
  95.       End
  96.       Begin VB.Label Label3 
  97.          Alignment       =   1  'Right Justify
  98.          Caption         =   "Parent Control Name"
  99.          Height          =   255
  100.          Left            =   600
  101.          TabIndex        =   5
  102.          Top             =   990
  103.          Width           =   1695
  104.       End
  105.       Begin VB.Label Label2 
  106.          Alignment       =   1  'Right Justify
  107.          Caption         =   "Tool Tip Name"
  108.          Height          =   255
  109.          Left            =   1200
  110.          TabIndex        =   4
  111.          Top             =   530
  112.          Width           =   1095
  113.       End
  114.       Begin VB.Label Label1 
  115.          Alignment       =   2  'Center
  116.          Caption         =   "Put your Tool Tip Object name and Parent Object name in the boxes below to customize your code"
  117.          Height          =   255
  118.          Left            =   240
  119.          TabIndex        =   2
  120.          Top             =   240
  121.          Width           =   7695
  122.       End
  123.    End
  124.    Begin RichTextLib.RichTextBox CodeGenText 
  125.       CausesValidation=   0   'False
  126.       Height          =   5295
  127.       Left            =   120
  128.       TabIndex        =   0
  129.       TabStop         =   0   'False
  130.       Top             =   1560
  131.       Width           =   8175
  132.       _ExtentX        =   14420
  133.       _ExtentY        =   9340
  134.       _Version        =   393217
  135.       BorderStyle     =   0
  136.       Enabled         =   -1  'True
  137.       ReadOnly        =   -1  'True
  138.       ScrollBars      =   3
  139.       RightMargin     =   32767
  140.       TextRTF         =   $"frmCodeGen.frx":1D76
  141.    End
  142.    Begin VB.Menu mnufile 
  143.       Caption         =   "&File"
  144.       Begin VB.Menu mnuClose 
  145.          Caption         =   "&Close"
  146.       End
  147.    End
  148.    Begin VB.Menu mnuWindow 
  149.       Caption         =   "&Window"
  150.       Begin VB.Menu mnuTooltip 
  151.          Caption         =   "Easy Tool Tip Class"
  152.       End
  153.       Begin VB.Menu mnuCodegen 
  154.          Caption         =   "Code Generator"
  155.          Checked         =   -1  'True
  156.       End
  157.       Begin VB.Menu mnuAboutETC 
  158.          Caption         =   "About Easy Tool Tip Class"
  159.       End
  160.    End
  161.    Begin VB.Menu mnuEdit 
  162.       Caption         =   "&Edit"
  163.       Begin VB.Menu mnuCopy 
  164.          Caption         =   "Copy"
  165.          Shortcut        =   ^C
  166.       End
  167.       Begin VB.Menu mnuSelectall 
  168.          Caption         =   "Select All"
  169.          Shortcut        =   ^A
  170.       End
  171.       Begin VB.Menu mnuSep1 
  172.          Caption         =   "-"
  173.       End
  174.       Begin VB.Menu mnuUndo 
  175.          Caption         =   "Undo Selection"
  176.          Shortcut        =   ^Z
  177.       End
  178.    End
  179.    Begin VB.Menu mnuAbout 
  180.       Caption         =   "&About"
  181.    End
  182. End
  183. Attribute VB_Name = "frmCodeGen"
  184. Attribute VB_GlobalNameSpace = False
  185. Attribute VB_Creatable = False
  186. Attribute VB_PredeclaredId = True
  187. Attribute VB_Exposed = False
  188.     '**************************************************************
  189.     '
  190.     '   Custom Tool Tip Demo
  191.     '   Code Generation form
  192.     '
  193.     '   Mark Mokoski
  194.     '   27-NOV-2004
  195.     '
  196.     '   Takes Tool Tip info from frmToolTips and produces code for
  197.     '   cut and paste into your project
  198.     '
  199.     '**************************************************************
  200.     
  201.     Option Explicit
  202.     Dim Picture1tip            As New clsTooltips
  203.  
  204.  
  205.  
  206. Private Sub CodeGenText_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  207.         
  208.         'Look for Right Click
  209.         If Button = 2 Then
  210.  
  211.                 If CodeGenText.SelText <> "" Then
  212.                     mnuCopy.Enabled = True
  213.                     mnuSelectall.Enabled = False
  214.                     mnuUndo.Enabled = True
  215.                     PopupMenu mnuEdit
  216.                 Else
  217.                     mnuCopy.Enabled = False
  218.                     mnuSelectall.Enabled = True
  219.                     mnuUndo.Enabled = False
  220.                     PopupMenu mnuEdit
  221.                 End If
  222.  
  223.         End If
  224.  
  225. End Sub
  226.  
  227. Private Sub Command1_Click()
  228.  
  229.     Call GenCode
  230.  
  231. End Sub
  232.  
  233.  
  234. Private Sub Command2_Click()
  235.  
  236.     Unload Me
  237.  
  238. End Sub
  239.  
  240. Private Sub Form_Load()
  241.  
  242.     Command1.Enabled = False
  243.     Command1.BackColor = &H8000000F
  244.     
  245.     
  246.     Picture1tip.CreateBalloon Picture1, _
  247.     "Put the Tool Tip name and Parent Conrol name in the text boxes to the right." & _
  248.     vbCrLf & _
  249.     vbCrLf & _
  250.     "Then Click the Customize buttom to update the code snippet", _
  251.     "Easy Tool Tip Code Generator", _
  252.     tipiconinfo
  253.     
  254. End Sub
  255.  
  256. Private Sub mnuAbout_Click()
  257.  
  258.     'Bring up the About info window
  259.     frmAbout.Visible = True
  260.     
  261.  
  262. End Sub
  263.  
  264. Private Sub mnuAboutETC_Click()
  265.  
  266.     frmAbout.Visible = True
  267.     frmAbout.SetFocus
  268.  
  269. End Sub
  270.  
  271. Private Sub mnuClose_Click()
  272.  
  273.     Unload Me
  274.  
  275. End Sub
  276.  
  277. Private Sub mnuCopy_Click()
  278.  
  279.     Clipboard.Clear
  280.     SendKeys "^C", True
  281.     'To copy selection and put cursor at end of selected text, use below
  282.     'CodeGenText.SelStart = CodeGenText.SelStart + (Len(CodeGenText.SelText) - 1)
  283.     
  284.     'To copy selection and put cursor at beginning of selected text, use below
  285.     CodeGenText.SelStart = CodeGenText.SelStart
  286.     
  287.     'To copy selection and put cursor at end of all text, use below
  288.     'CodeGenText.SelStart = (Len(CodeGenText.Text) + 1)
  289.     
  290.     'To copy selection and put cursor at beginning of all text, use below
  291.     'CodeGenText.SelStart = 0
  292.  
  293. End Sub
  294.  
  295. Private Sub mnuEdit_Click()
  296.  
  297.         If CodeGenText.SelText <> "" Then
  298.             mnuCopy.Enabled = True
  299.             mnuSelectall.Enabled = False
  300.             mnuUndo.Enabled = True
  301.         Else
  302.             mnuCopy.Enabled = False
  303.             mnuSelectall.Enabled = True
  304.             mnuUndo.Enabled = False
  305.         End If
  306.  
  307. End Sub
  308.  
  309. Private Sub mnuSelectall_Click()
  310.  
  311.     CodeGenText.SetFocus
  312.     CodeGenText.SelStart = 0
  313.  
  314.     CodeGenText.SelLength = Len(CodeGenText.Text)
  315.     
  316.  
  317.     SendKeys "^A", True
  318.  
  319. End Sub
  320.  
  321. Private Sub mnuTooltip_Click()
  322.  
  323.     frmToolTips.Visible = True
  324.     frmToolTips.SetFocus
  325.  
  326. End Sub
  327.  
  328. Private Sub mnuUndo_Click()
  329.  
  330.     'To cancel selection and put cursor at end of selected text, use below
  331.     'CodeGenText.SelStart = CodeGenText.SelStart + (Len(CodeGenText.SelText) - 1)
  332.     
  333.     'To cancel selection and put cursor at beginning of selected text, use below
  334.     CodeGenText.SelStart = CodeGenText.SelStart
  335.     
  336.     'To cancel selection and put cursor at end of all text, use below
  337.     'CodeGenText.SelStart = (Len(CodeGenText.Text) + 1)
  338.     
  339.     'To cancel selection and put cursor at beginning of all text, use below
  340.     'CodeGenText.SelStart = 0
  341.     
  342. End Sub
  343.  
  344. Private Sub Text1_Change()
  345.  
  346.         If Text1.Text <> "" And Text2.Text <> "" Then
  347.             Command1.Enabled = True
  348.             Command1.BackColor = &HC0C0C0
  349.         Else
  350.             Command1.Enabled = False
  351.             Command1.BackColor = &H8000000F
  352.         End If
  353.         
  354. End Sub
  355.  
  356. Private Sub Text2_Change()
  357.  
  358.         If Text1.Text <> "" And Text2.Text <> "" Then
  359.             Command1.Enabled = True
  360.             Command1.BackColor = &HC0C0C0
  361.         Else
  362.             Command1.Enabled = False
  363.             Command1.BackColor = &H8000000F
  364.         End If
  365.  
  366. End Sub
  367.  
  368. Public Sub GenCode()
  369.  
  370.     Dim TipName              As String
  371.     Dim TipParent            As String
  372.     Dim TipText              As String
  373.     
  374.     frmCodeGen.Visible = True
  375.     Text1.SetFocus
  376.     
  377.     'Replace vbCrLF code (Chr$(10)+Chr$(13)) with " & vbCrLf & " text
  378.     'for proper string format in code generation
  379.     TipText = ReplaceText(frmToolTips.TipText)
  380.     
  381.     'Clean out any current text
  382.     CodeGenText.SelStart = 0
  383.     CodeGenText.SelLength = Len(CodeGenText.Text) + 1
  384.     CodeGenText.SelText = ""
  385.     'Get the boilerplate text and insert date and time
  386.     CodeGenText.LoadFile App.Path & "\codegen.rtf"
  387.     CodeGenText.SelStart = 168
  388.     CodeGenText.SelText = Date & " at " & Time
  389.  
  390.         If Text1.Text = "" Then
  391.             TipName = "<Your Tip Name>"
  392.         Else
  393.             TipName = Text1.Text
  394.         End If
  395.         
  396.         If Text2.Text = "" Then
  397.             TipParent = "<Your Parent Control Name>"
  398.         Else
  399.             TipParent = Text2.Text
  400.         End If
  401.         
  402.     'Write out the Declarations section
  403.  
  404.         With CodeGenText
  405.             .SelStart = 726
  406.             .SelColor = vbBlue
  407.             .SelText = vbCrLf & "Dim "
  408.             .SelColor = vbBlack
  409.             .SelText = TipName & vbTab & vbTab
  410.             .SelColor = vbBlue
  411.             .SelText = "As New "
  412.             .SelColor = vbBlack
  413.             .SelText = "  clsTooltips"
  414.             .SelText = vbCrLf
  415.     
  416.             'Write out the Code section
  417.             .SelStart = 1044
  418.             .SelColor = vbBlack
  419.             .SelText = vbCrLf
  420.             
  421.                 If frmToolTips.TipStyle = styleBalloon Then
  422.                     .SelText = TipName & ".CreateBalloon " & TipParent & ", _" & vbCrLf & """" & TipText & """"
  423.                 Else
  424.                     .SelText = TipName & ".CreateTip " & TipParent & ", _" & vbCrLf & """" & TipText & """"
  425.                 End If
  426.         
  427.                 If frmToolTips.TipTitleText <> "" Then
  428.                     .SelText = ", _" & vbCrLf & """" & frmToolTips.TipTitleText & """, " & Val(frmToolTips.TipIcon)
  429.                 End If
  430.                 
  431.             .SelText = vbCrLf
  432.                 
  433.                 If frmToolTips.TipCentered = True Then
  434.                     .SelText = TipName & ".Centered = "
  435.                     .SelColor = vbBlue
  436.                     .SelText = "True" & vbCrLf
  437.                     .SelColor = vbBlack
  438.                     
  439.                 End If
  440.                 
  441.                 If frmToolTips.TipForeColor <> 0 Then
  442.                     .SelColor = vbBlack
  443.                     .SelText = TipName & ".ForeColor = " & "&H" & Hex(frmToolTips.TipForeColor) & vbCrLf
  444.                 End If
  445.                 
  446.                 If frmToolTips.TipBackColor <> 0 Then
  447.                     .SelColor = vbBlack
  448.                     .SelText = TipName & ".BackColor = " & "&H" & Hex(frmToolTips.TipBackColor) & vbCrLf
  449.                 End If
  450.                 
  451.             .SelText = vbCrLf
  452.             .SelStart = 0
  453.             
  454.         End With
  455.                                 
  456.  
  457. End Sub
  458.  
  459. Private Function ReplaceText(rText As String)
  460.     
  461.     'Replace Tool Tip Text with more verbose string. Add "& vbCrLf &"
  462.     'string in place of Chr$(10)+Chr$(13)
  463.     ReplaceText = Replace(rText, vbCrLf, """ & vbCrLf &  _" & vbCrLf & """")
  464.  
  465. End Function
  466.