vfp创建垂直标签控件，效果还是不错的

于 2023-06-07 09:16:09 发布
阅读量278 收藏
点赞数
原文链接：https://mp.weixin.qq.com/s?__biz=MzU1NDE4MjcxNw==&mid=2247488105&idx=1&sn=da1fd4ba8b9aee34de338424fbadaa1e&chksm=fbe6233bcc91aa2d87ba196a5859b450836519b086b841841e36c04fad8fad257f873aec2f4e&scene=126&sessionid=0
版权
文章展示了如何在VisualFoxPro中创建自定义VLabel控件，该控件支持垂直显示文本，可调整字体、颜色、对齐方式和方向。作者提倡用VFP进行混合编程，并分享了相关开发经验和社群资源，包括课程、框架和源码资源。
摘要由CSDN通过智能技术生成

66a11e6f53a528964855cbcd8a9e9780.gif


效果如图

97c5df4e7bd0a5916c970d9d616fb227.png

主要属性包括字体、V 和 H 对齐、前后颜色和方向（向上和向下）。

代码：

LOCAL obj
obj = CreateObject("TForm")
obj.Show(1)


DEFINE CLASS Tform As Form
  Width=460
  Height=300
  Caption=" Vertical Labels"
  AutoCenter=.T.
  
  ADD OBJECT text1 As TextBox WITH;
  Top=10, Left=70, Width=260, Height=21, Value="Visual FoxPro Demo"
  
  ADD OBJECT button1 As CommandButton WITH Top=10, Left=334,;
  Width=60, Height=24, Caption="Set", Default=.T.
  
  ADD OBJECT vlabel1 As VLabel WITH Top=0, Height=300,;
  Left=0, Width=60, FontName="Impact",;
  FontSize=24, ForeColor=Rgb(192,0,128), BackColor=Rgb(192,192,192),;
  Direction=0, VAlignment=1, Alignment=1


  ADD OBJECT vlabel2 As VLabel WITH Top=0, Height=300,;
  Left=406, Width=54, FontName="Verdana", FontSize=20,;
  ForeColor=Rgb(80,80,80), BackColor=Rgb(192,192,192),;
  Direction=1, VAlignment=1, Alignment=1


  ADD OBJECT vlabel3 As VLabel WITH;
  Top=50, Height=250, Left=70, Width=54, VAlignment=0,;
  VCaption = "Default font is used for this label"


PROCEDURE Init
  THIS.SetLabel
  THIS.vlabel3.DrawCaption
PROCEDURE button1.Click
  ThisForm.SetLabel
PROCEDURE SetLabel
  STORE RTRIM(THIS.text1.Value) TO THIS.vlabel1.VCaption,;
    THIS.vlabel2.VCaption
ENDDEFINE


DEFINE CLASS VLabel As Image
  PROTECTED bitmapfile
  VCaption=""  && "Caption" does not work
  Direction=0
  Alignment=0
  VAlignment=2
  Autowidth=.F.
  BackColor=-1
  FontBold=.F.
  FontItalic=.F.
  FontName="Arial"
  FontSize=10
  FontStrikethru=.F.
  FontUnderline=.F.
  ForeColor=0


PROCEDURE Init
  THIS.bitmapfile=SUBSTR(SYS(2015), 3) + ".bmp"


PROCEDURE Destroy
  IF FILE(THIS.bitmapfile)  && deleting temporary bitmap file
    DELETE FILE (THIS.bitmapfile)
  ENDIF


PROCEDURE VCaption_ASSIGN(vParam)
  THIS.VCaption = m.vParam
  THIS.DrawCaption
PROCEDURE Alignment_ASSIGN(vParam)
  THIS.Alignment = m.vParam
  THIS.DrawCaption
PROCEDURE VAlignment_ASSIGN(vParam)
  THIS.VAlignment = m.vParam
  THIS.DrawCaption
PROCEDURE Direction_ASSIGN(vParam)
  THIS.Direction = m.vParam
  THIS.DrawCaption
