注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

宝贝小屋

生活 工作 学习

 
 
 

日志

 
 

vfp打印代码  

2007-07-05 21:16:57|  分类: 默认分类 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |

*-- 报表预部份代码
Set REPORTBEHAVIOR 90
lcReport=Home(2)+"Solution\Europa\EmployeesMD.frx"
oListener = Createobject('BaseReportListener')
olistener.PreviewContainer=Newobject([ReportForm])
Report Form (lcreport) Object oListener Nowait

 

*-- 报表预览窗口
Define Class ReportForm As Form
 AutoCenter = .T.
 WindowState = 2
 BorderStyle = 0
 TitleBar = 0
 WindowType = 1
 BackColor = Rgb(65,65,65)

 DataSession = 1
 oListener = .Null.
 nCurrentPage = 1
 nPageHeight = 100
 nPageWidth = 100
 ScrollBars = 3
 Width =  400
 Height =  400
 AllowOutput = .F.
 oTools = .Null.
 oGotoPage =  .Null.
 oPrint =  .Null.

 Add Object shpPreview  As Shape   With ;
  Top = 10,;
  Left = 10,;
  Width =  300,;
  Height =  300


 Procedure Init
  DoDefault()
  With This As Form
   .oTools = Createobject([frxpreviewtoolbar])
   .oGotoPage  = Createobject([frxgotopageform])
   .oPrint  = Createobject([frxPrintForm])
   With .oTools
    .Show()
    Bindevent(This.oTools,[CboZooMInteractiveChange],This,[CboZooMInteractiveChange])
    Bindevent(.cmdClose,[Click],This,[cmdCloseClick])

    Bindevent(.cntPrev.cmdTop,[Click],This,[cmdTopClick])
    Bindevent(.cntPrev.cmdPrev,[Click],This,[cmdPrevClick])

    Bindevent(.CntNext.cmdNext,[Click],This,[cmdNextClick])
    Bindevent(.CntNext.cmdBott,[Click],This,[cmdBottClick])

    Bindevent(.cmdgotopage,[Click],This,[ActionGotoPage])
    Bindevent(.cmdprint,[Click],This,[Print])

   Endwith
   .Refresh

  Endwith
 Endproc


 Procedure SetReport
  Lparameters oListenerRef
  This.oListener = oListenerRef   &&将对ReportListener对象的引用保存到表单的oListener属性中
 Endproc

 

 Procedure Show
  Lparameters nStyle
  With This
   If Vartype(.oListener) = "O"

    .nPageHeight = .oListener.GetPageHeight() / 10   &&获得页面的像素高度(每英寸96DPI)

    .nPageWidth = .oListener.GetPageWidth() / 10    &&获得页面的像素宽度

    .shpPreview.Height = Int(.nPageHeight)        &&设置形状的高度

    .shpPreview.Width = Int(.nPageWidth)         &&设置形状的宽度

    .Caption = "报表预览程序-" + .oListener.CommandClauses.File  &&标题中包含有报表的文件名称

    .Refresh

   Endif

 

   DoDefault(nStyle)  &&执行默认的Show方法行为
  Endwith
 Endproc


 Procedure Paint
  With This

   If Vartype(.oListener)="O"

    .oListener.OutputPage(.nCurrentPage,.shpPreview,2)

   Endif
   .CmdRefresh()
  Endwith


 Endproc

 *-- 按扭的可用状态
 Procedure CMDRefresh
  With This

   .oTools.cntPrev.cmdPrev.Enabled = Vartype(.oListener) = 'O' And .nCurrentPage > 1

   .oTools.cntNext.cmdNext.Enabled = Vartype(.oListener) = 'O' And  .nCurrentPage < .oListener.OutputPageCount

   .oTools.cntPrev.cmdTop.Enabled = Vartype(.oListener) = 'O' And .nCurrentPage > 1

   .oTools.cntNext.cmdBott.Enabled = Vartype(.oListener) = 'O' And .nCurrentPage < .oListener.OutputPageCount
  Endwith
 Endproc


 Procedure QueryUnload
  With This

   If Vartype(This.oListener) = 'O'

    .oListener.PreviewContainer = .Null.   &&释放对报表预览程序对象的引用

    .oListener.OnPreviewClose(.F.)  &&关闭预览

   Endif

   .oListener = .Null.

  Endwith
 Endproc

 *-- 最前页

 Procedure cmdTopClick
  With Thisform

   .nCurrentPage = 1

   .oListener.OutputPage(1, .shpPreview, 2)  &&显示第一页

   .CmdRefresh()                &&设置按钮的可用状态

   * .txtPage.Value = 1

  Endwith

 Endproc

 *-- 前一页

 Procedure cmdPrevClick
  With Thisform

   .nCurrentPage = .nCurrentPage - 1  &&当前报表页号减1

   .oListener.OutputPage(.nCurrentPage, .shpPreview, 2)  &&显示指定页

   .CmdRefresh()      &&设置按钮的可用状态

   * .txtPage.Value = .nCurrentPage

  Endwith

 Endproc

 *-- 后一页

 Procedure cmdNextClick
  With Thisform
   .nCurrentPage = .nCurrentPage + 1  &&当前报表页号减1

   .oListener.OutputPage(.nCurrentPage, .shpPreview, 2)  &&显示指定页

   .CmdRefresh()      &&设置按钮的可用状态

   *.txtPage.Value = .nCurrentPage
  Endwith
 Endproc


 *-- 最后一页

 Procedure cmdBottClick
  With Thisform

   .nCurrentPage = .oListener.OutputPageCount

   .oListener.OutputPage(.nCurrentPage, .shpPreview, 2)  &&显示最后一页

   .CmdRefresh()                &&设置按钮的可用状态

   * .txtPage.Value = .nCurrentPage

  Endwith

 Endproc

 *-- 指定页

 Procedure ActionGotoPage
  With Thisform

   .oTools.Enabled = .F.

   .oGoToPage.PageNo = .nCurrentPage
   .oGoToPage.PageTotal  = .oListener.OutputPageCount
   .oGotoPage.Show()

   If .oGoToPage.PageNo >= 1 And .oGoToPage.PageNo <= .oListener.OutputPageCount

    .nCurrentPage = .oGoToPage.PageNo

    .oListener.OutputPage(.nCurrentPage, .shpPreview, 2)

    Thisform.CMDRefresh

   Else

    =Messagebox("页号无效或已经超出了总页数",0+48,"提示")

   Endif

   .oTools.Enabled = .T.
  Endwith


 Endproc

 

 *-- 关闭按扭
 Procedure cmdCloseClick
  With Thisform
   If Vartype(.oListener) = 'O'

    .oListener.PreviewContainer = .Null.

    .oListener.OnPreviewClose(.F.)

   Endif

   .oListener = .Null.

   .Release()
  Endwith
 Endproc


 *-- 更改显示比例
 Procedure CboZooMInteractiveChange
  Lparameters vVal
  With Thisform
   If Vartype(.oListener) = "O"

    .shpPreview.Height = Int(.nPageHeight * Val(vVal) /100)

    .shpPreview.Width = Int(.nPageWidth * Val(vVal) /100)

    .oListener.OutputPage(.nCurrentPage, .shpPreview, 2)

   Endif

  Endwith


 Endproc


 *-- 打印

 Procedure Print
  With Thisform

   .oTools.Enabled = .F.
   .oPrint.PageNo = .nCurrentPage
   .oPrint.PageTotal  = .oListener.OutputPageCount
   .oPrint.Show()
   If .oPrint.PrintOk = .T.
    Do Case
      *-- 打印所有的页
     Case .oPrint.opgPrint.Value = 1  &&打印所有页
      .oListener.CommandClauses.PrintRangeFrom = 1
      .oListener.CommandClauses.PrintRangeTo = .oListener.OutputPageCount

      *-- 打印当前页

     Case .oPrint.opgPrint.Value = 2
      .oListener.CommandClauses.PrintRangeFrom =  .nCurrentPage
      .oListener.CommandClauses.PrintRangeTo  = .nCurrentPage

      *-- 打印页码范围
     Case .oPrint.opgPrint.Value = 3
      .oListener.CommandClauses.PrintRangeFrom = .oPrint.spnPageNoFrom.Value
      .oListener.CommandClauses.PrintRangeTo = .oPrint.spnPageNoTo.Value

    ENDCASE
    WAIT WINDOW [请稍候,系统正在进行打印处理......] NOWAIT
    .oListener.PreviewContainer = .Null.   &&取消对预览程序对象的引用
    .oListener.OnPreviewClose(.T.)    &&输出到打印机
    .oListener = .Null.

    .Release     &&关闭表单
   Endif
   .oTools.Enabled = .T.
   .Refresh

  Endwith

 Endproc

