home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / characterm210276112001.psc / CharacterMapForm1.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2001-06-11  |  41.2 KB  |  1,161 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    AutoRedraw      =   -1  'True
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "Character Map"
  6.    ClientHeight    =   4200
  7.    ClientLeft      =   150
  8.    ClientTop       =   435
  9.    ClientWidth     =   7935
  10.    Icon            =   "CharacterMapForm1.frx":0000
  11.    KeyPreview      =   -1  'True
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    ScaleHeight     =   280
  15.    ScaleMode       =   3  'Pixel
  16.    ScaleWidth      =   529
  17.    StartUpPosition =   3  'Windows Default
  18.    Begin VB.PictureBox picSample 
  19.       Height          =   315
  20.       Left            =   6600
  21.       ScaleHeight     =   255
  22.       ScaleWidth      =   1155
  23.       TabIndex        =   36
  24.       Top             =   3720
  25.       Width           =   1215
  26.    End
  27.    Begin VB.TextBox txtrealClr 
  28.       Height          =   375
  29.       Left            =   4800
  30.       TabIndex        =   35
  31.       Top             =   3360
  32.       Width           =   615
  33.    End
  34.    Begin VB.TextBox txtNameHex 
  35.       Height          =   315
  36.       Left            =   5520
  37.       TabIndex        =   34
  38.       Top             =   3360
  39.       Width           =   855
  40.    End
  41.    Begin VB.ComboBox cboHtmlClrName 
  42.       Height          =   315
  43.       Left            =   4800
  44.       Style           =   2  'Dropdown List
  45.       TabIndex        =   33
  46.       Top             =   3720
  47.       Width           =   1575
  48.    End
  49.    Begin VB.CommandButton cmdCopyPush 
  50.       Height          =   315
  51.       Index           =   6
  52.       Left            =   3240
  53.       TabIndex        =   32
  54.       Top             =   2640
  55.       Width           =   135
  56.    End
  57.    Begin VB.TextBox txtHtmlName 
  58.       Height          =   315
  59.       Left            =   3360
  60.       TabIndex        =   31
  61.       ToolTipText     =   "HtmlNamedEntity"
  62.       Top             =   2640
  63.       Width           =   1215
  64.    End
  65.    Begin VB.CommandButton cmdCopyPush 
  66.       Height          =   315
  67.       Index           =   5
  68.       Left            =   4680
  69.       TabIndex        =   30
  70.       Top             =   3015
  71.       Width           =   135
  72.    End
  73.    Begin VB.CommandButton cmdCopyPush 
  74.       Height          =   315
  75.       Index           =   4
  76.       Left            =   4680
  77.       TabIndex        =   29
  78.       Top             =   2640
  79.       Width           =   135
  80.    End
  81.    Begin VB.CommandButton cmdCopyPush 
  82.       Height          =   315
  83.       Index           =   3
  84.       Left            =   1920
  85.       TabIndex        =   28
  86.       Top             =   2640
  87.       Width           =   135
  88.    End
  89.    Begin VB.CommandButton cmdCopyPush 
  90.       Height          =   315
  91.       Index           =   2
  92.       Left            =   480
  93.       TabIndex        =   27
  94.       Top             =   3360
  95.       Width           =   135
  96.    End
  97.    Begin VB.CommandButton cmdCopyPush 
  98.       Height          =   315
  99.       Index           =   1
  100.       Left            =   480
  101.       TabIndex        =   26
  102.       Top             =   3000
  103.       Width           =   135
  104.    End
  105.    Begin VB.CommandButton cmdCopyPush 
  106.       Height          =   315
  107.       Index           =   0
  108.       Left            =   480
  109.       TabIndex        =   25
  110.       Top             =   2640
  111.       Width           =   135
  112.    End
  113.    Begin VB.ComboBox cboHtmlClr 
  114.       Height          =   315
  115.       Left            =   4800
  116.       Style           =   2  'Dropdown List
  117.       TabIndex        =   24
  118.       Top             =   3000
  119.       Width           =   1575
  120.    End
  121.    Begin VB.TextBox txtHtmlClr 
  122.       Height          =   315
  123.       Left            =   4800
  124.       TabIndex        =   23
  125.       Top             =   2640
  126.       Width           =   1575
  127.    End
  128.    Begin VB.TextBox txthtml 
  129.       Height          =   315
  130.       Left            =   2040
  131.       TabIndex        =   22
  132.       ToolTipText     =   "Html Entity"
  133.       Top             =   2640
  134.       Width           =   1095
  135.    End
  136.    Begin VB.PictureBox Picture2 
  137.       Appearance      =   0  'Flat
  138.       AutoRedraw      =   -1  'True
  139.       BackColor       =   &H80000005&
  140.       BeginProperty Font 
  141.          Name            =   "MS Sans Serif"
  142.          Size            =   18
  143.          Charset         =   0
  144.          Weight          =   400
  145.          Underline       =   0   'False
  146.          Italic          =   0   'False
  147.          Strikethrough   =   0   'False
  148.       EndProperty
  149.       ForeColor       =   &H80000008&
  150.       Height          =   615
  151.       Left            =   720
  152.       ScaleHeight     =   39
  153.       ScaleMode       =   3  'Pixel
  154.       ScaleWidth      =   31
  155.       TabIndex        =   6
  156.       Top             =   1560
  157.       Width           =   495
  158.    End
  159.    Begin VB.PictureBox Picture3 
  160.       BackColor       =   &H00000000&
  161.       BorderStyle     =   0  'None
  162.       Height          =   615
  163.       Left            =   840
  164.       ScaleHeight     =   615
  165.       ScaleWidth      =   495
  166.       TabIndex        =   7
  167.       Top             =   1680
  168.       Width           =   495
  169.    End
  170.    Begin VB.Timer Timer1 
  171.       Interval        =   50
  172.       Left            =   6480
  173.       Top             =   120
  174.    End
  175.    Begin VB.PictureBox Picture4 
  176.       Appearance      =   0  'Flat
  177.       BackColor       =   &H80000005&
  178.       DrawMode        =   6  'Mask Pen Not
  179.       ForeColor       =   &H80000008&
  180.       Height          =   1695
  181.       Left            =   6600
  182.       ScaleHeight     =   111
  183.       ScaleMode       =   3  'Pixel
  184.       ScaleWidth      =   79
  185.       TabIndex        =   19
  186.       Top             =   2040
  187.       Width           =   1215
  188.    End
  189.    Begin VB.CommandButton cmdCopy 
  190.       Caption         =   "&Copy"
  191.       Height          =   375
  192.       Left            =   6720
  193.       TabIndex        =   16
  194.       Top             =   1200
  195.       Width           =   1095
  196.    End
  197.    Begin VB.CommandButton cmdSelect 
  198.       Caption         =   "&Select"
  199.       Height          =   375
  200.       Left            =   6720
  201.       TabIndex        =   15
  202.       Top             =   660
  203.       Width           =   1095
  204.    End
  205.    Begin VB.CommandButton cmdClose 
  206.       Caption         =   "Close"
  207.       Height          =   375
  208.       Left            =   6720
  209.       TabIndex        =   14
  210.       Top             =   120
  211.       Width           =   1095
  212.    End
  213.    Begin VB.TextBox Txt3 
  214.       Height          =   315
  215.       Left            =   600
  216.       TabIndex        =   13
  217.       Top             =   3360
  218.       Width           =   1215
  219.    End
  220.    Begin VB.TextBox Txt2 
  221.       Height          =   315
  222.       Left            =   600
  223.       TabIndex        =   9
  224.       Top             =   3000
  225.       Width           =   1215
  226.    End
  227.    Begin VB.TextBox Txt1 
  228.       Height          =   315
  229.       Left            =   600
  230.       TabIndex        =   8
  231.       Top             =   2640
  232.       Width           =   1215
  233.    End
  234.    Begin VB.PictureBox Picture1 
  235.       AutoRedraw      =   -1  'True
  236.       BackColor       =   &H00FFFFFF&
  237.       BorderStyle     =   0  'None
  238.       BeginProperty Font 
  239.          Name            =   "Times New Roman"
  240.          Size            =   8.25
  241.          Charset         =   0
  242.          Weight          =   400
  243.          Underline       =   0   'False
  244.          Italic          =   0   'False
  245.          Strikethrough   =   0   'False
  246.       EndProperty
  247.       Height          =   1800
  248.       Left            =   120
  249.       ScaleHeight     =   120
  250.       ScaleMode       =   3  'Pixel
  251.       ScaleWidth      =   417
  252.       TabIndex        =   5
  253.       Top             =   720
  254.       Width           =   6255
  255.    End
  256.    Begin VB.ComboBox CboFonts 
  257.       Height          =   315
  258.       Left            =   720
  259.       Sorted          =   -1  'True
  260.       Style           =   2  'Dropdown List
  261.       TabIndex        =   2
  262.       Top             =   120
  263.       Width           =   2535
  264.    End
  265.    Begin VB.TextBox Txtcopy 
  266.       Height          =   375
  267.       HideSelection   =   0   'False
  268.       Left            =   4800
  269.       TabIndex        =   4
  270.       Top             =   120
  271.       Width           =   1575
  272.    End
  273.    Begin VB.VScrollBar VScroll1 
  274.       Height          =   1695
  275.       Left            =   6480
  276.       Max             =   100
  277.       Min             =   1
  278.       TabIndex        =   20
  279.       Top             =   2040
  280.       Value           =   50
  281.       Width           =   135
  282.    End
  283.    Begin VB.Label Label5 
  284.       Alignment       =   2  'Center
  285.       Height          =   255
  286.       Left            =   6600
  287.       TabIndex        =   21
  288.       Top             =   1800
  289.       Width           =   1215
  290.    End
  291.    Begin VB.Label Label9 
  292.       Caption         =   "&Font:"
  293.       Height          =   255
  294.       Left            =   240
  295.       TabIndex        =   18
  296.       Top             =   120
  297.       Width           =   375
  298.    End
  299.    Begin VB.Label Label8 
  300.       Caption         =   "Char&acters to copy:"
  301.       Height          =   255
  302.       Left            =   3360
  303.       TabIndex        =   3
  304.       Top             =   120
  305.       Width           =   1455
  306.    End
  307.    Begin VB.Label Label7 
  308.       Height          =   495
  309.       Left            =   1920
  310.       TabIndex        =   17
  311.       Top             =   3000
  312.       Width           =   2655
  313.    End
  314.    Begin VB.Label Label6 
  315.       Caption         =   "Dec:"
  316.       Height          =   255
  317.       Left            =   120
  318.       TabIndex        =   12
  319.       Top             =   3480
  320.       Width           =   495
  321.    End
  322.    Begin VB.Label Label3 
  323.       Caption         =   "Bin:"
  324.       Height          =   255
  325.       Left            =   120
  326.       TabIndex        =   11
  327.       Top             =   3120
  328.       Width           =   375
  329.    End
  330.    Begin VB.Label Label2 
  331.       Caption         =   "Hex:"
  332.       Height          =   255
  333.       Left            =   120
  334.       TabIndex        =   10
  335.       Top             =   2760
  336.       Width           =   375
  337.    End
  338.    Begin VB.Label Label4 
  339.       Caption         =   "Label4"
  340.       Height          =   285
  341.       Left            =   1920
  342.       TabIndex        =   1
  343.       Top             =   3840
  344.       Width           =   2820
  345.    End
  346.    Begin VB.Label Label1 
  347.       Caption         =   "Label1"
  348.       Height          =   195
  349.       Left            =   1920
  350.       TabIndex        =   0
  351.       Top             =   3480
  352.       Width           =   2775
  353.    End
  354.    Begin VB.Menu mnuFile 
  355.       Caption         =   "file"
  356.       Visible         =   0   'False
  357.       Begin VB.Menu mnuWhatsThis 
  358.          Caption         =   "&what's this?"
  359.       End
  360.    End
  361. Attribute VB_Name = "Form1"
  362. Attribute VB_GlobalNameSpace = False
  363. Attribute VB_Creatable = False
  364. Attribute VB_PredeclaredId = True
  365. Attribute VB_Exposed = False
  366. Option Explicit
  367. '******************************************************************************
  368. '*Character Map recreation -17/jul/2000
  369. '******************************************************************************
  370. ''improved' 16/3/2001
  371. 'By oigres P Email:oigres@postmaster.co.uk
  372. Private Type POINTAPI  '  8 Bytes
  373.     x As Long
  374.     y As Long
  375. End Type
  376. 'Private Declare Function GetDesktopWindow Lib "user32" () As Long
  377. Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
  378. Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
  379. Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
  380. Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
  381. Private Declare Function GetDesktopWindow Lib "user32" () As Long
  382. Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  383. Private Declare Function BitBlt& Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, _
  384.         ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As _
  385.         Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long)
  386. Private Declare Function SelectObject& Lib "gdi32" (ByVal hdc As Long, ByVal hObject As _
  387.         Long)
  388. Private Declare Function DeleteObject& Lib "gdi32" (ByVal hObject As Long)
  389. Private Declare Function MoveToEx& Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, _
  390.         ByVal y As Long, lpPoint As POINTAPI)
  391. Private Declare Function CreateRectRgnIndirect& Lib "gdi32" (lprect As RECT)
  392. Private Declare Function CreateRectRgn& Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As _
  393.         Long, ByVal X2 As Long, ByVal Y2 As Long)
  394. ''Private Declare Function ShowCursor& Lib "user32" (ByVal bShow As Long)
  395. Private Declare Function LineTo& Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal _
  396.         y As Long)
  397. Private Declare Function Rectangle& Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, _
  398.         ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long)
  399. Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
  400. Private Const HORZRES = 8
  401. Private Const VERTRES = 10
  402. Const SRCCOPY = &HCC0020
  403. Dim HtmlNames(255) As String
  404. Dim HtmlClrHex(139) As String
  405. Dim asciiList() ' list of character descriptions
  406. Dim sizeX, sizeY, previousX, previousY
  407. Dim mouseDown As Boolean, bDrawLine As Boolean
  408. Dim mode As Long, loadokay As Boolean
  409. Private Sub CboFonts_Click()
  410.     drawSquare CboFonts.List(CboFonts.ListIndex)
  411.     Picture2.Font = CboFonts.List(CboFonts.ListIndex)
  412.     Picture2.FontSize = 18
  413.     Txtcopy.Font = CboFonts.List(CboFonts.ListIndex)
  414.     'reselect last square
  415.     drawfocusColour previousX, previousY
  416. End Sub
  417. Private Sub cboHtmlClr_Change()
  418. MsgBox "hello"
  419. cboHtmlClr.ToolTipText = "hello" 'cboHtmlClr.ListIndex
  420. End Sub
  421. Private Sub cboHtmlClr_Click()
  422. Dim clr As Long, hstr As String 'hexdecimal string
  423. Dim rpercent, gpercent, bpercent
  424. clr = Val(cboHtmlClr.List(cboHtmlClr.ListIndex))
  425. Dim lR As Long, lG As Long, LB As Long
  426.     lR = (clr Mod &H100)
  427.     lG = (clr \ &H100) Mod &H100
  428.     LB = (clr \ &H10000) Mod &H10000
  429. txtHtmlClr.BackColor = clr
  430. txtHtmlClr.ForeColor = (16 ^ 6) - (clr + 1)
  431. hstr = hstr & Format(Hex(lR), "00")
  432. hstr = hstr & Format(Hex(lG), "00")
  433. hstr = hstr & Format(Hex(LB), "00")
  434. cboHtmlClr.ToolTipText = "Colour number " & cboHtmlClr.ListIndex + 1 & ":Hex " & hstr
  435. rpercent = Int((lR / 255) * 100)
  436. gpercent = Int((lG / 255) * 100)
  437. bpercent = Int((LB / 255) * 100)
  438. txtHtmlClr.Text = "#" & hstr
  439. txtHtmlClr.ToolTipText = rpercent & "%:" & gpercent & "%:" & bpercent & "%"  'Hex(clr) & ":" & Hex(lR) & Hex(lG) & Hex(lB) & ":" & hstr
  440. End Sub
  441. Private Sub cboHtmlClr_KeyPress(KeyAscii As Integer)
  442. 'cboHtmlClr.ToolTipText = cboHtmlClr.ListIndex
  443. End Sub
  444. Private Sub cboHtmlClrName_Click()
  445.     Dim temp As Long, rghstr As String, rstr As String
  446.     Dim gstr As String, bstr As String
  447.     Dim lresult As Long, r1, g1, b1, tmpRealClr As Long
  448.     Me.txtNameHex.Text = HtmlClrHex(cboHtmlClrName.ListIndex)
  449.     rghstr = right$(Me.txtNameHex.Text, Len(Me.txtNameHex.Text) - 1)
  450.     rstr = Mid$(rghstr, 1, 2)
  451.     r1 = (Val("&h" & rstr) \ 51) * 51
  452.     gstr = Mid$(rghstr, 3, 2)
  453.     g1 = (Val("&h" & gstr) \ 51) * 51
  454.     bstr = Mid$(rghstr, 5, 2)
  455.     b1 = (Val("&h" & bstr) \ 51) * 51
  456.     Debug.Print r1; Hex(r1); g1; Hex(g1); b1; Hex(b1)
  457.     lresult = RGB(r1, g1, b1)
  458.     temp = RGB(Val("&h" & rstr), Val("&h" & gstr), Val("&h" & bstr))
  459.     'temp = CDbl(Val("&h" & rghstr & "&")) 'need long value in string to val
  460.     Me.txtNameHex.BackColor = temp
  461.     Me.txtNameHex.ForeColor = (16 ^ 6) - (temp + 1)
  462.     'lresult = temp \ 51
  463.     'Debug.Print "1: " & lresult & ":" & Hex(lresult)
  464.     'lresult = lresult * 51
  465.     'Debug.Print "2: " & lresult & ":" & Hex(lresult)
  466.     'Me.txtNameHex.ToolTipText = "#" & Format(Hex(r1), "00") & Format(Hex(g1), "00") & Format(Hex(b1), "00")
  467.     Me.txtNameHex.ToolTipText = "Named Colour Value"
  468.     tmpRealClr = RGB(r1, g1, b1)
  469.     Me.txtrealClr.BackColor = tmpRealClr
  470.     'try to get matching value in cbohtmlclr
  471.     Dim x As Integer
  472.     cboHtmlClr.Visible = False
  473.     For x = 0 To cboHtmlClr.ListCount - 1
  474.         If cboHtmlClr.List(x) = CStr(tmpRealClr) Then
  475.             cboHtmlClr.ListIndex = x
  476.             Exit For
  477.         End If
  478.         
  479.     Next x
  480.     'cboHtmlClr.Text = tmpRealClr
  481.     cboHtmlClr.Visible = True
  482.     txtrealClr.ToolTipText = "Web Colour:" & "#" & Format(Hex(r1), "00") & Format(Hex(g1), "00") & Format(Hex(b1), "00")
  483.     'Me.txtNameHex.ToolTipText = "#" & Hex(lresult)
  484. End Sub
  485. Private Sub cmdClose_Click()
  486.     Unload Me
  487. End Sub
  488. Private Sub cmdCopy_Click()
  489.     'copy to clipboard
  490.     Clipboard.Clear
  491.     Clipboard.SetText Txtcopy.Text, vbCFText
  492.     Picture1.SetFocus
  493. End Sub
  494. Private Sub cmdCopyPush_Click(index As Integer)
  495.     With Clipboard
  496.         .Clear
  497.         Select Case index
  498.         Case 0
  499.             .SetText Txt1.Text
  500.         Case 1
  501.             .SetText Txt2.Text
  502.         Case 2
  503.             .SetText Txt3.Text
  504.         Case 3
  505.             .SetText txthtml.Text
  506.         Case 4
  507.             .SetText txtHtmlClr.Text
  508.         Case 5
  509.             .SetText cboHtmlClr.List(cboHtmlClr.ListIndex)
  510.         Case 6
  511. .SetText txtHtmlName.Text
  512.         End Select
  513.     End With
  514. End Sub
  515. Private Sub cmdSelect_Click()
  516.     '
  517.     inserttext
  518.     Picture1.SetFocus
  519. End Sub
  520. Sub inserttext()
  521.     Dim X1, Y1, char$, lprect As RECT, offsetx, offsety, s
  522.     s = selectedsquare
  523.     Y1 = s \ 32
  524.     X1 = s Mod 32
  525.     char$ = Chr$((Y1 * 32) + (X1 + 1) + 30) '1)
  526.     Txtcopy.SelText = char$
  527. End Sub
  528. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  529. '************************************************************
  530. '* Name: Form_KeyDown
  531. '* Description :
  532. '* Parameters :
  533. '* Created : 17-Jul-2000
  534. '************************************************************
  535.     ''MsgBox "keydon " & KeyCode & ":" & ActiveControl
  536.     If KeyCode = Asc("A") And (Shift And vbAltMask) Then
  537.         MsgBox "alt+ A=frm key"
  538.         'Txtcopy.SelText =
  539.         Txtcopy.SelStart = 0
  540.         Txtcopy.SelLength = Len(Txtcopy.Text)
  541.         Txtcopy.SetFocus
  542.     End If
  543.     If KeyCode = Asc("F") And (Shift And vbAltMask) Then
  544.         'MsgBox "alt+ A"
  545.         'Txtcopy.SelText =
  546.         CboFonts.SetFocus
  547.     End If
  548.     If KeyCode = Asc("S") And (Shift And vbAltMask) Then
  549.         MsgBox "alt+ S"
  550.         'Txtcopy.SelText =
  551.         'CboFonts.SetFocus
  552.     End If
  553. End Sub
  554. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
  555.     If KeyCode = Asc("A") And (Shift And vbAltMask) Then
  556.         ''MsgBox "alt+ A=frm key"
  557.         'Txtcopy.SelText =
  558.         Txtcopy.SelStart = 0
  559.         Txtcopy.SelLength = Len(Txtcopy.Text)
  560.         Txtcopy.SetFocus
  561.     End If
  562.     If KeyCode = Asc("F") And (Shift And vbAltMask) Then
  563.         'MsgBox "alt+ A"
  564.         'Txtcopy.SelText =
  565.         CboFonts.SetFocus
  566.     End If
  567. End Sub
  568. Private Sub Form_Load()
  569.     Dim x, y, value, lastleft, lasttop
  570.     Dim index
  571.     '' Form1.ScaleWidth = 32 * 7
  572.     loadokay = True
  573.     bDrawLine = True 'magnifier cross is on
  574.     Form1.Icon = LoadPicture(App.Path & "\charmap.ico")
  575.     sizeX = (Picture1.ScaleWidth \ 32) ' + 1 '  32*7=224
  576.     sizeY = (Picture1.ScaleHeight \ 7) ''' + 1 '  32*7=224
  577.     '''MsgBox sizeX & ":" & sizeY
  578.     'load info files
  579.     If createAsciiList() = True Then
  580.         If createHtmlNamed() = True Then
  581.             If createHtmlColorName() = True Then
  582.             
  583.             Else
  584.                 loadokay = False
  585.             End If
  586.         Else
  587.             loadokay = False
  588.         End If
  589.     Else
  590.         loadokay = False
  591.     End If
  592.     If loadokay = False Then
  593.         MsgBox "Errors on loading"
  594.         Unload Me
  595.         'need to exit sub to stop code after executing
  596.         Exit Sub
  597.     End If
  598.     '
  599.     Me.cboHtmlClrName.ListIndex = 0
  600.     CboFonts.Visible = False
  601.     FillListWithFonts CboFonts 'List1
  602.     'load and select combo htmlclr
  603.     cboClr Me.cboHtmlClr
  604.     cboHtmlClr.ListIndex = 0
  605.     'getlast setting if saved
  606.     value = GetSetting("MyCharacterMap", "CboFonts", "LastFont", "0")
  607.     ''cbofonts.l
  608.     CboFonts.ListIndex = value
  609.     'get last font
  610.     value = GetSetting("MyCharacterMap", "CboFonts", "LastFontName", "Times New Roman")
  611.     'somehow we saved a zerolength string (registry has an entry of "")
  612.     If value = "" Then value = "Times New Roman"
  613.     drawSquare CStr(value)
  614.     CboFonts.Visible = True
  615.     Picture2.Visible = False
  616.     Picture3.Visible = False
  617.     mouseDown = False
  618.     Txtcopy.Text = GetSetting("MyCharacterMap", "Txt", "LastText", "")
  619.     Txtcopy.SelStart = Len(Txtcopy.Text)
  620.     Txtcopy_Change
  621.     'starts off with first square selected
  622.     Dim xp, yp
  623.     selectedsquare = GetSetting("MyCharacterMap", "Form1", "selectedsquare", "1")
  624.     'bug->boundary error (was selectedsquare Mod 32), error on value 224
  625.     'bug area --------------------------------------------
  626.     'Dim myselsqr As Long
  627.     'myselsqr = selectedsquare - 1
  628.     '
  629.     xp = ((selectedsquare - 1) Mod 32) ' (224-1) mod 32 = 31
  630.     'xp = (myselsqr Mod 32)
  631.     ''MsgBox xp
  632.     yp = (selectedsquare - 1) \ 32 '(224-1) \ 32 =6
  633.     ''MsgBox yp
  634.     ''MsgBox "selectedsquare = " & selectedsquare
  635.     drawselected selectedsquare - 1
  636.     'bug propagated to here - was xp * sizex + 13
  637.     Picture1_MouseDown 0&, 0&, xp * sizeX, yp * sizeY + 4  '(selectedsquare Mod 32) * 32, (selectedsquare \ 32) * 32
  638.     Picture1_MouseUp 0&, 0&, xp * sizeX, yp * sizeY + 4  '(selectedsquare Mod 32) * 32, (selectedsquare \ 32) * 32
  639.     'get last form coords
  640.     lastleft = GetSetting("MyCharacterMap", "Form1", "Left", "0")
  641.     If lastleft < 0 Then lastleft = 0
  642.     lasttop = GetSetting("MyCharacterMap", "Form1", "Top", "0")
  643.     If lasttop < 0 Then lasttop = 0
  644.     value = GetSetting("MyCharacterMap", "Magnification", "Last", "50")
  645.     If value < 1 Or value > 100 Then value = 50
  646.     VScroll1.value = value
  647.     Form1.Move lastleft, lasttop
  648.     Form1.Show
  649.     Picture1.SetFocus
  650. End Sub
  651. Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  652. End Sub
  653. Private Sub updateLabel(x, y)
  654.     Dim key, k$
  655.     'give keystroke and alt information
  656.     'changed 11 june 2001 -was (x+1)
  657.     'changed back to (x+1)
  658.     key = (y * 32) + (x + 1) ' + 31
  659.     k$ = "Keystroke: "
  660.     'MsgBox key
  661.     Select Case key
  662.     Case 1
  663.         Label4.Caption = k$ & "Spacebar"
  664.     Case 2 To 95 '
  665.         If key = 7 Then 'need && to show in label for ampersand
  666.             Label4.Caption = k$ & "&&" 'Chr$(key + 31)
  667.         Else
  668.             Label4.Caption = k$ & Chr$(key + 31)
  669.         End If
  670.     Case 96 To 97
  671.         Label4.Caption = k$ & "Ctrl+" & (key - 95)
  672.     Case 98 To 224
  673.         Label4.Caption = k$ & "Alt+0" & key + 31
  674.     End Select
  675.     'hex / bin text
  676.     Txt1.Text = Hex(key + 31)
  677.     Txt2.Text = Bin(key + 31, 8)
  678.     Txt3.Text = key + 31
  679.     'bug if I closed prog with last select character as '
  680.     '225+31 =256;started at form load-
  681.     'Debug.Assert key + 31 < 256
  682.     If key + 31 < 256 Then
  683.         txtHtmlName.Text = HtmlNames(key + 31)
  684.     End If
  685.     Label1.Caption = "Col: " & x & " Line: " & y & " Square:" & (y * 32) + (x + 1) & " Ascii: " & key + 31 ' * (y1 + 1)
  686.     'Debug.Print key
  687.     'asciilist array starts at 0 index
  688.     Select Case key
  689.     Case 1 To 98
  690.         Label7.Caption = asciiList(key - 1)
  691.     Case 99 To 129
  692.         Label7.Caption = asciiList(key - 1)
  693.     Case 130 To 224
  694.         Label7.Caption = asciiList(key - 1)
  695.     End Select
  696. 'update html entity
  697.     txthtml.Text = "&#" & key + 31 & ";"
  698. 'update colour square
  699. 'txtHtmlClr.BackColor = 77672 * (216 Mod key)
  700. 'txtHtmlClr.ForeColor = (16 ^ 6) - (77672 * (216 Mod key))
  701. 'txtHtmlClr.Text = Hex(txtHtmlClr.BackColor)
  702. End Sub
  703. Function createAsciiList() As Boolean
  704.     'assume true
  705.     createAsciiList = True
  706.     ReDim asciiList(250)
  707.     Dim a$, index As Long, ffile As Long
  708.     ffile = FreeFile()
  709.     If fileExists(App.Path & "\asciiquoteds.txt") Then
  710.         Open App.Path & "\asciiquoteds.txt" For Input As ffile
  711.         Do While Not (EOF(ffile))
  712.             Input #ffile, a$
  713.             asciiList(index) = a$
  714.             index = index + 1
  715.         Loop
  716.         Close ffile
  717.     Else
  718.         Close ffile
  719.         createAsciiList = False
  720.         MsgBox "File " & App.Path & "\asciiquoteds.txt" & " not found"
  721.         
  722.     End If
  723. End Function
  724. Function createHtmlNamed() As Boolean
  725.  Dim a$, index As Long, ffile As Long
  726.     createHtmlNamed = True 'assume success
  727.     ffile = FreeFile()
  728.     If fileExists(App.Path & "\htmlentand.txt") Then
  729.         Open App.Path & "\htmlentand.txt" For Input As ffile
  730.             Do While Not (EOF(ffile))
  731.                 Input #ffile, a$
  732.                 HtmlNames(index) = a$
  733.                 index = index + 1
  734.             Loop
  735.             '''MsgBox "create HtmlNamed index=  " & index - 1 ' -1 because it is incremented
  736.         
  737.         Close ffile
  738.     Else
  739.         Close ffile
  740.         MsgBox "File " & App.Path & "\htmlentand.txt" & " not found"
  741.         createHtmlNamed = False
  742.         'Unload Me
  743.     End If
  744. End Function
  745. Function createHtmlColorName() As Boolean
  746. Dim a$, index As Long, ffile As Long
  747.     createHtmlColorName = True
  748.     ffile = FreeFile()
  749.     If fileExists(App.Path & "\htmlcolournames.txt") Then
  750.     Open App.Path & "\htmlcolournames.txt" For Input As ffile
  751.     Do While Not (EOF(ffile))
  752.         Input #ffile, a$
  753.         Me.cboHtmlClrName.AddItem a$
  754.         Input #ffile, a$
  755.         HtmlClrHex(index) = a$
  756.         index = index + 1
  757.     Loop
  758.     Close ffile
  759.     Close ffile
  760.     MsgBox "File " & App.Path & "\htmlcolournames.txt"
  761.     createHtmlColorName = False
  762. End If
  763. End Function
  764. Private Sub Form_Unload(Cancel As Integer)
  765. If loadokay = True Then
  766.     SaveSetting "MyCharacterMap", "CboFonts", "LastFont", CboFonts.ListIndex
  767.     SaveSetting "MyCharacterMap", "CboFonts", "LastFontName", CboFonts.List(CboFonts.ListIndex)
  768.     SaveSetting "MyCharacterMap", "Form1", "Left", Form1.left
  769.     SaveSetting "MyCharacterMap", "Form1", "Top", Form1.top
  770.     SaveSetting "MyCharacterMap", "Magnification", "Last", Form1.VScroll1.value
  771.     'poosible bug
  772.     SaveSetting "MyCharacterMap", "Form1", "selectedSquare", Module1.selectedsquare
  773.     SaveSetting "MyCharacterMap", "Txt", "LastText", Txtcopy.Text
  774. End If
  775. End Sub
  776. Private Sub mnuWhatsThis_Click()
  777.     MsgBox "By oigres P", , "What's this?"
  778. End Sub
  779. Private Sub Picture1_DblClick()
  780.     inserttext
  781. End Sub
  782. Private Sub Picture1_KeyDown(KeyCode As Integer, Shift As Integer)
  783.     Select Case KeyCode
  784.     Case vbKeyDown
  785.         If selectedsquare + 32 < 225 Then
  786.             selectedsquare = selectedsquare + 32
  787.         End If
  788.     Case vbKeyUp
  789.         If selectedsquare - 32 > 0 Then
  790.             selectedsquare = selectedsquare - 32
  791.         End If
  792.     Case vbKeyRight
  793.         If selectedsquare + 1 < 225 Then
  794.             selectedsquare = selectedsquare + 1
  795.         End If
  796.     Case vbKeyLeft
  797.         If selectedsquare - 1 > 0 Then
  798.             selectedsquare = selectedsquare - 1
  799.         End If
  800.     Case Else
  801.         Exit Sub
  802.     End Select
  803.     drawselected (selectedsquare - 1)
  804.     updateLabel (selectedsquare - 1) Mod 32, (selectedsquare - 1) \ 32
  805. End Sub
  806. '/******************************************************************************
  807. Sub drawselected(s As Long)
  808.     '/******************************************************************************
  809.     Dim X1, Y1, char$, lprect As RECT, offsetx, offsety
  810.     ''MsgBox "draw selected input " & s
  811.     Y1 = s \ 32
  812.     X1 = s Mod 32
  813.     'erase previous ?
  814.     Picture1.Line (previousX * sizeX + 1, previousY * sizeY + 1)-(previousX * sizeX + (sizeX - 1), previousY * sizeY + (sizeY - 1)), vbWhite, BF
  815.     Picture1.CurrentX = (previousX * sizeX) + 3
  816.     Picture1.CurrentY = (previousY * sizeY)
  817.     Picture1.Print Chr$((previousY * 32) + (previousX + 1) + 31);
  818.     previousX = X1
  819.     previousY = Y1
  820.     char$ = Chr$((Y1 * 32) + (X1 + 1) + 31)
  821.     Picture2.Visible = False: Picture3.Visible = False
  822.     offsetx = (Picture2.ScaleWidth - Picture2.TextWidth(char$)) \ 2
  823.     offsety = (Picture2.ScaleHeight - Picture2.TextHeight(char$)) \ 2
  824.     Picture2.left = (X1 * sizeX - 5) + 10
  825.     Picture2.top = (Y1 * sizeY - 5) + 35
  826.     Picture3.left = Picture2.left + 5
  827.     Picture3.top = Picture2.top + 5
  828.     Picture2.CurrentX = offsetx
  829.     Picture2.CurrentY = offsety '    Chr$((y1 * 32) + (x1 + 1) + 31)
  830.     Picture2.Picture = LoadPicture()
  831.     Picture2.Print Chr$((Y1 * 32) + (X1 + 1) + 31)
  832.     Picture2.Visible = True: Picture3.Visible = True
  833. End Sub
  834. Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  835.     '*******************************************************************************
  836.     '* Name:  Picture1_MouseDown
  837.     '*
  838.     '* Description:
  839.     '*
  840.     '* Date Created:  7/17/00
  841.     '*
  842.     '* Created By: oigres P
  843.     '*
  844.     '* Modified: 7/19/00
  845.     '*
  846.     '*******************************************************************************
  847.     Dim X1, Y1, ret, lprect As RECT, offsetx, offsety, char$
  848.     X1 = x \ sizeX
  849.     Y1 = y \ sizeY
  850.     Debug.Print X1 & ":" & Y1
  851.     If Button = vbRightButton Then
  852.         Form1.PopupMenu mnuFile
  853.         Exit Sub
  854.     End If
  855.     'if in square of picture
  856.     If X1 >= 0 And X1 <= 31 And Y1 >= 0 And Y1 <= 6 Then
  857.         ''If x1 <> previousX And y <> previousY Then
  858.         'erase previous focus rectangle
  859.         ''MsgBox IsEmpty(previousX)
  860.         If Not (IsEmpty(previousX) And IsEmpty(previousY)) Then
  861.             lprect.left = X1 * sizeX + 1
  862.             lprect.top = Y1 * sizeY + 1
  863.             lprect.right = X1 * sizeX + (sizeX - 1) + 1 '- 1
  864.             lprect.bottom = Y1 * sizeY + (sizeY - 1) + 1
  865.             ''DrawFocusRect Picture1.hdc, lprect
  866.             Picture1.Line (previousX * sizeX, previousY * sizeY)-(previousX * sizeX + (sizeX), previousY * sizeY + (sizeY)), vbBlack, BF
  867.             Picture1.Line (previousX * sizeX + 1, previousY * sizeY + 1)-(previousX * sizeX + (sizeX - 1), previousY * sizeY + (sizeY - 1)), vbWhite, BF
  868.            
  869.             char$ = Chr$((previousY * 32) + (previousX + 1) + 31)
  870.             offsetx = (sizeX - Picture1.TextWidth(char$)) \ 2
  871.             offsety = (sizeY - Picture1.TextHeight(char$)) \ 2
  872.             Picture1.CurrentX = (previousX * sizeX) + offsetx
  873.             Picture1.CurrentY = (previousY * sizeY) + offsety
  874.             Picture1.Print char$;
  875.         End If
  876.         Picture2.Visible = False
  877.         Picture3.Visible = False
  878.         Picture2.left = (X1 * sizeX - 5) + 10
  879.         Picture2.top = (Y1 * sizeY - 5) + 35
  880.         Picture3.left = Picture2.left + 5
  881.         Picture3.top = Picture2.top + 5
  882.         Picture2.Visible = True
  883.         Picture3.Visible = True
  884.         selectedsquare = (Y1 * 32) + (X1 + 1)
  885.         previousX = X1
  886.         previousY = Y1
  887.     End If ' in square
  888.     Call updateLabel(X1, Y1)
  889.     'hide cursor
  890.     If mouseDown = False Then
  891.         
  892.         makeCursorInvisible
  893.       
  894.         mousevisible = False
  895.         '' Label5.Caption = "showcursor times= " & ret
  896.     End If
  897.     mousevisible = False
  898.     ''Form1.MousePointer = 15
  899.     Picture2.Visible = True
  900.     Picture3.Visible = True
  901.     mouseDown = True
  902. End Sub
  903. '/******************************************************************************
  904. Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  905.     '*******************************************************************************
  906.     '* Name:  Picture1_MouseMove
  907.     '*
  908.     '* Description:
  909.     '*
  910.     '* Date Created:  7/21/00
  911.     '*
  912.     '* Created By:
  913.     '*
  914.     '* Modified:
  915.     '*
  916.     '*******************************************************************************
  917.     Dim X1, Y1, ret, char$, key
  918.     Dim offsetx, offsety
  919.     Static lastx
  920.     Static lasty
  921.     X1 = x \ sizeX
  922.     Y1 = y \ sizeY
  923.     If mouseDown = True Then
  924.         If X1 >= 0 And X1 <= 31 And Y1 >= 0 And Y1 <= 6 Then
  925.             If mousevisible = True Then
  926.                 makeCursorInvisible
  927.             End If
  928.             If lastx = X1 And lasty = Y1 Then Exit Sub
  929.             lastx = X1: lasty = Y1
  930.             key = (Y1 * 32) + (X1 + 1)
  931.             Picture2.Visible = False
  932.             Picture3.Visible = False
  933.             Picture2.left = (X1 * sizeX - 5) + 10
  934.             Picture2.top = (Y1 * sizeY - 5) + 35
  935.             Picture3.left = Picture2.left + 5
  936.             Picture3.top = Picture2.top + 5
  937.             '            Picture2.Visible = True
  938.             '            Picture3.Visible = True
  939.             char$ = Chr$((Y1 * 32) + (X1 + 1) + 31)
  940.             If Picture2.Tag = char$ Then
  941.             Else
  942.                 '        Picture1.Picture = LoadPicture()
  943.                 '        Picture1.CurrentX = 0: Picture1.CurrentY = 0
  944.                 '        Picture1.Print Chr$((y1 * 32) + (x1 + 1) + 31)
  945.                 previousX = X1
  946.                 previousY = Y1
  947.                 ''Picture2.Visible = False
  948.                 Picture2.Tag = char$
  949.                 offsetx = (Picture2.ScaleWidth - Picture2.TextWidth(char$)) \ 2
  950.                 offsety = (Picture2.ScaleHeight - Picture2.TextHeight(char$)) \ 2
  951.                 Picture2.CurrentX = offsetx
  952.                 Picture2.CurrentY = offsety '    Chr$((y1 * 32) + (x1 + 1) + 31)
  953.                 Picture2.Picture = LoadPicture()
  954.                 Picture2.Print Chr$((Y1 * 32) + (X1 + 1) + 31)
  955.                 Picture2.Visible = True
  956.                 Picture3.Visible = True
  957.             End If 'if tag
  958.             Call updateLabel(X1, Y1)
  959.             previousX = X1
  960.             previousY = Y1
  961.         Else 'not in square
  962.             'showcursor ?
  963.             makeCursorVisible
  964.             Exit Sub
  965.         End If ' x1 >= 0 And x1 <= 31 And y1 >= 0 And y1 <= 6
  966.         
  967.     End If
  968. End Sub
  969. Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  970.     '*******************************************************************************
  971.     '* Name:  Picture1_MouseUp
  972.     '*
  973.     '* Description:
  974.     '*
  975.     '* Date Created:  7/21/00
  976.     '*
  977.     '* Created By:
  978.     '*
  979.     '* Modified:
  980.     '*
  981.     '*******************************************************************************
  982.     Dim ret, X1, Y1, lprect As RECT
  983.     X1 = x \ sizeX
  984.     Y1 = y \ sizeY
  985.     If mousevisible = False Then
  986.         makeCursorVisible
  987.         mousevisible = True
  988.     End If
  989.     drawfocusColour previousX, previousY
  990.     If X1 >= 0 And X1 <= 31 And Y1 >= 0 And Y1 <= 6 Then
  991.     Else
  992.         If mouseDown = True Then
  993.             Picture2.Visible = False
  994.             Picture3.Visible = False
  995.             'draw focus rectangle
  996.             drawfocusColour previousX, previousY
  997.         End If
  998.     End If
  999.     Picture2.Visible = False
  1000.     Picture3.Visible = False
  1001.     mouseDown = False
  1002. End Sub
  1003. '/******************************************************************************
  1004. Sub drawSquare(f As String)
  1005.     '/******************************************************************************
  1006.     'draw the font characters in the grid (picture1)
  1007.     Dim x As Long, y As Long, char$, lpPT As POINTAPI
  1008.     Dim offsetx, offsety
  1009.     Picture1.Visible = False
  1010.     Picture1.FontName = f
  1011.     Picture1.FontSize = 8
  1012.     Picture1.Picture = LoadPicture() 'fast clear
  1013.     For x = 0 To 31 '32
  1014.         For y = 0 To 6 '7
  1015.             ''Picture1.Line (x * sizex, y * sizey)-(x * sizex + (sizey - 1), y * sizex + (sizey - 1)), vbBlack, B
  1016.             char$ = Chr$((y * 32) + (x + 1) + 31)
  1017.             'centre the character in the grid square
  1018.             offsetx = (sizeX - Picture1.TextWidth(char$)) \ 2
  1019.             offsety = (sizeY - Picture1.TextHeight(char$)) \ 2
  1020.             Picture1.CurrentX = (x * sizeX) + offsetx
  1021.             Picture1.CurrentY = (y * sizeY) + offsety
  1022.             Picture1.Print char$;
  1023.         Next y
  1024.     Next x
  1025.     'draw grid lines
  1026.     For x = 0 To 7
  1027.         MoveToEx Picture1.hdc, 0, x * sizeY, lpPT
  1028.         LineTo Picture1.hdc, sizeX * 32, x * sizeY
  1029.     Next x
  1030.     For x = 0 To 32
  1031.         MoveToEx Picture1.hdc, x * sizeX, 0, lpPT
  1032.         LineTo Picture1.hdc, x * sizeX, sizeY * 7 + 1 'Picture1.ScaleHeight - 1
  1033.     Next x
  1034.     Picture1.Visible = True
  1035. End Sub
  1036. Private Sub Picture4_Click()
  1037. 'bDrawLine = Not bDrawLine
  1038. End Sub
  1039. Private Sub Picture4_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  1040. If Button = vbKeyLButton Then
  1041. bDrawLine = Not bDrawLine
  1042. End If
  1043. 'If Button = vbKeyRButton Then
  1044. ''bDrawLine = Not bDrawLine
  1045. 'mode = mode + 1
  1046. 'If mode > 16 Then
  1047. '    mode = 1
  1048. 'End If
  1049. 'Picture4.DrawMode = mode
  1050. 'End If
  1051. End Sub
  1052. Private Sub Timer1_Timer()
  1053.     Dim cp As POINTAPI, hr As Long, vr As Long, ret As Long
  1054. Dim clr As Long
  1055.     Static lastcpx
  1056.     Static lastcpy
  1057.     GetCursorPos cp
  1058.     ''Label1.Caption = cp.x & Space(6 - Len(CStr(cp.x))) & ":" & cp.y
  1059.     Dim dsDC As Long, lpPT As POINTAPI, dshwnd As Long, Percent
  1060.     Dim lengthx, lengthy, offsetx, offsety, blitareax, blitareay
  1061.     'get desktop device context
  1062.     dsDC = GetDC(0&)
  1063.     'get screen width, height
  1064.     hr = GetDeviceCaps(dsDC, HORZRES)
  1065.     vr = GetDeviceCaps(dsDC, VERTRES)
  1066.     dshwnd = GetDesktopWindow()
  1067.     '      vscroll1=1..100 so 1/100=.1; 100/100=1;New Resolution
  1068.     Percent = VScroll1.value / 100
  1069.     lengthx = (Picture4.ScaleWidth - 0) * Percent
  1070.     lengthy = (Picture4.ScaleHeight - 0) * Percent
  1071.     'center image about mouse
  1072.     offsetx = lengthx \ 2
  1073.     offsety = lengthy \ 2
  1074.     blitareax = Picture4.ScaleWidth - 0 'actual area to blit to
  1075.     blitareay = Picture4.ScaleHeight - 0
  1076.     'Debug.Print lengthx; lengthy; Percent; offsetx; offsety
  1077.     'stop copying the screen off the edges <0 and  >horzres
  1078.     If cp.x - offsetx >= 0 And cp.x + offsetx < hr Then '800=screen width
  1079.         lastcpx = cp.x
  1080.     End If
  1081.     If cp.y - offsety >= 0 And cp.y + offsety < vr Then '600= screen height
  1082.         lastcpy = cp.y
  1083.             '                dest hdc ,destx,desty,width,height, sourceDC, source x,sourcey,sourcewidth,sourceheight,raster operation
  1084.     End If
  1085.     ret = StretchBlt(Picture4.hdc, 0, 0, blitareax, blitareay, dsDC, lastcpx - offsetx, lastcpy - offsety, lengthx, lengthy, SRCCOPY)
  1086.     clr = GetPixel(dsDC, cp.x, cp.y)
  1087.     If clr > -1 Then
  1088.     If bDrawLine = True Then
  1089.     Picture4.Line (0, 0)-(Picture4.Width - 1, Picture4.Height - 1) ', (16 ^ 6) - (clr + 1)
  1090.     Picture4.Line (Picture4.Width - 3, 0)-(0, Picture4.Height - 1) ', (16 ^ 6) - (clr + 1)
  1091.     End If
  1092.     ''update colour under cursor to picbox - picSample
  1093.     picSample.BackColor = clr
  1094.     picSample.ToolTipText = clr
  1095.     picSample.CurrentX = 0: picSample.CurrentY = 0
  1096.     picSample.ForeColor = (16 ^ 6) - (clr + 1)
  1097.     picSample.Print clr
  1098.     End If
  1099.     'Form1.Line (0, 0)-(Form1.ScaleWidth - VScroll1.Width, Form1.ScaleHeight - Label1.Height)
  1100.     'Form1.Line (Form1.ScaleWidth - VScroll1.Width, 0)-(0, Form1.ScaleHeight - Label1.Height)
  1101.     ReleaseDC dshwnd, dsDC 'previous bug not releasing memory
  1102.     Label5.Caption = Format(100 / VScroll1.value, "FIXED") & ":" & cp.x & ":" & cp.y
  1103. End Sub
  1104. '/******************************************************************************
  1105. Private Sub Txtcopy_Change()
  1106.     '/******************************************************************************
  1107.     If Txtcopy.Text = "" Then
  1108.         cmdCopy.Enabled = False
  1109.     Else
  1110.         cmdCopy.Enabled = True
  1111.     End If
  1112. End Sub
  1113. '/******************************************************************************
  1114. Sub drawfocusColour(x, y)
  1115.     Dim lprect As RECT, offsetx, offsety, char$
  1116.     Picture1.Line (x * sizeX + 1, y * sizeY + 1)-(x * sizeX + (sizeX - 1), _
  1117.             y * sizeY + (sizeY - 1)), vbHighlight, BF
  1118.     ''Picture1.FillColor = vbHighlight
  1119.     'Rectangle Picture1.hdc, x * sizeX + 1, y * sizeY + 1, x * sizeX + (sizeX), y * sizeY + (sizeY)
  1120.     ''Picture1.FillColor = vbWhite
  1121.     'Picture1.CurrentX = (x * sizeX) + 3
  1122.     'Picture1.CurrentY = (y * sizeY)
  1123.     '
  1124.     char$ = Chr$((y * 32) + (x + 1) + 31)
  1125.     offsetx = (sizeX - Picture1.TextWidth(char$)) \ 2
  1126.     offsety = (sizeY - Picture1.TextHeight(char$)) \ 2
  1127.     Picture1.CurrentX = (x * sizeX) + offsetx
  1128.     Picture1.CurrentY = (y * sizeY) + offsety
  1129.     '
  1130.     Picture1.ForeColor = vbWhite
  1131.     'Picture1.Print Chr$((y * 32) + (x + 1) + 31);
  1132.     Picture1.Print char$;
  1133.     Picture1.ForeColor = vbBlack
  1134.     ''previousX = x
  1135.     ''previousY = y
  1136.     lprect.left = x * sizeX + 1
  1137.     lprect.top = y * sizeY + 1
  1138.     lprect.right = x * sizeX + (sizeX - 1) + 1 '- 1
  1139.     lprect.bottom = y * sizeY + (sizeY - 1) + 1  '- 1
  1140.     DrawFocusRect Picture1.hdc, lprect
  1141. End Sub
  1142. '/******************************************************************************
  1143. Private Sub Txtcopy_GotFocus()
  1144.     '/******************************************************************************
  1145.     '    ''Debug.Print "1   tgoptfcs"
  1146.     '        'MsgBox "gfocus"
  1147.     '        Txtcopy.SelStart = 0
  1148.     '        Txtcopy.SelLength = Len(Txtcopy.Text)
  1149.     '    End If
  1150. End Sub
  1151. 'Private Sub Txtcopy_KeyDown(KeyCode As Integer, Shift As Integer)
  1152. '    If KeyCode = Asc("A") And (Shift And vbAltMask) Then
  1153. '        MsgBox "tkdwn"
  1154. '        Txtcopy.SelStart = 0
  1155. '        Txtcopy.SelLength = Len(Txtcopy.Text)
  1156. '    End If
  1157. 'End Sub
  1158. Private Sub Txtcopy_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  1159.     '
  1160. End Sub
  1161.