Save form to image

[sarman.boyslo]

hi all, newbie wanna ask again...

i have build gui with VB6, my gui that i designed has a big size, fullscreen when i run, so in normal mode (not running) if i want to see the form i have to scroll it, if i want to save the design to an image, full of form, how can i make it? if i use PrtSc on keyboard, it just print image on screen, not full form image, any help for me, please? thanks

[tinstaafl]

You can use PrtScrn when the form is running. Paint is capable of loading the pic from the clipboard, and if necessary resizing it.

[rishif2]

i think using only PrtScrn isn't sufficient as there is problem regarding scrolling also so it can capture the entire form (capture only presently visible part) so try the following

first increase screen resolution , then probably you will be able to see the entire form and then use PrtScrn .

[sarman.boyslo]

thanks for reply,

@ tinstaafl : i want to all the component include on the image, so, if i printsreen it when it's running, the component won't be appear.

@ rishif2 : i can't increase screen resolution, in my computer the resolution is in the max value, any another idea?

[tinstaafl]

The most you can do, probably, is to switch to an SDI interface in the options. This will allow the design window to be full screen.

[AndreRet]

There is no easy way out of this. Try using PrintForm. A way to do it is to print in a loop: scroll to top and print, scroll one page and print, repeat until the bottom is reached.

Use something like this -

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Const VK_MENU As Byte = &H12
Private Const VK_SNAPSHOT As Byte = &H2C
Private Const KEYEVENTF_KEYUP = &H2

Private Sub PrintTheForm()
Dim lWidth As Long, lHeight As Long
    Clipboard.Clear
    Call keybd_event(VK_MENU, 0, 0, 0)
    Call keybd_event(VK_SNAPSHOT, 0, 0, 0)
    DoEvents
    Call keybd_event(VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0)
    Call keybd_event(VK_MENU, 0, KEYEVENTF_KEYUP, 0)
    Printer.Print
    If Width > Printer.ScaleWidth Then
        lWidth = Printer.ScaleWidth
        lHeight = (Printer.ScaleWidth / Width) * Height
    Else
        lWidth = Width
        lHeight = Height
    End If
    Printer.PaintPicture Clipboard.GetData, 0, 0, lWidth, lHeight
    Printer.EndDoc
End Sub

[sarman.boyslo]

thanks for reply....

@ tinstaafl : yes, this works! i can change my design to full screen s i can use printscreen to make the image of my gui.

@ AndreRet : how i use your code? make a new project and run it or i have to insert it to my project?

[AndreRet]

Just add it to your form you want to print. In the print button code, add -

Call PrintTheForm

[sarman.boyslo]

thanx for the reply...

as a newbie... i think tinstaafl's trick is the easiest way tho take the screenshot, so i prefer to use this trick...

thanx by the way ... :)

[Junjie_1]

For Module:

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
Public CropWidth As Double
Public CropHeight As Double
Public OrigWidth As Double
Public OrigHeight As Double
Public OverScaleW As String
Public OverScaleH As Boolean

Public Function SaveFormImageToFile(ByRef ContainerForm As Form, _
ByRef PictureBoxControl As PictureBox) As StdPicture
Dim FormInsideWidth As Long
Dim FormInsideHeight As Long
Dim PictureBoxLeft As Long
Dim PictureBoxTop As Long
Dim PictureBoxWidth As Long
Dim PictureBoxHeight As Long
Dim FormAutoRedrawValue As Boolean

With PictureBoxControl
'Set PictureBox properties
.Visible = False
.AutoRedraw = True
.Appearance = 0 ' Flat
.AutoSize = False
.BorderStyle = 0 'No border

'Store PictureBox Original Size and location Values
PictureBoxHeight = .Height: PictureBoxWidth = .Width
PictureBoxLeft = .Left: PictureBoxTop = .Top

'Make PictureBox to size to inside of form.
.Align = vbAlignTop: .Align = vbAlignLeft
DoEvents

FormInsideHeight = .Height: FormInsideWidth = .Width

'Restore PictureBox Original Size and location Values
.Align = vbAlignNone
.Height = FormInsideHeight: .Width = FormInsideWidth
.Left = PictureBoxLeft: .Top = PictureBoxTop

FormAutoRedrawValue = ContainerForm.AutoRedraw
ContainerForm.AutoRedraw = False
DoEvents

'Copy Form Image to Picture Box
BitBlt .hdc, 0, 0, _
FormInsideWidth / Screen.TwipsPerPixelX, _
FormInsideHeight / Screen.TwipsPerPixelY, _
ContainerForm.hdc, 0, 0, _
vbSrcCopy

DoEvents
Set SaveFormImageToFile = .Image
DoEvents

ContainerForm.AutoRedraw = FormAutoRedrawValue
DoEvents

End With
End Function

Public Function CropPhoto(FileName As Variant, X As Single, Y As Single, Optional OriginX As Single = 0, Optional OriginY As Single = 0, Optional bFlags As Boolean = True) As StdPicture
Dim m_X1 As Single, m_Y1 As Single
Dim m_X2 As Single, m_Y2 As Single
m_X1 = OriginX 15
m_Y1 = OriginY 15
m_X2 = X 15
m_Y2 = Y 15