Enddefine

Define Class PreToolbarCommandButton As CommandButton
 Height = 22
 Width = 23
 Top = 0
 SpecialEffect = 2
 Caption=[]
Enddefine

Define Class BaseReportListener As ReportListener
 ListenerType = 1  &&设置输出模式
 OutputType = 1 &&输出类型
    DynamicLineHeight = .F.
Enddefine

Define Class ReportText As TextBox
 Top = 1
 Width = 35
Enddefine

*
Define Class CntPrevClass As PreContainert
 Add Object cmdtop As PreToolbarCommandButton With ;
  Left = 0, ;
  Picture = "prefirst.bmp", ;
  ToolTipText = [最前页], ;
  Name = "cmdTop"

 Add Object cmdPrev As PreToolbarCommandButton With ;
  Left = 23, ;
  Picture = "preprev.bmp", ;
  ToolTipText = "上一页", ;
  Name = "cmdPrev"
Enddefine

Define Class CntNextClass As PreContainert

 Add Object  cmdNext As PreToolbarCommandButton With ;
  Left = 0, ;
  Picture = "prenext.bmp", ;
  ToolTipText = "下一页", ;
  Name = "cmdNext"

 Add Object  cmdBott As PreToolbarCommandButton With ;
  Top = 0,;
  Left = 23,;
  Picture = "prelast.bmp",;
  ToolTipText = "最后页",;
  Name = "cmdBott"

Enddefine

