紧急求助!!!各位大神!!帮我一下吧。

sdw7766 2010-10-22 10:16:28
各位大侠:
浪费您的时间了,感谢能在百忙之中帮我。

俺是工控人士,编程菜鸟。

是这样的,下面的程序里面有一条对角线,黑色的。但是因为用API创建了位图,把对角线的另一半给挡住了,如何让我看到另一半呢。

用VB环境运行很简单,把代码拷到VB环境里面去,一下就好。

谢谢各位!帮我一下下吧!



源程序如下:

只有两个元件:一个按钮(Command1),一个图片框(Picture1).


Option Explicit

Dim lngX As Double 'X的值
Dim L As Long '绘图区域的宽
Dim H As Long '绘图区域的高
Dim lngMemoryDC As Long '内存中绘图的设备场景的句柄
Dim lngBMPHandle As Long '位图的句柄
Dim lngBrushHandle As Long '填充刷子的句柄
Dim hRgn, jilu As Long '填充区域的句柄


Private Const DC_L = 500 '内存设备场景对图片设备场景的倍数,注意,这个数据太大会导致函数执行失败
Private Const SRCCOPY = &HCC0020

Private Type POINTAPI
X As Long
Y As Long
End Type


Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function Polyline Lib "gdi32 " (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function FillRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long

Private Sub Command1_Click()

Picture1.Line (0, 0)-(Picture1.ScaleWidth, Picture1.ScaleHeight)

Dim lngP, lngp1 As Long

Dim PTS(6) As POINTAPI
PTS(0).X = 10: PTS(0).Y = 10
PTS(1).X = 100: PTS(1).Y = 10
PTS(2).X = 100: PTS(2).Y = 200
PTS(3).X = 200: PTS(3).Y = 200
PTS(4).X = 200: PTS(4).Y = 10
PTS(5).X = 300: PTS(5).Y = 10
Dim hPen As Long
hPen = CreatePen(0, 3, RGB(255, 0, 0))
SelectObject lngMemoryDC, hPen
lngP = Polyline(lngMemoryDC, PTS(0), 6)

Dim PTS1(6) As POINTAPI
PTS1(0).X = 10: PTS1(0).Y = 50
PTS1(1).X = 80: PTS1(1).Y = 50
PTS1(2).X = 80: PTS1(2).Y = 250
PTS1(3).X = 220: PTS1(3).Y = 250
PTS1(4).X = 220: PTS1(4).Y = 50
PTS1(5).X = 300: PTS1(5).Y = 50
Dim hPen1 As Long
hPen1 = CreatePen(0, 1, RGB(0, 255, 0))
SelectObject lngMemoryDC, hPen1
lngp1 = Polyline(lngMemoryDC, PTS1(0), 6)


lngP = BitBlt(Picture1.hdc, 0, 0, L, H, lngMemoryDC, 0, 0, SRCCOPY)
lngp1 = BitBlt(Picture1.hdc, 0, 0, L, H, lngMemoryDC, 0, 0, SRCCOPY)
End Sub

Private Sub Form_Load()


Dim lngP As Long
L = Picture1.ScaleWidth / 15
H = Picture1.ScaleHeight / 15

lngMemoryDC = CreateCompatibleDC(Picture1.hdc) '创建一个与窗体相兼容的设备场景
lngBMPHandle = CreateCompatibleBitmap(Picture1.hdc, 0.5 * L, H) '在内存中创建与窗体同样大小的位图
SelectObject lngMemoryDC, lngBMPHandle '将位图选入刚才创建的设备场景中
hRgn = CreateRectRgn(0, 0, 0.5 * L, H) '创建一个与窗体同样大小的矩形区域
lngBrushHandle = CreateSolidBrush(RGB(255, 255, 255)) '用白色创建一个实色画刷
lngP = FillRgn(lngMemoryDC, hRgn, lngBrushHandle) '用创建的画刷对该区域进行填充



End Sub
...全文
62 2 打赏 收藏 转发到动态 举报
写回复
用AI写文章
2 条回复
切换为时间正序
请发表友善的回复…
发表回复
chinaboyzyq 2010-10-22
  • 打赏
  • 举报
回复

Option Explicit
Dim L1 As Long, H1 As Long

Private Sub Command1_Click()
Picture1.Scale (0, 0)-(Picture1.ScaleWidth, Picture1.ScaleHeight)
Picture1.Line (0, 0)-(0.5 * L1, H1), vbWhite, BF
Picture1.PSet (10, 10), vbRed
Picture1.DrawWidth = 3
Picture1.Line -(100, 10), vbRed
Picture1.Line -(100, 200), vbRed
Picture1.Line -(200, 200), vbRed
Picture1.Line -(200, 10), vbRed
Picture1.Line -(300, 10), vbRed

Picture1.DrawWidth = 1
Picture1.PSet (10, 50), vbGreen
Picture1.Line -(80, 50), vbGreen
Picture1.Line -(80, 250), vbGreen
Picture1.Line -(220, 250), vbGreen
Picture1.Line -(220, 50), vbGreen
Picture1.Line -(300, 50), vbGreen

Picture1.Line (0.5 * L1, 0)-(L1, H1), &H8000000F, BF
Picture1.Line (0, 0)-(Picture1.ScaleWidth, Picture1.ScaleHeight)

End Sub

Private Sub Form_Load()
Picture1.AutoRedraw = True
Picture1.ScaleMode = 3
L1 = Picture1.ScaleWidth
H1 = Picture1.ScaleHeight

End Sub

jhone99 2010-10-22
  • 打赏
  • 举报
回复
Option Explicit

Dim lngX As Double 'X的值
Dim L As Long '绘图区域的宽
Dim H As Long '绘图区域的高
Dim lngMemoryDC As Long '内存中绘图的设备场景的句柄
Dim lngBMPHandle As Long '位图的句柄
Dim lngBrushHandle As Long '填充刷子的句柄
Dim hRgn, jilu As Long '填充区域的句柄


Private Const DC_L = 500 '内存设备场景对图片设备场景的倍数,注意,这个数据太大会导致函数执行失败
Private Const SRCCOPY = &HCC0020

Private Type POINTAPI
X As Long
Y As Long
End Type


Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function Polyline Lib "gdi32 " (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function FillRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long

Private Sub Command1_Click()

' Picture1.Line (0, 0)-(Picture1.ScaleWidth, Picture1.ScaleHeight)
'不要放这里

Dim lngP, lngp1 As Long

Dim PTS(6) As POINTAPI
PTS(0).X = 10: PTS(0).Y = 10
PTS(1).X = 100: PTS(1).Y = 10
PTS(2).X = 100: PTS(2).Y = 200
PTS(3).X = 200: PTS(3).Y = 200
PTS(4).X = 200: PTS(4).Y = 10
PTS(5).X = 300: PTS(5).Y = 10
Dim hPen As Long
hPen = CreatePen(0, 3, RGB(255, 0, 0))
SelectObject lngMemoryDC, hPen
lngP = Polyline(lngMemoryDC, PTS(0), 6)

Dim PTS1(6) As POINTAPI
PTS1(0).X = 10: PTS1(0).Y = 50
PTS1(1).X = 80: PTS1(1).Y = 50
PTS1(2).X = 80: PTS1(2).Y = 250
PTS1(3).X = 220: PTS1(3).Y = 250
PTS1(4).X = 220: PTS1(4).Y = 50
PTS1(5).X = 300: PTS1(5).Y = 50
Dim hPen1 As Long
hPen1 = CreatePen(0, 1, RGB(0, 255, 0))
SelectObject lngMemoryDC, hPen1
lngp1 = Polyline(lngMemoryDC, PTS1(0), 6)


lngP = BitBlt(Picture1.hdc, 0, 0, L, H, lngMemoryDC, 0, 0, SRCCOPY)
lngp1 = BitBlt(Picture1.hdc, 0, 0, L, H, lngMemoryDC, 0, 0, SRCCOPY)

Picture1.Line (0, 0)-(Picture1.ScaleWidth, Picture1.ScaleHeight)
'放这里

End Sub

Private Sub Form_Load()


Dim lngP As Long
L = Picture1.ScaleWidth / 15
H = Picture1.ScaleHeight / 15

lngMemoryDC = CreateCompatibleDC(Picture1.hdc) '创建一个与窗体相兼容的设备场景
lngBMPHandle = CreateCompatibleBitmap(Picture1.hdc, 0.5 * L, H) '在内存中创建与窗体同样大小的位图
SelectObject lngMemoryDC, lngBMPHandle '将位图选入刚才创建的设备场景中
hRgn = CreateRectRgn(0, 0, 0.5 * L, H) '创建一个与窗体同样大小的矩形区域
lngBrushHandle = CreateSolidBrush(RGB(255, 255, 255)) '用白色创建一个实色画刷
lngP = FillRgn(lngMemoryDC, hRgn, lngBrushHandle) '用创建的画刷对该区域进行填充



End Sub

7,763

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