标题:利用API函数LineTo绘图的问题
只看楼主
xiangyue0510
Rank: 14Rank: 14Rank: 14Rank: 14
等 级:贵宾
威 望:86
帖 子:934
专家分:5244
注 册:2015-8-10
结帖率:100%
已结贴  问题点数:100 回复次数:17 
利用API函数LineTo绘图的问题
上个帖子萌发了对矢量图的兴趣,正好手上另外一个项目需要绘制极化曲线,由于窗口比较小(程序界面就很小),绘制出来的像素图放大之后效果不好,被说好像是网上找的。
目前的解决方法是后台弄一个大的窗口,在那里面重绘一遍再输出。只能说是应付一下,效果也不是太好。毕竟矢量图才是真正解决之道
言归正传,我在网上找到了一个emf格式的论文,按照上面的示例做了一下,但是出不来结果。
请各位帮助看看
http://www.
窗体:
程序代码:
Private Sub Form_Click()

 DrawCurve
End Sub

Sub DrawCurve()
  Dim T As Double
  Dim Xs As Long, Ys As Long
  Dim P0 As POINTAPI
  Dim Xp As Long, Yp As Long
  
  Dim hwMFC As Long, hwMF As Long, Box As RECT
  
  '设定绘图区域, 大小与窗体一致,尺寸大小以0.01mm为单位
  Box.Left = 0
  Box.Top = 0
  Box.Right = Form1.ScaleX(Form1.ScaleWidth, Form1.ScaleMode, vbMillimeters) * 100
  Box.Bottom = Form1.ScaleX(Form1.ScaleHeight, Form1.ScaleMode, vbMillimeters) * 100
  
  
  '获取窗体的宽度和高度,单位像素
  Xs = Form1.ScaleX(Form1.ScaleWidth, Form1.ScaleMode, vbPixels)
  Ys = Form1.ScaleX(Form1.ScaleHeight, Form1.ScaleMode, vbPixels)
  
  '建立一个元文件
  hwMFC = CreateEnhMetaFile(Form1.hdc, "C:\w3.emf", Box, "MetaFile Creater")
   
  If hwMFC = 0 Then
   MsgBox "元文件建立错误"
   Exit Sub
  End If
  
  
  For T = 0 To 6.283 Step 0.01
   Xp = Xs * (1 + Sin(4 * T)) / 2
   Yp = Xs * (1 + Sin(5 * T)) / 2
   If T = 0 Then
     MoveToEx hwMFC, Xp, Yp, P0
   Else
     LineTo hwMFC, Xp, Yp
   End If
  Next T


  MoveToEx hwMFC, 0, 0, P0
  LineTo hwMFC, 800, 600
  
  hwMF = CloseEnhMetaFile(hwMFC)
  
  Box.Left = 0
  Box.Top = 0
  Box.Right = Xs
  Box.Bottom = Ys
  
  PlayEnhMetaFile Form1.hdc, hwMF, Box
  
  DeleteEnhMetaFile hwMF
  
  Clipboard.Clear
  Clipboard.SetData LoadPicture("C:\w3.emf"), vbCFMetafile
End Sub

模块:
程序代码:
'POINTAPI 结构定义
Type POINTAPI

 X As Long

 Y As Long
End Type

'RECT 结构定义
Type RECT

 Left As Long

 Top As Long

 Right As Long

 Bottom As Long
End Type


'******************************* API 函数 CreateEnhMetaFile
'功能:               创建一个增强型的图元文件设备场景
'hdcRef               一个参考设备场景,即绘图设备句柄如窗口,打印机等。 如为0,则为整个屏幕
'lpFileName           图元文件的磁盘路径和文件名, 可用vbNullString传递一个NULL,从而创建内存图元文件。
'lpRect               绘图的矩形区域
'lpDescription        对图元文件的一段说明。 如果不愿意包含一段说明,也可设为vbNullString。
'返回值               增强型图元文件设备场景的句柄。 零表示函数执行出错

