Drawing rectangles in picture (data)
A friendly 'hello' to everybody!
I really don't like to ask you about some code, but I tried and tried and tried and I didn't get my code to work
I'm working with VBA.
I receive a picture from an interface and this picture is stored in memory in the variable pic (defined as stdPicture).
Now i want to draw rectangles and circles into this picture, but unfortunately I don't have a PictureBox or Image Control. I have a special Control (ocx) to display the picture. How can I do this??
I tried to get it to work with createDC, SelectObject, MoveTo, LineTo,... but it didn't work, obviously because I don't know how to use these commands right.
You can believe me, I really tried several hours, but as time is nearly up I'm asking for your help...
Can anyone pleeeaaase give me some lines of code??
Thanks in advance
Gosh... without knowing the specifics of that "special" control, it is not easy for us to help you...
The stdPicture is just a picture holder, and you cannot do any graphics in it (AFAIK, but I never tried). You can get the handle of the bitmap object from the stdPicture and do the graphics using API (this is what I do), or you can load the picture in a control that allows graphics (like the PictureBox)
"There are two ways to write error-free programs. Only the third one works."
The following code works with the picture from an image control, you have to do something to make the image refresh afterwards though, like resizing or making visible.
The problem with working in VBA is that it doesn't give you any handles to windows or DCs, I solved this using the FindWindow command: "ThunderDFrame" is the class name for userforms (I found it using an EnumWindows, I can give you that code as well if you want), so there must be a userform running to make this work.
If anyone knows an easier way, I would like to know because I've been trying to do this for ages and this is the only way I've found.
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd 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 DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 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 DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function FillRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long) As Long
Sub DrawOnPic(Pic As StdPicture)
Dim hImgDC As Long
'This line finds a userform, gets its DC and creates a new
'compatible DC which should also be compatible with the pic's DC
hImgDC = CreateCompatibleDC(GetDC(FindWindow("ThunderDFrame", vbNullString)))
Dim hPrevBM As Long 'storing previous values isnt actually necessary
hPrevBM = SelectObject(hImgDC, Pic)
Dim hCircle As Long
hCircle = CreateEllipticRgn(3, 20, 20, 57) 'create a circle
Dim hRect As Long
hRect = CreateRectRgn(10, 2, 45, 8) 'create a rectangle
Dim hBrush As Long
hBrush = CreateSolidBrush(RGB(10, 200, 250))
FillRgn hImgDC, hRect, hBrush 'draw rectangle
hBrush = CreateSolidBrush(RGB(120, 45, 2))
FillRgn hImgDC, hCircle, hBrush 'draw circle
DeleteObject hRect 'delete and reset everything
SelectObject hImgDC, hPrevBM
By software_develo in forum Database
Last Post: 11-21-2005, 11:18 AM
By Tim Frost in forum xml.announcements
Last Post: 04-02-2001, 11:53 AM
By sb in forum VB Classic
Last Post: 07-22-2000, 05:07 AM
By William Gaddam in forum VB Classic
Last Post: 05-02-2000, 10:19 PM
By Desmond Cassidy in forum authorevents.kurata
Last Post: 04-19-2000, 04:54 AM
-- Android Development Center
-- Cloud Development Project Center
-- HTML5 Development Center
-- Windows Mobile Development Center