home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Binary_Fil2075297132007.psc / ClipBoard.frm < prev    next >
Text File  |  2007-07-05  |  3KB  |  108 lines
  1. VERSION 5.00
  2. Begin VB.Form MyClip 
  3.    BorderStyle     =   5  'Sizable ToolWindow
  4.    Caption         =   "Clip Board"
  5.    ClientHeight    =   480
  6.    ClientLeft      =   60
  7.    ClientTop       =   360
  8.    ClientWidth     =   1035
  9.    LinkTopic       =   "Form2"
  10.    MaxButton       =   0   'False
  11.    MinButton       =   0   'False
  12.    ScaleHeight     =   480
  13.    ScaleWidth      =   1035
  14.    ShowInTaskbar   =   0   'False
  15.    StartUpPosition =   3  'Windows Default
  16.    Begin VB.Label TextGrid 
  17.       Alignment       =   2  'Center
  18.       BackColor       =   &H00FFFFFF&
  19.       Caption         =   "0"
  20.       BeginProperty Font 
  21.          Name            =   "Terminal"
  22.          Size            =   9
  23.          Charset         =   255
  24.          Weight          =   400
  25.          Underline       =   0   'False
  26.          Italic          =   0   'False
  27.          Strikethrough   =   0   'False
  28.       EndProperty
  29.       Height          =   225
  30.       Index           =   0
  31.       Left            =   105
  32.       TabIndex        =   0
  33.       Top             =   105
  34.       Width           =   750
  35.    End
  36. End
  37. Attribute VB_Name = "MyClip"
  38. Attribute VB_GlobalNameSpace = False
  39. Attribute VB_Creatable = False
  40. Attribute VB_PredeclaredId = True
  41. Attribute VB_Exposed = False
  42. Option Explicit
  43. '----------------------------------------------------------\
  44. 'Author: Richard E. Gagnon.                                |
  45. 'URL:    http://members.cox.net/reg501/                    |
  46. 'Email:  reg501@cox.net                                    |
  47. 'Copyright ⌐ 2007 Richard E. Gagnon. All Rights Reserved.  |
  48. '----------------------------------------------------------/
  49.  
  50. Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  51. Private Sub CreateGrids()
  52. Dim I As Integer, J As Integer
  53. Dim cT1 As Long     'Array Cell Top
  54. Dim cL As Long      'Cell Left
  55. Dim cW As Long      'Cell Width
  56. Const cT As Long = 100      'Cell Top
  57. Const cH As Long = 200      'Cell Height
  58. Const Thick As Long = 20    'Line Thickness
  59.  
  60. 'Create, Size and place the 32 Row Labels
  61. cW = 600: cL = 40
  62. 'Create, Size and place the 512 Text grids
  63. cW = 300
  64. cT1 = cT
  65. For I = 0 To 31
  66.     cL = 40
  67.     For J = I * 16 To I * 16 + 15
  68.         If J > 0 Then Load TextGrid(J) 'Create labels
  69.         TextGrid(J).Visible = True
  70.         TextGrid(J).Caption = ""
  71.         TextGrid(J).Width = cW
  72.         TextGrid(J).Height = cH
  73.         TextGrid(J).Top = cT1
  74.         TextGrid(J).Left = cL
  75.         cL = cL + cW + Thick
  76.     Next J
  77.     cT1 = cT1 + cH + Thick
  78. Next I
  79. Me.Width = TextGrid(15).Left + TextGrid(15).Width + 170
  80. Me.Height = TextGrid(511).Top + TextGrid(511).Height + 450
  81. End Sub
  82.  
  83. Private Sub Form_Load()
  84. Dim MC As Long
  85. CreateGrids
  86. ImportData
  87. MC = SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, 2 Or 1)
  88. End Sub
  89. Private Sub ImportData()
  90. 'Dim CopyString As String
  91. 'CopyString = Clipboard.GetText()
  92. 'If CopyString <> "" Then
  93. '    Dim I As Integer, X As Integer
  94. '    For I = 1 To Len(CopyString) Step 2
  95. '        TextGrid(X).Caption = Chr("&h" & Mid(CopyString, I, 2))
  96. '        X = X + 1
  97. '    Next I
  98. 'End If
  99. End Sub
  100. Private Function FillZeroLong(DecNum As Long) As String
  101. Dim rL As String
  102. rL = Hex(DecNum)
  103. Do Until Len(rL) >= 6
  104.     rL = "0" & rL
  105. Loop
  106. FillZeroLong = rL
  107. End Function
  108.