⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 frmview.frm

📁 通用样品管理系统是一个商业程序,功能界面都还不错!
💻 FRM
📖 第 1 页 / 共 3 页
字号:
🔍
123 
  If VScroll1.Value + (My - Sy) / 50 <= VScroll1.Max And VScroll1.Value + (My - Sy) / 50 > 0 Then
     VScroll1.Value = VScroll1.Value + (My - Sy) / 50
  End If
End If
End If
If PictureName(9) = "" Then
   DisplayPicture.ToolTipText = "没有图片装载"
    ElseIf Check2.Value = 1 Then
      DisplayPicture.ToolTipText = "图片：宽 " & DisplayPicture.Width / 15 & " 点、高 " & DisplayPicture.Height / 15 & " 点"
        Else
      DisplayPicture.ToolTipText = "要想显示图片大小，选取自动大小！"
End If
End Sub

Private Sub DisplayPicture_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  LB = False
  If Check2.Value = 1 Then
     DisplayPicture.MouseIcon = LoadPicture(Browser + "Pmove.Cur")
    Else
     DisplayPicture.MouseIcon = LoadPicture()
  End If
End Sub

Private Sub Form_Load()
 frmView.HelpContextID = 7
 frmView.Top = (MDIForm1.Height - frmView.Height) / 2
 frmView.Left = (MDIForm1.Width - frmView.Width) / 2
 StatusBar1.Panels.Item(5).Text = "公司名称:" & CompanyName
 StatusBar1.Panels.Item(4).Text = "操作员:" & UserText
 PartView.Left = 0
 PartView.Top = V_Toolbar.Height + 60
 Dim x As Integer
    For x = 0 To 8
        Label2(x) = Pro(x)
    Next
 CycleP = False
 CycleT = False
 Call CoolBar(V_Toolbar)
 Me.MousePointer = 11
 '读出记录
 Set DB = OpenDatabase(SampleData)
 Set EF = DB.OpenRecordset("S_Main", dbOpenTable)
     StatusBar1.Panels.Item(3).Text = "总共记录：" & EF.RecordCount
     AN = EF.RecordCount
 Set EF = DB.OpenRecordset("S_Main", dbOpenDynaset)
     If EF.EOF = True And EF.BOF = True Then
        x = 0
        For x = 0 To 9
            PictureName(x) = ""
        Next
        DB.Close
        StatusBar1.Panels.Item(1).Text = "样品库为空,不能浏览。"
        StatusBar1.Panels.Item(2).Text = "当前记录：0"
        StatusBar1.Panels.Item(3).Text = "总共记录：0"
        HR = False
        V_Toolbar.Buttons.Item(3).Enabled = False
        V_Toolbar.Buttons.Item(4).Enabled = False
        V_Toolbar.Buttons.Item(2).Enabled = False
        V_Toolbar.Buttons.Item(1).Enabled = False
      Else
        For x = 0 To 9
          If Not IsNull(EF.Fields(x).Value) Then
             PictureName(x) = EF.Fields(x).Value
             Info(x) = PictureName(x)
          End If
        Next
        Check2.Enabled = True
        HR = True
        RN = 1
        StatusBar1.Panels.Item(2).Text = "当前记录：" & Str(RN)
     End If
On Error GoTo NOp
If Check2.Value = 1 Then
     DisplayPicture.Stretch = False
      Else
     DisplayPicture.Height = 5880
     DisplayPicture.Width = 5295
     DisplayPicture.Stretch = True
  End If
DisplayPicture.Picture = LoadPicture(PictureName(9))
  'Large photo display
  If Check2.Value = 1 Then
  HScroll1.Value = 0
  VScroll1.Value = 0
  HScroll1.Max = DisplayPicture.Width - Picture1.Width + 280
  VScroll1.Max = DisplayPicture.Height - Picture1.Height + 280
  VScroll1.Visible = Picture1.Height < DisplayPicture.Height
  HScroll1.Visible = Picture1.Width < DisplayPicture.Width
      If HScroll1.Visible Or VScroll1.Visible Then
        Command3.Visible = True
       Else
        Command3.Visible = False
      End If
  Else
   VScroll1.Visible = False
   HScroll1.Visible = False
   Command3.Visible = False
  End If
  Me.MousePointer = 0



Exit Sub
NOp:
  MsgBox "图片文件没找到或格式出错，不能浏览！", vbOKOnly + 16, "图片不能安装"
  On Error Resume Next
  DisplayPicture.Picture = LoadPicture(Browser + "photo\default.bmp")
    'Large photo display
  If Check2.Value = 1 Then
  HScroll1.Value = 0
  VScroll1.Value = 0
  HScroll1.Max = DisplayPicture.Width - Picture1.Width + 280
  VScroll1.Max = DisplayPicture.Height - Picture1.Height + 280
  VScroll1.Visible = Picture1.Height < DisplayPicture.Height
  HScroll1.Visible = Picture1.Width < DisplayPicture.Width
      If HScroll1.Visible Or VScroll1.Visible Then
        Command3.Visible = True
       Else
        Command3.Visible = False
      End If
  Else
   VScroll1.Visible = False
   HScroll1.Visible = False
   Command3.Visible = False
  End If
  Me.MousePointer = 0
  Exit Sub
End Sub

Private Sub Form_Resize()
 PartView.Width = Me.ScaleWidth
 PartView.Height = Me.ScaleHeight - StatusBar1.Height - V_Toolbar.Height - 40
End Sub

Private Sub HScroll1_Change()
DisplayPicture.Left = -HScroll1.Value
End Sub

Private Sub V_Toolbar_ButtonClick(ByVal Button As ComctlLib.Button)
Dim x As Integer
On Error GoTo PError
Select Case Button.Key
  Case "Exit"
      If HR = True Then
         DB.Close
      End If
         Unload Me
         MDIForm1.Show
         Exit Sub
  Case "Previous"
    RN = RN - 1
    Me.MousePointer = 11
    Check2.Value = 0
    If EF.BOF Then
       For x = 0 To 9
          PictureName(x) = ""
          Info(x) = ""
       Next
       V_Toolbar.Buttons.Item(2).Enabled = False
       RN = 1
       MsgBox "已经到了记录首,不能再翻了!", vbOKOnly + vbExclamation, "记录尽头"
     Else
      On Error Resume Next
      EF.MovePrevious
       If EF.BOF Then
        V_Toolbar.Buttons.Item(2).Enabled = False
        EF.MoveFirst
        RN = 1
        Else
         V_Toolbar.Buttons.Item(3).Enabled = True
         For x = 0 To 9
             PictureName(x) = ""
             Info(x) = ""
          On Error Resume Next
          If Not IsNull(EF.Fields(x).Value) Then
             PictureName(x) = EF.Fields(x).Value
             Info(x) = PictureName(x)
          End If
        Next
        DisplayPicture.Picture = LoadPicture(PictureName(9))
           EF.MovePrevious
           If EF.BOF Then
              V_Toolbar.Buttons.Item(2).Enabled = False
              EF.MoveFirst
              RN = 1
               Else
              EF.MoveNext
           End If
      End If
    End If
    StatusBar1.Panels.Item(2).Text = "当前记录：" & Str(RN)
    Me.MousePointer = 0
  Case "Next"
    RN = RN + 1
    Me.MousePointer = 11
    Check2.Value = 0
    If EF.EOF Then
       For x = 0 To 9
          PictureName(x) = ""
          Info(x) = ""
       Next
       V_Toolbar.Buttons.Item(3).Enabled = False
       RN = AN
       MsgBox "已经到了记录末,不能再翻了!", vbOKOnly + vbExclamation, "记录尽头"
     Else
       On Error Resume Next
       EF.MoveNext
       If EF.EOF Then
          V_Toolbar.Buttons.Item(3).Enabled = False
          EF.MoveLast
          RN = AN
        Else
         V_Toolbar.Buttons.Item(2).Enabled = True
         For x = 0 To 9
             PictureName(x) = ""
             Info(x) = ""
          On Error Resume Next
          If Not IsNull(EF.Fields(x).Value) Then
             PictureName(x) = EF.Fields(x).Value
             Info(x) = PictureName(x)
          End If
         Next
         DisplayPicture.Picture = LoadPicture(PictureName(9))
           EF.MoveNext
              If EF.EOF Then
                 V_Toolbar.Buttons.Item(3).Enabled = False
                 EF.MoveLast
                 RN = AN
                  Else
                 EF.MovePrevious
             End If
        End If
    End If
    Me.MousePointer = 0
    StatusBar1.Panels.Item(2).Text = "当前记录：" & Str(RN)
  Case "Print"
    Me.MousePointer = 11
    PrintDialog.CancelError = True
    On Error Resume Next
    PrintDialog.ShowPrinter
    If Err.Number = 32755 Then
       Me.MousePointer = 0
       Exit Sub
    End If
    '打印记录
     Printer.PrintQuality = -4
     Printer.PaintPicture DisplayPicture.Picture, 1500, 800
     Printer.Font = "黑体"
     Printer.FontBold = True
     Printer.FontSize = 20
     Printer.CurrentX = 500
     Printer.CurrentY = 6500
     Printer.Print ""
     Printer.Print ""
     Printer.Print ""
     Printer.Print ""
     Printer.Print ""
     Printer.Print ""
     Printer.Print "  样品信息如下：________________________________________________________"
     Printer.Print ""
     Printer.Print ""

     Printer.Print "        " & Pro(0) & "： " + Info(0)
     Printer.Print "        " & Pro(2) & "： " + Info(2)
     Printer.Print "        " & Pro(3) & "： " + Info(3)
     Printer.Print "        " & Pro(4) & "： " + Info(4)
     Printer.Print "        " & Pro(5) & "： " + Info(5)
     Printer.Print "        " & Pro(6) & "： " + Info(6)
     Printer.Print "        " & Pro(7) & "： " + Info(7)
     Printer.Print "        " & Pro(8) & "： " + Info(8)
     Printer.Print ""
     Printer.Print ""
     Printer.Font = "隶书"
     Printer.FontBold = False
     Printer.FontSize = 14
     Printer.Print "  <<<<<<<<<<<<<<<<<<<<<<<<<< " & CompanyName; "制单 " & Year(Date) & "年" & Month(Date) & "月" & Day(Date) & "日" & " " & Time()
     Printer.EndDoc
    Me.MousePointer = 0
  Case "AutoDisplay"
    Me.MousePointer = 11
    If V_Toolbar.Buttons.Item(1).ToolTipText = "停止自动浏览" Then
       AutoTimer.Enabled = False
       V_Toolbar.Buttons.Item(1).ToolTipText = "自动浏览"
       V_Toolbar.Buttons.Item(1).Image = ToolImage.ListImages.Item(1).Index
       If RN > 1 Then
          V_Toolbar.Buttons.Item(2).Enabled = True
       End If
       If RN <> AN Then
          V_Toolbar.Buttons.Item(3).Enabled = True
       End If
       V_Toolbar.Buttons.Item(4).Enabled = True
       V_Toolbar.Buttons.Item(5).Enabled = True
       V_Toolbar.Buttons.Item(7).Enabled = True
       CycleP = False
       Else
       CycleP = False
       frmOption.Show 1
    End If
    Me.MousePointer = 0
  Case "About"
    Me.MousePointer = 11
       About.Show 1
    Me.MousePointer = 0
  Case Else

End Select
  
  
  Exit Sub
PError:
  Me.MousePointer = 0
  MsgBox "图片文件没找到或格式错误,以缺省的图片。", vbOKOnly + vbCritical, "图片安装错误"
  Exit Sub

End Sub

Private Sub VScroll1_Change()
DisplayPicture.Top = -VScroll1.Value
End Sub
123

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -