home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / MenuBitmap204623242007.psc / frmMain.frm < prev    next >
Text File  |  2007-02-04  |  38KB  |  1,192 lines
  1. VERSION 5.00
  2. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
  3. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
  4. Begin VB.Form frmMain 
  5.    BorderStyle     =   1  'Fixed Single
  6.    Caption         =   "Menu Bitmap: New"
  7.    ClientHeight    =   4635
  8.    ClientLeft      =   150
  9.    ClientTop       =   435
  10.    ClientWidth     =   7590
  11.    Icon            =   "frmMain.frx":0000
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    ScaleHeight     =   4635
  15.    ScaleWidth      =   7590
  16.    StartUpPosition =   1  'CenterOwner
  17.    Begin VB.Frame fraBMP 
  18.       Caption         =   "Bitmap"
  19.       Height          =   615
  20.       Left            =   5160
  21.       TabIndex        =   13
  22.       Top             =   150
  23.       Width           =   735
  24.       Begin VB.PictureBox picBMP 
  25.          Appearance      =   0  'Flat
  26.          AutoRedraw      =   -1  'True
  27.          BackColor       =   &H80000005&
  28.          BorderStyle     =   0  'None
  29.          ForeColor       =   &H80000008&
  30.          Height          =   195
  31.          Left            =   300
  32.          ScaleHeight     =   13
  33.          ScaleMode       =   3  'Pixel
  34.          ScaleWidth      =   13
  35.          TabIndex        =   14
  36.          Top             =   270
  37.          Width           =   195
  38.       End
  39.    End
  40.    Begin MSComctlLib.ImageList imgMnu 
  41.       Left            =   3360
  42.       Top             =   4200
  43.       _ExtentX        =   1005
  44.       _ExtentY        =   1005
  45.       BackColor       =   -2147483643
  46.       ImageWidth      =   13
  47.       ImageHeight     =   13
  48.       MaskColor       =   12632256
  49.       _Version        =   393216
  50.       BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  51.          NumListImages   =   9
  52.          BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  53.             Picture         =   "frmMain.frx":014A
  54.             Key             =   "Undo"
  55.          EndProperty
  56.          BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  57.             Picture         =   "frmMain.frx":03A4
  58.             Key             =   "Cut"
  59.          EndProperty
  60.          BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  61.             Picture         =   "frmMain.frx":05FE
  62.             Key             =   "New"
  63.          EndProperty
  64.          BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  65.             Picture         =   "frmMain.frx":0858
  66.             Key             =   "Open"
  67.          EndProperty
  68.          BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  69.             Picture         =   "frmMain.frx":0AB2
  70.             Key             =   "Paste"
  71.          EndProperty
  72.          BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  73.             Picture         =   "frmMain.frx":0D0C
  74.             Key             =   "Redo"
  75.          EndProperty
  76.          BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  77.             Picture         =   "frmMain.frx":0F66
  78.             Key             =   "Save"
  79.          EndProperty
  80.          BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  81.             Picture         =   "frmMain.frx":11C0
  82.             Key             =   "Copy"
  83.          EndProperty
  84.          BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  85.             Picture         =   "frmMain.frx":141A
  86.             Key             =   "PasteAll"
  87.          EndProperty
  88.       EndProperty
  89.    End
  90.    Begin MSComDlg.CommonDialog CD 
  91.       Left            =   2040
  92.       Top             =   4200
  93.       _ExtentX        =   847
  94.       _ExtentY        =   847
  95.       _Version        =   393216
  96.       CancelError     =   -1  'True
  97.    End
  98.    Begin VB.PictureBox picWork 
  99.       Appearance      =   0  'Flat
  100.       AutoRedraw      =   -1  'True
  101.       AutoSize        =   -1  'True
  102.       BackColor       =   &H00FFFFFE&
  103.       BorderStyle     =   0  'None
  104.       ForeColor       =   &H80000008&
  105.       Height          =   480
  106.       Left            =   7800
  107.       ScaleHeight     =   32
  108.       ScaleMode       =   3  'Pixel
  109.       ScaleWidth      =   32
  110.       TabIndex        =   9
  111.       Top             =   1560
  112.       Visible         =   0   'False
  113.       Width           =   480
  114.    End
  115.    Begin VB.PictureBox picDrag 
  116.       Appearance      =   0  'Flat
  117.       AutoRedraw      =   -1  'True
  118.       BackColor       =   &H00FFFFFE&
  119.       BorderStyle     =   0  'None
  120.       ForeColor       =   &H80000008&
  121.       Height          =   480
  122.       Left            =   7800
  123.       ScaleHeight     =   32
  124.       ScaleMode       =   3  'Pixel
  125.       ScaleWidth      =   32
  126.       TabIndex        =   8
  127.       Top             =   2280
  128.       Visible         =   0   'False
  129.       Width           =   480
  130.    End
  131.    Begin VB.Frame fraCurr 
  132.       Caption         =   "Color Selection"
  133.       Height          =   3345
  134.       Left            =   4560
  135.       TabIndex        =   2
  136.       Top             =   810
  137.       Width           =   2895
  138.       Begin VB.PictureBox picPal 
  139.          Appearance      =   0  'Flat
  140.          AutoRedraw      =   -1  'True
  141.          BackColor       =   &H80000005&
  142.          BorderStyle     =   0  'None
  143.          ForeColor       =   &H80000008&
  144.          Height          =   2400
  145.          Left            =   240
  146.          ScaleHeight     =   160
  147.          ScaleMode       =   3  'Pixel
  148.          ScaleWidth      =   160
  149.          TabIndex        =   12
  150.          ToolTipText     =   "Right or Left click to select color, Double click for custom color"
  151.          Top             =   720
  152.          Width           =   2400
  153.       End
  154.       Begin VB.Label lblPal 
  155.          Alignment       =   2  'Center
  156.          Caption         =   "R0,G0,B0"
  157.          Height          =   195
  158.          Left            =   600
  159.          TabIndex        =   11
  160.          Top             =   3120
  161.          Width           =   1575
  162.       End
  163.       Begin VB.Label lblRInfo 
  164.          Caption         =   "Right: R0,G0,B255"
  165.          Height          =   255
  166.          Left            =   600
  167.          TabIndex        =   6
  168.          Top             =   480
  169.          Width           =   2175
  170.       End
  171.       Begin VB.Label lblLInfo 
  172.          Caption         =   "Left:   R255,G0,B0"
  173.          Height          =   255
  174.          Left            =   600
  175.          TabIndex        =   5
  176.          Top             =   240
  177.          Width           =   2175
  178.       End
  179.       Begin VB.Label lblRight 
  180.          BackColor       =   &H00FF0000&
  181.          BorderStyle     =   1  'Fixed Single
  182.          Height          =   255
  183.          Left            =   240
  184.          TabIndex        =   4
  185.          Top             =   480
  186.          Width           =   255
  187.       End
  188.       Begin VB.Label lblLeft 
  189.          BackColor       =   &H000000FF&
  190.          BorderStyle     =   1  'Fixed Single
  191.          Height          =   255
  192.          Left            =   240
  193.          TabIndex        =   3
  194.          Top             =   240
  195.          Width           =   255
  196.       End
  197.    End
  198.    Begin VB.PictureBox picGrid 
  199.       Appearance      =   0  'Flat
  200.       AutoRedraw      =   -1  'True
  201.       BackColor       =   &H80000005&
  202.       BorderStyle     =   0  'None
  203.       ForeColor       =   &H80000008&
  204.       Height          =   3915
  205.       Left            =   480
  206.       ScaleHeight     =   261
  207.       ScaleMode       =   3  'Pixel
  208.       ScaleWidth      =   261
  209.       TabIndex        =   0
  210.       Top             =   240
  211.       Width           =   3915
  212.       Begin VB.PictureBox picSel 
  213.          Appearance      =   0  'Flat
  214.          AutoRedraw      =   -1  'True
  215.          BackColor       =   &H00FFFFFE&
  216.          BorderStyle     =   0  'None
  217.          ForeColor       =   &H80000008&
  218.          Height          =   480
  219.          Left            =   0
  220.          ScaleHeight     =   32
  221.          ScaleMode       =   3  'Pixel
  222.          ScaleWidth      =   32
  223.          TabIndex        =   10
  224.          Top             =   0
  225.          Visible         =   0   'False
  226.          Width           =   480
  227.       End
  228.       Begin VB.Shape shRect 
  229.          BorderColor     =   &H00FF0000&
  230.          BorderStyle     =   4  'Dash-Dot
  231.          DrawMode        =   6  'Mask Pen Not
  232.          Height          =   495
  233.          Left            =   0
  234.          Top             =   0
  235.          Visible         =   0   'False
  236.          Width           =   855
  237.       End
  238.       Begin VB.Line Lin 
  239.          BorderColor     =   &H00FF0000&
  240.          BorderStyle     =   4  'Dash-Dot
  241.          DrawMode        =   6  'Mask Pen Not
  242.          Visible         =   0   'False
  243.          X1              =   16
  244.          X2              =   16
  245.          Y1              =   88
  246.          Y2              =   152
  247.       End
  248.       Begin VB.Shape shCirc 
  249.          BorderColor     =   &H00FF0000&
  250.          BorderStyle     =   4  'Dash-Dot
  251.          DrawMode        =   6  'Mask Pen Not
  252.          Height          =   615
  253.          Left            =   0
  254.          Shape           =   2  'Oval
  255.          Top             =   480
  256.          Visible         =   0   'False
  257.          Width           =   855
  258.       End
  259.    End
  260.    Begin MSComctlLib.ImageList imlTools 
  261.       Left            =   2640
  262.       Top             =   4200
  263.       _ExtentX        =   1005
  264.       _ExtentY        =   1005
  265.       BackColor       =   -2147483643
  266.       ImageWidth      =   16
  267.       ImageHeight     =   16
  268.       MaskColor       =   16711935
  269.       _Version        =   393216
  270.       BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  271.          NumListImages   =   12
  272.          BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  273.             Picture         =   "frmMain.frx":1674
  274.             Key             =   "Select"
  275.          EndProperty
  276.          BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  277.             Picture         =   "frmMain.frx":1786
  278.             Key             =   "Text"
  279.          EndProperty
  280.          BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  281.             Picture         =   "frmMain.frx":1898
  282.             Key             =   "SelColor"
  283.          EndProperty
  284.          BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  285.             Picture         =   "frmMain.frx":19AA
  286.             Key             =   "Erase"
  287.          EndProperty
  288.          BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  289.             Picture         =   "frmMain.frx":1ABC
  290.             Key             =   "Line"
  291.          EndProperty
  292.          BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  293.             Picture         =   "frmMain.frx":1BCE
  294.             Key             =   "FCirc"
  295.          EndProperty
  296.          BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  297.             Picture         =   "frmMain.frx":1CE0
  298.             Key             =   "Circ"
  299.          EndProperty
  300.          BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  301.             Picture         =   "frmMain.frx":1DF2
  302.             Key             =   "Flood"
  303.          EndProperty
  304.          BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  305.             Picture         =   "frmMain.frx":1F04
  306.             Key             =   "FRect"
  307.          EndProperty
  308.          BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  309.             Picture         =   "frmMain.frx":2016
  310.             Key             =   "Rect"
  311.          EndProperty
  312.          BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  313.             Picture         =   "frmMain.frx":2128
  314.             Key             =   "Pencil"
  315.          EndProperty
  316.          BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  317.             Picture         =   "frmMain.frx":223A
  318.             Key             =   "Capture"
  319.          EndProperty
  320.       EndProperty
  321.    End
  322.    Begin MSComctlLib.Toolbar TBTools 
  323.       Height          =   3690
  324.       Left            =   0
  325.       TabIndex        =   1
  326.       Top             =   240
  327.       Width           =   420
  328.       _ExtentX        =   741
  329.       _ExtentY        =   6509
  330.       ButtonWidth     =   609
  331.       ButtonHeight    =   582
  332.       Appearance      =   1
  333.       ImageList       =   "imlTools"
  334.       _Version        =   393216
  335.       BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  336.          NumButtons      =   11
  337.          BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  338.             Key             =   "Select"
  339.             Object.ToolTipText     =   "Selection Rectangle"
  340.             ImageKey        =   "Select"
  341.          EndProperty
  342.          BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  343.             Key             =   "Pencil"
  344.             Object.ToolTipText     =   "Pencil"
  345.             ImageKey        =   "Pencil"
  346.          EndProperty
  347.          BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  348.             Key             =   "Line"
  349.             Object.ToolTipText     =   "Line"
  350.             ImageKey        =   "Line"
  351.          EndProperty
  352.          BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  353.             Key             =   "Rect"
  354.             Object.ToolTipText     =   "Rectangle"
  355.             ImageKey        =   "Rect"
  356.          EndProperty
  357.          BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  358.             Key             =   "FRect"
  359.             Object.ToolTipText     =   "Filled Rectange"
  360.             ImageKey        =   "FRect"
  361.          EndProperty
  362.          BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  363.             Key             =   "Circ"
  364.             Object.ToolTipText     =   "Circle"
  365.             ImageKey        =   "Circ"
  366.          EndProperty
  367.          BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  368.             Key             =   "FCirc"
  369.             Object.ToolTipText     =   "Filled Circle"
  370.             ImageKey        =   "FCirc"
  371.          EndProperty
  372.          BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  373.             Key             =   "SelColor"
  374.             Object.ToolTipText     =   "Color Selection"
  375.             ImageKey        =   "SelColor"
  376.          EndProperty
  377.          BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  378.             Key             =   "Flood"
  379.             Object.ToolTipText     =   "Flood Fill"
  380.             ImageKey        =   "Flood"
  381.          EndProperty
  382.          BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  383.             Key             =   "Text"
  384.             Object.ToolTipText     =   "Text"
  385.             ImageKey        =   "Text"
  386.          EndProperty
  387.          BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  388.             Key             =   "Erase"
  389.             Object.ToolTipText     =   "Erase"
  390.             ImageKey        =   "Erase"
  391.          EndProperty
  392.       EndProperty
  393.    End
  394.    Begin MSComctlLib.StatusBar SB 
  395.       Align           =   2  'Align Bottom
  396.       Height          =   375
  397.       Left            =   0
  398.       TabIndex        =   7
  399.       Top             =   4260
  400.       Width           =   7590
  401.       _ExtentX        =   13388
  402.       _ExtentY        =   661
  403.       _Version        =   393216
  404.       BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
  405.          NumPanels       =   3
  406.          BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
  407.          EndProperty
  408.          BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
  409.             Object.Width           =   2999
  410.             MinWidth        =   2999
  411.          EndProperty
  412.          BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
  413.             AutoSize        =   1
  414.             Object.Width           =   7752
  415.          EndProperty
  416.       EndProperty
  417.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  418.          Name            =   "Lucida Console"
  419.          Size            =   8.25
  420.          Charset         =   0
  421.          Weight          =   400
  422.          Underline       =   0   'False
  423.          Italic          =   0   'False
  424.          Strikethrough   =   0   'False
  425.       EndProperty
  426.    End
  427.    Begin VB.Menu mnuFile 
  428.       Caption         =   "File"
  429.       Begin VB.Menu mnuFArr 
  430.          Caption         =   "New"
  431.          Index           =   0
  432.       End
  433.       Begin VB.Menu mnuFArr 
  434.          Caption         =   "Open"
  435.          Index           =   1
  436.       End
  437.       Begin VB.Menu mnuFArr 
  438.          Caption         =   "Save"
  439.          Index           =   2
  440.       End
  441.       Begin VB.Menu mnuFArr 
  442.          Caption         =   "SaveAs"
  443.          Index           =   3
  444.       End
  445.       Begin VB.Menu mnuFArr 
  446.          Caption         =   "Paste Clipboard"
  447.          Index           =   4
  448.       End
  449.       Begin VB.Menu mnuFSep 
  450.          Caption         =   "-"
  451.       End
  452.       Begin VB.Menu MRU 
  453.          Caption         =   ""
  454.          Index           =   0
  455.          Visible         =   0   'False
  456.       End
  457.    End
  458.    Begin VB.Menu mnuEdit 
  459.       Caption         =   "Edit"
  460.       Begin VB.Menu mnuEArr 
  461.          Caption         =   "Cut"
  462.          Enabled         =   0   'False
  463.          Index           =   0
  464.          Shortcut        =   ^X
  465.       End
  466.       Begin VB.Menu mnuEArr 
  467.          Caption         =   "Copy"
  468.          Enabled         =   0   'False
  469.          Index           =   1
  470.          Shortcut        =   ^C
  471.       End
  472.       Begin VB.Menu mnuEArr 
  473.          Caption         =   "Paste"
  474.          Enabled         =   0   'False
  475.          Index           =   2
  476.          Shortcut        =   ^V
  477.       End
  478.       Begin VB.Menu mnuEArr 
  479.          Caption         =   "-"
  480.          Index           =   3
  481.       End
  482.       Begin VB.Menu mnuEArr 
  483.          Caption         =   "Undo"
  484.          Enabled         =   0   'False
  485.          Index           =   4
  486.       End
  487.       Begin VB.Menu mnuEArr 
  488.          Caption         =   "Redo"
  489.          Enabled         =   0   'False
  490.          Index           =   5
  491.       End
  492.    End
  493.    Begin VB.Menu mnuTest 
  494.       Caption         =   "View Menu Bitmap"
  495.       Begin VB.Menu mnuTMB 
  496.          Caption         =   "This Menu Bitmap"
  497.       End
  498.    End
  499. End
  500. Attribute VB_Name = "frmMain"
  501. Attribute VB_GlobalNameSpace = False
  502. Attribute VB_Creatable = False
  503. Attribute VB_PredeclaredId = True
  504. Attribute VB_Exposed = False
  505. Option Explicit
  506. Private Const Pix As Long = 20
  507. Private Const PixH As Long = 10
  508. Private i As Long, j As Long, k As Long
  509. Private Gx As Long, Gy As Long
  510. Private Ix As Long, Iy As Long
  511. Private SGx As Long, SGy As Long
  512. Private PSx As Long, PSy As Long
  513. Private SIx As Long, SIy As Long
  514. Private PalX As Long, PalY As Long, PalB As Integer
  515. Private Pasted As Boolean
  516. Private CurrTool As Long
  517. Private CurrColor As Long
  518. Private CurrFileName As String
  519. Private KeyVal As Long
  520. Private Rec(1 To 5) As String 'for MRU
  521. Private RecCnt As Long
  522. Private cUndo As New Collection
  523. Private cRedo As New Collection
  524. Private Btn As MSComctlLib.Button
  525. Private Frm As Form
  526.  
  527.  
  528. Private Sub Form_Load()
  529.  Init
  530.  Show
  531.  DoEvents
  532. End Sub
  533. Private Sub Form_Unload(Cancel As Integer)
  534.  SaveSettings
  535.  Set cUndo = Nothing
  536.  Set cRedo = Nothing
  537.  Set Frm = Nothing
  538.  Set Btn = Nothing
  539. End Sub
  540.  
  541. Private Sub mnuFArr_Click(Index As Integer)
  542.  Select Case Index
  543.   Case 0 'new
  544.    Set picBMP.Picture = LoadPicture
  545.    Pic2Grid
  546.    CurrFileName = ""
  547.   Case 1 'open
  548.    CurrFileName = OpenFileName()
  549.    'in case user cancelled
  550.    If Len(CurrFileName) = 0 Then Exit Sub
  551.    DoLoad True
  552.    UpdateUndo
  553.    UpdateMRU
  554.   Case 2 'save
  555.    If Len(CurrFileName) = 0 Then
  556.     CurrFileName = SaveFileName()
  557.    End If
  558.    If Len(CurrFileName) = 0 Then Exit Sub
  559.    SavePicture picBMP.Image, CurrFileName
  560.    UpdateMRU
  561.   Case 3 'save as
  562.    'curious, never seen an icon or bmp for this
  563.    CurrFileName = SaveFileName()
  564.    'in case user cancelled
  565.    If Len(CurrFileName) = 0 Then Exit Sub
  566.    SavePicture picBMP.Image, CurrFileName
  567.    UpdateMRU
  568.   Case 4    'paste clipboard
  569.    DoLoad False
  570.    CurrFileName = ""
  571.  End Select
  572.  If Len(CurrFileName) Then
  573.   Caption = "Menu Bitmap: " & CurrFileName
  574.  Else
  575.   Caption = "Menu Bitmap: New"
  576.  End If
  577. End Sub
  578.  
  579. Private Sub picPal_DblClick()
  580.  'to add from the color dialog
  581.  Dim idx As Long, oc As Long
  582.  oc = GetPixel(picPal.hdc, PalX, PalY)
  583.  With CD
  584.   .CancelError = True
  585.   .Flags = cdlCCFullOpen Or cdlCCRGBInit
  586.   .Color = oc
  587.   On Error GoTo Canx
  588.   .ShowColor
  589.   idx = 16 * (PalY \ 10) + PalX \ 10
  590.   Pal(idx) = .Color
  591.   'user has added a new color
  592.   'so change the pic to reflect it
  593.   'otherwise the pic won't be in sync with the palette
  594.   For PalY = 0 To 12
  595.    For PalX = 0 To 12
  596.     If GetPixel(picBMP.hdc, PalX, PalY) = oc Then
  597.      SetPixelV picBMP.hdc, PalX, PalY, .Color
  598.     End If
  599.    Next
  600.   Next
  601.   DrawPalette
  602.   If PalB = vbLeftButton Then
  603.    lblLeft.BackColor = .Color
  604.    lblLInfo.Caption = "Left:   R" & RedV(.Color) & ",G" & GrnV(.Color) & ",B" & BluV(.Color)
  605.   Else
  606.    lblRight.BackColor = .Color
  607.    lblRInfo.Caption = "Right: R" & RedV(.Color) & ",G" & GrnV(.Color) & ",B" & BluV(.Color)
  608.   End If
  609.  End With
  610. Canx:
  611. End Sub
  612.  
  613. Private Sub picPal_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  614.  Dim MC As Long
  615.  'for the double click
  616.  PalX = x: PalY = y: PalB = Button
  617.  MC = GetPixel(picPal.hdc, x, y)
  618.  If Button = vbLeftButton Then
  619.   lblLeft.BackColor = MC
  620.   lblLInfo.Caption = "Left:   R" & RedV(MC) & ",G" & GrnV(MC) & ",B" & BluV(MC)
  621.  Else
  622.   lblRight.BackColor = MC
  623.   lblRInfo.Caption = "Right: R" & RedV(MC) & ",G" & GrnV(MC) & ",B" & BluV(MC)
  624.  End If
  625. End Sub
  626.  
  627. Private Sub picPal_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  628.  'display color info
  629.  Dim MC As Long
  630.  MC = GetPixel(picPal.hdc, x, y)
  631.  lblPal.Caption = "R" & RedV(MC) & ",G" & GrnV(MC) & ",B" & BluV(MC)
  632. End Sub
  633.  
  634. Private Sub TBTools_ButtonClick(ByVal Button As MSComctlLib.Button)
  635.  For i = 1 To TBTools.Buttons.Count
  636.   TBTools.Buttons(i).Value = tbrUnpressed
  637.  Next
  638.  TBTools.Buttons(Button.Index).Value = tbrPressed
  639.  TBTools.Refresh
  640.  CurrTool = Button.Index
  641.  'show user some help for the tools
  642.  With SB.Panels(3)
  643.  Select Case Button.Index
  644.   Case TPencil
  645.    .Text = "Free draw"
  646.   Case TRect, TFRect
  647.    .Text = "Hold a shift key for a square"
  648.   Case TText
  649.    .Text = "Click the grid to position the text"
  650.   Case TLine
  651.    .Text = "Hold a shift key for Hor/Vert Line"
  652.   Case TCirc, TFCirc
  653.    .Text = "Hold a shift key for Circle"
  654.   Case TErase
  655.    .Text = "Free draw in white"
  656.   Case TSelect
  657.    .Text = "Selection tool for Cut, Copy, Paste"
  658.   Case TFlood
  659.    .Text = "Flood an area with selected color"
  660.   Case TSelColor
  661.    .Text = "Click the grid to get desired color"
  662.  End Select
  663.  End With
  664. End Sub
  665. Private Sub mnuEArr_Click(Index As Integer)
  666.  Select Case Index
  667.   Case 0 'cut
  668.    PasteXY picSel.Left \ Pix, picSel.Top \ Pix, True
  669.    picSel.Visible = False
  670.    mnuEArr(0).Enabled = False
  671.    mnuEArr(1).Enabled = False
  672.    mnuEArr(2).Enabled = True
  673.    UpdateUndo
  674.   Case 1 'copy
  675.    picSel.Visible = False
  676.    mnuEArr(0).Enabled = False
  677.    mnuEArr(1).Enabled = False
  678.    mnuEArr(2).Enabled = True
  679.   Case 2 'paste
  680.    picSel.Move 0, 0
  681.    picSel.Visible = True
  682.    Pasted = True
  683.   Case 4 'undo
  684.    DoUnDo
  685.   Case 5 'redo
  686.    DoReDo
  687.  End Select
  688. End Sub
  689.  
  690. Private Sub MRU_Click(Index As Integer)
  691.  If FileExists(MRU(Index).Caption) Then
  692.   CurrFileName = MRU(Index).Caption
  693.   DoLoad True
  694.  End If
  695. End Sub
  696.  
  697. Private Sub picSel_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  698.  PSx = x: PSy = y
  699.  If Pasted = False Then
  700.   PasteXY picSel.Left \ Pix, picSel.Top \ Pix, True
  701.  End If
  702. End Sub
  703.  
  704. Private Sub picSel_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  705.  Dim nx As Long, ny As Long
  706.  If Button Then
  707.   With picSel
  708.    nx = ((.Left + (x - PSx)) \ Pix) * Pix
  709.    ny = ((.Top + (y - PSy)) \ Pix) * Pix
  710.    .Move nx, ny
  711.   End With
  712.  End If
  713. End Sub
  714.  
  715. Private Sub picSel_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  716.  PasteXY picSel.Left \ Pix, picSel.Top \ Pix, False
  717.  picSel.Visible = False
  718.  mnuEArr(0).Enabled = False
  719.  mnuEArr(1).Enabled = False
  720.  mnuEArr(2).Enabled = True
  721.  UpdateUndo
  722. End Sub
  723.  
  724. Private Sub picGrid_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  725.  Gx = (x \ Pix) * Pix: Gy = (y \ Pix) * Pix
  726.  Ix = x \ Pix: Iy = y \ Pix
  727.  SGx = Gx: SGy = Gy 'save these for mousemove & mouseup
  728.  SIx = Ix: SIy = Iy
  729.  'get the drawing color
  730.  If Button = vbRightButton Then
  731.   CurrColor = lblRight.BackColor
  732.  Else
  733.   CurrColor = lblLeft.BackColor
  734.  End If
  735.  Select Case CurrTool
  736.   Case TPencil
  737.    Call picGrid_MouseMove(Button, Shift, x, y)
  738.   Case TErase
  739.    Call picGrid_MouseMove(Button, Shift, x, y)
  740.   Case TLine 'use the Line control to delineate the line
  741.    'make it start in the center of the box
  742.    Lin.X1 = Gx + PixH: Lin.X2 = Gx + PixH
  743.    Lin.Y1 = Gy + PixH: Lin.Y2 = Gy + PixH
  744.    Lin.Visible = True
  745.   Case TRect, TFRect, TSelect
  746.    Pasted = False 'in case we're selecting
  747.    shRect.Move Gx + PixH, Gy + PixH, 0, 0
  748.    shRect.Visible = True
  749.   Case TCirc, TFCirc
  750.    shCirc.Move Gx + PixH, Gy + PixH, 0, 0
  751.    shCirc.Visible = True
  752.   Case TSelColor
  753.    If Button = vbRightButton Then
  754.     lblRight.BackColor = GetPixel(picBMP.hdc, Ix, Iy)
  755.     lblRInfo.Caption = "Right: R" & RedV(lblRight.BackColor) & ",G" & GrnV(lblRight.BackColor) & ",B" & BluV(lblRight.BackColor)
  756.    Else
  757.     lblLeft.BackColor = GetPixel(picBMP.hdc, Ix, Iy)
  758.     lblLInfo.Caption = "Left:   R" & RedV(lblLeft.BackColor) & ",G" & GrnV(lblLeft.BackColor) & ",B" & BluV(lblLeft.BackColor)
  759.    End If
  760.   Case TFlood
  761.    picBMP.FillStyle = vbFSSolid
  762.    picBMP.FillColor = CurrColor 'color to fill with
  763.    ExtFloodFill picBMP.hdc, Ix, Iy, GetPixel(picBMP.hdc, Ix, Iy), 1
  764.    Pic2Grid
  765.  End Select
  766.  picBMP.Refresh
  767. End Sub
  768.  
  769. Private Sub picGrid_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  770.  Dim MC As Long
  771.  Gx = (x \ Pix) * Pix: Gy = (y \ Pix) * Pix
  772.  Ix = x \ Pix: Iy = y \ Pix
  773.  MC = GetPixel(picBMP.hdc, Ix, Iy)
  774.  SB.Panels(1).Text = Left$("X: " & Right$(" " & Ix, 2) & "   ", 5) & _
  775.     " Y: " & Right$(" " & Iy, 2)
  776.  SB.Panels(2).Text = "R" & RedV(MC) & ",G" & GrnV(MC) & ",B" & BluV(MC)
  777.  If Button Then 'dragging the shape or freedrawing
  778.   Select Case CurrTool
  779.    Case TPencil
  780.     picGrid.Line (Gx + 1, Gy + 1)-(Gx + Pix - 1, Gy + Pix - 1), CurrColor, BF
  781.     SetPixelV picBMP.hdc, Ix, Iy, CurrColor
  782.    Case TErase
  783.     picGrid.Line (Gx + 1, Gy + 1)-(Gx + Pix - 1, Gy + Pix - 1), picGrid.BackColor, BF
  784.     SetPixelV picBMP.hdc, Ix, Iy, vbWhite
  785.    Case TLine
  786.     If Shift Then 'horizontal or vertical line
  787.      If Abs(Gx - SGx) > Abs(Gy - SGy) Then
  788.       Gy = SGy
  789.      Else
  790.       Gx = SGx
  791.      End If
  792.     End If
  793.     With Lin
  794.      'size the line control
  795.      .X1 = SGx + PixH
  796.      .X2 = Gx + PixH
  797.      .Y1 = SGy + PixH
  798.      .Y2 = Gy + PixH
  799.     End With
  800.    Case TRect, TFRect, TSelect
  801.     With shRect
  802.      'a little math here to
  803.      'allow the rect to be drawn left to right or vice versa
  804.      ' or top to bottom or vice versa
  805.      If Gx - SGx < 0 And Gy - SGy < 0 Then
  806.       .Left = Gx + PixH
  807.       .Top = Gy + PixH
  808.      ElseIf Gx - SGx < 0 Then
  809.       .Left = Gx + PixH
  810.      ElseIf Gy - SGy < 0 Then
  811.       .Top = Gy + PixH
  812.      Else
  813.       .Left = SGx + PixH
  814.       .Top = SGy + PixH
  815.      End If
  816.      If Shift Then 'for a square
  817.       .Width = Abs(Gx - SGx)
  818.       .Height = Abs(Gx - SGx)
  819.      Else
  820.       .Width = Abs(Gx - SGx)
  821.       .Height = Abs(Gy - SGy)
  822.      End If
  823.     End With
  824.  
  825.    Case TCirc, TFCirc
  826.     With shCirc
  827.      If Gx - SGx < 0 And Gy - SGy < 0 Then
  828.       .Left = Gx + PixH
  829.       .Top = Gy + PixH
  830.      ElseIf Gx - SGx < 0 Then
  831.       .Left = Gx + PixH
  832.      ElseIf Gy - SGy < 0 Then
  833.       .Top = Gy + PixH
  834.      Else
  835.       .Left = SGx + PixH
  836.       .Top = SGy + PixH
  837.      End If
  838.      If Shift Then 'for a circle
  839.       .Width = Abs(Gx - SGx)
  840.       .Height = Abs(Gx - SGx)
  841.      Else
  842.       .Width = Abs(Gx - SGx)
  843.       .Height = Abs(Gy - SGy)
  844.      End If
  845.     End With
  846.  
  847.   End Select
  848.  End If
  849.  picBMP.Refresh
  850. End Sub
  851.  
  852. Private Sub picGrid_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  853.  Gx = (x \ Pix) * Pix: Gy = (y \ Pix) * Pix
  854.  Ix = x \ Pix: Iy = y \ Pix
  855.  Select Case CurrTool
  856.   Case TSelect
  857.    shRect.Visible = False
  858.    picSel.BorderStyle = 1
  859.    picSel.Visible = True
  860.    'size picSel to the shape size
  861.    picSel.Move shRect.Left - PixH, shRect.Top - PixH, shRect.Width, shRect.Height
  862.    picSel.Cls
  863.    'and copy the selected part of the grid to it
  864.    BitBlt picSel.hdc, 0, 0, picSel.ScaleWidth, picSel.ScaleHeight, _
  865.      picGrid.hdc, SGx, SGy, vbSrcCopy
  866.    mnuEArr(0).Enabled = True
  867.    mnuEArr(1).Enabled = True
  868.   Case TLine
  869.    With Lin
  870.     .Visible = False
  871.     picBMP.Line (.X1 \ Pix, .Y1 \ Pix)-(.X2 \ Pix, .Y2 \ Pix), CurrColor
  872.     'line does not get the last x,y pixel
  873.     SetPixelV picBMP.hdc, .X2 \ Pix, .Y2 \ Pix, CurrColor
  874.    End With
  875.    Pic2Grid
  876.   Case TRect, TFRect
  877.    With shRect
  878.     .Visible = False
  879.     If CurrTool = TRect Then
  880.      picBMP.Line (.Left \ Pix, .Top \ Pix)-((.Left + .Width) \ Pix, (.Top + .Height) \ Pix), CurrColor, B
  881.     Else
  882.      picBMP.Line (.Left \ Pix, .Top \ Pix)-((.Left + .Width) \ Pix, (.Top + .Height) \ Pix), CurrColor, BF
  883.     End If
  884.    End With
  885.    Pic2Grid
  886.   Case TCirc, TFCirc
  887.    With shCirc
  888.     .Visible = False
  889.     'for the ellipse call below
  890.     picBMP.ForeColor = CurrColor
  891.     If CurrTool = TCirc Then
  892.      picBMP.FillStyle = vbFSTransparent
  893.     Else
  894.      picBMP.FillStyle = vbFSSolid
  895.      picBMP.FillColor = CurrColor
  896.     End If
  897.     Ellipse picBMP.hdc, .Left \ Pix, .Top \ Pix, (.Left + .Width) \ Pix, (.Top + .Height) \ Pix
  898.    End With
  899.    Pic2Grid
  900.   Case TSelColor
  901.    SetPencil
  902.   Case TText
  903.    Set Frm = New frmText
  904.    Frm.Move Left + picGrid.Left + picGrid.Width, Top + picGrid.Top + picGrid.Height \ 2
  905.    Frm.Show vbModal, Me
  906.    'retrieve the selected font items
  907.    picBMP.FontName = gFontName
  908.    picBMP.FontBold = gFontBold
  909.    picBMP.FontItalic = gFontItalic
  910.    picBMP.FontSize = gFontSize
  911.    picBMP.ForeColor = CurrColor
  912.    picBMP.CurrentX = SIx 'saved from mousedown
  913.    picBMP.CurrentY = SIy '  "       "
  914.    picBMP.Print gText
  915.    Pic2Grid
  916.  End Select
  917.  picBMP.Refresh
  918.  UpdateUndo 'mouseup so save for undo
  919.  ' and update mnuTest
  920.  SetMenuItemBMP Me.hwnd, 2, 0, picBMP.Picture
  921. End Sub
  922.  
  923. '==============================
  924. 'my routines
  925.  
  926. '=======undo/redo routines========
  927. Private Sub DeleteCollections()
  928.  Set cUndo = New Collection
  929.  Set cRedo = New Collection
  930.  KeyVal = 0
  931.  mnuEArr(4).Enabled = False 'undo
  932.  mnuEArr(5).Enabled = False 'redo
  933. End Sub
  934. Private Sub UpdateUndo()
  935.  'save the current pic in the undo coll
  936.  KeyVal = KeyVal + 1 'just a unique no for coll
  937.  picBMP.Picture = picBMP.Image
  938.  cUndo.Add picBMP.Picture, CStr(KeyVal)
  939.  mnuEArr(4).Enabled = cUndo.Count > 1
  940.  mnuEArr(5).Enabled = cRedo.Count > 0
  941. End Sub
  942. Private Sub DoUnDo()
  943.  cRedo.Add cUndo.Item(cUndo.Count)
  944.  cUndo.Remove cUndo.Count
  945.  picBMP.Picture = cUndo.Item(cUndo.Count)
  946.  picBMP.Refresh
  947.  mnuEArr(4).Enabled = cUndo.Count > 1
  948.  mnuEArr(5).Enabled = cRedo.Count > 0
  949.  Pic2Grid
  950. End Sub
  951. Private Sub DoReDo()
  952.  cUndo.Add cRedo.Item(cRedo.Count)
  953.  cRedo.Remove cRedo.Count
  954.  picBMP.Picture = cUndo.Item(cUndo.Count)
  955.  picBMP.Refresh
  956.  mnuEArr(4).Enabled = cUndo.Count > 1
  957.  mnuEArr(5).Enabled = cRedo.Count > 0
  958.  Pic2Grid
  959. End Sub
  960. Private Sub FixColors()
  961.  Dim LP As LOGPALETTE
  962.  Dim x As Long
  963.  Dim y As Long
  964.  Dim c As Long
  965.  Dim n As Long
  966.  Dim hPal As Long
  967.  With LP
  968.   CopyMemory .palPalEntry(0), Pal(0), 1024
  969.   .palNumEntries = 256
  970.   .palVersion = &H300
  971.  End With
  972.  hPal = CreatePalette(LP)
  973.  For y = 0 To 12
  974.   For x = 0 To 12
  975.    c = GetPixel(picBMP.hdc, x, y)
  976.    If InPal(c) = False Then
  977.     'color is not in our palette
  978.     'so get the nearest color index
  979.     n = GetNearestPaletteIndex(hPal, c)
  980. '    Debug.Print n, Hex$(Pal(n)), Hex$(c)
  981.     'and put it in our palette
  982.     Pal(n) = c
  983.    End If
  984.   Next
  985.  Next
  986.  DeleteObject hPal
  987.  DrawPalette
  988. End Sub
  989. ' search palette for given color
  990. Private Function InPal(ByVal clr As Long) As Boolean
  991.  For i = 0 To 255
  992.   If clr = Pal(i) Then
  993.    InPal = True: Exit Function
  994.   End If
  995.  Next
  996. End Function
  997.  
  998. Private Sub Init()
  999.  'put bitmaps in the menus
  1000.  SetMenuItemBMP Me.hwnd, 0, 0, imgMnu.ListImages("New").Picture
  1001.  SetMenuItemBMP Me.hwnd, 0, 1, imgMnu.ListImages("Open").Picture
  1002.  SetMenuItemBMP Me.hwnd, 0, 2, imgMnu.ListImages("Save").Picture
  1003.  SetMenuItemBMP Me.hwnd, 0, 4, imgMnu.ListImages("PasteAll").Picture
  1004.  
  1005.  SetMenuItemBMP Me.hwnd, 1, 0, imgMnu.ListImages("Cut").Picture
  1006.  SetMenuItemBMP Me.hwnd, 1, 1, imgMnu.ListImages("Copy").Picture
  1007.  SetMenuItemBMP Me.hwnd, 1, 2, imgMnu.ListImages("Paste").Picture
  1008.  SetMenuItemBMP Me.hwnd, 1, 4, imgMnu.ListImages("Undo").Picture
  1009.  SetMenuItemBMP Me.hwnd, 1, 5, imgMnu.ListImages("Redo").Picture
  1010.  LoadSettings 'get MRU list
  1011.  GetPal 'load & draw the color palette
  1012.  DrawPalette 'default user colors
  1013.  DrawGrid
  1014.  SetPencil
  1015. End Sub
  1016.  
  1017. Private Sub DrawPalette()
  1018.  Dim x As Long, y As Long, k As Long
  1019.  With picPal
  1020.  For y = 0 To .ScaleHeight - 1 Step 10
  1021.   For x = 0 To .ScaleWidth - 1 Step 10
  1022.    picPal.Line (x, y)-(x + 10, y + 10), Pal(k), BF
  1023.    k = k + 1
  1024.   Next
  1025.  Next
  1026.  End With
  1027. End Sub
  1028.  
  1029. Private Sub DrawGrid()
  1030.  With picGrid
  1031.  For i = 0 To .ScaleWidth Step Pix
  1032.   picGrid.Line (0, i)-(.ScaleWidth, i)
  1033.   picGrid.Line (i, 0)-(i, .ScaleHeight)
  1034.  Next
  1035.  End With
  1036. End Sub
  1037. Private Sub Pic2Grid()
  1038.  'expand the bitmap pic to grid size
  1039.  picGrid.PaintPicture picBMP.Image, 0, 0, picGrid.ScaleWidth, picGrid.ScaleHeight
  1040.  'then draw lines on it
  1041.  DrawGrid
  1042. End Sub
  1043. Private Sub DoLoad(ByVal Pic As Boolean)
  1044.  Dim SP As StdPicture
  1045.  Dim H As Long, W As Long
  1046.  Dim Msg As String
  1047.  If Pic Then
  1048.   Set SP = LoadPicture(CurrFileName)
  1049.  Else
  1050.   Set SP = Clipboard.GetData(vbCFBitmap)
  1051.   If SP = 0 Then
  1052.    MsgBox "No picture on clipboard"
  1053.    Exit Sub
  1054.   End If
  1055.  End If
  1056.  'check the size
  1057.  W = CLng(ScaleX(SP.Width, vbHimetric, vbPixels))
  1058.  H = CLng(ScaleX(SP.Height, vbHimetric, vbPixels))
  1059.  If W <> 13 Or H <> 13 Then
  1060.   Msg = "This image is not 13x13" & vbNewLine & _
  1061.     "If you wish to select a 13x13 portion, select Yes" & vbNewLine & _
  1062.     "Otherwise the image will be sized to 13x13"
  1063.   If MsgBox(Msg, vbYesNo) = vbYes Then
  1064.    Set Frm = New frmCrop
  1065.    Set Frm.picSrc.Picture = SP
  1066.    'try to size the form to fit the picture
  1067.    If W * 15 < Frm.Frame1.Width Then
  1068.     Frm.Width = Frm.Frame1.Width
  1069.    Else
  1070.     Frm.Width = W * 15
  1071.    End If
  1072.    Frm.Height = H * 15 + 2000 ' Frm.Frame1.Height
  1073.    Frm.Show vbModal
  1074.   Else
  1075.    'here just stretchblt the pic to fit
  1076.    Set picWork.Picture = SP 'picWork has AutoSize = True
  1077.    'allegedly produces better quality stretches
  1078.    SetStretchBltMode picBMP.hdc, HALFTONE
  1079.    StretchBlt picBMP.hdc, 0, 0, 13, 13, _
  1080.     picWork.hdc, 0, 0, picWork.ScaleWidth, picWork.ScaleHeight, vbSrcCopy
  1081.   End If
  1082.  Else
  1083.   'pic is 13x13
  1084.   Set picBMP.Picture = SP
  1085.  End If
  1086.  GetPal 'reload the default palette
  1087.  FixColors 'change any colors that don't match
  1088.  Pic2Grid
  1089.  DeleteCollections 'reset undo/redo
  1090.  UpdateUndo 'in case user wants to undo this
  1091.  SetMenuItemBMP hwnd, 2, 0, picBMP.Picture '& show it in mnuTest
  1092. End Sub
  1093. Private Function OpenFileName() As String
  1094.  With CD
  1095.   .CancelError = True
  1096.   .Filter = "Picture Files|*.bmp;*.jpg;*.ico;*.gif"
  1097.   On Error GoTo Canx
  1098.   .ShowOpen
  1099.   OpenFileName = .FileName
  1100.  End With
  1101. Canx:
  1102. End Function
  1103. Private Function SaveFileName() As String
  1104.  With CD
  1105.   .CancelError = True
  1106.   .Filter = "Bitmap Files|*.bmp"
  1107.   .DefaultExt = "bmp"
  1108.   On Error GoTo Canx
  1109.   .ShowSave
  1110.   SaveFileName = .FileName
  1111.  End With
  1112. Canx:
  1113. End Function
  1114. 'The MRU business is much easier
  1115. ' if you have a fixed number
  1116. ' of MRUs-here I'm using 5
  1117. Private Sub UpdateMRU()
  1118.  If Len(CurrFileName) = 0 Then Exit Sub
  1119. 'check exists
  1120.  For i = 1 To 5
  1121.   If CurrFileName = Rec(i) Then
  1122.    Exit Sub 'could move it to top
  1123.   End If
  1124.  Next
  1125.  'move all down 1 slot
  1126.  For i = 5 To 2 Step -1
  1127.   Rec(i) = Rec(i - 1)
  1128.  Next
  1129.  If RecCnt < 5 Then RecCnt = RecCnt + 1
  1130.  Rec(1) = CurrFileName 'put new at top
  1131.  FillMnuMRU
  1132. End Sub
  1133. Private Sub FillMnuMRU()
  1134.  For i = 1 To RecCnt
  1135.   If i > MRU.UBound Then Load MRU(i)
  1136.   MRU(i).Visible = True
  1137.   MRU(i).Caption = Rec(i)
  1138.  Next
  1139. End Sub
  1140. Private Sub SaveSettings()
  1141.  SaveSetting App.EXEName, "MRU", "Count", RecCnt
  1142.  For i = 1 To RecCnt
  1143.   SaveSetting App.EXEName, "MRU", "File" & i, Rec(i)
  1144.  Next
  1145. End Sub
  1146. Private Sub LoadSettings()
  1147.  Dim Pth As String, Cnt As String
  1148.  Cnt = GetSetting(App.EXEName, "MRU", "Count", "0")
  1149.  For i = 1 To Cnt
  1150.   Pth = GetSetting(App.EXEName, "MRU", "File" & i, "")
  1151.   'in case the file went away
  1152.   If FileExists(Pth) Then
  1153.    RecCnt = RecCnt + 1
  1154.    Rec(RecCnt) = Pth
  1155.   End If
  1156.  Next
  1157.  FillMnuMRU
  1158. End Sub
  1159.  
  1160. Private Sub SetPencil()
  1161.  'for certain tools, return the
  1162.  ' drawing tool to pencil
  1163.  For i = 1 To TBTools.Buttons.Count
  1164.   TBTools.Buttons(i).Value = tbrUnpressed
  1165.  Next
  1166.  TBTools.Refresh
  1167.  CurrTool = TPencil
  1168.  TBTools.Buttons(CurrTool).Value = tbrPressed
  1169. End Sub
  1170. Private Sub PasteXY(ByVal x As Long, ByVal y As Long, ByVal Clear As Boolean)
  1171.  'picSel will hold a picture
  1172.  'of the selected part of the grid
  1173.  'this routine just puts the
  1174.  'colors in picBMP at right position
  1175.  'or clears it for the cut operation
  1176.  Dim mx As Long, my As Long, c As Long
  1177.  With picSel
  1178.   For my = 0 To .ScaleHeight - 1 Step 20
  1179.    For mx = 0 To .ScaleWidth - 1 Step 20
  1180.     If Clear Then
  1181.      c = vbWhite
  1182.     Else
  1183.      c = GetPixel(.hdc, mx + PixH, my + PixH)
  1184.     End If
  1185.     SetPixelV picBMP.hdc, x + mx \ Pix, y + my \ Pix, c
  1186.    Next
  1187.   Next
  1188.  End With
  1189.  Pic2Grid
  1190. End Sub
  1191.  
  1192.