Saving picture in VB6
Bu
In VB6 you can save a picture, image or drawing with SavePicture
Picture1.Image. This saves an image in .BMP-format which is very
large.
Is there a way to save this image in an .JPG format or other format
that produces smaller files?
N.B. The picture i want to sve is very simple (graph with just a few
colours)
Bu
Mike Williams
Bu wrote:
> In VB6 you can save a picture, image or drawing with
> SavePicture Picture1.Image. This saves an image in
> .BMP-format which is very large. Is there a way to save
> this image in an .JPG format or other format that
> produces smaller files? N.B. The picture i want to
> save is very simple (graph with just a few colours)
Did you draw this picture yourself in VB, using the various VB drawing
methods (Line, Circle, print, etc)? If so then it looks like the
metafile or enhanced metafile format will be the most suitable (.wmf or
.emf). These produce a very small file size for drawing of the type you
have mentioned. You can draw your picture directly to a metafile and /
or to a Picture Box as well and you can then save the metafile to disk
and it will open in almost any application that handles graphic files.
The big advantage of such files is that they can be drawn into any
device (a printer for example) using the full available resolution of
that device. Otherwise, if you want a general purpose solution for
saving images of various kinds then jpg is probably the way to go.
There are many free bitmap to jpeg converters available for use in VB6.
Various other options are also available. Post again with more details.
Mike
Bu
wrote:
Hi Mike,
Thanks for your response.
Yes i am 'drawing' a picture with mainly the commands 'Picture1.Line'
or 'Picture1.Pset'. Actual i am drawing a kind of x-y graph (or x-T
graph).
I like to know a VB6-command that stores the result directly as an
JPG- or GIF-file (or other general purpose small format file).
Ofcourse i can convert later the file from bmp to jpg with a
conversion program but i prefer however to save the picture directly
from the VB program in the required format.
I hope you or anybody else has any suggestions.
Bu
Günter Grodotzki
> Hi Mike,
> Thanks for your response.
> Yes i am 'drawing' a picture with mainly the commands 'Picture1.Line'
> or 'Picture1.Pset'. Actual i am drawing a kind of x-y graph (or x-T
> graph).
> I like to know a VB6-command that stores the result directly as an
> JPG- or GIF-file (or other general purpose small format file).
> Ofcourse i can convert later the file from bmp to jpg with a
> conversion program but i prefer however to save the picture directly
> from the VB program in the required format.
> I hope you or anybody else has any suggestions.
>
> Bu
afaik its not possible. you have to use a ocx/dll (either write one or use
available). but this is very easy to use.
Mike Williams
news:a9g7j29pvdl5ld1om...@4ax.com...
> Yes i am 'drawing' a picture with mainly the commands
> 'Picture1.Line' or 'Picture1.Pset'. Actual i am drawing
> a kind of x-y graph (or x-T graph). I like to know a VB6
> -command that stores the result directly as an JPG- or
> GIF-file (or other general purpose small format file).
Well, it's not actually so straight forward as simply having a "command"
that will perform this job for you. VB6 just doesn't provide such functions.
You can however write code to perform those tasks, and there are some nice
examples on various VB programming sites. The first thing you need to do is
to decide on a suitable format. Most formats that compress picture data have
advantages and limitations, and those that give the best compression usually
"lose" some of the original data in order to achieve the quite large
compression that some of them are capable of, and most of them have various
strengths and weaknesses. In your specific example, where you are dealing
with an image that you are drawing yourself in code using the various Line
and Pset and other standard VB drawing functions you would probably be
better off using the metafile format. Essentially a metafile is a "list" of
drawing instructions (often compiled into a file) that tell the viewer
program how to perform the required drawing, and most graphic programs that
you'll find in Windows understand that format, including Visual Basic. The
big advantage with metafiles is that the completed file can be drawn into
any suitable device (screen, printer or whatever) and it will use the full
available pixels resolution of that device. Also, they usually have a very
small file size.
Visual Basic has a method for displaying a metafile (PaintPicture) or you
can load such a metafile directly into the picture property of a picture
box, but it does not have a method for creating them. One other little
problem is that you need to create the metafile and then draw into it using
its handle, which means you cannot use the VB printer object methods and
must instead use the equivalent API drawing methods. These are quite simple
to use though once you get used to them.
Here is some very nice metafile code that was recently posted on one of the
VB newsgroups (I think it was mpvbgd but I can't remember now who posted
it). Create a new VB project and place a Comamnd Button on the Form and then
paste in the following code. There are one or two very small points that
needs ironing out in order for it to perform the precise job it is intended
to do on the printed page, but other than that it performs extremely well
and it will teach you a lot about both creating metafles and also using the
API drawing routines. Check it out.
Mike
Option Explicit
Private Type DOCINFO
cbSize As Long
sDocName As String
sOutput As String
sDatatype As String
fwType As Long
End Type
Private Type RECT
L As Long
T As Long
R As Long
B As Long
End Type
Private Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
LFItalic As Byte
LFUnderline As Byte
LFStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName As String * 32
End Type
Const TA_BASELINE& = 24, TA_BOTTOM& = 8
Const TA_LEFT& = 0, TA_CENTER& = 6, TA_RIGHT& = 2
Private Declare Function GetEnhMetaFile& Lib "gdi32" _
Alias "GetEnhMetaFileA" (ByVal lpszMetaFile$)
Private Declare Function CreateEnhMetaFile& Lib "gdi32" _
Alias "CreateEnhMetaFileA" (ByVal hdcRef&, _
ByVal FName$, Rct As RECT, ByVal D$)
Private Declare Function CloseEnhMetaFile& Lib "gdi32" _
(ByVal hdc&)
Private Declare Function DeleteEnhMetaFile& Lib "gdi32" _
(ByVal Hdl&)
Private Declare Function PlayEnhMetaFile& Lib "gdi32" _
(ByVal hdc&, ByVal hemf&, lpRect As RECT)
Private Declare Function Rectangle& Lib "gdi32" _
(ByVal hdc&, ByVal x1&, ByVal y1&, ByVal x2&, ByVal y2&)
Private Declare Function Ellipse& Lib "gdi32" _
(ByVal hdc&, ByVal x1&, ByVal y1&, ByVal x2&, ByVal y2&)
Private Declare Function SetStretchBltMode& Lib "gdi32" _
(ByVal hdc&, ByVal nStretchMode&)
Private Declare Function SelectObject& Lib "gdi32" _
(ByVal hdc&, ByVal hObject&)
Private Declare Function SetTextAlign& Lib "gdi32" _
(ByVal hdc&, ByVal wFlags&)
Private Declare Function TextOut& Lib "gdi32" _
Alias "TextOutA" (ByVal hdc&, ByVal x&, ByVal y&, _
ByVal lpString$, ByVal nCount&)
Private Declare Function SetBkMode& Lib "gdi32" _
(ByVal hdc&, ByVal nBkMode&)
Private Declare Function CreateFontIndirect& _
Lib "gdi32" Alias "CreateFontIndirectA" _
(lpLogFont As LOGFONT)
Private Declare Function DeleteObject& Lib "gdi32" _
(ByVal hObject&)
Private Declare Function GetDeviceCaps& Lib "gdi32" _
(ByVal hdc&, ByVal nIndex&)
Private Declare Function StartDoc& Lib "gdi32" _
Alias "StartDocA" (ByVal hdc&, lpdi As DOCINFO)
Private Declare Function StartPage& Lib "gdi32" _
(ByVal hdc&)
Private Declare Function EndDoc& Lib "gdi32" (ByVal hdc&)
Private Declare Function EndPage& Lib "gdi32" (ByVal hdc&)
Private dpMMX!, dpMMY!
Private Sub Command1_Click()
Dim MFDC&, MFHdl&, Rct As RECT, PixToHimetricX!
Dim PixToHimetricY!
'define Metafile-Size (Himetric = 1/100 mm)
Rct.R = 20000: Rct.B = 28200 'A4 with some Border
'generate Metafile-DC (compatible to the Printer-DC)
'directly on a File
'(for drawing in Screen-Resolution use 0 instead
'of Printer.hdc)
MFDC = CreateEnhMetaFile(Printer.hdc, "c:\test.emf", _
Rct, vbNullString)
'here we draw against the Metafile-DC
DrawPrintOut MFDC
'closing the MF-DC generates an MF-Handle
MFHdl = CloseEnhMetaFile(MFDC)
'delete Handle (File is not deleted)
DeleteEnhMetaFile MFHdl
MsgBox FileLen("c:\test.emf"), , "FileSize in Bytes"
'And now Read-Direction
'get the Handle ...
MFHdl = GetEnhMetaFile("c:\test.emf")
'Play against the Picture-DC...
Picture1.ScaleMode = vbPixels: Picture1.AutoRedraw = True
Rct.R = Picture1.ScaleWidth: Rct.B = Picture1.ScaleHeight
SetStretchBltMode hdc, 4 'HalfTone
PlayEnhMetaFile Picture1.hdc, MFHdl, Rct
Picture1.Refresh
'and here (possibly) against the printer
If MsgBox("Should we print?", vbYesNo) = vbYes Then
PrintDoc "TestDocument", MFHdl
End If
DeleteEnhMetaFile MFHdl
End Sub
Private Sub DrawPrintOut(ByVal DC&)
Dim hFont1&, hFont2&, OldFont&
'calculate mm-scale
dpMMX = GetDeviceCaps(DC, 88) / 25.40003
dpMMY = GetDeviceCaps(DC, 90) / 25.40003
SetBkMode DC, 1
SetTextAlign DC, TA_BASELINE
hFont1 = GethFont(DC, "Arial", 12, True)
hFont2 = GethFont(DC, "Times", 17)
DrawEllipseMM DC, 25, 25, 150, 150
DrawRectangleMM DC, 10, 10, 90, 90
DrawRectangleMM DC, 100, 100, 90, 90
OldFont = SelectObject(DC, hFont1)
DrawTextMM DC, 20, 20, "Test hFont1"
'Destroy hFont1 and select hFont2
DeleteObject SelectObject(DC, hFont2)
DrawTextMM DC, 110, 110, "Test hFont2"
'Destroy hFont2 and reselect OldFont-Handle
DeleteObject SelectObject(DC, OldFont)
End Sub
Function GethFont&(DC&, Name$, Size!, Optional Bold&)
Dim LF As LOGFONT
'DC-independent "Point-To-Pixel-Mapping"
LF.lfHeight = -(CLng(Size * GetDeviceCaps(DC, 90)) / 72)
LF.lfWeight = IIf(Bold, 700, 400)
LF.lfCharSet = 1
LF.lfFaceName = Name & Chr$(0)
GethFont = CreateFontIndirect(LF)
End Function
Function DrawTextMM(DC&, ByVal x!, ByVal y!, S$)
TextOut DC, x * dpMMX, y * dpMMY, S, Len(S)
End Function
Function DrawRectangleMM(DC&, ByVal x!, ByVal y!, _
ByVal dx!, ByVal dy!)
Dim x1&, x2&, y1&, y2&
x1 = x * dpMMX: y1 = y * dpMMY
x2 = x1 + (dx * dpMMX): y2 = y1 + (dy * dpMMY)
Rectangle DC, x1, y1, x2, y2
End Function
Function DrawEllipseMM(DC&, ByVal x!, ByVal y!, _
ByVal dx!, ByVal dy!)
Dim x1&, x2&, y1&, y2&
x1 = x * dpMMX: y1 = y * dpMMY
x2 = x1 + (dx * dpMMX): y2 = y1 + (dy * dpMMY)
Ellipse DC, x1, y1, x2, y2
End Function
Private Sub Form_Load()
Me.WindowState = vbMaximized
End Sub
Private Sub Form_Resize() 'Aspect-Ratio A4
On Error Resume Next
Picture1.BorderStyle = 0: Picture1.BackColor = vbWhite
ScaleMode = vbPixels: BackColor = &HDFDFDF
Move Left, Top, Width, Width * 1.4142
Picture1.Move 10, 10, ScaleWidth - 20, ScaleHeight - 20
Err.Clear
Command1.ZOrder
End Sub
Private Sub PrintDoc(ByVal DocName$, ByVal MFHdl&)
Dim DI As DOCINFO, Rct As RECT
DI.cbSize = 20: DI.sDocName = DocName
DI.sDatatype = "emf" & Chr(0)
Printer.ScaleMode = vbPixels
'Print two pages (portrait and landscape)
StartDoc Printer.hdc, DI
Printer.Orientation = vbPRORPortrait
StartPage Printer.hdc
Rct.R = Printer.ScaleWidth: Rct.B = Printer.ScaleHeight
PlayEnhMetaFile Printer.hdc, MFHdl, Rct
EndPage Printer.hdc
Printer.Orientation = vbPRORLandscape
StartPage Printer.hdc
Rct.R = Printer.ScaleHeight: Rct.B = Printer.ScaleWidth
PlayEnhMetaFile Printer.hdc, MFHdl, Rct
EndPage Printer.hdc
EndDoc Printer.hdc
End Sub
Bu
Mike,
Thanks again for your response. I'll study it and see how i am going
to use it
Bu