PROCEDURE BackColor_ASSIGN(vParam)
  THIS.BackColor = m.vParam
  THIS.DrawCaption
PROCEDURE Autowidth_ASSIGN(vParam)
  THIS.Autowidth = m.vParam
  THIS.DrawCaption
PROCEDURE FontBold_ASSIGN(vParam)
  THIS.FontBold = m.vParam
  THIS.DrawCaption
PROCEDURE FontItalic_ASSIGN(vParam)
  THIS.FontItalic = m.vParam
  THIS.DrawCaption
PROCEDURE FontName_ASSIGN(vParam)
  THIS.FontName = m.vParam
  THIS.DrawCaption
PROCEDURE FontSize_ASSIGN(vParam)
  THIS.FontSize = m.vParam
  THIS.DrawCaption
PROCEDURE FontStrikethru_ASSIGN(vParam)
  THIS.FontStrikethru = m.vParam
  THIS.DrawCaption
PROCEDURE FontUnderline_ASSIGN(vParam)
  THIS.FontUnderline = m.vParam
  THIS.DrawCaption
PROCEDURE ForeColor_ASSIGN(vParam)
  THIS.ForeColor = m.vParam
  THIS.DrawCaption


PROCEDURE DrawCaption
#DEFINE OUT_OUTLINE_PRECIS  8
#DEFINE CLIP_STROKE_PRECIS  2
#DEFINE PROOF_QUALITY       2
#DEFINE LOGPIXELSY          90
  DECLARE INTEGER SelectObject IN gdi32 INTEGER hdc, INTEGER hObject
  DECLARE INTEGER SetTextColor IN gdi32 INTEGER hdc, INTEGER crColor
  DECLARE INTEGER GetDeviceCaps IN gdi32 INTEGER hdc, INTEGER nIndex
  DECLARE INTEGER SetBkMode IN gdi32 INTEGER hdc, INTEGER iBkMode
  DECLARE INTEGER CreateSolidBrush IN gdi32 LONG crColor
  DECLARE INTEGER DeleteObject IN gdi32 INTEGER hObject
  DECLARE INTEGER DeleteDC IN gdi32 INTEGER hdc
  DECLARE INTEGER GetDesktopWindow IN user32
  DECLARE INTEGER GetWindowDC IN user32 INTEGER hwnd
  DECLARE INTEGER CreateCompatibleDC IN gdi32 INTEGER hdc
  DECLARE INTEGER ReleaseDC IN user32 INTEGER hwnd, INTEGER hdc


  DECLARE INTEGER GetTextExtentPoint32 IN gdi32;
    INTEGER hdc, STRING lpString,;
    INTEGER cbString, STRING @lpSize


  DECLARE INTEGER CreateCompatibleBitmap IN gdi32;
    INTEGER hdc, INTEGER nWidth, INTEGER nHeight


  DECLARE INTEGER TextOut IN gdi32;
    INTEGER hdc, INTEGER x, INTEGER y,;
    STRING  lpString, INTEGER nCount


  DECLARE INTEGER CreateFont IN gdi32;
    INTEGER nHeight, INTEGER nWidth, INTEGER nEscapement,;
    INTEGER nOrientation, INTEGER fnWeight, INTEGER fdwItalic,;
    INTEGER fdwUnderline, INTEGER fdwStrikeOut, INTEGER fdwCharSet,;
    INTEGER fdwOutPrecis, INTEGER fdwClipPrecis, INTEGER fdwQuality,;
    INTEGER fdwPitchAndFamily, STRING lpszFace


  DECLARE INTEGER FillRect IN user32;
    INTEGER hDC, STRING @RECT, INTEGER hBrush


  LOCAL hDesktop, hDesktopDC, hMemDC, hMemBmp, hFont, hBrush, nBaseWidth,;
    nBaseHeight, BaseRect, nTextWidth, nTextHeight, nX, nY
  nBaseWidth = THIS.Width
  nBaseHeight = THIS.Height
  BaseRect = num2dword(0) + num2dword(0) +;
    num2dword(nBaseWidth) + num2dword(nBaseHeight)


  hDesktop = GetDesktopWindow()
  hDesktopDC = GetWindowDC(hDesktop)
  hMemDC = CreateCompatibleDC(hDesktopDC)
  hMemBmp = CreateCompatibleBitmap(hDesktopDC, nBaseWidth, nBaseHeight)
  = DeleteObject(SelectObject(hMemDC, hMemBmp))
  = ReleaseDC(hDesktop, hDesktopDC)


  hFont = CreateFont(-THIS.FontSize *;
    GetDeviceCaps(hMemDC, LOGPIXELSY) / 72,;
    0, Iif(THIS.Direction=0, 900, -900),0,;
    Iif(THIS.FontBold,700,400), Iif(THIS.FontItalic,1,0),0,0,;
    0, OUT_OUTLINE_PRECIS, CLIP_STROKE_PRECIS,;
    PROOF_QUALITY, 0, THIS.FontName)


  = DeleteObject(SelectObject(hMemDC, hFont)))
  
  STORE 0 TO nTextWidth, nTextHeight
  = GetTextRect(hMemDC, THIS.VCaption,;
    @nTextWidth, @nTextHeight)


  IF THIS.Autowidth
    STORE nTextHeight TO nBaseWidth, THIS.Width
  ENDIF


  DO CASE
  CASE THIS.Alignment = 0 && left
    nX = 0
  CASE THIS.Alignment = 1 && center
    nX = Int((nBaseWidth - nTextHeight)/2)
  CASE THIS.Alignment = 2 && right
    nX = nBaseWidth - nTextHeight
  ENDCASE


  DO CASE
  CASE THIS.VAlignment = 0 && top
    nY = nTextWidth
  CASE THIS.VAlignment = 1 && center
    nY = nTextWidth + Int((nBaseHeight - nTextWidth)/2)
  CASE THIS.VAlignment = 2 && bottom
    nY = nBaseHeight
  ENDCASE


  IF THIS.Direction <> 0
    nY = nY - nTextWidth
    nX = nX + nTextHeight
  ENDIF
  
  IF THIS.BackColor = -1
    hBrush = CreateSolidBrush(ThisForm.BackColor)
  ELSE
    hBrush = CreateSolidBrush(THIS.BackColor)
  ENDIF


  = FillRect(hMemDC, @BaseRect, hBrush)
  = DeleteObject(hBrush)
  = SetBkMode(hMemDC, 1)  && transparent
  = SetTextColor(hMemDC, THIS.ForeColor)
  = TextOut(hMemDC, nX, nY, THIS.VCaption, Len(THIS.VCaption))


  IF BmpToFile(hMemDC, hMemBmp,;
    nBaseWidth, nBaseHeight, THIS.bitmapfile)
    THIS.Picture = THIS.Bitmapfile
  ENDIF


  = DeleteDC(hMemDC)
  = DeleteObject(hMemBmp)
  = DeleteObject(hFont)
ENDDEFINE


PROCEDURE GetTextRect(hDC, cText, nTextWidth, nTextHeight)
  LOCAL cBuffer
  cBuffer = Repli(Chr(0), 8)
  = GetTextExtentPoint32(hDC, cText, Len(cText), @cBuffer)
  nTextWidth = buf2dword(SUBSTR(cBuffer, 1,4))
  nTextHeight = buf2dword(SUBSTR(cBuffer, 5,4))


PROCEDURE BmpToFile(hMemDC, hMemBmp, nWidth, nHeight, cFilename)
#DEFINE cnBitsPerPixel         24
#DEFINE BHDR_SIZE              40  && BITMAPINFOHEADER
#DEFINE BFHDR_SIZE             14  && BITMAPFILEHEADER
#DEFINE GENERIC_WRITE          0x40000000
#DEFINE FILE_SHARE_WRITE       2
#DEFINE CREATE_ALWAYS          2
#DEFINE FILE_ATTRIBUTE_NORMAL  128
  DECLARE INTEGER GlobalAlloc IN kernel32 INTEGER wFlags, INTEGER dwBytes
  DECLARE RtlZeroMemory IN kernel32 As ZeroMemory INTEGER dst, INTEGER nBytes
  DECLARE INTEGER GlobalFree IN kernel32 INTEGER hMem
  DECLARE INTEGER CloseHandle IN kernel32 INTEGER hObject
  DECLARE INTEGER GetDIBits IN gdi32;
    INTEGER hdc, INTEGER hbmp, INTEGER uStartScan,;
    INTEGER cScanLines, INTEGER lpvBits, STRING @lpbi, INTEGER uUsage
  DECLARE INTEGER CreateFile IN kernel32;
    STRING lpFileName, INTEGER dwDesAccess, INTEGER dwShareMode,;
    INTEGER lpSecurAttr, INTEGER dwCreatDisp, INTEGER dwFlagsAndAttrs,;
    INTEGER hTemplateFile


  LOCAL nBytesPerScan, nBitsArray, nBitsSize, nRgbQuadSize, cBInfo,;
    hFile, lnOffBits, lnFileSize, cBFileHdr
  STORE 0 TO nBytesPerScan, nRgbQuadSize, nBitsArray, nBitsSize
  STORE "" TO cBInfo


  nBytesPerScan = nWidth * 3  && initialising bitmap data
  IF Mod(nBytesPerScan, 4) <> 0
    nBytesPerScan = nBytesPerScan + 4 - Mod(nBytesPerScan, 4)
  ENDIF


  cBInfo = num2dword(BHDR_SIZE) + num2dword(nWidth) + num2dword(nHeight) +;
    num2word(1) + num2word(cnBitsPerPixel) + Repli(Chr(0),24)
  nBitsSize = nHeight * nBytesPerScan
  nBitsArray = GlobalAlloc(0, nBitsSize)
  = ZeroMemory(nBitsArray, nBitsSize)
  = GetDIBits(hMemDC, hMemBmp, 0, nHeight, nBitsArray, @cBInfo, 0)


  * copying created structures to bitmap file
  lnFileSize = BFHDR_SIZE + BHDR_SIZE + nRgbQuadSize + nBitsSize
  lnOffBits = BFHDR_SIZE + BHDR_SIZE + nRgbQuadSize
  cBFileHdr = "BM" + num2dword(lnFileSize) +;
    num2dword(0) + num2dword(lnOffBits)
  hFile = CreateFile(m.cFilename, GENERIC_WRITE, FILE_SHARE_WRITE, 0,;
        CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
  IF hFile <> -1
    = Str2File(hFile, @cBFileHdr)
    = Str2File(hFile, @cBInfo)
    = Ptr2File(hFile, nBitsArray, nBitsSize)
    = CloseHandle (hFile)
  ENDIF
  = GlobalFree(nBitsArray)


PROCEDURE Str2File(hFile, cBuffer)  && appending string buffer to a file
  DECLARE INTEGER WriteFile IN kernel32;
    INTEGER hFile, STRING @lpBuffer, INTEGER nBt2Write,;
    INTEGER @lpBtWritten, INTEGER lpOverlapped
  = WriteFile(hFile, @cBuffer, Len(cBuffer), 0,0)


PROCEDURE Ptr2File(hFile, nPtr, nBytes)  && appending memory block to a file
  DECLARE INTEGER WriteFile IN kernel32;
    INTEGER hFile, INTEGER lpBuffer, INTEGER nBt2Write,;
    INTEGER @lpBtWritten, INTEGER lpOverlapped
  = WriteFile(hFile, nPtr, nBytes, 0,0)


FUNCTION buf2dword(lcBuffer)
RETURN Asc(SUBSTR(lcBuffer, 1,1)) + ;
  BitLShift(Asc(SUBSTR(lcBuffer, 2,1)),  8) +;
  BitLShift(Asc(SUBSTR(lcBuffer, 3,1)), 16) +;
  BitLShift(Asc(SUBSTR(lcBuffer, 4,1)), 24)


FUNCTION num2dword(lnValue)
#DEFINE m0  0x100
#DEFINE m1  0x10000
#DEFINE m2  0x1000000
  IF lnValue < 0
    lnValue = 0x100000000 + lnValue
  ENDIF
  LOCAL b0, b1, b2, b3
  b3 = Int(lnValue/m2)
  b2 = Int((lnValue - b3*m2)/m1)
  b1 = Int((lnValue - b3*m2 - b2*m1)/m0)
  b0 = Mod(lnValue, m0)
RETURN Chr(b0)+Chr(b1)+Chr(b2)+Chr(b3)


FUNCTION num2word(lnValue)
RETURN Chr(MOD(m.lnValue,256)) + CHR(INT(m.lnValue/256))

猫猫的心里话

加菲猫的VFP|狐友会社群接收投稿啦

加菲猫的VFP，用VFP不局限VFP，用VFP混合一切。无论是VFP，还是JS，还是C，只要能混合起来，都可以发表。

商业模式，销售技巧、需求规划、产品设计的知识通通可以发表。

暂定千字50元红包，，优秀的文章红包更大，一经发表，红包到手。

如何帮助使用VFP的人？

用VFP的人，有专业的，有非专业了，很多人其实是小白，问出的问题是小白，如果问题不对，我们引导他们问正确的问题。无论如何请不要嘲笑他们说帮助都不看，这么简单的问题都不会，嘲笑别人不行，而无法提出建设性答案，是很low的。

我们无论工作需要，还是有自己的软件，都是是需要真正的知识，如何让更多人学习真正的VFP知识呢，只需要点赞，在看，能转发朋友圈就更好了。

加菲猫的vfp倡导用"VFP极简混合开发，少写代码、快速出活，用VFP，但不局限于VFP，各种语言混合开发"。

我已经带领一百多名会员成功掌到VFP的黑科技，进入了移动互联网时代，接下来我们要进入物联网领域。

2023年狐友会社群会员继续招募中

社群会员获取的权益有：

祺佑三层开发框架商业版（猫框），终身免费升级，终身技术支持。

开放的录播课程有：

微信小程序，微信公众号开发，H5 APP开发，Extjs BS开发，VFP面向对象进阶，VFP中间层开发。

源码类资源有：

支付组件源码，短信源码，权限组件源码，一些完整系统的源码。这个可以单独出售的，需要的可以联系我。

会员也可以实现群内资源对接，可以接分包，合作等各项商业或技术业务

d378c1d43cc17b2e974164b24196a3ae.gif

4fc875c9495e9f9f419e68687906adda.jpeg

712dd3ee33b6baf3e10778ec753e815a.gif

加菲猫的VFP
关注
VFP开发动态创建组件
同一天空下
05-11 3222
1。VFP动态添加VFP自己的控件的代码如下 thisform.AddObject("textBox1","TextBox") Thisform.textBox.visible=.T. 非常简单 2。如果在Grid中更改列中的编辑控件的代码如下： Grid1.Column1.RemoveObject('Text1') Grid1.Column1.AddObject('Check
Codejock ChartPro vfp 使用示例
01-18
2. **Codejock ChartPro组件**：ChartPro是Codejock Suite Pro的一部分，它提供了一组丰富的控件，可以在VFP中创建各种复杂和交互式的图表，如折线图、柱状图、饼图、散点图、面积图、甘特图等。每个图表类型都有其...
vfp 控件类
11-23
包括VFP中使用的控件，并带有示例 包括VFP中使用的控件，并带有示例
vfp mysql教程_VFP基础教程 5.5 编辑框控件(editbox)
weixin_42516575的博客
02-22 815
一。编辑框与文本框的功能类似，都是用于显示，输入和修改数据。它们之间的区别是文本框是在一行中显示数据，输入的内容放不下，会自动向左移动；而编辑框为若干行的一个区域，当编辑框的scrollbars属性设为。T.,还可包含滚动条，适合编辑较多内容的文本。此外，编辑框的integraheight属性可控制编辑框的高度是否可自动调整，以便其最后一项的内容能被完全显示。二。编辑框的属性和事件大多与文本框类似...
VFP封装第三方控件，如何添加ControlSource属性？
加菲猫的VFP
10-25 695
用容器类包装第三方控件，添加ControlSource类 ，使得更规范，更符合VFP的开发方式。 思路:1 自定义属性ControlSource INIT和Refresh时取这个值进行赋值给控件. 2 第三方控件LOSTFOUCES时,Replace 回ControlSource的字段 3 添加自定义方法SetSize,设置各控件位置关系,在Init Resize事件分别调用,并设置好Anchor属性 设计原则 　1　容器类添加ControlSource 并且判...
VFP-常用表单控件.ppt
09-15
掌握这些控件及其属性是VFP表单设计的基础，通过灵活运用，可以创建出功能丰富的用户界面，提升应用程序的用户体验。在实际开发中，还可以结合事件处理程序，如`Click`、`Change`等，来实现更复杂的交互逻辑。
电脑分辨率
09-04
【标签】"VFP分辨率"强调了这个问题是关于在VFP环境中处理分辨率的。在VFP编程中，可能需要根据用户设备的分辨率调整界面布局，确保在不同分辨率的显示器上应用都能正确显示。开发者可能需要编写代码来检测屏幕大小...
福建工程学院面向对象程序设计PPT课件.pptx
10-09
每种类型的控件都有其默认的名称，例如标签控件可能是Label1、Label2等，便于编程时引用。 3. **标签控件**： - **作用**：标签常用来显示说明文字或对象标题，增强用户界面的可理解性。 - **常用属性**：...
VFP技巧
最新发布
AYongSoft的专栏
11-08 937
个人整理的VFP编程技巧
[VFP实例]VFP的OLE技术应用详解
风无痕
11-09 6334
<br /><br />VFP用了OLE2．0技术，使VFP应用程序的适应能力大为加强。<br />VFP提供两种类型的OLE对象：一种是OLE控件（．OCX文件），这是一种自定义控件，通常在WINDOWS/SYSTEM目录下，拥有自己的事件、方法，类似于VFP的基本类，这种控件可以用VC、VB5．0、DeLphi、SDK2．0等编程工具开发。VFP缺省提供了四种可供使用的OLE控件，即通信（MSCOMM32．OCX）、消息应用程序接口MAPI（MSMAPI32．OCX）、OutLine（MSOUTL32．
VFP编写DLL
wwle的专栏
05-28 927
VFP编写DLL 分类： VFP - 编程技巧 2008-04-23 17:16 2636人阅读 评论(4) 收藏 举报 有两种DLL文件，一种是用Declare说明然后调用，这种文件copy了就能用，但不能用智能提示，只能用专门的工具查看里面有什么东西，这种Dll一般是用C编写的。 另外一种是COM方式的Dll,用Createobject(对象名)方式调用，对象名
VFP中使用浏览器控件制软件界面
木瓜的专栏
08-04 6195
 不知你在使用VFP中是否 有以下困惑：１．如何使自己VFP软件的界面更漂亮些？２．如何使用嵌入浏览器控件？３．如何屏蔽嵌入页面的右键菜单？４．如何截获超链接的点击事件？５．使用浏览器控件后，如何同时使用模式表单和非模式表单６．如何阻止浏览器控件弹出新窗口？下面，是我在编程时对浏览器控件的经验：１．如何使自己VFP软件的界面更漂亮些？这个问题可大可小，与个人
VideoSoft Report控件：VFP与SQL的完美结合
VideoSoft Report控件是VFP（Visual FoxPro）和SQL环境中的一个专业报告工具，允许开发者创建复杂的报告，并且可以与数据库直接交互。 ### VFP和SQL基础 Visual FoxPro是一种数据驱动的编程语言和开发环境，它结合...
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值