Define Class frxpreviewtoolbar As Toolbar

 Caption = "报表预览工具条"
 Height = 28
 KeyPreview = .T.
 Left = 0
 Top = 0
 Width = 564
 ShowWindow = 1
 previewform = .Null.
 specialmousexcoord = 0
 Name = "frxpreviewtoolbar"

 Movable = .F.
 Alias=[]

 DataTool = .T.


 Add Object cntprev As CntPrevClass With ;
  Top = 3, ;
  Left = 5, ;
  Width = 46, ;
  Height = 22, ;
  BorderWidth = 0, ;
  Name = "cntPrev"


 Add Object separator1 As Separator With ;
  Top = 3, ;
  Left = 58, ;
  Height = 0, ;
  Width = 0, ;
  Name = "Separator1"


 Add Object cmdgotopage As PreToolbarCommandButton With ;
  Top = 3, ;
  Left = 58, ;
  Height = 22, ;
  Width = 100, ;
  Picture = "gotopage.bmp", ;
  Caption = " 指定页", ;
  ToolTipText = "指定页", ;
  PicturePosition = 1, ;
  Name = "cmdGoToPage"


 Add Object separator3 As Separator With ;
  Top = 3, ;
  Left = 165, ;
  Height = 0, ;
  Width = 0, ;
  Name = "Separator3"


 Add Object cntnext As CntNextClass With ;
  Top = 3, ;
  Left = 165, ;
  Width = 46, ;
  Height = 22, ;
  BorderWidth = 0, ;
  Name = "cntNext"

 Add Object separator2 As Separator With ;
  Top = 3, ;
  Left = 218, ;
  Height = 0, ;
  Width = 0, ;
  Name = "Separator2"


 Add Object cbozoom As ComboBox With ;
  Height = 22, ;
  Left = 218, ;
  Style = 2, ;
  TabStop = .F., ;
  ToolTipText = "选择页面缩放比例", ;
  Top = 3, ;
  DisplayCount = 5, ;
  RowSourceType = 1,;
  RowSource=[25,50,100,150,200,300,400,500],;
  Value= [100],;
  Name = "cboZoom"


 Add Object separator4 As Separator With ;
  Top = 3, ;
  Left = 325, ;
  Height = 0, ;
  Width = 0, ;
  Name = "Separator4"


 Add Object opgpagecount As OpgPageCountClass With ;
  ButtonCount = 3, ;
  BorderStyle = 0, ;
  Height = 22, ;
  Left = 325, ;
  Top = 3, ;
  Width = 77, ;
  Name = "opgPageCount"

 


 Add Object separator5 As Separator With ;
  Top = 3, ;
  Left = 409, ;
  Height = 0, ;
  Width = 0, ;
  Name = "Separator5"


 Add Object cmdclose As PreToolbarCommandButton With ;
  Top = 3, ;
  Left = 409, ;
  Height = 22, ;
  Width = 75, ;
  Picture = "preclose.bmp", ;
  Caption = " 关闭", ;
  ToolTipText = "关闭预览", ;
  PicturePosition = 1, ;
  Name = "cmdClose"


 Add Object cmdprint As PreToolbarCommandButton With ;
  Top = 3, ;
  Left = 484, ;
  Height = 22, ;
  Width = 75, ;
  Picture = "print.bmp", ;
  Caption = " 打印", ;
  ToolTipText = "打印报表", ;
  PicturePosition = 1, ;
  Name = "cmdPrint"

 Procedure Init
  DoDefault()

  With This
   .Dock(0)
  Endwith
 Endproc

 Procedure CboZoom.InteractiveChange
  This.Parent.CboZooMInteractiveChange(This.Value)
 Endproc

 Procedure CboZooMInteractiveChange
  Lparameters vVal
 Endproc

Enddefine
*
*-- EndDefine: frxpreviewtoolbar
**************************************************

Define Class PreContainert As Container


 Width = 200
 Height = 112
 BackStyle = 0
 Name = "PreContainert"

 


 Procedure Error
  Lparameters nError, cMethod, nLine
  This.Parent.Error( nError, cMethod, nLine )
 Endproc


 Procedure SetFocus
  Local oControl
  For Each oControl In This.Controls
   If Type("oControl.TabIndex") = "N"
    If oControl.TabIndex = 1
     If Pemstatus( m.oControl,"setFocus",5)
      oControl.SetFocus()
      Nodefault
     Endif
     Exit
    Endif
   Endif
  Endfor
 Endproc


 Procedure RightClick
  This.Parent.RightClick()
 Endproc


Enddefine

 

*-- 多页显示

Define Class OpgPageCountClass  As BaseOptiongroup

 Add Object Opt1 As BaseOptionButton With ;
  Picture = "1page.bmp", ;
  PicturePosition = 13, ;
  Caption = "", ;
  Height = 38, ;
  Left = 0, ;
  SpecialEffect = 2, ;
  Style = 1, ;
  ToolTipText = "一 页", ;
  Top = 0, ;
  Width = 32, ;
  AutoSize = .F., ;
  Name = "Opt1"

 Add Object Opt2 As BaseOptionButton With ;
  Picture = "2page.bmp", ;
  PicturePosition = 13, ;
  Caption = "", ;
  Height = 38, ;
  Left = 25, ;
  SpecialEffect = 2, ;
  Style = 1, ;
  ToolTipText = "两 页", ;
  Top = 0, ;
  Width = 32, ;
  AutoSize = .F., ;
  Name = "Opt2"

 Add Object Opt3 As BaseOptionButton With ;
  Picture = "4page.bmp", ;
  PicturePosition = 13, ;
  Caption = "", ;
  Height = 38, ;
  Left = 50, ;
  SpecialEffect = 2, ;
  Style = 1, ;
  ToolTipText = "四 页", ;
  Top = 0, ;
  Width = 32, ;
  AutoSize = .F., ;
  Name = "Opt3"


Enddefine

 

 

*-- 跳转到指定页

