Working with clipboard and bitmaps
Introduction
Visual foxpro works well with the text clipboard.Can put any text in clipboard with
_cliptext system variable (Contains the contents of the Clipboard.).It can simulate the windows public hotkeys CTRL+C (copy),CTRL+X(cut),ctrl+V(paste) (for text only).its very usefull but when working on images there is nothing to work with clipboard.
-This article raises some methods to do that goal using APIs
*below 6 codes as samples on working with clipboard & bitmaps
*1)* This code gets the clipboard bitmap content and save it as standard image PNG,JPG,BMP ,GIF,TIF...It uses APIs for that (in gdiplusX its the equivalent of FromClipboard() function).
The great advantage is that you have not to embed all gdiplusX library to do that.It consists in some lines of code only.-first open clipboard, get the bitmaps content, an close the clipbaord.The encoders and the apis GdipCreateBitmapFromHBITMAP and gdipSaveImagetoFile does the job.
To test press prtscreen key (to put a bitmap in Clipboard)and run the code below
*begin code
Do yDeclare
Publi m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
Local m.ext
m.ext=inputbox("Save clipboard bitmap content as :PNG,JPG,BMP,GIF,TIF","","PNG")
if ! inlist(m.ext,"PNG","JPG","BMP","GIF","TIF")
m.ext="PNG"
endi
local m.lcoutputfile0,lcoutputfile,uBitmap,hBitmap
If !Directory(m.yrep+"images") &&create an images folder
Md (m.yrep+"images")
Endi
#Define CF_BITMAP 2
*Save the graphics from the local clipboard
OpenClipboard(0)
hBitmap = GetClipboardData(CF_BITMAP)
CloseClipboard()
If hBitmap=0
Messagebox("No bitmap in clipboard!",16+4096,"Error",1000)
Return .F.
Endi
*make a picture name with Datetime() function.if the timeout>1 sec the name is unique(as the function sys(2015) can provides).
Set Date short
Local m.xx
m.xx=Ttoc(Datetime())
m.xx=Strtran(m.xx,":","_")
m.xx=Strtran(m.xx,"/","_")
m.xx=Strtran(m.xx," ","_")
m.xx=Strtran(m.xx,";","_")
lcOutputFile0=m.yrep+"images\ycap"+m.xx+"."+m.ext
uBitmap=0
GdipCreateBitmapFromHBITMAP(hBitmap,2,@uBitmap)
lcOutputFile=Strconv(m.lcOutputFile0+Chr(0),5)
*use the associated encoderClsiD of the image format
Do Case
Case m.ext="PNG"
lqEncoderClsID_PNG=0h06F47C55041AD3119A730000F81EF32E &&PNGFormat
Case m.ext="JPG"
lqEncoderClsID_JPG=0h01F47C55041AD3119A730000F81EF32E &&JPGFormat
Case m.ext="BMP"
lqEncoderClsID_BMP=0h00F47C55041AD3119A730000F81EF32E &&BMPFormat
Case m.ext="GIF"
lqEncoderClsID_GIF=0h02F47C55041AD3119A730000F81EF32E &&GIFFormat
Case m.ext="TIF"
lqEncoderClsID_TIF=0h05F47C55041AD3119A730000F81EF32E &&TIFFormat
Endcase
GdipSaveImageToFile(uBitmap,lcOutputFile,Eval("lqEncoderClsID_"+m.ext),Null)
sleep(100)
Local m.oo
m.oo=m.yrep+"images"
Run/N explorer &oo &&see captures folder
Procedure yDeclare
declare integer Sleep in kernel32 integer
Declare Integer OpenClipboard In User32 Integer
Declare Integer CloseClipboard In User32
Declare Integer EmptyClipboard In User32
Declare Integer SetClipboardData In User32 Integer,Integer
Declare Integer GetClipboardData In User32 Integer
Declare Integer GdipSaveImageToFile In GDIPlus.Dll Integer,String,String @,String @
Declare Long GdipCreateHBITMAPFromBitmap In GDIPlus.Dll Long nativeImage, Long @, Long
Declare Integer GdipCreateBitmapFromHBITMAP In GDIPlus.Dll Integer, Integer, Integer @
Declare Integer Sleep In kernel32 Integer
Endproc
*End code
*2)*This code is an *Equivalent of gdiplusX function :toClipboard()
-copy any bitmap file to clipboard with APIs
-The copyImage API also have a very good add to resize the image simultaneously to the wanted dimensions
-It can also produce a monochrome image
-can visit msdn Link :http://msdn.microsoft.com/en-us/library/windows/desktop/ms648031
*Begin Code
do ydeclare
#Define CF_BITMAP 2
#Define CF_DIB 8
#Define IMAGE_BITMAP 0
#Define LR_LOADFROMFILE 16
#Define LR_MONOCHROME 0x00000001 && Creates a new monochrome image. if used
Local m.xpict
m.xpict=Getpict()
If Empty(m.xpict)
Return .F.
Endi
Local m.oo
m.oo=Newobject("image")
m.oo.Picture=m.xpict
Local lnWidth,lnHeight
lnWidth=m.oo.Width
lnHeight=m.oo.Height
Messagebox("Width="+Trans(m.lnWidth)+" px Height="+Trans(m.lnHeight)+" px .....can resize image in code !",0+32+4096,'',2000)
*Save the bitmap file to the clipboard
nBitmap=0
hbm=0
GdipCreateBitmapFromFile(Strconv(m.xpict+0h00,5),@nBitmap)
GdipCreateHBITMAPFromBitmap(nBitmap,@hbm,0)
lhBmp = CopyImage(hbm, 0, m.lnWidth, m.lnHeight,0) &&resize if
If OpenClipboard(0)!= 0
EmptyClipboard()
SetClipboardData(CF_BITMAP, lhBmp)
CloseClipboard()
If Messagebox("image "+Allt(m.xpict)+" copied to clipboard! want to show on MSpaint ?",4+64+4096)=6
*to ensure the image is in clipbrd fire mspaint ans paste int
=ypaste()
Endi
Endif
Function ypaste()
Run/N mspaint
Sleep(2000)
Local oshell
oshell=Newobject("wscript.shell")
oshell.sendkeys("^{v}") &&standard wundows hotkey CTRL+V
Endfunc
Procedure ydeclare
Declare integer Sleep in kernel32 integer
Declare Integer OpenClipboard In User32 Integer
Declare Integer CloseClipboard In User32
Declare Integer EmptyClipboard In User32
Declare Integer SetClipboardData In User32 Integer,Integer
Declare Integer LoadImage In WIN32API Integer,String,Integer,Integer,Integer,Integer
Declare Integer GetClipboardData In User32 Integer
Declare Integer GdipCreateBitmapFromHBITMAP In GDIPlus.Dll Integer, Integer, Integer @
Declare Integer GdipSaveImageToFile In GDIPlus.Dll Integer,String,String @,String @
Declare Long GdipCreateHBITMAPFromBitmap In GDIPlus.Dll Long nativeImage, Long @, Long
Declare Long GdipCreateBitmapFromFile In GDIPlus.Dll String FileName, Long @nBitmap
DECLARE Long GdipCreateBitmapFromFile IN GDIPLUS.DLL String FileName, Long @nBitmap
Declare Long CopyImage In WIN32API Long hImage, Long, Long, Long , Long
Endproc
*Endcode
*3)*Equivalent of gdiplusX function :toClipboard()
*copy any bitmap file to clipboard with APIs
*The copyImage API also have a very good add to resize the image simultaneously to the wanted dimensions
*It can also produce a monochrome image
*can visit http://msdn.microsoft.com/en-us/library/windows/desktop/ms648031
*This resize original image to new width/height.
*Begin Code
do ydeclare
#Define CF_BITMAP 2
#Define CF_DIB 8
#Define IMAGE_BITMAP 0
#Define LR_LOADFROMFILE 16
#Define LR_MONOCHROME 0x00000001 && Creates a new monochrome image.
Local m.xpict
m.xpict=Getpict()
If Empty(m.xpict)
Return .F.
Endi
Local m.oo
m.oo=Newobject("image")
m.oo.Picture=m.xpict
Local lnWidth,lnHeight
lnWidth=m.oo.Width
lnHeight=m.oo.Height
Messagebox("Width="+Trans(m.lnWidth)+" px Height="+Trans(m.lnHeight)+" px .....can resize image in code !",0+32+4096,'',2000)
Local lnWidth1,lnHeight1
m.lnWidth1=Val(Inputbox("Resize original image width:","",Trans(lnWidth)))
If Empty(m.lnWidth) Or ! lnWidth>0
m.lnWidth1=m.lnWidth
Endi
m.lnHeight1=Val(Inputbox("Resize original image Height:","",Trans(lnHeight)))
If Empty(m.lnHeight1) Or ! lnHeight1>0
m.lnHeight1=m.lnHeight
Endi
*Save the bitmap file to the clipboard
nBitmap=0
hbm=0
GdipCreateBitmapFromFile(Strconv(m.xpict+0h00,5),@nBitmap)
GdipCreateHBITMAPFromBitmap(nBitmap,@hbm,0)
lhBmp = CopyImage(hbm, 0, m.lnWidth1, m.lnHeight1,0) &&resize if
If OpenClipboard(0)!= 0
EmptyClipboard()
SetClipboardData(CF_BITMAP, lhBmp)
CloseClipboard()
If Messagebox("image "+Allt(m.xpict)+" copied to clipboard! want to show on MSpaint ?",4+64+4096)=6
*to ensure the image is in clipbrd fire mspaint ans paste int
=ypaste()
Endi
Endif
Function ypaste()
Run/N mspaint
Sleep(2000)
Local oshell
oshell=Newobject("wscript.shell")
oshell.sendkeys("^{v}") &&standard wundows hotkey CTRL+V
Endfunc
Procedure ydeclare
Declare integer Sleep in kernel32 integer
Declare Integer OpenClipboard In User32 Integer
Declare Integer CloseClipboard In User32
Declare Integer EmptyClipboard In User32
Declare Integer SetClipboardData In User32 Integer,Integer
Declare Integer LoadImage In WIN32API Integer,String,Integer,Integer,Integer,Integer
Declare Integer GetClipboardData In User32 Integer
Declare Integer GdipCreateBitmapFromHBITMAP In GDIPlus.Dll Integer, Integer, Integer @
Declare Integer GdipSaveImageToFile In GDIPlus.Dll Integer,String,String @,String @
Declare Long GdipCreateHBITMAPFromBitmap In GDIPlus.Dll Long nativeImage, Long @, Long
Declare Long GdipCreateBitmapFromFile In GDIPlus.Dll String FileName, Long @nBitmap
Declare Long CopyImage In WIN32API Long hImage, Long, Long, Long , Long
DECLARE Long GdipCreateBitmapFromFile IN GDIPLUS.DLL String FileName, Long @nBitmap
Endproc
*END CODE
*4)*Equivalent of gdiplusX function :toClipboard()
*copy any bitmap file to clipboard with APIs
*The copyImage API also have a very good add to resize the image simultaneously to the wanted dimensions
*It can also produce a monochrome image
*can visit http://msdn.microsoft.com/en-us/library/windows/desktop/ms648031
*This resizes original image to new width/height and turns original bitmap to monochrome.
*Begin Code
do ydeclare
#Define CF_BITMAP 2
#Define CF_DIB 8
#Define IMAGE_BITMAP 0
#Define LR_LOADFROMFILE 16
#Define LR_MONOCHROME 0x00000001 && Creates a new monochrome image.
Local m.xpict
m.xpict=Getpict()
If Empty(m.xpict)
Return .F.
Endi
Local m.oo
m.oo=Newobject("image")
m.oo.Picture=m.xpict
Local lnWidth,lnHeight
lnWidth=m.oo.Width
lnHeight=m.oo.Height
Messagebox("Width="+Trans(m.lnWidth)+" px Height="+Trans(m.lnHeight)+" px .....can resize image in code !",0+32+4096,'',2000)
Local lnWidth1,lnHeight1
m.lnWidth1=Val(Inputbox("Resize original image width:","",Trans(lnWidth)))
If Empty(m.lnWidth) Or ! lnWidth>0
m.lnWidth1=m.lnWidth
Endi
m.lnHeight1=Val(Inputbox("Resize original image Height:","",Trans(lnHeight)))
If Empty(m.lnHeight1) Or ! lnHeight1>0
m.lnHeight1=m.lnHeight
Endi
*Save the bitmap file to the clipboard
nBitmap=0
hbm=0
GdipCreateBitmapFromFile(Strconv(m.xpict+0h00,5),@nBitmap)
GdipCreateHBITMAPFromBitmap(nBitmap,@hbm,0)
lhBmp = CopyImage(hbm, 0, m.lnWidth1, m.lnHeight1,0) &&resize if
lhBmp = CopyImage(hbm, 0,m.lnWidth1, m.lnHeight1,LR_MONOCHROME) &&resize if
If OpenClipboard(0)!= 0
EmptyClipboard()
SetClipboardData(CF_BITMAP, lhBmp)
CloseClipboard()
If Messagebox("image "+Allt(m.xpict)+" copied to clipboard! want to show on MSpaint ?",4+64+4096)=6
*to ensure the image is in clipbrd fire mspaint ans paste int
=ypaste()
Endi
Endif
Function ypaste()
Run/N mspaint
Sleep(2000)
Local oshell
oshell=Newobject("wscript.shell")
oshell.sendkeys("^{v}") &&standard wundows hotkey CTRL+V
Endfunc
Procedure ydeclare
Declare integer Sleep in kernel32 integer
Declare Integer OpenClipboard In User32 Integer
Declare Integer CloseClipboard In User32
Declare Integer EmptyClipboard In User32
Declare Integer SetClipboardData In User32 Integer,Integer
Declare Integer LoadImage In WIN32API Integer,String,Integer,Integer,Integer,Integer
Declare Integer GetClipboardData In User32 Integer
Declare Integer GdipCreateBitmapFromHBITMAP In GDIPlus.Dll Integer, Integer, Integer @
Declare Integer GdipSaveImageToFile In GDIPlus.Dll Integer,String,String @,String @
Declare Long GdipCreateHBITMAPFromBitmap In GDIPlus.Dll Long nativeImage, Long @, Long
Declare Long GdipCreateBitmapFromFile In GDIPlus.Dll String FileName, Long @nBitmap
Declare Long CopyImage In WIN32API Long hImage, Long, Long, Long , Long
Endproc
*End Code
*5)* *Equivalent of gdiplusX function :toClipboard()
-copy any bitmap file to clipboard with APIs
-rhis code fires a vfp samples form as object, change the picture of an image an copy the image of the control imgdisplay to clipboard+view it in mspaint.
-Can with this artifact capture any image from the form surface
*Begin Code
do ydeclare
If File( Home(1)+"samples\solution\forms\image.scx") &&a test form
Do Form Home(1)+"samples\solution\forms\image.scx" Name yb &&name is very important makes contoling form as object with OOP
sleep(3000) &&wait to play the form
Else
Return .F. &&cancel
Endi
With yb.imgDisplay
.Picture=Getpict() &&change picture
.Stretch=2
Endwith
#Define CF_BITMAP 2
#Define CF_DIB 8
#Define IMAGE_BITMAP 0
#Define LR_LOADFROMFILE 16
Local m.xpict
m.xpict=yb.imgDisplay.Picture
Messagebox(m.xpict)
If Empty(m.xpict)
Return .F.
Endi
Local m.oo
m.oo=Newobject("image")
m.oo.Picture=m.xpict
Local lnWidth,lnHeight
lnWidth=m.oo.Width
lnHeight=m.oo.Height
Messagebox("Width="+Trans(m.lnWidth)+" px Height="+Trans(m.lnHeight)+" px .....can resize image in code !",0+32+4096,'',2000)
*Save the bitmap file to the clipboard
nBitmap=0
hbm=0
GdipCreateBitmapFromFile(Strconv(m.xpict+0h00,5),@nBitmap)
GdipCreateHBITMAPFromBitmap(nBitmap,@hbm,0)
lhBmp = CopyImage(hbm, 0, m.lnWidth, m.lnHeight,0) &&resize if
If OpenClipboard(0)!= 0
EmptyClipboard()
SetClipboardData(CF_BITMAP, lhBmp)
CloseClipboard()
If Messagebox("image "+Allt(m.xpict)+" copied to clipboard! want to show on MSpaint ?",4+64+4096)=6
*to ensure the image is in clipbrd fire mspaint ans paste in
=ypaste()
Endi
Endif
Read Events
Function ypaste()
Run/N mspaint
sleep(2000)
Local oshell
oshell=Newobject("wscript.shell")
oshell.sendkeys("^{v}") &&standard wundows hotkey CTRL+V
Endfunc
Procedure ydeclare
Declare Integer OpenClipboard In User32 Integer
Declare Integer CloseClipboard In User32
Declare Integer EmptyClipboard In User32
Declare Integer SetClipboardData In User32 Integer,Integer
Declare Integer LoadImage In WIN32API Integer,String,Integer,Integer,Integer,Integer
Declare Integer GetClipboardData In User32 Integer
Declare Integer GdipCreateBitmapFromHBITMAP In GDIPlus.Dll Integer, Integer, Integer @
Declare Integer GdipSaveImageToFile In GDIPlus.Dll Integer,String,String @,String @
Declare Long GdipCreateHBITMAPFromBitmap In GDIPlus.Dll Long nativeImage, Long @, Long
Declare Long GdipCreateBitmapFromFile In GDIPlus.Dll String FileName, Long @nBitmap
Declare Long CopyImage In WIN32API Long hImage, Long, Long, Long , Long
Declare Integer Sleep In kernel32 Integer
Endproc
*End code
*Begin Code
Do ydeclare
#Define CF_BITMAP 2
#Define IMAGE_BITMAP 0
Publi m.yrep0
m.yrep0=Addbs(Justpath(Sys(16,1))) &&start folder
Local m.yrep
m.yrep=Getdir()
Local gnbre
gnbre=Adir(gabase,m.yrep+"*.*")
If Empty(m.yrep) Or gnbre=0
Return .F.
Endi
m.yrep=Addbs(m.yrep)
If !Directory(m.yrep0+"images")
Md (m.yrep0+"images")
Endi
Create Cursor ycurs (yimage c(150))
For i=1 To gnbre
If Inlist(Lower(Justext(gabase(i,1))),"png","jpg","bmp","gif","tif")
Insert Into ycurs Values (m.yrep+gabase(i,1))
Endi
Endfor
Sele ycurs
If Reccount()=0 &&no images
Return .F.
Endi
Local lnWidth,lnHeight
lnWidth=320
lnHeight=240
m.lnWidth=Val(Inputbox("Resize images folder to dimensions (px):","",Trans(lnWidth))) &&chose image width
If Empty(m.lnWidth) Or ! lnWidth>0
m.lnWidth1=320
Endi
m.lnHeight=Val(Inputbox("Resize original image Height:","",Trans(lnHeight))) &&chose image height
If Empty(m.lnHeight) Or ! lnHeight>0
m.lnHeight=240
Endi
Local m.ext
m.ext=Inputbox("Convert images to: PNG,JPG,BMP,GIF,TIF","","JPG") &&chose image conversion format
If Empty(m.ext) Or !Inlist(m.ext,"PNG","JPG","BMP","GIF","TIF")
m.ext="JPG"
Endi
Do Case
Case m.ext="PNG"
lqEncoderClsID_PNG=0h06F47C55041AD3119A730000F81EF32E &&PNGFormat
Case m.ext="JPG"
lqEncoderClsID_JPG=0h01F47C55041AD3119A730000F81EF32E &&JPGFormat
Case m.ext="BMP"
lqEncoderClsID_BMP=0h00F47C55041AD3119A730000F81EF32E &&BMPFormat
Case m.ext="GIF"
lqEncoderClsID_GIF=0h02F47C55041AD3119A730000F81EF32E &&GIFFormat
Case m.ext="TIF"
lqEncoderClsID_TIF=0h05F47C55041AD3119A730000F81EF32E &&TIFFormat
Endcase
Scan
*Save the graphic file to the clipboard
nBitmap=0
hbm=0
GdipCreateBitmapFromFile(Strconv(Allt(yimage)+0h00,5),@nBitmap)
GdipCreateHBITMAPFromBitmap(nBitmap,@hbm,0)
lhbmp=CopyImage(hbm, 0, lnWidth, lnHeight,0) &&resize
If OpenClipboard(0)!= 0
EmptyClipboard()
SetClipboardData(CF_BITMAP, lhbmp)
CloseClipboard()
Endif
*get the graphics from the local clipboard
OpenClipboard(0)
hBitmap = GetClipboardData(CF_BITMAP)
CloseClipboard()
*export as image file
Local lcoutputfile,lcoutputfile0,ubitmap
lcoutputfile0=m.yrep0+"images\"+Juststem(yimage)+"."+m.ext &&
ubitmap=0
GdipCreateBitmapFromHBITMAP(hBitmap,2,@ubitmap)
lcoutputfile=Strconv(m.lcoutputfile0+Chr(0),5)
GdipSaveImageToFile(ubitmap,lcoutputfile,Eval("lqEncoderClsID_"+ext),Null)
sleep(100)
Endscan
Local m.oo
m.oo=m.yrep0+"images"
Run/N explorer &oo &&show resized images with explorer
Procedure ydeclare
Declare Integer Sleep In kernel32 Integer
Declare Integer OpenClipboard In User32 Integer
Declare Integer CloseClipboard In User32
Declare Integer EmptyClipboard In User32
Declare Integer SetClipboardData In User32 Integer,Integer
Declare Integer GetClipboardData In User32 Integer
Declare Integer GdipSaveImageToFile In GDIPlus.Dll Integer,String,String @,String @
Declare Long GdipCreateHBITMAPFromBitmap In GDIPlus.Dll Long nativeImage, Long @, Long
Declare Long CopyImage In WIN32API Long hImage, Long, Long, Long , Long
DECLARE Long GdipCreateBitmapFromFile IN GDIPLUS.DLL String FileName, Long @nBitmap
DECLARE INTEGER GdipCreateBitmapFromHBITMAP IN GdiPlus.dll INTEGER, INTEGER, INTEGER @
Endproc
*End Code
Click on code to select [then copy] -click outside to deselect
*7* added on Tuesday 26 january 2016; 18:59:25
*Get any picture on the form and rightClick (capture to clipboard) to view it in MSPAINT,can resize in tesxtboxes before saving..
*these operations are given only with APIs, no need to gdiplus ro gdiplusX.
*can add encoders (as seen in previous codes) t save directy to the format wanted (PNG,JPG,BMP,GIF,....
*Do Case
*Case m.ext="PNG"
*lqEncoderClsID_PNG=0h06F47C55041AD3119A730000F81EF32E &&PNGFormat
*Case m.ext="JPG"
*lqEncoderClsID_JPG=0h01F47C55041AD3119A730000F81EF32E &&JPGFormat
*Case m.ext="BMP"
*lqEncoderClsID_BMP=0h00F47C55041AD3119A730000F81EF32E &&BMPFormat
*Case m.ext="GIF"
*lqEncoderClsID_GIF=0h02F47C55041AD3119A730000F81EF32E &&GIFFormat
*Case m.ext="TIF"
*lqEncoderClsID_TIF=0h05F47C55041AD3119A730000F81EF32E &&TIFFormat
*Endcase
Publi yform
yform=Newobject("ycaptureIM")
yform.Show
Read Events
Retu
*
Define Class ycaptureIM As Form
BorderStyle = 0
Height = 326
Width = 659
ShowWindow = 2
AutoCenter = .T.
Caption = "Capture image on form,resize,view"
MaxButton = .F.
Name = "Form1"
Add Object command1 As CommandButton With ;
Top = 276, ;
Left = 96, ;
Height = 27, ;
Width = 96, ;
FontSize = 11, ;
Caption = "GetPict()", ;
MousePointer = 15, ;
ForeColor = Rgb(128,0,64), ;
BackColor = Rgb(128,255,0), ;
Name = "Command1"
Add Object image1 As Image With ;
Stretch = 2, ;
Height = 229, ;
Left = 36, ;
Top = 24, ;
Visible = .F., ;
Width = 253, ;
Name = "Image1"
Add Object label1 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 10, ;
BackStyle = 0, ;
Caption = "Width", ;
Height = 18, ;
Left = 336, ;
Top = 36, ;
Width = 39, ;
ForeColor = Rgb(0,0,255), ;
Name = "Label1"
Add Object text1 As TextBox With ;
FontBold = .T., ;
Height = 25, ;
Left = 378, ;
Top = 31, ;
Width = 73, ;
Name = "Text1"
Add Object label2 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 10, ;
BackStyle = 0, ;
Caption = "Height", ;
Height = 18, ;
Left = 333, ;
Top = 79, ;
Width = 43, ;
ForeColor = Rgb(0,0,255), ;
Name = "Label2"
Add Object text2 As TextBox With ;
FontBold = .T., ;
Height = 25, ;
Left = 379, ;
Top = 75, ;
Width = 73, ;
Name = "Text2"
Add Object label3 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 10, ;
BackStyle = 0, ;
Caption = "Rightclick on image1 to save in MSpaint as ...", ;
Height = 18, ;
Left = 326, ;
Top = 149, ;
Width = 290, ;
ForeColor = Rgb(255,0,0), ;
Name = "Label3"
Add Object label4 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 10, ;
BackStyle = 1, ;
Caption = "Can resize image directly from textboxes above!", ;
Height = 18, ;
Left = 328, ;
Top = 106, ;
Width = 310, ;
ForeColor = Rgb(255,0,0), ;
BackColor = Rgb(255,255,128), ;
Name = "Label4"
Procedure ysave
Lparameters xpict
#Define CF_BITMAP 2
#Define CF_DIB 8
#Define IMAGE_BITMAP 0
#Define LR_LOADFROMFILE 16
#Define LR_MONOCHROME 0x00000001 && Creates a new monochrome image. if used
m.lnWidth=Thisform.text1.Value
m.lnHeight=Thisform.text2.Value
Messagebox("Width="+Trans(m.lnWidth)+" px Height="+Trans(m.lnHeight)+" px .....can resize image in code !",0+32+4096,'',2000)
*Save the bitmap file to the clipboard
nBitmap=0
hbm=0
GdipCreateBitmapFromFile(Strconv(m.xpict+0h00,5),@nBitmap)
GdipCreateHBITMAPFromBitmap(nBitmap,@hbm,0)
lhBmp = CopyImage(hbm, 0, m.lnWidth, m.lnHeight,0) &&resize if want
If OpenClipboard(0)!= 0
EmptyClipboard()
SetClipboardData(CF_BITMAP, lhBmp)
CloseClipboard()
If Messagebox("image "+Allt(m.xpict)+" copied to clipboard! want to show on MSpaint...save as... ?",4+64+4096)=6
*to ensure the image is in clipbrd fire mspaint ans paste int
Run/N mspaint
Sleep(2000)
Local oshell
oshell=Newobject("wscript.shell")
oshell.sendkeys("^{v}") &&standard wundows hotkey CTRL+V
Endi
Endi
Endproc
Procedure Destroy
Clea Events
Endproc
Procedure Load
Declare Integer Sleep In kernel32 Integer
Declare Integer OpenClipboard In User32 Integer
Declare Integer CloseClipboard In User32
Declare Integer EmptyClipboard In User32
Declare Integer SetClipboardData In User32 Integer,Integer
Declare Integer LoadImage In WIN32API Integer,String,Integer,Integer,Integer,Integer
Declare Integer GetClipboardData In User32 Integer
Declare Integer GdipCreateBitmapFromHBITMAP In GDIPlus.Dll Integer, Integer, Integer @
Declare Integer GdipSaveImageToFile In GDIPlus.Dll Integer,String,String @,String @
Declare Long GdipCreateHBITMAPFromBitmap In GDIPlus.Dll Long nativeImage, Long @, Long
Declare Long GdipCreateBitmapFromFile In GDIPlus.Dll String FileName, Long @nBitmap
Declare Long GdipCreateBitmapFromFile In GDIPlus.Dll String FileName, Long @nBitmap
Declare Long CopyImage In WIN32API Long hImage, Long, Long, Long , Long
Endproc
Procedure command1.Click
Local m.xpict
m.xpict=Getpict()
If Empty(m.xpict)
Return .F.
Endi
Thisform.image1.Picture=m.xpict
Thisform.image1.Visible=.T.
Local m.oo
m.oo=Newobject("image")
m.oo.Picture=Thisform.image1.Picture
Thisform.text1.Value=m.oo.Width
Thisform.text2.Value=m.oo.Height
Endproc
Procedure image1.RightClick
Thisform.ysave(This.Picture)
Endproc
Enddefine
*
*-- EndDefine: ycaptureIM
