在场景中输出横向或纵向压缩的中文字符

原创 2004年08月01日 23:15:00

    今天参考一个外文代码写的:

(作者:Steve McMahon   steve@vbaccelerator.com,

网址:  http://www.shitalshah.com/vbxlr/tips/vba0035.htm )

 

Private Const LF_FACESIZE = 32
Private Const FW_NORMAL = 400
Private Const FW_BOLD = 700
Private Const FF_DONTCARE = 0
Private Const DEFAULT_QUALITY = 0
Private Const DEFAULT_PITCH = 0
Private Const DEFAULT_CHARSET = 1
Private Const DT_CALCRECT = &H400
Private Type LOGFONT
   lfHeight As Long
   lfWidth As Long
   lfEscapement As Long
   lfOrientation As Long
   lfWeight As Long
   lfItalic As Byte
   lfUnderline As Byte
   lfStrikeOut As Byte
   lfCharSet As Byte
   lfOutPrecision As Byte
   lfClipPrecision As Byte
   lfQuality As Byte
   lfPitchAndFamily As Byte
   lfFaceName(LF_FACESIZE) As Byte
End Type
Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

 

Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function OffsetRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long

 


Private Sub printtext(ByVal hdc As Long, ByVal mystr As String, myfont As StdFont, Optional ByVal fontwidth As Integer = 30, Optional ByVal fontheight As Integer = 15, Optional ByVal fontbold As Boolean = False, Optional ByVal fontitlaic As Boolean = False, Optional ByVal fontunderline As Boolean = False, Optional ByVal fontStrikethrough As Boolean = False)

 

Dim tLF As LOGFONT
Dim hFnt As Long
Dim hFntOld As Long
Dim tR As RECT
Dim sFont As String
Dim iChar As Integer
Dim temp() As Byte

 

   ' Convert an OLE StdFont to a LOGFONT structure:
   With tLF
     sFont = myfont.Name
     temp = StrConv(sFont, vbFromUnicode)
     For iChar = 1 To Len(sFont)
       .lfFaceName(iChar - 1) = temp(iChar - 1)
     Next iChar
     ' Based on the Win32SDK documentation:
        .lfItalic = myfont.Italic
      lfWeight = IIf(myfont.Bold, FW_BOLD, FW_NORMAL)
      .lfWidth = fontwidth
     .lfHeight = fontheight
     .lfUnderline = fontunderline
     .lfStrikeOut = fontStrikethrough
     .lfCharSet = myfont.Charset
   End With

 


 
   hFnt = CreateFontIndirect(tLF)  ' Convert the LOGFONT into a font handle

 

   ' Test the font out:
   hFntOld = SelectObject(hdc, hFnt)
   DrawText hdc, mystr, -1, tR, DT_CALCRECT
   OffsetRect tR, 32, 32
   DrawText hdc, mystr, -1, tR, 0&
   SelectObject hdc, hFntOld

 

   '  remember to delete the font when finished
  
   DeleteObject hFnt

 

End Sub

 

Private Sub Command1_Click()
Me.Cls
Dim myfont As New StdFont
myfont.Name = "arial"
printtext Me.hdc, "扁扁的几个字", myfont, 50, 20

 

End Sub

 

Private Sub Command2_Click()
Dim myfont As New StdFont
myfont.Name = "arial"
printtext Me.hdc, "修长的几个字", myfont, 10, 200, True, True, False, False
End Sub

 

 

 

输出:



 

点阵纵向取模以及放大算法

这两天在调d'y
  • sddsighhz
  • sddsighhz
  • 2014年09月16日 14:02
  • 2781

Oracle之纵向数据转换横向数据

资源一:来源 Jason_zhu的博客 http://jason-zhu.iteye.com/blog/430647 以一张薪资表为例,表结构如下: 表结构中,每个...
  • qq609600523
  • qq609600523
  • 2014年07月25日 11:07
  • 2317

将数据表的纵向数据横向显示

http://blog.sina.com.cn/s/blog_604fb7ae0100pfgg.html 有时为了使数据记录显示的更直观,会需要将记录横向显示。例如航空公司仓位数据表有这样的...
  • DJ2008
  • DJ2008
  • 2015年06月08日 11:22
  • 1485

CSS解压器 1.0 中文绿色版(支持横向和纵向解压)

  • 2013年05月22日 09:12
  • 16KB
  • 下载

sql server 纵向表横向输出的实现

有时候,我们经常需要通过纵向存储的数据,在做报表的时候,横向输出显示出来。最典型的例子:问卷系统中的存储答案的表,存储的数据类似于(存储形式):  c_UserId (用户编号)c_QuestionI...
  • asrain
  • asrain
  • 2011年05月19日 16:46
  • 919

ASP横向输出和纵向输出PDF

 edition=session("edition") userrole=session("userrole") projectid=request("projectid") pl...
  • wendykui
  • wendykui
  • 2017年04月07日 16:20
  • 482

CRT中文字符横向显示解决

原创作品,出自 “深蓝的blog” 博客,欢迎转载,转载时请务必注明以下出处,否则追究版权法律责任。 深蓝的blog:   今天登陆一台中文字符集的linux系统,调整CRT后中文可以正常显示,但显示...
  • huangyanlong
  • huangyanlong
  • 2015年04月10日 10:41
  • 1930

一个文件实现横向纵向拉拽刷新

今天分享一个非常轻量级的拉拽刷新控件,整个控件只有一个文件,不到500行代码,支持横向纵向,侵入非侵入,自定义拉拽行为以及刷新内容,ListView、RecyclerView、ViewPager等等什...
  • u012199331
  • u012199331
  • 2017年08月09日 19:54
  • 693

MSSQL表分区的创建, 横向 纵向 多维度,多指标 分表

MSSQL表分区的创建 最近在做项目数据库优化过程中,考虑了数据库表分区的方案,MSSQL2005新增了表分区的概念,现在我用测试表来做一次表分区。表分区可以把不同数据放到不同数据库文件,按...
  • xj626852095
  • xj626852095
  • 2015年08月12日 17:55
  • 1162

DataTable纵向记录转换成横向列显示,动态新增列及填充数据

DataTable dt = Maticsoft.DBUtility.DbHelperOra.Query(QuerySql).Tables[0]; #region 创建新的DataTable ...
  • smartsmile2012
  • smartsmile2012
  • 2012年11月27日 13:42
  • 2918
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:在场景中输出横向或纵向压缩的中文字符
举报原因:
原因补充:

(最多只允许输入30个字)