disp.prg

包括了6个VFP程序设计实例

                        m.RBRColor = 0
                        m.RBGColor = 255
                        m.RBBColor = 255

		CASE ShadowColor = 6    && 兰色   
		          m.LTRColor = 0
		          m.LTGColor = 0
		          m.LTBColor = 128
                        m.RBRColor = 0
                        m.RBGColor = 0
                        m.RBBColor = 255

		CASE ShadowColor = 7    && 橙色   
		          m.LTRColor = 128
		          m.LTGColor = 0
		          m.LTBColor = 128
                        m.RBRColor = 255
                        m.RBGColor = 0
                        m.RBBColor = 255
        ENDCASE
        	
	ELSE  && style == 1
          DO CASE        
		CASE ShadowColor = 0    && 灰色   
		          m.LTRColor = 255
		          m.LTGColor = 255
		          m.LTBColor = 255
                        m.RBRColor = 128
                        m.RBGColor = 128
                        m.RBBColor = 128
                        
		CASE ShadowColor = 1    && 黑色   
		          m.LTRColor = 255
		          m.LTGColor = 255
		          m.LTBColor = 255
                        m.RBRColor = 0
                        m.RBGColor = 0
                        m.RBBColor = 0
                        
		CASE ShadowColor = 2    && 红色   
		          m.LTRColor = 255
		          m.LTGColor = 0
		          m.LTBColor = 0
                        m.RBRColor = 128
                        m.RBGColor = 0
                        m.RBBColor = 0

		CASE ShadowColor = 3    && 黄色   
		          m.LTRColor = 255
		          m.LTGColor = 255
		          m.LTBColor = 0
                        m.RBRColor = 128
                        m.RBGColor = 128
                        m.RBBColor = 0

		CASE ShadowColor = 4    && 绿色   
		          m.LTRColor = 0
		          m.LTGColor = 255
		          m.LTBColor = 0
                        m.RBRColor = 0
                        m.RBGColor = 128
                        m.RBBColor = 0

		CASE ShadowColor = 5    && 青色   
		          m.LTRColor = 0
		          m.LTGColor = 255
		          m.LTBColor = 255
                        m.RBRColor = 0
                        m.RBGColor = 128
                        m.RBBColor = 128

		CASE ShadowColor = 6    && 兰色   
		          m.LTRColor = 0
		          m.LTGColor = 0
		          m.LTBColor = 255
                        m.RBRColor = 0
                        m.RBGColor = 0
                        m.RBBColor = 128

		CASE ShadowColor = 7    && 橙色   
		          m.LTRColor = 255
		          m.LTGColor = 0
		          m.LTBColor = 255
                        m.RBRColor = 128
                        m.RBGColor = 0
                        m.RBBColor = 128
        ENDCASE
        
   ENDIF
         
   FOR m.i = 1  TO m.BorderWidth STEP 1
           @ m.top + (m.i - 1) * VDist, m.left + (m.i - 1) * HDist  TO  m.top + (m.i - 1) * VDist, m.right - (m.i - 1) * HDist;
               PEN 1, 8  STYLE "1"  COLOR RGB(m.LTRColor,m.LTGColor,m.LTBColor,,,)   
           @ m.top + (m.i - 1) * VDist, m.left + (m.i - 1) * HDist  TO  m.bottom - (m.i - 1) * VDist, m.left + (m.i - 1) * HDist;
               PEN 1, 8  STYLE "1"  COLOR RGB(m.LTRColor,m.LTGColor,m.LTBColor,,,)   
           @ m.top + (m.i - 1) * VDist, m.right - (m.i - 1) * HDist  TO  m.bottom - (m.i - 1) * VDist, m.right - (m.i - 1) * HDist;
               PEN 1, 8  STYLE "1"  COLOR RGB(m.RBRColor,m.RBGColor,m.RBBColor,,,)   
           @ m.bottom - (m.i - 1) * VDist, m.left + (m.i - 1) * HDist  TO  m.bottom - (m.i - 1) * VDist, m.right - (m.i - 2) * HDist;
               PEN 1, 8  STYLE "1"  COLOR RGB(m.RBRColor,m.RBGColor,m.RBBColor,,,)   
   ENDFOR   
   
   IF m.outline
       @  m.top - m.VDist , m.left - m.HDist  TO  m.bottom + m.VDist, m.right + m.HDist  PEN 1, 8  COLOR RGB(0,0,0,,,,)
   ENDIF

RETURN

