Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   30
      TabIndex        =   13
      Top             =   4920
      Width           =   6375
   End
   Begin VB.Menu mnucp 
      Caption         =   "Copy Image"
      Visible         =   0   'False
      Begin VB.Menu mnuCopyImage1 
         Caption         =   "將條碼保存到剪切板"
      End
      Begin VB.Menu mnuSaveImage1 
         Caption         =   "條碼保存為..."
      End
   End
   Begin VB.Menu mnucp1 
      Caption         =   "Copy Image2"
      Visible         =   0   'False
      Begin VB.Menu mnuCopyImage2 
         Caption         =   "將條碼保存到剪切板"
      End
      Begin VB.Menu mnuSaveImage2 
         Caption         =   "條碼保存為..."
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

Dim Target As Object
Dim LastSave As String '上次保存目錄
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Sub cboBarSize_Click()
    '改變條形碼的大小
    Picture2.ScaleMode = 3
    Picture1.ScaleMode = 3
    Select Case cboBarSize.ListIndex
        Case 0
            Picture2.Height = Picture2.Height * (1.4 * 40 / Picture2.ScaleHeight)
            Picture2.FontSize = 8
        Case 1
            Picture2.Height = Picture2.Height * (2.4 * 40 / Picture2.ScaleHeight)
            Picture2.FontSize = 10
        Case 2
            Picture2.Height = Picture2.Height * (3 * 40 / Picture2.ScaleHeight)
            Picture2.FontSize = 14
    End Select
    Call Text1_Change
End Sub

Private Sub cboTextStyle_Click()
    Text1_Change
End Sub

Private Sub checkBarCaption_Click()
    If checkBarCaption.Value = 1 Then
        checkBarCaption.Caption = "顯示文字"
        chkTextAlignment.Visible = True
    Else
        checkBarCaption.Caption = "不顯示文字"
        chkTextAlignment.Value = 0
        chkTextAlignment.Visible = False
    End If
End Sub

Private Sub chkBar128_Click()
    If chkBar128.Value = 0 Then
        Picture1.Visible = False
    Else
        Picture1.Visible = True
    End If
End Sub

Private Sub chkBar39_Click()
    If chkBar39.Value = 0 Then
        Picture2.Visible = False
    Else
        Picture2.Visible = True
    End If
End Sub

Private Sub chkTextAlignment_Click()
    If chkTextAlignment.Value = 1 Then
        chkTextAlignment.Caption = "文字置底"
    Else
        chkTextAlignment.Caption = "文字置頂"
    End If
End Sub

Private Sub printBar128()
    '打印128型條碼
    Dim Dl As Long
    Dim MinWidth  As Long
    Picture1.Cls
    
    Dim RT_VAL As RET_VAL
    
    With bar
        .crBack = RGB(255, 255, 255)
        .crFore = RGB(0, 0, 0)
        .lalign = 1     '文本對其方式
        .lExtra = 4     '條碼和文字間距離
        .lheight = 40   '條碼高度
        .lLeft = 20     '條碼左邊位置
        .lR1 = 1        '大小條碼比例
        .lR2 = 1        '
        .lRetHeight = 0 '返回條碼實際高度
        .lRetWidth = 0  '返回條碼實際寬度
        .lRotation = 0  '條碼旋轉角度，0表示0度，1表示90度
        .lShowCheck = 1 '是否顯示檢查數位
        '文本的增粗，傾斜，下劃線等
        .lstyle = cboTextStyle.ListIndex + 1
        .lTop = 1       '條碼頂端位置
        '文本顯示在頂(1)端還是底端(2)
        .ltxtdisp = chkTextAlignment.Value + 1
        'Width of thin bar in pixel
        .lWidth = cboBarSize.ListIndex + 1
        .nsize = 10     '條碼字體大小
        .szAdDigit = "" '
        .szBarCaption = IIf(checkBarCaption.Value, Text1.Text, "")
        .szDigit = ""   '
        .szReadText = Text1.Text
        .szSymbology = 16
        '文字顏色
        .TextColor = RGB(255, 0, 0)
        '字體名稱
        .tiFaceName = "Courier New"
    End With
    
    Set Target = Picture1
    Dl = Special_128b(bar, Target.hDc)
    
    If Dl <> 0 Then MsgBox ErrSpecial_128bMessage(Dl)
