其他数据库

开发平台：
VFP

msgbox.prg：源码内容
							*---------------------------------------------------------------------
procedure MSGBOX
          parameters Msg, Buttons, Wtitle, Dummy1, Dummy2
   * VFP version
* Parameters:  Msg      Multi-line display string
*              Buttons    0 = Ok           (default if omitted)
*                         1 = Ok, Cancel
*                         2 = Abort, Retry, Ignore
*                         3 = Yes, No, Cancel
*                         4 = Yes, No
*                         5 = Retry, Cancel
*                       optional: string with custom buttons
*              Wtitle   optional window title
*              Dummy1 & Dummy2 - obsolete, no longer used
* Returns action number
* Example usage:
* Action = MsgBox("Location is not on file.+chr(13)+"Do you wish to add it?", 4)
* Action = MsgBox("Are you sure you want to quit?", "!<Yes;?<Maybe", 5)
* 10/18/01 - Get rid of DOS window, use a screen form for custom buttons. DC
*        NB: Custom buttons aren't used often, so the auto-sizing has
*             not been finely tuned - not worth the expense.  It works!
*            Delete color scheme and default action parameters.
* 02/15/01 - "Local all" doesn't work, fix local declarations
* 01/10/01 - De-select current dbf to avoid conflicts with field names
* 12/13/00 - Add CR to force Windows wrapping at a reasonable width.
*            Delete prevision for centered lines delimited by ';'.
*            Multiple lines now must be separated by chr(13).
* 12/23/99 - VFP: use system MessageBox if no special buttons.
* 11/08/95 - provide for automatic wordwrap if no ';' in Msg
* 11/95 - Windows-compatible button sets copied from FoxTools by D.Covill
*         Reference FoxPro Developers Journal, November 1995, Page 9
* Original "ALERT" by Steve Ramsower
*----------------------------------------
set talk off
local OldSel
OldSel = select()            && 01/10/01
select 0				&& so we don't pick up data fields by mistake
*-- Msg is the only required parameter
if parameters() < 3
   Wtitle = ''
endif
if parameters() < 2
   Buttons = 0
endif
if empty(Wtitle)
   Wtitle = 'Note:'
endif
if vartype(Buttons) = 'N'
   *--We can use the Windows messagebox
   local iButtons, iResult, cTitle
	*-- if just an Ok, then use Info icon, otherwise use Question
	iButtons = iif(Buttons = 0, 64, Buttons + 32)
	cTitle = Wtitle
   *-- Fix the Msg so it doesn't come out as one long line!
   *-- (Windows doesn't wrap it until it gets about 100 chars long)
   iResult = MessageBox(MsgBox2(Msg), iButtons, cTitle)
   *-- now map the result codes back to our (positional) system
   do case
   case iResult = 0          && Escape
      *-- the same
   case Buttons = 1         && Ok=1, Cancel=2
      *-- leave it alone
   case Buttons = 2         && Abort=3, Retry=4, Ignore=5
      iResult = iResult - 2
   case Buttons = 3         && Yes=6, No=7, Cancel=2
      do case
      case iResult = 6
         iResult = 1
      case iResult = 7
         iResult = 2
      case iResult = 2
         iResult = 3
      endcase
   case Buttons = 4         && Yes=6, No=7
      iResult = iResult - 5
   case Buttons = 5         && Retry=4, Cancel=2
      iResult = iif(iResult=4, 1, 2)
   endcase
   select (OldSel)			&& 01/10/01
   return m.iResult
endif
   *-- Custom buttons, have to create our own messagebox
*-- Break message into lines
local MaxLen, NumLines, MsgArray, Center
m.MaxLen = 0                 && maximum line length
OldMemo = set("memowidth")
   *-- calculate a reasonable breakdown of lines
   set memowidth to 30
   NumLines = memlines(Msg)
   if NumLines > 5
     set memowidth to 40
     NumLines = memlines(Msg)
   endif
   if NumLines > 10
      set memowidth to 50
      NumLines = memlines(Msg)
   endif
   if NumLines > 20
      set memowidth to 80
      NumLines = memlines(Msg)
   endif
   for I = 1 to NumLines
      MaxLen = max(MaxLen, len(mline(Msg, I)))
   endfor
*-- now stuff CR on end of each line
T2 = ''
for L = 1 to memlines(Msg)
   T2 = T2 + mline(Msg, L) + chr(13)
endfor
Msg = left(T2, len(T2)-1)   && strip off last chr(13)
*-- and reset the memowidth
set memowidth to (OldMemo)
Center = iif(NumLines = 1, .T., .F.)
*-- Create the form and set the editbox size
oBox = createobject("frmMessageBox")
with oBox
   *-- Size the form and the edit box
   .edtMessage.Width = m.MaxLen * 8
   .edtMessage.Height = m.NumLines * 18
   .Width = .edtMessage.Width + 24
   .Height = .edtMessage.Height + 50
   .Caption = Wtitle
   .cMessage = Msg               && the message text
endwith
*-- Parse buttons and calculate longest
if empty(Buttons)
   NumBtns = 1
   Buttons = "OK"
else
   NumBtns  = occurs(';',Buttons) + 1    && number of buttons
endif
dimension aButtons[m.NumBtns]
Remain = Buttons
MaxWidth = 0
for I = 1 to m.NumBtns
   Break = at(';', m.Remain)
   if m.Break > 0
      aButtons[I] = left(m.Remain, m.Break - 1)
      m.Remain = substr(m.Remain, m.Break + 1)
   else
      aButtons[I] = m.Remain
   endif
   *-- get length of buttons without escape chars
   Temp = strtran(aButtons[I], '', '')
   Temp = strtran(Temp, '<', '')
   MaxWidth = max(MaxWidth, len(Temp))
endfor
BtnWidth = MaxWidth * 9  + 10     && Pixels
BtnWidth = max(BtnWidth, 40)      && Don't make 'em too small
Gap = 10
BtnTotal = BtnWidth * NumBtns + Gap * (NumBtns-1)
if BtnTotal > oBox.Width
   with oBox
      .Width = BtnTotal
      .edtMessage.Width = BtnTotal - 24
   endwith
endif
* do MsgBox in VLIB with ;
  + "NumLines = "+str(NumLines,3)+chr(13);
  + "Longest = "+str(MaxLen,3)+chr(13);
  + "NumBtns = "+str(NumBtns,2)+chr(13);
  + "BtnWidth = "+str(BtnWidth,3)+chr(13);
  + ""
*-- Now put the buttons on the form
*-- And delete the ones not used
with oBox
   *-- Calculate the gap between buttons
   Bleft = (.Width - BtnTotal) / 2
   for I = 1 to NumBtns
      CmdName = "Command"+str(I,1)
      *-- Pass the button number as a parameter
      *-- On click, the button will set Action to this number
      with oBox.&CmdName
         .Top = oBox.Height - 28
         .Left = Bleft
         .Width = BtnWidth
         .Caption = aButtons[I]
         .Visible = .T.
      endwith
      Bleft = Bleft + BtnWidth + Gap
   endfor
   *-- delete the ones we didn't use
   for J = NumBtns+1 to 5
      CmdName = "Command"+str(J,1)
      .RemoveObject(CmdName)
   endfor
endwith
* do ERRTRAP in VLIB with lineno(), "MSGBOX:"
* set step on
*-- Display the window
Action = 0                   && default
oBox.Show()                  && Sets Action on exit
select (m.OldSel)
return m.Action
*---------------------------------------------------------------------
DEFINE CLASS frmMessageBox AS form
* 10/18/01 - New form by D.Covill
   AutoCenter = .T.
	Top = 0
	Left = 0
	Height = 242
	Width = 375
	DoCreate = .T.
	Caption = "Note:"
	WindowType = 1            && modal
   MaxButton = .F.
   MinButton = .F.
   cMessage = ' '            && the message itself
	Name = "frmMessageBox"
	ADD OBJECT edtmessage AS editbox WITH ;
		BackStyle = 0, ;       && transparent
		BorderStyle = 0, ;     && none
      ControlSource = "thisform.cMessage", ;
		Height = 192, ;
		Left = 24, ;           && leave margin at left
		FontSize = 11, ;
		ReadOnly = .T., ;
		ScrollBars = 0, ;      && none
		TabIndex = 6, ;
		Top = 12, ;
		Width = 348, ;
		Name = "edtMessage"
   *-- Up to 5 command buttons, we'll remove the ones not used
   *-- (Code turns out to be easier than adding new ones.)
	ADD OBJECT command1 AS commandbutton WITH ;
		Top = 216, ;
		Left = 12, ;
		Height = 28, ;
		Width = 60, ;
		FontSize = 10, ;
		Caption = "Cmd1", ;    && will be set by caller
		TabIndex = 1, ;
		Name = "Command1"
	ADD OBJECT command2 AS commandbutton WITH ;
		Top = 216, ;
		Left = 84, ;
		Height = 28, ;
		Width = 60, ;
		FontSize = 10, ;
		Caption = "cmd1", ;
		TabIndex = 2, ;
		Name = "Command2"
	ADD OBJECT command3 AS commandbutton WITH ;
		Top = 216, ;
		Left = 156, ;
		Height = 28, ;
		Width = 60, ;
		FontSize = 10, ;
		Caption = "cmd3", ;
		TabIndex = 3, ;
		Name = "Command3"
	ADD OBJECT command4 AS commandbutton WITH ;
		Top = 216, ;
		Left = 228, ;
		Height = 28, ;
		Width = 60, ;
		FontSize = 10, ;
		Caption = "cmd4", ;
		TabIndex = 4, ;
		Name = "Command4"
	ADD OBJECT command5 AS commandbutton WITH ;
		Top = 216, ;
		Left = 300, ;
		Height = 25, ;
		Width = 60, ;
		Caption = "cmd5", ;
		TabIndex = 5, ;
		Name = "Command5"
   *-- Buttons set the Action memvar, then exit
	PROCEDURE command1.Click
		m.Action = 1
		thisform.Release()
	ENDPROC
	PROCEDURE command2.Click
		m.Action = 2
		thisform.Release()
	ENDPROC
	PROCEDURE command3.Click
		m.Action = 3
		thisform.Release()
	ENDPROC
	PROCEDURE command4.Click
		m.Action = 4
		thisform.Release()
	ENDPROC
	PROCEDURE command5.Click
		m.Action = 5
		thisform.Release()
	ENDPROC
ENDDEFINE
*---------------------------------------------------------------------
procedure MsgBox2
          lparameters Tx      && Text of message
   * Break message into multiple lines so it looks more reasonable
* Windows MessageBox() doesn't wrap the lines until they get nearly
* the entire width of the screen.  We'll insert CR characters at
* reasonable points so the box is more of a rectangle.
* 01/10/01 - Add "m.", remove potential conflict with field names
local OldMemo, T2, L
OldMemo = set("memowidth")
*-- Keep the width small until the number of lines gets too large
set memowidth to 40
if memlines(Tx) > 5
   set memowidth to 50
endif
if memlines(Tx) > 12
   set memowidth to 80
endif
*-- now stuff CR on end of each line
T2 = ''
for L = 1 to memlines(Tx)
   T2 = T2 + mline(Tx, L) + chr(13)
endfor
T2 = left(T2, len(T2)-1)   && strip off last chr(13)
*-- and reset the memowidth
set memowidth to (OldMemo)
return T2
*---------------------------------------------------------------------

						