Dim wid As Single, hgt As Single

Dim Types As String
Types = LCase(TypeName(FileName))


Dim TempPic As PictureBox, HighDPI As PictureBox
Dim HighDPI2 As PictureBox, newPic As StdPicture

Set TempPic = Form1.Controls.Add("VB.PictureBox", "TempPic")

wid = m_X2 - m_X1
hgt = m_Y2 - m_Y1

TempPic.Width = wid + (TempPic.Width - TempPic.ScaleWidth)
TempPic.Height = hgt + (TempPic.Height - TempPic.ScaleHeight)
TempPic.Picture = TempPic.Image
If bFlags = True Then
    CropWidth = TempPic.Width
    CropHeight = TempPic.Height
End If

Set HighDPI = Form1.Controls.Add("VB.PictureBox", "HighDPI")
Set HighDPI2 = Form1.Controls.Add("VB.PictureBox", "HighDPI2")

HighDPI.AutoSize = True
HighDPI.Width = 10
HighDPI.Height = 10
HighDPI2.AutoSize = True
Select Case Types
Case "stdpicture", "ipicturedisp", "picture"
    Set HighDPI.Picture = FileName
Case "picturebox", "image"
    HighDPI.Picture = FileName.Picture
Case "string"
    HighDPI.Picture = LoadPicture(FileName)
Case Else
    HighDPI.Picture = TempPic.Picture
End Select
tmp = TempDirRandom(RandomFiles(20) & ".bmp")
SavePicture HighDPI.Picture, tmp

If bFlags = True Then
    OrigWidth = HighDPI.Width
    OrigHeight = HighDPI.Height
End If

If HighDPI.Width >= TempPic.Width And HighDPI.Height >= TempPic.Height Then
    HighDPI.Line (m_X1, m_Y1)-(m_X2, m_Y2), , B
    HighDPI2.Width = wid + (HighDPI2.Width - HighDPI2.ScaleWidth)
    HighDPI2.Height = hgt + (HighDPI2.Height - HighDPI2.ScaleHeight)
    HighDPI2.AutoRedraw = True
    HighDPI2.PaintPicture HighDPI.Picture, 0, 0, wid, hgt, m_X1, m_Y1, wid, hgt
    HighDPI2.Picture = HighDPI2.Image
    HighDPI2.AutoRedraw = False
    Set CropPhoto = HighDPI2.Picture
Else
    Set CropPhoto = HighDPI.Picture
End If

Form1.Controls.Remove HighDPI
Form1.Controls.Remove HighDPI2
Form1.Controls.Remove TempPic

End Function

Public Function FitImage(FileName As Variant, DimX As Double, DimY As Double) As StdPicture
Dim newPic As StdPicture, TempPic As PictureBox
Dim HighDPI As PictureBox, DPI As StdPicture
Set TempPic = Form1.Controls.Add("VB.PictureBox", "TempPic")

TempPic.Width = DimX * 15
TempPic.Height = DimY * 15
TempPic.Picture = TempPic.Image
If DimX = 1280 Or DimY = 960 Then
    DimX = 1275
    DimY = 956
End If
Dim Types As String
Types = LCase(TypeName(FileName))
Select Case Types
Case "stdpicture", "ipicturedisp", "picture"
    Set newPic = FileName
Case "picturebox", "image"
    Set newPic = FileName.Picture
Case "string"
    Set newPic = LoadPicture(FileName)
Case Else
    Set newPic = TempPic.Picture
End Select

tmp = TempDirRandom(RandomFiles(20) & ".bmp")
SavePicture newPic, tmp
If newPic.Width = newPic.Height Then
                            'MsgBox "Cannot process square (" & StrFile & "." & Ext & ")", vbExclamation, "Square"
    'Set FitImage = newPic
    'Exit Function
ElseIf newPic.Width < newPic.Height Then
    CropX = DimY / 96
    CropY = DimX / 96
    TWX = CropX * 1452
    TWY = CropY * 1450
ElseIf newPic.Width > newPic.Height Then
    CropX = DimX / 96
    CropY = DimY / 96
    TWX = CropX * 1450
    TWY = CropY * 1452
End If
DPI_X = newPic.Width
DPI_Y = newPic.Height
Set HighDPI = Form1.Controls.Add("VB.PictureBox", "HighDPI")
Set DPI = LoadPicture(tmp)
HighDPI.AutoRedraw = True
HighDPI.Cls
HighDPI.Move 0, 0, DPI_X / 15, DPI_Y / 15
HighDPI.Width = TWX
HighDPI.Height = TWY
HighDPI.PaintPicture DPI, 0, 0, TWX, TWY
Kill tmp
HighDPI.AutoRedraw = False
Set DPI = HighDPI.Image
Form1.Controls.Remove HighDPI
Set FitImage = DPI

End Function

For Form:

Private Sub Form_Deactivate()

Dim PicImageForm As StdPicture
PicForm.Cls

Set PicImageForm = SaveFormImageToFile(Me, PicForm)

PicForm.Picture = PicImageForm
PicForm.Visible = True

End Sub