|
在ACCESS自定义纸张源码
窗体代码:- Private Sub CmdNew_Click()
- Dim PrinterName As String
- Dim FormName As String
- Dim FormSize As SIZEL
- Dim PrinterHandle As Long
- Dim LngWidth As Long
- Dim LngHeight As Long
-
- If IsNull(Me.TxtNewStyle) Then
- MsgBox "请输入要创建的打印格式"
- Me.TxtNewStyle.SetFocus
- Exit Sub
- End If
-
- If IsNull(Me.TxtWidth) Then
- MsgBox "请输入要创建的打印格式的宽度尺寸(mm)"
- Me.TxtHeight.SetFocus
- Exit Sub
- End If
-
- If IsNull(Me.TxtHeight) Then
- MsgBox "请输入要创建的打印格式高度尺寸(mm)"
- Me.TxtWidth.SetFocus
- Exit Sub
- End If
-
- If Not IsNumeric(Me.TxtWidth) Then
- MsgBox "打印格式宽度尺寸必须是数字类型"
- Me.TxtWidth.SetFocus
- Exit Sub
- End If
-
- If Not IsNumeric(Me.TxtHeight) Then
- MsgBox "打印格式高度尺寸必须是数字类型"
- Me.TxtWidth.SetFocus
- Exit Sub
- End If
-
-
- Dim RetVal As Long
- Dim Continue As Long
-
-
- PrinterName = GetSrvName(cmbPrinter)
- FormName = Me.TxtNewStyle
- LngWidth = Me.TxtWidth * 1000
- LngHeight = Me.TxtHeight * 1000
-
- If PrinterName = "" Then
- PrinterName = Printer.DeviceName '当前打印机
- Else
- MakeDefaultPrinter PrinterName '设置默认打印机
- End If
- RetVal = AddCustForm(FormName, Me.hwnd, LngWidth, LngHeight, PrinterName)
- Select Case RetVal
- Case FORM_NOT_SELECTED ' 0
- ' Selection failed!
- MsgBox "添加错误" & " ErrorCode:" & Err.LastDllError, vbExclamation, _
- "错误!"
- Case FORM_SELECTED ' 1
- MsgBox FormName & " 打印格式已经存在于 " & PrinterName & " ", vbExclamation
- Case FORM_ADDED ' 2
- '//Form added and selected.
- MsgBox FormName & " 打印格式已经添加到 " & PrinterName, vbInformation
- AddMyForm = True
- End Select
-
- ReGetPaperList
-
- End Sub
- Private Sub Form_Load()
- Dim Prn As Printer
- Dim Obj As AccessObject
-
- For Each Prn In Printers
- Me.cmbPrinter.AddItem Prn.DeviceName
- Next
-
- If cmbPrinter.ListCount > 0 Then
- cmbPrinter = Printer.DeviceName
- LstPaper.RowSource = GetPaperList(cmbPrinter)
- End If
-
- For Each Obj In CurrentProject.AllReports
- Me.LstReport.AddItem Obj.Name
- Next
- End Sub
- Private Sub cmbPrinter_AfterUpdate()
- Call ReGetPaperList
- End Sub
- Private Sub CmdDelete_Click()
- Dim colNetworkPrinters As New Collection
- Dim srvName As String, tmpName As String
- Dim FormName As String
- Dim PrinterName As String
- Dim i
- On Error Resume Next
- If Me.LstPaper.ListIndex < 0 Then
- MsgBox "请选择要删除的纸张格式"
- Exit Sub
- End If
- FormName = Mid(LstPaper, 1, InStr(1, LstPaper, " -") - 1)
-
- tmpName = ""
- srvName = GetSrvName(cmbPrinter)
-
- If srvName <> "" Then
- Call DeleteMyForm(srvName, FormName)
- End If
-
-
- ReGetPaperList
- End Sub
- Private Sub CmdReport_Click()
- Dim Rpt As Report
- ' Dim Prt As Report
- 'Dim accObj As AccessObject
-
- Dim strReportName As String
-
- If Me.LstReport.ListIndex < 0 Then
- MsgBox "请选择报表"
- Exit Sub
- End If
-
-
- If Me.LstPaper.ListIndex < 0 Then
- MsgBox "请选择打印的纸张类型"
- Exit Sub
- End If
-
- strReportName = LstReport
-
- If IsLoaded(strReportName) Then
- MsgBox "不能重复打开相同的报表"
- Exit Sub
- End If
-
-
- Select Case strReportName
-
- Case "报表1"
-
- Set Rpt = New Report_报表1
-
- Case "客户标签"
-
- Set Rpt = New Report_客户标签
-
- Case "概览子报表"
-
- Set Rpt = New Report_概览子报表
-
- Case Else
-
- Set Rpt = New Report_报表1
-
- End Select
-
-
-
-
- ' Set Rpt = Reports(strReportName)
-
- 'Set Rpt = New Report_报表1
- With Rpt.Printer
-
- .PaperSize = GetPaperSize(LstPaper)
- .Orientation = Me.frameOrientation.Value
-
- End With
- clnClient.Add Item:=Rpt, Key:=CStr(Rpt.hwnd)
- Rpt.Visible = True
- End Sub
- Private Sub ReGetPaperList()
- '刷新表单(纸张)列表
- If Not IsNull(Me.cmbPrinter) Then
- LstPaper.RowSource = ""
- LstPaper.RowSource = GetPaperList(cmbPrinter)
- End If
-
- End Sub
- 完整代码请参考附件
复制代码 |
本帖子中包含更多资源
您需要 登录 才可以下载或查看,没有帐号?注册
x
评分
-
查看全部评分
|