# 如何能在萤幕及列印时,让文字左右及上下产生不同比例?

Posted by 小徐 on November 14, 1997 at 22:51:28:

类似倚天中文下~w2z1;之效果让文字可以依不同比例拉长拉宽
同时让文字可以旋转若干角度之效果(例90度等类似~v;)
以下是我在网路上看到类似的程式可是经修改测试无效
我使用vb6.0中文专业版
范例说明:
*********
1. 先于表格上放置两个命令按钮物件Commadn1及Command2，其功能如下:

- Command1为执行旋转文字的工作，首先将表格画面清除再执行一个回圈给予
不同的角度去呼叫副程式RotaText来绘制旋转的文字。
- Command2为执行End函式结束程式。
2. 在副程式RotaText中首先定义一个LOGFONT的资料结构如下:

Type LOGFONT
'字形的高度,如值为0则使用Default的高度
lfHeight As Integer
'字形的宽度,如值为0则使用Default的宽度
lfWidth As Integer
'指定角度(其值为十分之一度,如180度则值为1800)
lfEscapement As Integer
'指定字元的方向，这值是被忽视的
lfOrientation As Integer
'字体的线宽度
lfWeight As Integer
'如值为True表示斜体字
lfItalic As String * 1
'如值为True表示有底线
lfUnderline As String * 1
'如值为True表示有中线
lfStrikeOut As String * 1
'字元集如ANSI_CHARSET,OEM_CHARSET
lfCharSet As String * 1
'输出精密度
lfOutPrecision As String * 1
'剪贴精密度
lfClipPrecision As String * 1
'品质层次
lfQuality As String * 1
'选择字体类别
lfPitchAndFamily As String * 1
'使用的字形
lfFaceName As String * LF_FACESIZE
End Type

2. 在填满LOGFONT的资料后呼叫视窗函式CreateFontIndirec建立一个逻辑字形，
并呼叫视窗函式SelectObject选择这个新字形，此函式会传回上一次所使用的
字形并将值存入hOldFont变数中，再呼叫视窗函式TextOut将文字输出到表格
上，文字于表格内印出后再次的呼叫视窗函式SelectObject选择原来的字形
(hOldFont)后呼叫视窗函式DeleteObject把新建立的字形从记忆体中删除。

函式说明:
*********
1. CreateFontIndirect% (lpLogFont As LOGFONT)
功能:依指定的LOGFONT资料结构建立一个逻辑字形
宣告:
Declare Function CreateFontIndirect Lib "gdi32"
Alias "CreateFontIndirectA"
(lpLogFont As LOGFONT) As Long
参数说明:
lpLogFont:指定一个LOGFONT的资料结构。
返回值:如成功则传回新字形的视窗处理，否则传回NULL。

2. SelectObject% ( hDC As Integer,Object As Integer)
功能:于设备环境中选择一个物件如笔，笔刷，字形，位元图，区域，调色盘
宣告:
Declare Function SelectObject Lib "user32"
Alias "SelectObject"
(ByVal hdc As Long, ByVal hObject As Long) As Long
参数说明:
hDC:指定一个设备环境处理。
Object: 指定选择的笔，笔刷，字形，位元图，区域，调色盘。
返回值:如成功则传回上一次所使用的物件的视窗处理，否则传回NULL。

3. TextOut% ( hDC%, X%, Y%, Text$, nCount%)
功能:于设备环境中列印文字
宣告:
Declare Function TextOut Lib "gdi32"
Alias "TextOutA"
(ByVal hdc As Long, ByVal x As Long, ByVal y As Long,
ByVal lpString As String, ByVal nCount As Long) As Long
参数说明:
hDC:指定一个设备环境处理。
X:字串开始位置的水平逻辑座标。
Y:字串开始位置的垂直逻辑座标。
Text:指定输出的文字。
nCount:指定输出的文字的长度。
返回值:如成功则True，否则传回False。

4. DeleteObject ( Object% )
功能:从记忆体中删除笔，笔刷，字形，位元图，区域，调色盘等物件
宣告:
Declare Function DeleteObject Lib "gdi32"
Alias "DeleteObject"
(ByVal hObject As Long) As Long
参数说明:
Object: 指定选择的笔，笔刷，字形，位元图，区域，调色盘。
返回值:无。

程式说明:
*********
1. 从表单的File选项中,选择 NEW PROJECT(ALT,F,N)
2. 放置两个命令按钮物件(Command1-2)于表格上
3. 从表单的File选项中,选择NEW Module(ALT,F,M)，并储存档名为MODULE1.BAS
4. 依物件特性表设定各物件特性(Property)的值(Value)
5. 依程式清单中的程式码，放入各物件的事件程序中。
6. 从表单的File选项中,选择Save Project As...(ALT,F,E)储存专题。
7. 执行程式，按下Commadn1表格会出现旋转180度的文字。

物件特性设定(未更改的值不列入此表):
***********************************
===============================================
物件名称(Object) 物件特性(Property) 值(Value)
===============================================
Form1 Caption 旋转字形
Command1 FontSize 12
Caption 执行
Command2 FontSize 12
Caption 结束
===============================================

程式内容:
*********
请将下列程式输入 Form1-Command1.Click
======================================================================
Sub Command1_Click ()
'清除画面
form1.Cls
'设定角度
For nAngle% = 20 To 80 Step 10
'设定前景颜色
form1.ForeColor = QBColor(nAngle% / 15)
'旋转列印
RotaText (form1.hDC), "> 文字旋转测试 !", 10, 290, 30, nAngle%
Next
End Sub
======================================================================

请将下列程式输入 Form1-Command1.Click
======================================================================
Sub Command2_Click ()
'结束程式
End
End Sub
======================================================================

请将下列程式输入 Module1-General.declarations
======================================================================
'定义整数从字母A到Z
DefInt A-Z
'全域性常数
'字形大小
Global Const LF_FACESIZE = 32
'字形性质
Global Const FW_DONTCARE = 0
Global Const FW_THIN = 100
Global Const FW_EXTRALIGHT = 200
Global Const FW_LIGHT = 300
Global Const FW_NORMAL = 400
Global Const FW_MEDIUM = 500
Global Const FW_SEMIBOLD = 600
Global Const FW_BOLD = 700
Global Const FW_EXTRABOLD = 800
Global Const FW_HEAVY = 900
Global Const FW_ULTRALIGHT = FW_EXTRALIGHT
Global Const FW_REGULAR = FW_NORMAL
Global Const FW_DEMIBOLD = FW_SEMIBOLD
Global Const FW_ULTRABOLD = FW_EXTRABOLD
Global Const FW_BLACK = FW_HEAVY
'字元集
Global Const ANSI_CHARSET = 0
Global Const SYMBOL_CHARSET = 2
Global Const SHIFTJIS_CHARSET = 128
Global Const OEM_CHARSET = 255
'输出精密度
Global Const OUT_DEFAULT_PRECIS = 0
Global Const OUT_STRING_PRECIS = 1
Global Const OUT_CHARACTER_PRECIS = 2
Global Const OUT_STROKE_PRECIS = 3
Global Const OUT_TT_PRECIS = 4
Global Const OUT_DEVICE_PRECIS = 5
Global Const OUT_RASTER_PRECIS = 6
Global Const OUT_TT_ONLY_PRECIS = 7
'剪贴精密度
Global Const CLIP_DEFAULT_PRECIS = 0
Global Const CLIP_CHARACTER_PRECIS = 1
Global Const CLIP_STROKE_PRECIS = 2
'品质层次
Global Const DEFAULT_QUALITY = 0
Global Const DRAFT_QUALITY = 1
Global Const PROOF_QUALITY = 2
'选择字体类别
Global Const DEFAULT_PITCH = 0
Global Const FIXED_PITCH = 1
Global Const VARIABLE_PITCH = 2
'使用的字形
Global Const FF_DONTCARE = 0
Global Const FF_ROMAN = 16
Global Const FF_SWISS = 32
Global Const FF_MODERN = 48
Global Const FF_SCRIPT = 64
Global Const FF_DECORATIVE = 80
'字形结构
Type LOGFONT
lfHeight As Integer
lfWidth As Integer
lfEscapement As Integer
lfOrientation As Integer
lfWeight As Integer
lfItalic As String * 1
lfUnderline As String * 1
lfStrikeOut As String * 1
lfCharSet As String * 1
lfOutPrecision As String * 1
lfClipPrecision As String * 1
lfQuality As String * 1
lfPitchAndFamily As String * 1
lfFaceName As String * LF_FACESIZE
End Type
'宣告视窗API
'建立新的逻辑字形
Declare Function CreateFontIndirect Lib "GDI" (lpLogFont As LOGFONT) As Integer
'选择设备环境中的物件(笔，位元图，字形)
Declare Function SelectObject Lib "GDI" (ByVal hDC%, ByVal Object%) As Integer
'文字输出
Declare Function TextOut Lib "GDI" (ByVal hDC%, ByVal X%, ByVal Y%, ByVal Text$, ByVal nCount%) As Integer
'从记忆体中删除所选择的物件(笔，位元图，字形)
Declare Sub DeleteObject Lib "GDI" (ByVal Object%)
======================================================================

请将下列程式输入 Module1-RotaText
======================================================================
Sub RotaText (hDC As Integer, Text$, X As Integer, Y As Integer, Size As Integer, LineAngle As Integer)
'*参数 hDC ---> 输出的设备环境
'* Text$ ---> 欲显示之文字
'* X ---> 水平座标
'* Y ---> 垂直座标
'* Size ---> 字形大小
'* LineAngle ---> 显示角度
'定义整数变数
Dim hFont As Integer, hOldFont As Integer
'定义Font结构变数
Dim Font As LOGFONT
'填满Font结构的资料
Font.lfHeight = Size
Font.lfWidth = 0
'旋转角度,视窗使用1/10度为单位
Font.lfEscapement = LineAngle * 10
'使用有效字形
Font.lfPitchAndFamily = Chr$(VARIABLE_PITCH Or FF_DONTCARE)
'使用ANSI字元集
Font.lfCharSet = Chr$(ANSI_CHARSET)
Font.lfQuality = Chr$(PROOF_QUALITY)
Font.lfWeight = FW_NORMAL
Font.lfFaceName = ""
'建立字形
hFont = CreateFontIndirect(Font)
'选择新字形
hOldFont = SelectObject(hDC, hFont)
'取得文字长度
nChars = Len(Text$)
'依座标列印文字到设备环境
Result = TextOut(hDC, X, Y, Text$, nChars)
'选择旧字形
hFont = SelectObject(hDC, hOldFont)
'删除新字形物件
DeleteObject hFont
End Sub
======================================================================

--- End of File ---

Follow Ups:

- Re: 好长喔! 小贤 18:19:35 11/16/97 (2)
  - 相同的困扰 ???? 小林 22:48:03 11/23/97 (1)
    - Re: 相同的困扰 ???? 小贤 23:37:39 11/23/97 (0)