Define Class frxgotopageform As  Form
 WindowType = 1
 AutoCenter = .T.
 Height = 92
 Width = 345
 ShowWindow = 1
 DoCreate = .T.
 BorderStyle = 2
 Closable = .F.
 MaxButton = .F.
 MinButton = .F.

 *-- Provides the current page number for report output.
 PageNo = 0
 *-- Provides a PageTotal for report output.
 PageTotal = 0

 Name = "frxgotopageform"
 Caption = [指定页]

 Add Object shp1 As Shape With ;
  Top = 15, ;
  Left = 12, ;
  Height = 66, ;
  Width = 224, ;
  BackStyle = 0, ;
  ZOrderSet = 0, ;
  Style = 3, ;
  Name = "Shp1"


 Add Object spnpageno As BaseSpinner With ;
  Height = 21, ;
  InputMask = "9999", ;
  Left = 52, ;
  Top = 36, ;
  Width = 138, ;
  ZOrderSet = 1, ;
  Name = "spnPageno"


 Add Object lblcaption As Label With ;
  AutoSize = .T.,;
  Caption = "跳转至页", ;
  Left = 20, ;
  Top = 8, ;
  ZOrderSet = 2, ;
  Style = 3, ;
  Name = "lblCaption"


 Add Object cmdok As PreToolbarCommandButton  With ;
  Top = 16, ;
  Left = 252, ;
  Height = 23,;
  Width = 75,;
  Caption = "确  定", ;
  Default = .T., ;
  ZOrderSet = 3, ;
  Name = "cmdOK"


 Add Object cmdcancel As PreToolbarCommandButton  With ;
  Top = 49, ;
  Left = 252, ;
  Height = 23,;
  Width = 75,;
  Cancel = .T., ;
  Caption = "取  消", ;
  ZOrderSet = 4, ;
  Name = "cmdCancel"

 

 Procedure Show
  Lparameters nStyle

  This.spnPageNo.SpinnerLowValue = 1
  This.spnPageNo.SpinnerHighValue = This.PageTotal

  *THIS.spnPageNo.KeyboardLowValue = 1
  *THIS.spnPageNo.KeyboardHighValue = THIS.pageTotal

  This.spnPageNo.Value = This.PageNo

  DoDefault(nStyle)
 Endproc

 


 Procedure cmdok.Click
  This.Parent.PageNo = This.Parent.spnPageNo.Value
  This.Parent.Hide()
 Endproc


 Procedure cmdcancel.Click
  This.Parent.Hide()
 Endproc


Enddefine

*-- 打印选择页


Define Class frxPrintForm As  Form
 WindowType = 1
 AutoCenter = .T.
 Height = 155
 Width = 345
 ShowWindow = 1
 DoCreate = .T.
 BorderStyle = 2
 Closable = .F.
 MaxButton = .F.
 MinButton = .F.

 PrintOk = .F.

 *-- Provides the current page number for report output.
 PageNo = 0
 *-- Provides a PageTotal for report output.
 PageTotal = 0

 Name = "frxgotopageform"
 Caption = [打印]

 Add Object shp1 As Shape With ;
  Top = 15, ;
  Left = 12, ;
  Height = 125, ;
  Width = 224, ;
  BackStyle = 0, ;
  ZOrderSet = 0, ;
  Style = 3, ;
  Name = "Shp1"

 

 Add Object lblcaption As Label With ;
  AutoSize = .T.,;
  Caption = "页码范围", ;
  Left = 20, ;
  Top = 8, ;
  ZOrderSet = 2, ;
  Style = 3, ;
  Name = "lblCaption"

 

 Add Object opgPrint As opgPrintClass With ;
  Left =30, ;
  Top =36

 


 Add Object spnpagenoFrom As BaseSpinner With ;
  Height = 21, ;
  InputMask = "9999", ;
  Left = 30, ;
  Top = 105, ;
  Width = 80, ;
  ZOrderSet = 1, ;
  Name = "spnPagenoFrom"

 Add Object lblTo As Label With ;
  AutoSize = .T.,;
  Caption = "至", ;
  Left = 115, ;
  Top = 108, ;
  ZOrderSet = 2, ;
  Style = 3, ;
  Name = "lblNo"


 Add Object spnpagenoTo As BaseSpinner With ;
  Height = 21, ;
  InputMask = "9999", ;
  Left = 130, ;
  Top = 105, ;
  Width =  80, ;
  ZOrderSet = 1, ;
  Name = "spnPagenoTo"

 

 Add Object cmdok As PreToolbarCommandButton  With ;
  Top = 16, ;
  Left = 252, ;
  Height = 23,;
  Width = 75,;
  Caption = "打  印", ;
  Default = .T., ;
  ZOrderSet = 3, ;
  Name = "cmdOK"


 Add Object cmdcancel As PreToolbarCommandButton  With ;
  Top = 49, ;
  Left = 252, ;
  Height = 23,;
  Width = 75,;
  Cancel = .T., ;
  Caption = "取  消", ;
  ZOrderSet = 4, ;
  Name = "cmdCancel"

 

 Procedure Show
  Lparameters nStyle
  With This
  .opgPrint.value  = 1
   .spnPageNoFrom.SpinnerLowValue = 1
   .spnPageNoFrom.SpinnerHighValue = .PageTotal
   .spnPageNoFrom.Value = .PageNo
   .spnPageNoTo.SpinnerLowValue = 1
   .spnPageNoTo.SpinnerHighValue = .PageTotal
   .spnPageNoTo.Value =  .PageTotal
   .PrintOk = .F.
  Endwith
  DoDefault(nStyle)
 Endproc

 

 Procedure cmdok.Click
  * This.Parent.PageNo = This.Parent.spnPageNo.Value
  With This.Parent
   If .opgPrint.Value  = 3
    If .spnPageNoFrom.Value > .spnPageNoTo.Value
     =Messagebox("终止页号设置无效!", 48, "提示")

     Return 0
    Endif
   Endif

   .PrintOk = .T.
   .Hide()

  Endwith
 Endproc


 Procedure cmdcancel.Click
  This.Parent.Hide()
 Endproc


Enddefine

 

