📄 datarep.dsr
字号:
Object.Height = 285
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BackColor = 14737632
BackStyle = 1
DataField = "ProductID"
Alignment = 1
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 1
Format = "0"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 1033
SubFormatType = 1
EndProperty
FunctionType = 4
DataMember = "Order_Details"
EndProperty
EndProperty
SectionCode5 = 7
BeginProperty Section5 {1C13A8E0-A0B6-11D0-848E-00A0C90DC8A9}
_Version = 393216
Name = "Section4"
Object.Height = 528
NumControls = 3
ItemType0 = 3
BeginProperty Item0 {1C13A8E1-A0B6-11D0-848E-00A0C90DC8A9}
_Version = 393216
Name = "Label10"
Object.Left = 6768
Object.Top = 144
Object.Width = 1440
Object.Height = 240
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
Object.Caption = "Page %p of %P"
EndProperty
ItemType1 = 3
BeginProperty Item1 {1C13A8E1-A0B6-11D0-848E-00A0C90DC8A9}
_Version = 393216
Name = "Label15"
Object.Left = 144
Object.Top = 144
Object.Width = 4752
Object.Height = 240
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
Object.Caption = "Printed on %D, at %t"
CanGrow = -1 'True
EndProperty
ItemType2 = 6
BeginProperty Item2 {1C13A8E4-A0B6-11D0-848E-00A0C90DC8A9}
_Version = 393216
Name = "Shape2"
Object.Left = 144
Object.Width = 8352
Object.Height = 60
BackColor = 4210752
BackStyle = 1
EndProperty
EndProperty
SectionCode6 = 8
BeginProperty Section6 {1C13A8E0-A0B6-11D0-848E-00A0C90DC8A9}
_Version = 393216
Name = "Section2"
Object.Height = 435
NumControls = 6
ItemType0 = 13
BeginProperty Item0 {49FF6930-2B8C-11D1-8DA9-00A0C90FFFC2}
_Version = 393216
Name = "Function1"
Object.Left = 3600
Object.Width = 1290
Object.Height = 285
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
DataField = "Freight"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 1
Format = """$""#,##0.00"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 1033
SubFormatType = 2
EndProperty
EndProperty
ItemType1 = 3
BeginProperty Item1 {1C13A8E1-A0B6-11D0-848E-00A0C90DC8A9}
_Version = 393216
Name = "Label5"
Object.Left = 2160
Object.Width = 1440
Object.Height = 285
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Object.Caption = "Total Freight:"
EndProperty
ItemType2 = 3
BeginProperty Item2 {1C13A8E1-A0B6-11D0-848E-00A0C90DC8A9}
_Version = 393216
Name = "Label9"
Object.Width = 864
Object.Height = 285
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Object.Caption = "Orders:"
EndProperty
ItemType3 = 13
BeginProperty Item3 {49FF6930-2B8C-11D1-8DA9-00A0C90FFFC2}
_Version = 393216
Name = "Function2"
Object.Left = 864
Object.Width = 864
Object.Height = 285
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
DataField = "OrderID"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 1033
SubFormatType = 0
EndProperty
FunctionType = 4
EndProperty
ItemType4 = 13
BeginProperty Item4 {49FF6930-2B8C-11D1-8DA9-00A0C90FFFC2}
_Version = 393216
Name = "Function6"
Object.Left = 6336
Object.Width = 1290
Object.Height = 285
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
DataField = "Total"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 1
Format = """$""#,##0.00"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 1033
SubFormatType = 2
EndProperty
DataMember = "Order_Details"
EndProperty
ItemType5 = 3
BeginProperty Item5 {1C13A8E1-A0B6-11D0-848E-00A0C90DC8A9}
_Version = 393216
Name = "Label8"
Object.Left = 5616
Object.Width = 720
Object.Height = 285
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Object.Caption = "Total"
EndProperty
EndProperty
End
Attribute VB_Name = "DataReport1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'欢迎你下载使用本代码,本份代码由程序太平洋提供下载学习之用
'声明:
'1.本站所有代码的版权归原作者所有,如果你使用了在本站下载的源代码
' 引起的一切纠纷(后果)与本站无关,请您尊重原作者的劳动成果!
'2.若本站在代码上有侵权之处请您与站长联系,站长会及时更正。
'网站:http://www.daima.com.cn
'程序太平洋:http://www.5ivb.net
'Email:dapha@etang.com
'CopyRight 2001-2005 By WangFeng
'整理时间:2005-5-21 14:34:38
Option Explicit
' This will be used to trap the instant when a new record
' is read by the report writer.
Dim WithEvents CustFormat As StdDataFormat
Attribute CustFormat.VB_VarHelpID = -1
Dim WithEvents DiscountFormat As StdDataFormat
Attribute DiscountFormat.VB_VarHelpID = -1
' This is used to lookup up the CustomerID field
' against the Customers table
Dim rsCust As New ADODB.Recordset
' member variable for ShowDetails property
Private m_ShowDetails As Boolean
Private Sub DataReport_Initialize()
' Create another DataFormat for the Discount field.
Set DiscountFormat = New StdDataFormat
Set Sections("Order_Details_Detail").Controls("txtDiscount").DataFormat = DiscountFormat
' Create a new format object and assign it to the txtCustomer field.
Set CustFormat = New StdDataFormat
Set Sections("Orders_Header").Controls("txtCustomerName").DataFormat = CustFormat
' Open a recordset on the Customers table.
rsCust.Open "Customers", DataEnvironment1.Connection1, adOpenStatic, adLockReadOnly, adCmdTable
End Sub
Private Sub DataReport_Terminate()
' Close the recordset.
rsCust.Close
Set rsCust = Nothing
End Sub
Private Sub DataReport_ProcessingTimeout(ByVal Seconds As Long, Cancel As Boolean, ByVal JobType As MSDataReportLib.AsyncTypeConstants, ByVal Cookie As Long)
' Display a message every 20 seconds.
Const TIMEOUT = 20
' The value of Seconds when we displayed the message.
Static LastMessageSecs As Long
' Reset LastMessage if a new print operation is in progress.
If Seconds < LastMessageSecs Then
LastMessageSecs = 0
ElseIf LastMessageSecs + TIMEOUT <= Seconds Then
LastMessageSecs = Seconds
' Ask the user whether the operation should be canceled.
If MsgBox("This operation has been started " & Seconds & " seconds ago." & vbCr _
& "Do you want to cancel it?", vbYesNo + vbExclamation) = vbYes Then
Cancel = True
End If
End If
End Sub
Private Sub DataReport_AsyncProgress(ByVal JobType As MSDataReportLib.AsyncTypeConstants, ByVal Cookie As Long, ByVal PageCompleted As Long, ByVal TotalPages As Long)
' Display the advance state in a Label control on the main form.
frmMain.lblStatus = "Printing page " & PageCompleted _
& " of " & TotalPages
End Sub
Private Sub DataReport_Error(ByVal JobType As MSDataReportLib.AsyncTypeConstants, ByVal Cookie As Long, ByVal ErrObj As MSDataReportLib.RptError, ShowError As Boolean)
' Display your own custom error message box.
If JobType = rptAsyncPrint Or JobType = rptAsyncExport Then
MsgBox "Error #" & ErrObj.ErrorNumber & vbCr & ErrObj.Description, vbCritical
ShowError = False
End If
End Sub
'--------------------------------------------
' Format events
'--------------------------------------------
Private Sub CustFormat_Format(ByVal DataValue As StdFormat.StdDataValue)
rsCust.MoveFirst
rsCust.Find "CustomerID='" & DataValue.Value & "'"
If rsCust.EOF Then
DataValue.Value = Null
Else
DataValue.Value = rsCust("CompanyName")
End If
End Sub
Private Sub DiscountFormat_Format(ByVal DataValue As StdFormat.StdDataValue)
If CDbl(DataValue.Value) = 0 Then
DataValue.Value = Null
End If
End Sub
'--------------------------------------------
' Custom properties
'--------------------------------------------
' The ShowDetails property
Public Property Get ShowDetails() As Boolean
ShowDetails = m_ShowDetails
End Property
Public Property Let ShowDetails(ByVal newValue As Boolean)
Dim newTop As Single
m_ShowDetails = newValue
' Change the report title
If m_ShowDetails Then
Sections("Section1").Controls("lblTitle").Caption = "ORDERS DETAILS"
Else
Sections("Section1").Controls("lblTitle").Caption = "ORDERS SUMMARY"
End If
' This property affects the visibility of the innermost section.
Sections("Order_Details_Detail").Visible = m_ShowDetails
' It also affects the visibility of a few fields in the Orders section.
' If we want to reduce the height of the section we need to make all
' the unnecessary controls invisible and them move up, otherwise assigning
' a smaller value to the section's Height property won't work.
' This returns the actual Top value if controls are visible, 0 otherwise.
newTop = IIf(m_ShowDetails, 1870, 0)
With Sections("Orders_Header")
.Controls("lblProduct").Visible = m_ShowDetails
.Controls("lblProduct").Top = newTop
.Controls("lblUnitPrice").Visible = m_ShowDetails
.Controls("lblUnitPrice").Top = newTop
.Controls("lblQty").Visible = m_ShowDetails
.Controls("lblQty").Top = newTop
.Controls("lblDiscount").Visible = m_ShowDetails
.Controls("lblDiscount").Top = newTop
.Controls("lblTotal").Visible = m_ShowDetails
.Controls("lblTotal").Top = newTop
.Controls("shaDetailHeader").Visible = m_ShowDetails
.Controls("shaDetailHeader").Top = newTop
' Setting the section's Height to zero shrinks it
' as much as possible
.Height = IIf(m_ShowDetails, 2200, 0)
End With
End Property
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -