ab.com コミュニティ

コード: 全て選択

Sub DrawLine(hDC As HDC,sx As Long,sy As Long,ex As Long,ey As Long,ColorCode As Long,IsBasicColor As Long)
	'引数"IsBasicColor"が非0の時、ColorCodeはGetBasicColorを参照する。それ以外のときはRGB値として処理する。
	'元のDrawLine関数のパラメータが不明だったので、必要なパラメータを再配置した。

	Dim hPen As HPEN,hOldPen As VoidPtr

	If IsBasicColor then ColorCode=GetBasicColor(ColorCode)

	hPen=CreatePen(PS_SOLID,1,ColorCode)
	hOldPen=SelectObject(hDC,hPen)

	MoveToEx(hDC,sx,sy,ByVal NULL)
	LineTo(hDC,ex,ey)
	SetPixel(hDC,ex,ey,ColorCode)

	SelectObject(hDC,hOldPen)
	DeleteObject(hPen)
End Sub

コード: 全て選択

Function DrawLine(hDC As HDC,width As Long,sx As Long,sy As Long,ex As Long,ey As Long,r As Byte,g As Byte,b As Byte) As Long
	Dim hPen As HPEN
	hPen = CreatePen(PS_SOLID,width,RGB(r,g,b))
	
	If hPen Then
		hPen = SelectObject(hDC,hPen)
		
		If MoveToEx(hDC,sx,sy,ByVal NULL) Then
			If LineTo(hDC,ex,ey) Then DrawLine=TRUE
		End If
		
		hPen = SelectObject(hDC,hPen)
		DeleteObject(hPen)
	End If
End Function