VB screenshot 1

Source: Internet
Author: User
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 longprivate declare function getdc lib "USER32" (byval hwnd as long) as longprivate declare function using lib "gdiplus" (token as long, inputbuf as long, byval outputbuf as long) as longprivate declare function using lib "gdiplus" (byval token as long) as longprivate declare function using lib "gdiplus" (byval HBM as long, byval hpal as long, bitmap as long) as longprivate declare function gdipdisposeimage lib "gdiplus" (byval image as long) as longprivate declare function gdipsaveimagetofile lib "gdiplus" (byval image as long, byval filename as long, clsidencoder as guid, encoderparams as any) as longprivate declare function clsidfromstring lib "OLE32" (byval STR as long, ID as guid) as longprivate declare function using lib "gdiplus" (byval filename as long, bitmap as long) as longprivate type guid data1 as long data2 as integer data3 as integer data4 (0 to 7) as byteend ready type defined gdiplusversion as long defined as longend defined type encoderparameter guid as guid numberofvalues as long type as long value as longend typeprivate type encoderparameters count as long parameter encoderparameterend typeprivate sub form_load () dim rfn as stringdim RET as booleanrfn = getfnme. hideme. autoredraw = truepicture1.width = screen. width + 30picture1. height = screen. height + 30 bitblt picture1.hdc, 0, 0, screen. width + 30, screen. height + 30, getdc (0), 0, 0, vbsrccopyset picture1.picture = picture1.imageret = pictureboxsavejpg (picture1.picture, replace (App. path & "\" & rfn &". jpg "," \ "," \ ") 'Save the compressed image endend subfunction getfn () as stringdim dd as string, TT as stringdd = Replace (CSTR (date), "-", ""): TT = Replace (CSTR (time ),":","") tt = Replace (TT, "Afternoon", "PM"): TT = Replace (TT, "Morning", "am") getfn = Replace (DD & TT ,"", "") end functionprivate function pictureboxsavejpg (byval PICT as stdpicture, byval filename as string, optional byval quality as byte = 80) as Boolean dim TSI as gdiplusstartupinput dim lres as long dim lgdip as long dim lbitmap as long 'initialize GDI + TSI. gdiplusversion = 1 lres = gdiplusstartup (lgdip, TSI, 0) If lres = 0 then 'create a GDI + image lres = gdipcreatebitmapfromhbitmap (Pict. handle, 0, lbitmap) If lres = 0 then dim tjpgencoder as guid dim tparams as encoderparameters The guid id of the initialization decoder clsidfromstring strptr ("{identifier }"), tjpgencoder 'sets the decoder parameter tparams. count = 1 with tparams. parameter 'quality' gets the guid of the quality parameter. clsidfromstring strptr ("{1d5be4b5-fa4a-452d-9cdd-5db35105e7eb }"),. guid. numberofvalues = 1. type = 4. value = varptr (quality) end with 'Save image lres = gdipsaveimagetofile (lbitmap, strptr (filename), tjpgencoder, tparams) 'Destroy GDI + image gdipdisposeimage lbitmap end if' destroy GDI + gdiplusshutdown lgdip end if lres then pictureboxsavejpg = false else pictureboxsavejpg = true end ifend Function

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.