End Sub

Private Sub Form_KeyDown(keycode As Integer, Shift As Integer)
    If keycode = vbKeyEscape Then Unload Me
End Sub

Private Sub Form_Load()
    cboBarSize.ListIndex = 1
    cboTextStyle.ListIndex = 0
End Sub

Private Sub mnuCopyImage1_Click()
    '將條碼1保存到剪切板
    pCopyToClipBoard Picture1
End Sub

Private Sub mnuCopyImage2_Click()
    '將條碼2保存到剪切板
     pCopyToClipBoard Picture2
End Sub

Private Sub mnuSaveImage1_Click()
    '調用FileSaving，保存128型條碼
     FileSave Picture1
     If ChkExecute.Value = 1 Then
        '顯示導出文件
        ShellExecute Me.hwnd, "open", CDialog.FileName, 0&, LastSave, vbNormalFocus
     End If
End Sub

Private Sub mnuSaveImage2_Click()
    '調用FileSaving，保存39型條碼
    FileSave Picture2
    If ChkExecute.Value = 1 Then
        '顯示導出文件
        ShellExecute Me.hwnd, "open", CDialog.FileName, 0&, LastSave, vbNormalFocus
    End If
    
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 2 And Text1 <> "" Then
        PopupMenu mnucp
    End If
End Sub

Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 2 And Text1 <> "" Then
        PopupMenu mnucp1
    End If
End Sub

Private Sub Text1_Change()
    '文字改變時重繪條碼
    Dim MinWidth, pw
    If chkBar128.Value = 1 Then
        printBar128
    End If
    If chkBar39.Value = 1 Then
        Call DrawBarcode(Text1, Picture2)
    End If
End Sub
Sub pCopyToClipBoard(ByVal PictureBox As Object)
    '將條碼導入剪切板
    PictureBox.Picture = PictureBox.Image
    Clipboard.Clear
    Clipboard.SetData PictureBox.Image, 2
End Sub


Sub FileSave(Picbox As PictureBox)
    '將條碼導入適當格式的文件中
    Dim sName, RetVal, retSave
    Dim ObjGifImg As GIF
    Screen.MousePointer = 11
    
    CDialog.FilterIndex = 1
    If LastSave <> "" Then
        CDialog.InitDir = LastSave
    Else
        CDialog.InitDir = App.Path & "\ExportedImages"
    End If
    
On Error GoTo ErrHandler
    CDialog.FileName = Picbox.Name
    CDialog.CancelError = True
    CDialog.Flags = cdlOFNOverwritePrompt + cdlOFNNoReadOnlyReturn
    CDialog.Filter = "Bitmaps (*.bmp)|*.bmp|Gif (*.gif)|*.gif|Transparent Gif (*.gif)|*.gif"
    CDialog.ShowSave
    '獲取文件夾
    retSave = InStrRev(CDialog.FileName, "\")
    LastSave = Mid(CDialog.FileName, 1, retSave)
    DoEvents
    
    Picbox.Picture = Picbox.Image
    Select Case CDialog.FilterIndex
      Case 1: '保存為位圖文件
                SavePicture Picbox.Picture, CDialog.FileName
      Case 2: '保存為GIF文件
                Set ObjGifImg = New GIF
                ObjGifImg.SaveGIF Picbox.Image, CDialog.FileName, Picbox.hDc, False, Picbox.Point(0, 0)
                Set ObjGifImg = Nothing
      Case 3: '保存為透明的GIF文件
                Set ObjGifImg = New GIF
                ObjGifImg.SaveGIF Picbox.Image, CDialog.FileName, Picbox.hDc, True, Picbox.Point(0, 0)
                Set ObjGifImg = Nothing
    End Select

    Screen.MousePointer = 0
    Exit Sub
ErrHandler:

    If Err.Number = 32755 Then '獲取保存文件對話框的CancelError
        Screen.MousePointer = 0
        Exit Sub
    Else
        If Err.Number <> 0 Then MsgBox "保存文件錯誤: " & Err.Number & " - " & Err.Description
        Screen.MousePointer = 0
    End If
    
End Sub