home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD13440162001.psc / fmMain.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2001-01-06  |  19.9 KB  |  543 lines
  1. VERSION 5.00
  2. Begin VB.Form fmMain 
  3.    BackColor       =   &H00800000&
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "Package Label Maker"
  6.    ClientHeight    =   4680
  7.    ClientLeft      =   45
  8.    ClientTop       =   330
  9.    ClientWidth     =   7170
  10.    Icon            =   "fmMain.frx":0000
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   4680
  15.    ScaleWidth      =   7170
  16.    StartUpPosition =   2  'CenterScreen
  17.    Begin VB.CommandButton cmdSort 
  18.       BackColor       =   &H00FFC0C0&
  19.       Caption         =   "Sort by Label Name"
  20.       BeginProperty Font 
  21.          Name            =   "MS Sans Serif"
  22.          Size            =   8.25
  23.          Charset         =   0
  24.          Weight          =   700
  25.          Underline       =   0   'False
  26.          Italic          =   0   'False
  27.          Strikethrough   =   0   'False
  28.       EndProperty
  29.       Height          =   555
  30.       Left            =   2760
  31.       Style           =   1  'Graphical
  32.       TabIndex        =   6
  33.       Top             =   3960
  34.       Width           =   2175
  35.    End
  36.    Begin VB.CommandButton cmdExit 
  37.       BackColor       =   &H00FFC0C0&
  38.       Caption         =   "EXIT"
  39.       BeginProperty Font 
  40.          Name            =   "MS Sans Serif"
  41.          Size            =   18
  42.          Charset         =   0
  43.          Weight          =   700
  44.          Underline       =   0   'False
  45.          Italic          =   0   'False
  46.          Strikethrough   =   0   'False
  47.       EndProperty
  48.       Height          =   555
  49.       Left            =   120
  50.       Style           =   1  'Graphical
  51.       TabIndex        =   4
  52.       Top             =   3960
  53.       Width           =   2265
  54.    End
  55.    Begin VB.CommandButton cmdPrint 
  56.       BackColor       =   &H00FFC0C0&
  57.       Caption         =   "Print Labels"
  58.       BeginProperty Font 
  59.          Name            =   "MS Sans Serif"
  60.          Size            =   8.25
  61.          Charset         =   0
  62.          Weight          =   700
  63.          Underline       =   0   'False
  64.          Italic          =   0   'False
  65.          Strikethrough   =   0   'False
  66.       EndProperty
  67.       Height          =   615
  68.       Left            =   5160
  69.       Style           =   1  'Graphical
  70.       TabIndex        =   3
  71.       Top             =   1800
  72.       Width           =   1695
  73.    End
  74.    Begin VB.CommandButton cmdDeleteLbl 
  75.       BackColor       =   &H00FFC0C0&
  76.       Caption         =   "Delete Label item from Database"
  77.       BeginProperty Font 
  78.          Name            =   "MS Sans Serif"
  79.          Size            =   8.25
  80.          Charset         =   0
  81.          Weight          =   700
  82.          Underline       =   0   'False
  83.          Italic          =   0   'False
  84.          Strikethrough   =   0   'False
  85.       EndProperty
  86.       Height          =   735
  87.       Left            =   5160
  88.       Style           =   1  'Graphical
  89.       TabIndex        =   2
  90.       Top             =   960
  91.       Width           =   1695
  92.    End
  93.    Begin VB.CommandButton cmdAddLabel 
  94.       BackColor       =   &H00FFC0C0&
  95.       Caption         =   "Add Label item to Database"
  96.       BeginProperty Font 
  97.          Name            =   "MS Sans Serif"
  98.          Size            =   8.25
  99.          Charset         =   0
  100.          Weight          =   700
  101.          Underline       =   0   'False
  102.          Italic          =   0   'False
  103.          Strikethrough   =   0   'False
  104.       EndProperty
  105.       Height          =   615
  106.       Left            =   5160
  107.       Style           =   1  'Graphical
  108.       TabIndex        =   1
  109.       Top             =   240
  110.       Width           =   1695
  111.    End
  112.    Begin VB.ListBox lstItems 
  113.       BackColor       =   &H00FFFFFF&
  114.       BeginProperty Font 
  115.          Name            =   "MS Sans Serif"
  116.          Size            =   9.75
  117.          Charset         =   0
  118.          Weight          =   700
  119.          Underline       =   0   'False
  120.          Italic          =   0   'False
  121.          Strikethrough   =   0   'False
  122.       EndProperty
  123.       ForeColor       =   &H00FF0000&
  124.       Height          =   3660
  125.       ItemData        =   "fmMain.frx":0442
  126.       Left            =   120
  127.       List            =   "fmMain.frx":0444
  128.       Sorted          =   -1  'True
  129.       TabIndex        =   0
  130.       Top             =   120
  131.       Width           =   4815
  132.    End
  133.    Begin VB.Label lblPart 
  134.       Alignment       =   2  'Center
  135.       BackColor       =   &H00800000&
  136.       BeginProperty Font 
  137.          Name            =   "MS Sans Serif"
  138.          Size            =   9.75
  139.          Charset         =   0
  140.          Weight          =   700
  141.          Underline       =   0   'False
  142.          Italic          =   0   'False
  143.          Strikethrough   =   0   'False
  144.       EndProperty
  145.       ForeColor       =   &H00FFFFFF&
  146.       Height          =   375
  147.       Left            =   5160
  148.       TabIndex        =   5
  149.       Top             =   4080
  150.       Width           =   1695
  151.    End
  152.    Begin VB.Image Image1 
  153.       Height          =   1500
  154.       Left            =   5280
  155.       Picture         =   "fmMain.frx":0446
  156.       Stretch         =   -1  'True
  157.       Top             =   2520
  158.       Width           =   1500
  159.    End
  160. Attribute VB_Name = "fmMain"
  161. Attribute VB_GlobalNameSpace = False
  162. Attribute VB_Creatable = False
  163. Attribute VB_PredeclaredId = True
  164. Attribute VB_Exposed = False
  165. Private Sub cmdAddLabel_Click()
  166.     'Show form to edit database
  167.     fmEdit.Show
  168.         
  169. End Sub
  170. Private Sub cmdDeleteLbl_Click()
  171.     Dim TmpFileNum As Integer
  172.     Dim TmpRecord As RecLabel
  173.     Dim TmpRecNum As Long
  174.     'If Labels.tmp already exists, delete it.
  175.     If Dir("Labels.tmp") = "Labels.tmp" Then
  176.         Kill "Labels.tmp"
  177.     End If
  178.     FileNum = FreeFile
  179.     Open FileNam For Random As FileNum Len = RecLength
  180.     TmpFileNum = FreeFile
  181.     TmpLbl = "C:\Program Files\LabelMaker\Labels.tmp"
  182.     Open TmpLbl For Random As TmpFileNum Len = RecLength
  183.     TmpRecNum = 1
  184.     'If the nothing is selected on the listbox when the "Delete Label" is pressed,
  185.     'Position will = 0.
  186.     'Trap the error, display a message box, and exit the routine.
  187.     If Position = 0 Then
  188.         MsgBox ("Please select a record from the list to delete.")
  189.         Exit Sub
  190.     End If
  191.     Do While Position < LastRec + 1
  192.         If Position <> CurrentRec Then
  193.             Get #FileNum, Position, TmpRecord
  194.             Put #TmpFileNum, TmpRecNum, TmpRecord
  195.             TmpRecNum = TmpRecNum + 1
  196.         End If
  197.         Position = Position + 1
  198.     Loop
  199.     Close FileNum
  200.     Kill FileNam
  201.     Close TmpFileNum
  202.     Name TmpLbl As FileNam
  203.     Open FileNam For Random As FileNum Len = RecLength
  204.     LastRec = LastRec - 1
  205.     If LastRec = 0 Then LastRec = 1
  206.     If CurrentRec > LastRec Then
  207.         CurrentRec = LastRec
  208.     End If
  209.     Position = lstItems.ListIndex
  210.     lstItems.RemoveItem Position
  211.     Close FileNum
  212.     Image1.Picture = LoadPicture("C:\Program Files\LabelMaker\NoPicAvail.jpg")
  213. End Sub
  214. Private Sub cmdExit_Click()
  215.     Unload Me
  216. End Sub
  217. Private Sub cmdPrint_Click()
  218. Dim Row As Single
  219. Dim Col As Single
  220. Dim BSString As String
  221. Dim XL As Integer
  222. Dim SetX
  223. Dim SetY
  224. Dim offX
  225. Dim offY
  226. 'This section of code formats Image boxes on fmPrint to print
  227. '7 rows deep and 2 columns of labels.
  228. offX = 4
  229. offY = 21
  230. For Row = 0 To 6
  231.     For Col = 1 To 2
  232.         If Col = 1 Then
  233.             Printer.ScaleMode = 6
  234.             Printer.CurrentX = ((Col - 1) * 106) + offX
  235.             SetX = Printer.CurrentX
  236.         ElseIf Col = 2 Then
  237.             Printer.ScaleMode = 6
  238.             Printer.CurrentX = ((Col - 1) * 106) + offX
  239.             SetX = Printer.CurrentX
  240.         End If
  241.         fmPrint.Image1(0).Stretch = True
  242.         fmPrint.Image1(0).Picture = LoadPicture(PicString)
  243.             If Col = 1 Then
  244.                 If ColorVal <> "NONE" Then
  245.                     Call SetColor
  246.                     Printer.CurrentY = (Row * 34) + offY
  247.                     SetY = Printer.CurrentY
  248.                     Printer.PaintPicture fmPrint.Image2.Picture, SetX, SetY, 25, 25
  249.                     Printer.CurrentX = ((Col - 1) * 106) + (offX + 1)
  250.                     SetX = Printer.CurrentX
  251.                     Printer.CurrentY = (Row * 34) + (offY + 1)
  252.                     SetY = Printer.CurrentY
  253.                     Printer.PaintPicture fmPrint.Image1(0).Picture, SetX, SetY, 23, 23
  254.                 Else
  255.                     Printer.CurrentY = (Row * 34) + offY
  256.                     SetY = Printer.CurrentY
  257.                     Printer.PaintPicture fmPrint.Image2.Picture, SetX, SetY, 25, 25
  258.                     Printer.CurrentX = ((Col - 1) * 106) + (offX + 1)
  259.                     SetX = Printer.CurrentX
  260.                     Printer.CurrentY = (Row * 34) + (offY + 1)
  261.                     SetY = Printer.CurrentY
  262.                     Printer.PaintPicture fmPrint.Image1(0).Picture, SetX, SetY, 25, 25
  263.                 End If
  264.             ElseIf Col = 2 Then
  265.                 If ColorVal <> "NONE" Then
  266.                     Call SetColor
  267.                     Printer.CurrentY = (Row * 34) + offY
  268.                     SetY = Printer.CurrentY
  269.                     Printer.PaintPicture fmPrint.Image2.Picture, SetX, SetY, 25, 25
  270.                     Printer.CurrentX = ((Col - 1) * 106) + (offX + 1)
  271.                     SetX = Printer.CurrentX
  272.                     Printer.CurrentY = (Row * 34) + (offY + 1)
  273.                     SetY = Printer.CurrentY
  274.                     Printer.PaintPicture fmPrint.Image1(0).Picture, SetX, SetY, 23, 23
  275.                 Else
  276.                     Printer.CurrentY = (Row * 34) + offY
  277.                     SetY = Printer.CurrentY
  278.                     Printer.PaintPicture fmPrint.Image2.Picture, SetX, SetY, 25, 25
  279.                     Printer.CurrentX = ((Col - 1) * 106) + (offX + 1)
  280.                     SetX = Printer.CurrentX
  281.                     Printer.CurrentY = (Row * 34) + (offY + 1)
  282.                     SetY = Printer.CurrentY
  283.                     Printer.PaintPicture fmPrint.Image1(0).Picture, SetX, SetY, 25, 25
  284.                 End If
  285.             End If
  286.     Next Col
  287. Next Row
  288. 'This section of code formats the Label Box on fmPrint for
  289. '7 rows deep and columns wide. It also determines the length of
  290. 'the description name and if it's greater than 20 characters
  291. 'it will break the descriptive name in half.
  292. For Row = 0 To 6
  293.     For Col = 1 To 2
  294.         Printer.CurrentY = (Row * 34) + offY
  295.         SetY = Printer.CurrentY
  296.         If Col = 1 Then
  297.             Printer.ScaleMode = 6
  298.             Printer.CurrentX = ((Col - 1) * 106) + (offX + 30)
  299.             Printer.ScaleMode = 4
  300.             If Len(NameString) > 20 Then
  301.                 XP = Len(NameString) / 2
  302.                 XL = InStr(XP, NameString, " ", vbTextCompare)
  303.                 XT = Len(NameString) - XL
  304.                 NameStringB = Right(NameString, XT)
  305.                 NameString = Replace(NameString, NameStringB, "")
  306.                 fmPrint.Label1(0).Caption = Trim(NameString)
  307.                 Printer.FontSize = 18
  308.                 Printer.Font = "Arial"
  309.                 Printer.FontBold = False
  310.                 Printer.FontItalic = True
  311.                 fmPrint.Label1(0).Alignment = 2
  312.                 Printer.Print fmPrint.Label1(0).Caption
  313.                 Printer.ScaleMode = 6
  314.             Else
  315.                 fmPrint.Label1(0).Caption = Trim(NameString)
  316.                 Printer.FontSize = 18
  317.                 Printer.Font = "Arial"
  318.                 Printer.FontBold = False
  319.                 Printer.FontItalic = True
  320.                 fmPrint.Label1(0).Alignment = 2
  321.                 Printer.Print fmPrint.Label1(0).Caption
  322.                 Printer.ScaleMode = 6
  323.             End If
  324.         ElseIf Col = 2 Then
  325.             Printer.ScaleMode = 6
  326.             Printer.CurrentX = ((Col - 1) * 106) + (offX + 30)
  327.             Printer.ScaleMode = 4
  328.             If Len(NameString) > 20 Then
  329.                 XP = Len(NameString) / 2
  330.                 XL = InStr(XP, NameString, " ", vbTextCompare)
  331.                 XT = Len(NameString) - XL
  332.                 NameStringB = Right(NameString, XT)
  333.                 NameString = Replace(NameString, NameStringB, "")
  334.                 fmPrint.Label1(0).Caption = Trim(NameString)
  335.                 Printer.FontSize = 18
  336.                 Printer.Font = "Arial"
  337.                 Printer.FontBold = False
  338.                 Printer.FontItalic = True
  339.                 fmPrint.Label1(0).Alignment = 2
  340.                 Printer.Print fmPrint.Label1(0).Caption
  341.                 Printer.ScaleMode = 6
  342.             Else
  343.                 fmPrint.Label1(0).Caption = Trim(NameString)
  344.                 Printer.FontSize = 18
  345.                 Printer.Font = "Arial"
  346.                 Printer.FontBold = False
  347.                 Printer.FontItalic = True
  348.                 fmPrint.Label1(0).Alignment = 2
  349.                 Printer.Print fmPrint.Label1(0).Caption
  350.                 Printer.ScaleMode = 6
  351.             End If
  352.         End If
  353.         
  354.     Next Col
  355. Next Row
  356. 'This section will print the second part of the descriptive name if there
  357. 'is any.
  358. If NameStringB <> "" Then
  359.     For Row = 0 To 6
  360.         For Col = 1 To 2
  361.             
  362.             
  363.             If Col = 1 Then
  364.                 Printer.CurrentY = (Row * 34) + (offY + 8)
  365.                 SetY = Printer.CurrentY
  366.                 Printer.ScaleMode = 6
  367.                 Printer.CurrentX = ((Col - 1) * 106) + (offX + 30)
  368.                 Printer.ScaleMode = 4
  369.                 'Printer.CurrentX = Printer.CurrentX
  370.                 BSString = Trim(NameStringB)
  371.                 fmPrint.Label1(0).Caption = BSString
  372.                 Printer.FontSize = 18
  373.                 Printer.Font = "Arial"
  374.                 Printer.FontItalic = True
  375.                 fmPrint.Label1(0).Alignment = 2
  376.                 Printer.Print fmPrint.Label1(0).Caption
  377.                 Printer.ScaleMode = 6
  378.             ElseIf Col = 2 Then
  379.                 Printer.CurrentY = (Row * 34) + (offY + 8)
  380.                 Printer.ScaleMode = 6
  381.                 Printer.CurrentX = ((Col - 1) * 106) + (offX + 30)
  382.                 Printer.ScaleMode = 4
  383.                 'Printer.CurrentX = Printer.CurrentX
  384.                 BSString = Trim(NameStringB)
  385.                 fmPrint.Label1(0).Caption = BSString
  386.                 Printer.FontSize = 18
  387.                 Printer.Font = "Arial"
  388.                 Printer.FontItalic = True
  389.                 fmPrint.Label1(0).Alignment = 2
  390.                 Printer.Print fmPrint.Label1(0).Caption
  391.                 Printer.ScaleMode = 6
  392.             End If
  393.         
  394.         Next Col
  395.     Next Row
  396. End If
  397. 'This section of code prints 7 rows and 2 columns worth of
  398. 'Part Numbers
  399. For Row = 0 To 6
  400.     For Col = 1 To 2
  401.         
  402.         
  403.         If Col = 1 Then
  404.             Printer.CurrentY = (Row * 34) + (offY + 15)
  405.             SetY = Printer.CurrentY
  406.             Printer.ScaleMode = 6 'Set scale to Centimeters
  407.             Printer.CurrentX = ((Col - 1) * 106) + (offX + 30)
  408.             Printer.ScaleMode = 4 'Set scale to Characters
  409.             'Printer.CurrentX = Printer.CurrentX
  410.             fmPrint.Label1(0).Caption = PNumber
  411.             Printer.FontSize = 24
  412.             Printer.Font = "Arial"
  413.             Printer.FontItalic = False
  414.             fmPrint.Label1(0).Alignment = 2
  415.             Printer.Print fmPrint.Label1(0).Caption
  416.             Printer.ScaleMode = 6 'Set scale back to Cm
  417.         ElseIf Col = 2 Then
  418.             Printer.CurrentY = (Row * 34) + (offY + 15)
  419.             Printer.ScaleMode = 6
  420.             Printer.CurrentX = ((Col - 1) * 106) + (offX + 30)
  421.             Printer.ScaleMode = 4
  422.             'Printer.CurrentX = Printer.CurrentX
  423.             fmPrint.Label1(0).Caption = PNumber
  424.             Printer.FontSize = 24
  425.             Printer.Font = "Arial"
  426.             Printer.FontItalic = False
  427.             fmPrint.Label1(0).Alignment = 2
  428.             Printer.Print fmPrint.Label1(0).Caption
  429.             Printer.ScaleMode = 6
  430.         End If
  431.         
  432.     Next Col
  433. Next Row
  434. Printer.EndDoc 'Send Printer object to your printer
  435. Unload fmPrint 'Unload the form
  436. End Sub
  437. Private Sub cmdSort_Click()
  438.     FileNum = FreeFile
  439.     RecLength = Len(Record)
  440.     indexVal = 1
  441.     Position = 1
  442.     FileNam = "C:\Program Files\LabelMaker\Labels.nlb"
  443.     Open FileNam For Random As FileNum Len = RecLength
  444.     LastRec = FileLen(FileNam) / RecLength
  445.     If cmdSort.Caption = "Sort by Part Number" Then
  446.         lstItems.Clear
  447.         lblPart.Caption = ""
  448.         Image1.Picture = LoadPicture("C:\Program Files\LabelMaker\NoPicAvail.jpg")
  449.         For Position = 1 To LastRec
  450.             Get #FileNum, Position, Record
  451.             lstItems.AddItem (Trim(Record.PartNum) & "     " & Trim(Record.TName)) & "                            " & Position
  452.         Next Position
  453.         cmdSort.Caption = "Sort by Label Name"
  454.     Else
  455.         lstItems.Clear
  456.         lblPart.Caption = ""
  457.         Image1.Picture = LoadPicture("C:\Program Files\LabelMaker\NoPicAvail.jpg")
  458.         For Position = 1 To LastRec
  459.             Get #FileNum, Position, Record
  460.             lstItems.AddItem (Trim(Record.TName) & "     " & Trim(Record.PartNum)) & "                            " & Position
  461.         Next Position
  462.         cmdSort.Caption = "Sort by Part Number"
  463.     End If
  464. End Sub
  465. Private Sub Form_Activate()
  466.     If AddItem = True Then
  467.         If InitVar = "No items in database" Then
  468.             lstItems.Clear
  469.             InitVar = ""
  470.         End If
  471.         If cmdSort.Caption = "Sort by Label Name" Then
  472.             lstItems.AddItem (PartStr(Position) & "     " & NameStr(Position)) & "                               " & Position
  473.             Position = Position + 1
  474.         Else
  475.             lstItems.AddItem (NameStr(Position) & "     " & PartStr(Position)) & "                               " & Position
  476.             Position = Position + 1
  477.         End If
  478.     End If
  479.     AddItem = False
  480. End Sub
  481. Public Sub Form_Load()
  482.     FileNum = FreeFile
  483.     RecLength = Len(Record)
  484.     indexVal = 1
  485.     Position = 1
  486.     If Dir("C:\Program Files\LabelMaker", vbDirectory) = "" Then
  487.         ChDir ("C:\Program Files")
  488.         MkDir ("LabelMaker")
  489.     End If
  490.     FileNam = "C:\Program Files\LabelMaker\Labels.nlb"
  491.     Open FileNam For Random As FileNum Len = RecLength
  492.     LastRec = FileLen(FileNam) / RecLength
  493.     If LastRec = 0 Then
  494.         lstItems.AddItem "No items in database"
  495.         InitVar = "No items in database"
  496.     ElseIf LastRec <> 0 Then
  497.         For Position = 1 To LastRec
  498.             Get #FileNum, Position, Record
  499.             lstItems.AddItem (Trim(Record.PartNum) & "     " & Trim(Record.TName)) & "                            " & Position
  500.         Next Position
  501.     End If
  502.     Close #FileNum
  503.     Position = 0
  504. End Sub
  505. Private Sub LstItems_Click()
  506.     If lstItems.Text = "No items in database" Then
  507.         Exit Sub
  508.     End If
  509.     Position = Right(lstItems.Text, 3)
  510.     Call GetFromFile
  511.     CurrentRec = Position
  512.     Image1.Picture = LoadPicture(PicString)
  513.     lblPart.Caption = PNumber
  514. End Sub
  515. Public Sub Save2File()
  516.     FileNum = FreeFile
  517.     Open FileNam For Random As FileNum Len = RecLength
  518.     LastRec = LastRec + 1
  519.     Position = LastRec
  520.     Record.TName = Trim(NameString)
  521.     Record.Picpath = Trim(PicString)
  522.     Record.PartNum = Trim(PNumber)
  523.     Record.Color = Trim(ColorVal)
  524.     'Store variable data to Labels.nlb
  525.     Put #FileNum, Position, Record
  526.     Close #FileNum
  527.     NameStr(Position) = NameString
  528.     PicStr(Position) = PicString
  529.     PartStr(Position) = PNumber
  530.     ColrStr(Position) = ColorVal
  531. End Sub
  532. Public Sub GetFromFile()
  533.     FileNum = FreeFile
  534.     Open FileNam For Random As FileNum Len = RecLength
  535.     Get #FileNum, Position, Record
  536.     'Retrieves record data from Labels.nlb
  537.     NameString = Trim(Record.TName)
  538.     PicString = Trim(Record.Picpath)
  539.     PNumber = Trim(Record.PartNum)
  540.     ColorVal = Trim(Record.Color)
  541.     Close #FileNum
  542. End Sub
  543.