Define Class OpgPrintClass  As BaseOptiongroup
 BorderStyle = 0
 Value = 1
 Add Object Opt1 As BaseOptionButton With ;
  PicturePosition = 13, ;
  Caption = "全部", ;
  Left = 0, ;
  SpecialEffect = 2, ;
  ToolTipText = "打印所有页", ;
  Top = 0, ;
  AutoSize = .T., ;
  Name = "Opt1"

 Add Object Opt2 As BaseOptionButton With ;
  PicturePosition = 13, ;
  Caption = "当前页", ;
  Height = 38, ;
  Left = 0, ;
  SpecialEffect = 2, ;
  ToolTipText = "打印当前页", ;
  Top = 22,;
  AutoSize = .T., ;
  Name = "Opt2"

 Add Object Opt3 As BaseOptionButton With ;
  PicturePosition = 13, ;
  Caption = "页码范围", ;
  Left = 0, ;
  SpecialEffect = 2, ;
  ToolTipText = "请输入页码范围", ;
  Top = 44, ;
  AutoSize = .T., ;
  Name = "Opt3"


Enddefine

 

 

*-- 微调框

Define Class BaseSpinner As Spinner

 

 Height = 21
 KeyboardLowValue = 0
 SelectOnEntry = .T.
 SpinnerLowValue =   0.00
 Width = 121
 incomingvalue = 0
 Name = "spn"


 Procedure resetincoming
  This.incomingValue = This.Value
 Endproc


 Procedure LostFocus
  If This.incomingValue <> This.Value
   This.action()
  Endif
 Endproc


 Procedure UpClick
  If This.incomingValue <> This.Value
   This.action()
   This.resetIncoming()
  Endif
 Endproc


 Procedure DownClick
  If This.incomingValue <> This.Value
   This.action()
   This.resetIncoming()
  Endif
 Endproc


 Procedure Error
  Lparameters nError, cMethod, nLine
  This.Parent.Error( nError, cMethod, nLine )
 Endproc


 Procedure GotFocus
  This.resetIncoming()
 Endproc


 Procedure KeyPress
  Lparameters iKey, iModifier

  *----------------------------------
  * Do not allow nulls to be entered
  * with Ctrl-0 :
  *----------------------------------
  If m.iKey = 48 And 0 < Bitand( m.iModifier, 2 )
   Nodefault
  Endif
 Endproc


 Procedure action
 Endproc

 Procedure LostFocus
  If This.Value < This.SpinnerLowValue
   This.Value = 1
  Endif
  If This.Value > This.SpinnerHighValue
   This.Value = This.SpinnerHighValue
  Endif
  DoDefault()
 Endproc

 

Enddefine


*-- 选项按扭
Define Class BaseOptiongroup As OptionGroup

 *MemberClassLibrary = "test.prg"
 Member
 ButtonCount = 0
 BackStyle = 0
 BorderStyle = 1
 Value = 0
 Height = 66
 Width = 117
 Name = "opg"

 *-- Specifies if the user can edit a control, or specifies if a table or view associated with a Cursor object allows updates.
 ReadOnly = .F.


 Procedure enabled_assign
  Lparameter lEnabled

  For Each optbut In This.Buttons
   optbut.Enabled = m.lEnabled
  Endfor
 Endproc


 Procedure readonly_assign
  Lparameter lReadOnly
  *
  * Returning .F. in each button's .When() produces
  * a more visually acceptable effect:
  *
  *for each optbut in this.Buttons
  * optbut.Enabled = not m.lReadOnly
  *endfor

  This.ReadOnly = m.lReadOnly
 Endproc


 *-- Sets the focus to a control.
 Procedure SetFocus
  *----------------------------------------------------
  * SetFocus() in containers doesn't work so well. This
  * compensates for that bug by doing it manually:
  *----------------------------------------------------
  Local oControl
  For Each oControl In This.Buttons
   If oControl.TabIndex = 1
    oControl.SetFocus()
    Nodefault
    Exit
   Endif
  Endfor
 Endproc


 Procedure RightClick
  This.Parent.RightClick()
 Endproc


 Procedure Error
  Lparameters nError, cMethod, nLine
  This.Parent.Error( nError, cMethod, nLine )
 Endproc


Enddefine

 

*-- 选项组
Define Class BaseOptionbutton As OptionButton

 Caption = "prompt"
 Height = 15
 Width = 52
 AutoSize = .T.
 Name = "opt"


 Procedure Error
  Lparameters nError, cMethod, nLine
  This.Parent.Error( nError, cMethod, nLine )
 Endproc


 Procedure When
  If This.Parent.ReadOnly
   Return .F.
  Else
   Return .T.
  Endif
 Endproc


 Procedure KeyPress
  Lparameters iKey, iModifier

  *----------------------------------
  * Do not allow nulls to be entered
  * with Ctrl-0 :
  *----------------------------------
  If m.iKey = 48 And 0 < Bitand( m.iModifier, 2 )
   Nodefault
  Endif
 Endproc

Enddefine


**************************************************************************************************

*

*

**************************************************************************************************

*-- 程序名称:RptPrint.prg
*-- 程序功能:以自定义的对话框显示报表的打印设置,以取代系统打印设置的一些不足
*-- 使用方法:RptPrint ( [<cReportName>] )
*  或者:do RptPrint [ with <cReportName> ]
*-- 程序说明:cReportName 为 报表文件名(无须带扩展名),如果省略的话,则可显示设置对话框
*     报表的扩展名以 frx 为准
*-- 原创作者:红虎
*-- 联系方式:E-mail: hu_feng@163.net
*     HomePage: http://rts.coolbel.com
*     Oicq: 1569040
*-- 编写日期:2001年1月


Func RptPrint
para rptname

*-- 创建打印设置对话框
oPrintSetup=createobject("printsetup")
oPrintSetup.show