********************************************************
*
*        过    程：Draw3DFrame
*
*        功    能：画三维框
*
*        参    数：top, left -- 左上角坐标
*                       bottom, right -- 右下角坐标
*                       style -- 风格(0或1)
*                       BorderWidth -- 边线宽度
*                       BackRColor -- 背景色
*                       BackGColor -- 背景色
*                       BackBColor -- 背景色
*                       ShadowColor -- 边框阴影颜色(0 -- 灰色, 1 -- 黑色)
*
********************************************************
PROCEDURE Draw3DFrame
PARAMETER  top, left, bottom, right, style, BorderWidth, BackRColor, BackGColor, ;
                        BackBColor, ShadowColor

   PRIVATE ALL

   m.HDist = 1 / WinFontWidth()
   m.VDist = 1 / WinFontHeight()

   IF (m.top + 2 * m.BorderWidth * m.VDist > m.Bottom) OR (m.left + 2 * m.BorderWidth * m.HDist > m.right)
        RETURN
   ENDIF       
   
   m.OutsideStyle = 0
   m.InsideStyle = 0
   
   IF (m.style = 0)
    	m.OutsideStyle = 0
    	m.InsideStyle = 1
   ELSE
    	m.OutsideStyle = 1
    	m.InsideStyle = 0
   ENDIF	
                  
  DO Draw3DPanel WITH m.top, m.left, m.bottom, m.right, m.OutsideStyle, 1, ;
                                           m.BackRColor, m.BackGColor, m.BackBColor, m.ShadowColor, .F.

  IF (BorderWidth > 1)
       DO Draw3DPanel WITH top + (BorderWidth - 1) * VDist, left + (BorderWidth - 1) * HDist,;
              bottom  - (BorderWidth - 1) * VDist, right  - (BorderWidth - 1) * HDist, InsideStyle,;
              1,  m.BackRColor, m.BackGColor, m.BackBColor, m.ShadowColor, .F.
  ENDIF

RETURN

******************************************************************
*
*        函    数：WinFontWidth
*
*        功    能：计算窗口的字体宽度
*
*        参    数：无
*
*        返回值:   窗口字体的宽度
*
******************************************************************
FUNCTION  WinFontWidth

     PRIVATE FontName, FontSize, FontStyle, FontWidth
     
     m.FontName  = WFONT(1)
     m.FontSize    = WFONT(2)
     m.FontStyle   = WFONT(3)
     m.FontWidth  = FONTMETRIC(6, m.FontName, m.FontSize, m.FontStyle) + 0.000
     
RETURN m.FontWidth     

******************************************************************
*
*        函    数：WinFontHeight
*
*        功    能：计算窗口字体的高度
*
*        参    数：无
*
*        返回值:   窗口字体的高度
*
******************************************************************
FUNCTION  WinFontHeight

     PRIVATE FontName, FontSize, FontStyle, FontHeight
     
     m.FontName  = WFONT(1)
     m.FontSize    = WFONT(2)
     m.FontStyle   = WFONT(3)
     
     m.FontHeight = FONTMETRIC(1, m.FontName, m.FontSize, m.FontStyle) + 0.000 + ;
                              FONTMETRIC(5, m.FontName, m.FontSize, m.FontStyle)

RETURN m.FontHeight

******************************************************************
*
*        过    程：GetWFontWH
*
*        功    能：计算窗口字体的宽度和高度
*
*        参    数：WinName -- 窗口名
*                       WinFontWidth -- 窗口字体宽度
*                       WinFontHeight -- 窗口字体高度
*
******************************************************************
PROCEDURE  GetWFontWH
PARAMETER  WinName, FontWidth, FontHeight

     PRIVATE ALL
     
     m.FontName  = WFONT(1, WinName)
     m.FontSize    = WFONT(2, WinName)
     m.FontStyle   = WFONT(3, WinName)
     
     m.FontWidth  = FONTMETRIC(6, m.FontName, m.FontSize, m.FontStyle) + 0.000
     m.FontHeight = FONTMETRIC(1, m.FontName, m.FontSize, m.FontStyle) + 0.000 + ;
                              FONTMETRIC(5, m.FontName, m.FontSize, m.FontStyle)
     
RETURN

******************************************************************
*
*        过    程：GetFontWH
*
*        功    能：计算字体的宽度和高度
*
*        参    数：FontName -- 字体名
*                       FontSize -- 字号
*                       FontStyle -- 字体风格
*                       FontWidth -- 字体宽度
*                       FontHeight -- 字体高度    
*
******************************************************************
PROCEDURE  GetFontWH
PARAMETER  FontName, FontSize, FontStyle, FontWidth, FontHeight

     PRIVATE ALL
     
     m.FontWidth  = FONTMETRIC(6, m.FontName, m.FontSize, m.FontStyle) + 0.000
     m.FontHeight = FONTMETRIC(1, m.FontName, m.FontSize, m.FontStyle) + 0.000 + ;
                              FONTMETRIC(5, m.FontName, m.FontSize, m.FontStyle)
     
RETURN