Public Declare Function CreateEnhMetaFile Lib "gdi32" Alias "CreateEnhMetaFileA" (ByVal hdcRef As Long, ByVal lpFileName As String, lpRect As RECT, ByVal lpDescription As String) As Long


'******************************* API 函数 CloseEnhMetaFile
'功能:               关闭指定的增强型图元文件设备场景,并将新建的图元文件返回一个句柄
'hdc                  增强型图元文件设备场景的句柄,对应CreateEnhMetaFile的返回值
'返回值               增强型图元文件的一个句柄。 零表示函数执行出错

Public Declare Function CloseEnhMetaFile Lib "gdi32" (ByVal hdc As Long) As Long



'******************************* API 函数 PlayEnhMetaFile
'功能:               指定的设备中绘制(显示)一个增强型图元文件
'hdc                  用于显示的设备句柄,如窗口、控件等
'hemf                 增强型图元文件的句柄
'lpRect               绘图的矩形区域
'返回值               非零表示成功,零表示失败

Public Declare Function PlayEnhMetaFile Lib "gdi32" (ByVal hdc As Long, ByVal hemf As Long, lpRect As RECT) As Long


'******************************* API 函数 DeleteEnhMetaFile
'功能:               使用完图元文件之后,释放其所使用的系统资源(清除内存,不删除文件)
'hwMF                 增强型图元文件的句柄
'返回值               非零表示成功,零表示失败

Public Declare Function DeleteEnhMetaFile Lib "gdi32" (ByVal hwMF As Long) As Long


'******************************* API 函数 MoveToEx
'功能:               将当前绘图位置移动到设备的指定位置——设置画笔位置
'hdc                  绘图的目标设备
'X、Y                 位置坐标(相对于目标设备)
'lpPoint              指向POINT结构的指针,用来存放上一个点的位置,若此参数为NULL,则不保存上一个点的位置
'返回值               返回TRUE代表移动成功,FALSE代表失败

Public Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, X As Long, Y As Long, lpPoint As POINTAPI) As Long


'******************************* API 函数 LineTo
'功能:               以指定设备的当前位置为起点,向终点位置划一条直线
'hdc                  绘图的目标设备
'X、Y                 终点位置坐标(相对于目标设备)
'返回值               返回TRUE代表移动成功,FALSE代表失败

Public Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, X As Long, Y As Long) As Long

'******************************* API 函数 CreatePen
'功能:               设置画笔格式
'nPenStyle            线条样式
'nWidth               线条宽度
'crColor              线条颜色
'返回值               返回新画笔的句柄,零表示失败

Public Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long


Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

'其他函数 Arc  Rectangle   TextOut


搜索更多相关主题的帖子: 函数 Long 文件 设备 ByVal 
2017-09-22 17:21
xzlxzlxzl
Rank: 15Rank: 15Rank: 15Rank: 15Rank: 15
来 自:湖北
等 级:贵宾
威 望:125
帖 子:1091
专家分:5825
注 册:2014-5-3
得分:60 
用下述代码似乎打开了你画的那个图元文件,是不是就是一条斜线?窗口在屏幕不同位置,斜线斜率不同。
程序代码:
Private Type RECT

 Left As Long

 Top As Long

 Right As Long

 Bottom As Long
End Type

Private Type RECTL
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Private Type SIZEL
    cx As Long
    cy As Long
End Type

Private Type ENHMETAHEADER
        iType As Long
        nSize As Long
        rclBounds As RECTL
        rclFrame As RECTL
        dSignature As Long
        nVersion As Long
        nBytes As Long
        nRecords As Long
        nHandles As Integer
        sReserved As Integer
        nDescription As Long
        offDescription As Long
        nPalEntries As Long
        szlDevice As SIZEL
        szlMillimeters As SIZEL
End Type

