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

📄 wxlcommreppic.dsr

📁 用于电子行业打印复杂报表格式和不干胶标签
💻 DSR
字号:
VERSION 5.00
Begin {82282820-C017-11D0-A87C-00A0C90F29FC} wxlcommreppic 
   Caption         =   "ActiveReport1"
   ClientHeight    =   5895
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   11595
   StartUpPosition =   2  '屏幕中心
   _ExtentX        =   20452
   _ExtentY        =   10398
   SectionData     =   "wxlcommreppic.dsx":0000
End
Attribute VB_Name = "wxlcommreppic"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rsTempcar As ADODB.Recordset
Dim abjctmp As String
Dim picheight As Variant '记录

Private Sub setimage() '给image赋值
Dim n, m, i As Integer

If wxlabnum = 1 Then
  Image1.Left = 90: Image8.Left = 3150
End If
If wxlabnum = 2 Then
  Image1.Left = 90: Image2.Left = 610
  Image8.Left = 3150: Image9.Left = 3670
End If
If wxlabnum = 3 Then
  Image1.Left = 90: Image2.Left = 610: Image3.Left = 1130
  Image8.Left = 3150: Image9.Left = 3670: Image10.Left = 4190
End If
If wxlabnum = 4 Then
  Image1.Left = 90: Image2.Left = 555: Image3.Left = 1020: Image4.Left = 1485
  Image8.Left = 3150: Image9.Left = 3615: Image10.Left = 4080: Image11.Left = 4545
End If
If wxlabnum = 5 Then
  Image1.Left = 90: Image2.Left = 535: Image3.Left = 980: Image4.Left = 1425: Image5.Left = 1870
  Image8.Left = 3150: Image9.Left = 3595: Image10.Left = 4040: Image11.Left = 4485: Image12.Left = 4930
End If

 For i = 1 To 2
   For n = 0 To wxlabnum - 1
      m = n + (i - 1) * 7 + 1
      Call loadpic(wxlarray(n))
      Me.Detail.Controls("Image" & m).Picture = LoadPicture(abjctmp)
      Me.Detail.Controls("Image" & m).SizeMode = 1
      Me.Detail.Controls("Image" & m).Width = picwidth * pubabpercent
      Me.Detail.Controls("Image" & m).Height = picheight * pubabpercent
      Me.Detail.Controls("Image" & m).PictureAlignment = 2
  Next
 Next
End Sub

Private Sub loadpic(abjcstr As String)
  '调安标
 Dim ajt As String
  abjctmp = ""
  ajt = "无"
  Set rsTempcar = New ADODB.Recordset   '初始化数据库
  rsTempcar.CursorType = adOpenKeyset
  rsTempcar.CursorLocation = adUseClient
  rsTempcar.LockType = adLockOptimistic
  rsTempcar.Open "select * from 安标表 where 安标简称='" & ajt & "'", cnSys
  If abjcstr <> "" Then
      rsTempcar.Close
      rsTempcar.Open "Select * From 安标表 Where 安标简称 = '" & abjcstr & "'", cnSys
      Do While Not rsTempcar.EOF
       abjctmp = pcpath & Trim(rsTempcar("安标路径"))
       picwidth = rsTempcar("安标宽度") * stunit
       picheight = rsTempcar("安标高度") * stunit
       rsTempcar.MoveNext
      Loop
  End If
End Sub

Private Sub ActiveReport_Initialize()
   wxlcommreppic.Printer.PaperSize = bgjpapersize
   If wxlprintflag = 1 Then
     wxlcommreppic.Printer.PrintDialog
   End If
End Sub

Private Sub ActiveReport_ReportStart()
 ' Printer.PaperWidth = 106 * stunit  '纸张高
 ' Printer.PaperHeight = 51 * stunit   '纸张宽
 ' wxlcommrep.Printer.PaperSize = bgjpapersize
    If wxlslflag = 1 Then
      Label24.Visible = True
      Label25.Visible = True
      Label24.Caption = "Short Leads"
      Label25.Caption = "Short Leads"
    Else
    '2006.08.01 add the code
    If wxlslflag = 2 Then
      Label24.Visible = True: Label25.Visible = True
      Label24.Caption = "Long Leads"
      Label25.Caption = "Long Leads"
     Else
      Label24.Visible = False: Label25.Visible = False
    End If
  End If
  
 '2007.01.24  cancel the code
 ' If wxlabnum >= 4 Then
 '    Field3.Left = 15
 '    Field3.Width = 2790
 '    Field8.Left = 3090
 '    Field8.Width = 2790
 '   Else
 '   If InStr(wxlab, "CURUS") > 0 And InStr(wxlab, "SEMKO") > 0 Then
 '     Field3.Left = 475: Field8.Left = 3545
 '     Field3.Width = 2240: Field8.Width = 2240
 '     Field3.Alignment = ddTXRight: Field8.Alignment = ddTXRight
 '    Else
 '     Field3.Left = 1095: Field3.Width = 1740
 '     Field8.Left = 4165: Field8.Width = 1740
 '   End If
 ' End If
End Sub

Private Sub Detail_AfterPrint()
  wxlprint = 0
End Sub

Private Sub setjpnull()
Dim tmpab As String
Dim tmpfirstab, tmpwholeab As String
Dim i, firstnum As Integer
 For i = 1 To 12  '清空数据
   Me.Detail.Controls("Field" & i).Text = ""
 Next
 
  '2007.01.24 add the code
For i = 1 To 14
  Me.Detail.Controls("Image" & i).Picture = LoadPicture()
Next
 
     Field11.Visible = False
     Field12.Visible = False
     If wxlabnum > 5 Then
       tmpab = "": tmpfirstab = "": tmpwholeab = ""
       'Field11.Visible = True
       'Field12.Visible = True
       firstnum = InStr(wxlab, " ")
       For i = 1 To firstnum
         tmpab = Mid(wxlab, i, 1)
         tmpfirstab = tmpfirstab & tmpab
       Next
       'Field11.Text = tmpfirstab
       'Field12.Text = tmpfirstab
       
       For i = (firstnum + 1) To Len(wxlab)
         tmpab = Mid(wxlab, i, 1)
         tmpwholeab = tmpwholeab & tmpab
       Next
       wxlab = tmpwholeab
     End If

 For i = 0 To 1
   Me.Detail.Controls("Field" & 1 + i * 5).Text = wxltype
   Me.Detail.Controls("Field" & 2 + i * 5).Text = wxlratings
   'Me.Detail.Controls("Field" & 3 + i * 5).Text = wxlab
   Me.Detail.Controls("Field" & 4 + i * 5).Text = wxllotno
   Me.Detail.Controls("Field" & 5 + i * 5).Text = wxlqty

 Next
End Sub

Private Sub Detail_Format()
  Call setjpnull
  Call setimage    '给image赋值  2007.01.24
End Sub

⌨️ 快捷键说明

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