*-- 定义打印设置对话框
DEFINE CLASS printsetup AS form
 Top = 11
 Left = 115
 Height = 270
 Width = 531
 Desktop = .T.
 DoCreate = .T.
 Caption = "报表打印设置"
 Name = "PRINTSETUP"
 *-- 新增属性
 nxcoord = 0  && 可以使点击对话框就可以拖动的坐标
 nycoord = 0
 rptname = "" && 报表的文件名

 ADD OBJECT shape1 AS shape WITH ;
  Top = 12, ;
  Left = 12, ;
  Height = 144, ;
  Width = 504, ;
  Enabled = .F., ;
  SpecialEffect = 0, ;
  Name = "Shape1"


 ADD OBJECT label1 AS label WITH ;
  AutoSize = .T., ;
  Caption = "打印机", ;
  Height = 16, ;
  Left = 22, ;
  Top = 9, ;
  Width = 38, ;
  Name = "Label1"

 *-- 存放目前安装的打印机的名称列表
 ADD OBJECT printerlist AS combobox WITH ;
  Alignment = 0, ;
  Height = 22, ;
  Left = 112, ;
  Style = 2, ;
  Top = 33, ;
  Width = 260, ;
  Name = "PrinterList"


 ADD OBJECT label2 AS label WITH ;
  AutoSize = .T., ;
  Caption = "打印机名(\<N):", ;
  Height = 16, ;
  Left = 24, ;
  Top = 36, ;
  Width = 86, ;
  Name = "Label2"


 ADD OBJECT label3 AS label WITH ;
  AutoSize = .T., ;
  Caption = "状态:", ;
  Height = 16, ;
  Left = 24, ;
  Top = 60, ;
  Width = 38, ;
  Name = "Label3"


 ADD OBJECT label4 AS label WITH ;
  AutoSize = .T., ;
  Caption = "类型:", ;
  Height = 16, ;
  Left = 24, ;
  Top = 84, ;
  Width = 38, ;
  Name = "Label4"


 ADD OBJECT label5 AS label WITH ;
  AutoSize = .T., ;
  Caption = "位置:", ;
  Height = 16, ;
  Left = 24, ;
  Top = 108, ;
  Width = 38, ;
  Name = "Label5"


 ADD OBJECT label6 AS label WITH ;
  AutoSize = .T., ;
  Caption = "纸张:", ;
  Height = 16, ;
  Left = 24, ;
  Top = 132, ;
  Width = 38, ;
  Name = "Label6"

 *-- 显示打印机的位置的标签
 ADD OBJECT printerlocation AS label WITH ;
  AutoSize = .T., ;
  Caption = "PrinterLocation", ;
  Height = 16, ;
  Left = 112, ;
  Top = 108, ;
  Width = 92, ;
  Name = "PrinterLocation"


 ADD OBJECT cmdok AS commandbutton WITH ;
  Top = 178, ;
  Left = 442, ;
  Height = 25, ;
  Width = 66, ;
  Caption = "确定", ;
  Default = .T., ;
  Name = "cmdOk"

 *-- 打印机状态标签
 ADD OBJECT printerstatus AS label WITH ;
  AutoSize = .T., ;
  Caption = "PrinterStatus", ;
  Height = 16, ;
  Left = 112, ;
  Top = 60, ;
  Width = 80, ;
  Name = "PrinterStatus"


 ADD OBJECT command1 AS commandbutton WITH ;
  Top = 226, ;
  Left = 442, ;
  Height = 25, ;
  Width = 66, ;
  Cancel = .T., ;
  Caption = "取消", ;
  Name = "Command1"


 ADD OBJECT shape5 AS shape WITH ;
  Top = 171, ;
  Left = 14, ;
  Height = 84, ;
  Width = 252, ;
  Enabled = .F., ;
  SpecialEffect = 0, ;
  Name = "Shape5"


 ADD OBJECT label11 AS label WITH ;
  AutoSize = .T., ;
  Caption = "打印范围", ;
  Height = 16, ;
  Left = 24, ;
  Top = 168, ;
  Width = 50, ;
  Name = "Label11"


 ADD OBJECT shape6 AS shape WITH ;
  Top = 170, ;
  Left = 276, ;
  Height = 84, ;
  Width = 143, ;
  Enabled = .F., ;
  SpecialEffect = 0, ;
  Name = "Shape6"


 ADD OBJECT label12 AS label WITH ;
  AutoSize = .T., ;
  Caption = "份数", ;
  Height = 16, ;
  Left = 286, ;
  Top = 167, ;
  Width = 26, ;
  Name = "Label12"

 *-- 打印范围选择
 ADD OBJECT optiongroup2 AS optiongroup WITH ;
  AutoSize = .F., ;
  ButtonCount = 3, ;
  BackStyle = 0, ;
  BorderStyle = 0, ;
  Value = 1, ;
  Enabled = .T., ;
  Height = 62, ;
  Left = 25, ;
  Top = 184, ;
  Width = 236, ;
  Name = "Optiongroup2", ;
  Option1.Caption = "全部(\<A)", ;
  Option1.Value = 1, ;
  Option1.Height = 16, ;
  Option1.Left = 5, ;
  Option1.Style = 0, ;
  Option1.Top = 5, ;
  Option1.Width = 69, ;
  Option1.AutoSize = .T., ;
  Option1.Name = "Option1", ;
  Option2.Caption = "当前页(\<E)", ;
  Option2.Height = 16, ;
  Option2.Left = 82, ;
  Option2.Style = 0, ;
  Option2.Top = 5, ;
  Option2.Width = 81, ;
  Option2.AutoSize = .T., ;
  Option2.Name = "Option2", ;
  Option3.Caption = "页码(\<G)", ;
  Option3.Height = 16, ;
  Option3.Left = 5, ;
  Option3.Style = 0, ;
  Option3.Top = 34, ;
  Option3.Width = 69, ;
  Option3.AutoSize = .T., ;
  Option3.Name = "Option3"

 *-- 打印起始页
 ADD OBJECT pbpage AS textbox WITH ;
  Alignment = 3, ;
  Value = 1, ;
  Enabled = .F., ;
  Height = 20, ;
  InputMask = "9999", ;
  Left = 120, ;
  SelectOnEntry = .T., ;
  Top = 219, ;
  Width = 49, ;
  Name = "pbpage"

 *-- 打印分数
 ADD OBJECT copy AS spinner WITH ;
  Height = 20, ;
  KeyboardLowValue = 1, ;
  Left = 338, ;
  SpinnerLowValue =   1.00, ;
  Top = 192, ;
  Width = 72, ;
  Value = 1, ;
  Name = "copy"

 *-- 是否逐份打印,还是逐页
 ADD OBJECT check1 AS checkbox WITH ;
  Top = 229, ;
  Left = 338, ;
  Height = 16, ;
  Width = 69, ;
  AutoSize = .T., ;
  Caption = "逐份打印", ;
  Value = .T., ;
  Name = "Check1"


 ADD OBJECT label14 AS label WITH ;
  AutoSize = .T., ;
  Caption = "份数(\<C)", ;
  Height = 16, ;
  Left = 288, ;
  Top = 194, ;
  Width = 50, ;
  Name = "Label14"

 *-- 结束页数
 ADD OBJECT pepage AS textbox WITH ;
  Alignment = 3, ;
  Value = _pepage, ;
  Enabled = .F., ;
  Height = 20, ;
  InputMask = "9999", ;
  Left = 196, ;
  SelectOnEntry = .T., ;
  Top = 219, ;
  Width = 49, ;
  Name = "pepage"


 ADD OBJECT label15 AS label WITH ;
  AutoSize = .T., ;
  Caption = "从", ;
  Height = 16, ;
  Left = 104, ;
  Top = 221, ;
  Width = 14, ;
  Name = "Label15"


 ADD OBJECT label16 AS label WITH ;
  AutoSize = .T., ;
  Caption = "到", ;
  Height = 16, ;
  Left = 178, ;
  Top = 221, ;
  Width = 14, ;
  Name = "Label16"


 ADD OBJECT command2 AS commandbutton WITH ;
  Top = 33, ;
  Left = 388, ;
  Height = 25, ;
  Width = 109, ;
  Caption = "打印机设置(\<S)...", ;
  Name = "Command2"

 *-- 纸张类型及方向
 ADD OBJECT papertype AS label WITH ;
  AutoSize = .T., ;
  Caption = "PaperType", ;
  Height = 16, ;
  Left = 112, ;
  Top = 132, ;
  Width = 56, ;
  Name = "PaperType"

 *-- 当前页号
 ADD OBJECT pageno AS textbox WITH ;
  Alignment = 3, ;
  Value = 9999, ;
  Enabled = .F., ;
  Height = 20, ;
  InputMask = "9999", ;
  Left = 196, ;
  SelectOnEntry = .T., ;
  Top = 190, ;
  Width = 49, ;
  Name = "pageno"

 PROCEDURE getprinterinfo
  *-- 获取打印机信息
  * 并存放到数组 paPrinter 中
  * pnPrinterNo 用来存放打印机的个数
  thisform.PrinterLocation.caption = paPrinter(pnPrinterNo,2)
  *-- 打印机状态
  thisform.PrinterStatus.caption  = sys(13)
 ENDPROC


 PROCEDURE getpaper
  *-- 通过 RPTINFO() 函数来获得打印机的纸张设置类型及方向
  dime paper_list(41)
  paper_list(1) = "Letter, 8 1/2 x 11 in"
  paper_list(2) = "Letter Small, 8 1/2 x 11 in"
  paper_list(3) = "Tabloid, 11 x 17 in"
  paper_list(4) = "Ledger, 17 x 11 in"
  paper_list(5) = "Legal, 8 1/2 x 14 in"
  paper_list(6) = "Statement, 5 1/2 x 8 1/2 in"
  paper_list(7) = "Executive, 7 1/4 x 10 1/2 in"
  paper_list(8) = "A3, 297 x 420 mm"
  paper_list(9) = "A4, 210 x 297 mm"
  paper_list(10) = "A4, Small  210 x 297 mm"
  paper_list(11) = "A5, 148 x 210 mm"
  paper_list(12) = "B4, 250 x 354 mm"
  paper_list(13) = "B5, 182 x 257 mm"
  paper_list(14) = "Folio, 8 1/2 x 13 in"
  paper_list(15) = "Quarto, 215 x 275 mm"
  paper_list(16) = "10 x 14 in"
  paper_list(17) = "11 x 17 in"
  paper_list(18) = "Note, 8 1/2 x 11 in"
  paper_list(19) = "Envelope #9, 3 7/8 x 8 7/8 in"
  paper_list(20) = "Envelope #10, 4 1/8 x 9 1/2 in"
  paper_list(21) = "Envelope #11, 4 1/2 x 10 3/8 in"
  paper_list(22) = "Envelope #12, 4 1/2 x 11 in"
  paper_list(23) = "Envelope #14, 5 x 11 1/2 in"
  paper_list(24) = "C size sheet"
  paper_list(25) = "D size sheet"
  paper_list(26) = "E size sheet"
  paper_list(27) = "Envelope DL, 110 x 220 mm"
  paper_list(28) = "Envelope C5, 162 x 229 mm"
  paper_list(29) = "Envelope C3, 324 x 458 mm"
  paper_list(30) = "Envelope C4, 229 x 324 mm"
  paper_list(31) = "Envelope C6, 114 x 162 mm"
  paper_list(32) = "Envelope C65, 114 x 229 mm"
  paper_list(33) = "Envelope B4, 250 x 353 mm"
  paper_list(34) = "Envelope B5, 176 x 250 mm"
  paper_list(35) = "Envelope B6, 176 x 125 mm"
  paper_list(36) = "Envelope, 110 x 230 mm"
  paper_list(37) = "Envelope Monarch, 3 7/8 x 7.5 in"
  paper_list(38) = "6 3/4 Envelope, 3 5/8 x 6 1/2 in"
  paper_list(39) = "US Std Fanfold, 14 7/8 x 11 in"
  paper_list(40) = "German Std Fanfold, 8 1/2 x 12 in"
  paper_list(41) = "German Legal Fanfold, 8 1/2 x 13 in "

  RETU PAPER_LIST(prtinfo(2)) + "," + iif(prtinfo(1)=0,"纵向","横向")
 ENDPROC

 PROCEDURE MouseMove
  *-- 用鼠标拖动表单的移动
      Lparameters nButton, nShift, nxcoord, nycoord
      With Thisform
          if mdown() and nButton = 1
              .top = (nycoord - this.nycoord) + .top + 1
              .left = (nxcoord - this.nxcoord) + .left + 1
          endif
      Endwith
 ENDPROC

 PROCEDURE MouseDown
  *-- 当鼠标在表单上按下时,记下表单的坐标位置
      Lparameters nButton, nShift, nxcoord, nycoord
      This.nxcoord = nxcoord
      This.nycoord = nycoord
 ENDPROC

 PROCEDURE Init
 *-- 表单初始化 ...
  With thisform
   .rptname = rptname
   .MinButton = .F.
   .MaxButton = .F.
   .Borderstyle= 2
   .WindowType = 1
   .AutoCenter = .T.
   .pageno.value = _pageno
  Endwith
  if type("paPrinter") =  "U" or type("pnPrinterNo") # "N"
   public paPrinter(1,2),pnPrinterNo
   pnPrinterNo = 1
  endif
   *-- 获取打印机信息,并存入数组中
   nPrinterNum = APRINTERS(paPrinter)

  With ThisForm.PrinterList
  if nPrinterNum = 0
   .value = "没有安装打印机"
  else
   .clear
   For n = 1 to nPrinterNum
    .additem(paPrinter(n,1))
   Endfor
   .listindex = pnPrinterNo
  endif
  Endwith
  *-- 获取打印机的信息
  thisform.GetPrinterInfo()
  *-- 获取纸张及方向
  thisform.papertype.caption = thisform.getpaper()
 ENDPROC

 *-- 改变打印机列表的事件
 PROCEDURE printerlist.InteractiveChange
  pnPrinterNo = this.listindex
  cCurPrinter = thisform.PrinterList.value
  set printer to name "&cCurPrinter"
  *-- 重新获取打印机的信息及大小和方向
  thisform.GetPrinterInfo
  thisform.papertype.caption = thisform.GetPaper()
 ENDPROC


 PROCEDURE cmdok.Click
  *-- 设置打印机
  cCurPrinter = thisform.PrinterList.value
  set printer to name "&cCurPrinter"
  pnPrinterNo = thisform.PrinterList.listindex

  *-- 获得打印范围
     pbpage = 1
     pepage = _pepage
  With ThisForm.Optiongroup2
   do case
    case .value = 1
     pbpage = 1
     pepage = _pepage
    case .value = 2
     pbpage = _pageno
     pepage = _pageno
    case .value = 3
     pbpage = ThisForm.pbpage.value
     pepage = ThisForm.pepage.value
     if pbpage > pepage or pbpage > _pepage or pbpage <= 0
      messagebox("页码设置错误!",48,"警告")
      thisform.pbpage.setfocus
      retu
     endif
   endcase
  Endwith
 
  RptName = thisform.rptname
  if !empty(rptname)
  nCopy = thisform.copy.value
  isOneByOne = thisform.check1.value
   if isOneByOne  && 逐份打印
    for n=1 to nCopy
     wait windo "正在输出打印 ..." + allt(str(n)) + "/" + allt(str(nCopy)) + "按 ESC 取消!" nowait
     if inkey(1) = 27
       exit
     endif
     report form "&RptName" nocon noeject range pbpage,pepage to print
    endfor
   else
    nMax = (pepage-pbpage)*nCopy
    i = 1
    for n=pbpage to pepage && 逐页打印
     for m=1 to nCopy
      wait window "正在输出打印 ..." + allt(str(i)) + "/" + allt(str(nMax)) + "按 ESC 取消!" nowait
      report form "&RptName" nocon noeject range n,n to print
      i = i + 1
      if inkey(1) = 27
       i = 0
        exit
      endif
     endfor
      if i=0
       exit
      endif
    endfor
   endif
  endif
  thisform.release
 ENDPROC


 PROCEDURE command1.Click
  thisform.release
 ENDPROC


 PROCEDURE optiongroup2.InteractiveChange
  ThisForm.pbpage.enabled = IIF(this.value = 3,.T.,.F.)
  ThisForm.pepage.enabled = ThisForm.pbpage.enabled
  thisform.pbpage.setfocus
 ENDPROC


 PROCEDURE command2.Click
  =sys(1037)

  thisform.GetPrinterInfo
  thisform.papertype.caption = thisform.GetPaper()
 ENDPROC


ENDDEFINE
*
*-- 结束定义: printsetup
**************************************************

 

  评论这张
 
阅读(482)| 评论(0)
推荐 转载

历史上的今天

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017