| View previous topic :: View next topic |
| Author |
Message |
rfgrove
Joined: 10 Jan 2007
Posts: 3
|
 Posted: Mon Jan 15, 2007 10:38 am Post subject: How to copy 3D surface plot to the Clipboard |
 |
|
Does anyone have VB6 code to copy a 3D surface plot to the Windows clipboard? I am using the sample program btest2 modified for my application. The following code produces the 3D plot
PlotViewAz = Val(Text2.text)
PlotViewEl = Val(Text3.text)
ZplotScaleFactor = Val(Text1.text)
HasMetrics = 0
d.version = DPLOT_DDE_VERSION
d.hwnd = Me.hwnd
d.DataFormat = DATA_3D
d.MaxCurves = Nx - 1
d.MaxPoints = Ny - 1
d.NumCurves = 1
d.ScaleCode = SCALE_LINEARX_LINEARY
d.Title1 = "SurfacePlot"
d.Title2 = ""
d.Title3 = ""
d.XAxis = "Range"
d.YAxis = "Deflection"
cmds = "[Contour3D(1)][ContourGrid(1)][ContourAxes(1)]"
cmds = cmds & "[ContourView(" & Str(PlotViewAz) & "," & Str(PlotViewEl) & ")]"
cmds = cmds & "[ContourLegend(0)]"
cmds = cmds + "[ContourLevels(20," & Str(zMin) & "," & Str(zMax) & ")]"
cmds = cmds & "[ContourScales(1,1," & Str(ZplotScaleFactor) & ")]"
cmds = cmds & "[FontPoints(1, ][FontPoints(2,12)][FontPoints(3,12)]"
cmds = cmds & "[FontPoints(4,10)][FontPoints(5,10)][FontPoints(6,]"
cmds = cmds & "[ZAxisLabel(""frequency"")]"
ret = GetClientRect(Picture1.hwnd, rcPic)
If (hBitmap <> 0) Then
ret = DeleteObject(hBitmap)
hBitmap = 0
End If
If DocNum <> 0 Then
ret = DPlot_Command(DocNum, "[FileClose()]")
End If
DocNum = DPlot_Plot(d, extents(0), Z(0), cmds)
If (DocNum > 0) Then
hBitmap = DPlot_GetBitmap(DocNum, rcPic.Right - rcPic.Left, rcPic.Bottom - rcPic.Top)
End If
Call Picture1_Paint
Private Sub Picture1_Paint()
Dim bm As BITMAP
Dim hbmpOld As Long
Dim hdc As Long
Dim hdcMem As Long
Dim ret As Long
If hBitmap <> 0 Then
hdc = GetDC(Picture1.hwnd)
hdcMem = CreateCompatibleDC(hdc)
If (hdcMem <> 0) Then
hbmpOld = SelectObject(hdcMem, hBitmap)
ret = GetObject(hBitmap, Len(bm), bm)
ret = SetBkMode(hdc, NEWTRANSPARENT)
ret = SetBkColor(hdc, RGB(255, 255, 255))
ret = BitBlt(hdc, rcPic.Left, rcPic.Top, bm.bmWidth, bm.bmHeight, hdcMem, 0, 0, SRCCOPY)
ret = SelectObject(hdcMem, hbmpOld)
ret = DeleteDC(hdcMem)
End If
ret = ReleaseDC(Picture1.hwnd, hdc)
End If
End Sub |
|
| Back to top |
|
 |
DPlotAdmin
Site Admin
Joined: 24 Jun 2003
Posts: 2310
Location: Vicksburg, Mississippi
|
| Posted: Mon Jan 15, 2007 12:00 pm Post subject: |
|
|
Does your copy of the btest2 demo not include a "Copy" button?
| Code: | Private Sub Command4_Click()
'
' Copy bitmap to the Clipboard
'
Dim hbmpCopy As Long
Dim ret As Long
If (hBitmap <> 0) Then
ret = OpenClipboard(Me.hwnd)
ret = EmptyClipboard()
hbmpCopy = CopyImage(hBitmap, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
ret = SetClipboardData(CF_BITMAP, hbmpCopy)
ret = CloseClipboard()
Else
Beep
End If
End Sub
|
Extracted from global.vb:
| Code: | Global Const CF_BITMAP = 2
Global Const IMAGE_BITMAP = 0
Global Const LR_COPYRETURNORG = &H4
Declare Function CopyImage Lib "user32" (ByVal handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Declare Function CloseClipboard Lib "user32" () As Long
Declare Function EmptyClipboard Lib "user32" () As Long
Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
|
_________________
Visualize Your Data
support@dplot.com |
|
| Back to top |
|
|
|
|
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
|
Powered by phpBB © 2001, 2005 phpBB Group
|
FAQ
Search
Memberlist
Usergroups
Profile
Log in to check your private messages
Log in