Private Declare Function GetEnhMetaFile Lib "gdi32" Alias "GetEnhMetaFileA" (ByVal lpszMetaFile As String) As Long
Private Declare Function GetEnhMetaFileHeader Lib "gdi32" (ByVal hemf As Long, ByVal cbBuffer As Long, lpemh As ENHMETAHEADER) As Long
Private Declare Function PlayEnhMetaFile Lib "gdi32" (ByVal hdc As Long, ByVal hemf As Long, lpRect As RECT) As Long

Private Sub aaa()
    Picture1.Cls '清除图形
    Dim ret, lp As ENHMETAHEADER, lpRect As RECT
    If Dir("c:\w3.emf") <> "" Then '判断文件是否存在
        hwd = GetEnhMetaFile("c:\w3.emf") '获取图元文件句柄
        GetEnhMetaFileHeader hwd, Len(lp), lp '获取图元文件头,主要目的是获取结构中有关图元文件坐标的信息

        With lpRect '设置RECT结构成员主要用于定义了在哪里描绘图元文件

            .Left = 0
            .Top = 0
            .Right = lp.rclBounds.Right
            .Bottom = lp.rclBounds.Bottom
        End With
        ret = PlayEnhMetaFile(Picture1.hdc, hwd, lpRect) '绘制绘图元文件
        P = 1
    Else
        MsgBox "缺失地图文件"
        End
    End If

End Sub

Private Sub Form_Click()
   aaa
End Sub
2017-09-22 22:45
xiangyue0510
Rank: 14Rank: 14Rank: 14Rank: 14
等 级:贵宾
威 望:86
帖 子:934
专家分:5244
注 册:2015-8-10
得分:0 
回复 2楼 xzlxzlxzl
两个东西,一个是bowditch曲线  
For T = 0 To 6.283 Step 0.01
   Xp = Xs * (1 + Sin(4 * T)) / 2
   Yp = Xs * (1 + Sin(5 * T)) / 2
   If T = 0 Then
     MoveToEx hwMFC, Xp, Yp, P0
   Else
     LineTo hwMFC, Xp, Yp
   End If
  Next T

另外一个是随便画的斜线
  MoveToEx hwMFC, 0, 0, P0
  LineTo hwMFC, 800, 600
你得意思是在你的电脑上可以看到绘制的emf文件? 那就奇怪了因为在我的电脑上无论是form1上,还是这个文件都看不到任何效果。
2017-09-23 14:44
xiangyue0510
Rank: 14Rank: 14Rank: 14Rank: 14
等 级:贵宾
威 望:86
帖 子:934
专家分:5244
注 册:2015-8-10
得分:0 
回复 2楼 xzlxzlxzl
奇怪了,你的代码确实可以查看绘图的效果。我的窗口,直接打开文件,emf插入word,画板都不能正常查看
而且结果不对,我删除了画斜线的代码,但是结果还是一条斜线,没有出现曲线。 脑子中出现无数巨大的问号和惊叹号。

程序代码:
  For T = 0 To 6.283 Step 0.01
   Xp = Xs * (1 + Sin(4 * T)) / 2
   Yp = Ys * (1 + Sin(5 * T)) / 2     'Xs 改成 Ys
   If T = 0 Then
     MoveToEx hwMFC, Xp, Yp, P0
   Else
     LineTo hwMFC, Xp, Yp
   End If
  Next T


  'MoveToEx hwMFC, 0, 0, P0          斜线已经标注了
  'LineTo hwMFC, 800, 600
2017-09-25 10:05
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4912
专家分:29900
注 册:2008-10-15
得分:40 
我测试过了第一段代码,也是用 WORD 和 画板 看到一片空白。

xzlxzlxzl 的代码也是网上的,我百度时,最少看到了三个网站都是这个代码。因为不是绘制的,所以就没去看了。

实在不行,还是回到自己解析 EMF 的路子上来吧。

只找到一个 C++  的例子
http://www.

授人于鱼,不如授人于渔
早已停用QQ了
2017-09-25 10:35
xiangyue0510
Rank: 14Rank: 14Rank: 14Rank: 14
等 级:贵宾
威 望:86
帖 子:934
专家分:5244
注 册:2015-8-10
得分:0 
以下是引用风吹过b在2017-9-25 10:35:56的发言:

我测试过了第一段代码,也是用 WORD 和 画板 看到一片空白。

xzlxzlxzl 的代码也是网上的,我百度时,最少看到了三个网站都是这个代码。因为不是绘制的,所以就没去看了。

实在不行,还是回到自己解析 EMF 的路子上来吧。

只找到一个 C++  的例子
http://www.

解析EMF,风版不如你杀了我吧。
C学过个把月,说实话门缝都没有摸清楚。
说实话还有点奇怪的是,为何显示的和画出来的不是同一个东西。 绘图代码lineto这一段是很清晰的,不应该有这样的问题。 我把画斜线的语句标注了,还把原来生成的文件删除了,还是一条斜线……
2017-09-25 10:57
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4912
专家分:29900
注 册:2008-10-15
得分:0 
C ,我只看了 几天的书,没学过,绝大部分看不懂。还是在 没出WIN95时看的 TC2 。

估计要请 xzlxzlxzl  版主出手了。


授人于鱼,不如授人于渔
早已停用QQ了
2017-09-25 11:04
xzlxzlxzl
Rank: 15Rank: 15Rank: 15Rank: 15Rank: 15
来 自:湖北
等 级:贵宾
威 望:125
帖 子:1091
专家分:5825
注 册:2014-5-3
得分:0 
被风版点名了,好有压力啊!
我也没有好的办法。初看香版主的代码,感觉是没有定义画笔的原因,但我就是定义了画笔,仍然没有得到正确结果。
windows画图是通过设备句柄完成的,要作图,首先要有一个画布dc,其次要有一个画笔pen,第三还要通过SelectObject将dc和pen联系起来,这样才能开始作图;因此一个完整的画图代码如下:
  Dim hpen As Long, ret As Long, lp As RECT
  hpen = CreatePen(0, 1, vbRed)                 '创建红色画笔
  ret = SelectObject(Picture1.hdc, hpen)        '将画笔和画布联系起来,这里的画布就是picturebox控件,如果没有则需要通过creatdc创建画布
  ret = MoveToEx(Picture1.hdc, 10, 10, 0&)      
  ret = LineTo(Picture1.hdc, 50, 10)
  ret = LineTo(Picture1.hdc, 50, 60)            '画第一个折线段
  ret = MoveToEx(Picture1.hdc, 100, 100, 0&)
  ret = LineTo(Picture1.hdc, 150, 110)
  ret = LineTo(Picture1.hdc, 150, 160)          '画第二个线段
  ret = DeleteObject(hpen)                      '取消画笔和画布的联系
下面是我试验的工程文件,里面包含一个coreldraw做的emf文件,用于测试显示的,希望对香版主有用。

emf图元文件访问.rar (6.25 KB)

2017-09-25 21:32
xiangyue0510
Rank: 14Rank: 14Rank: 14Rank: 14
等 级:贵宾
威 望:86
帖 子:934
专家分:5244
注 册:2015-8-10
得分:0 
回复 8楼 xzlxzlxzl
这个叫做能者多劳,
谢谢了。我先研究一下你的代码。
2017-09-26 08:55
xiangyue0510
Rank: 14Rank: 14Rank: 14Rank: 14
等 级:贵宾
威 望:86
帖 子:934
专家分:5244
注 册:2015-8-10
得分:0 
@xzlxzlxzl
我看了一下你的代码,收获不少,但是保存文件还是空白一片,
但是我如果换成Polyline,就可以在保存的文件中看到内容。
不知道是为何?
2017-09-26 10:34



参与讨论请移步原网站贴子:https://bbs.bccn.net/thread-480880-1-1.html




关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.156064 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved