$PBExportHeader$u_tabpg_picture.sru forward global type u_tabpg_picture from u_base_tabpg end type type cb_100pct from commandbutton within u_tabpg_picture end type type cb_center from commandbutton within u_tabpg_picture end type type cb_fromclipboard from commandbutton within u_tabpg_picture end type type cb_toclipboard from commandbutton within u_tabpg_picture end type type cb_clear from commandbutton within u_tabpg_picture end type type cb_resource from commandbutton within u_tabpg_picture end type type cb_print from commandbutton within u_tabpg_picture end type type cb_rotate from commandbutton within u_tabpg_picture end type type cb_save from commandbutton within u_tabpg_picture end type type cb_fromblob from commandbutton within u_tabpg_picture end type type cb_verticalfit from commandbutton within u_tabpg_picture end type type cb_horizontalfit from commandbutton within u_tabpg_picture end type type st_zoom from statictext within u_tabpg_picture end type type cb_loadimage from commandbutton within u_tabpg_picture end type type uo_pict from u_cst_picture within u_tabpg_picture end type end forward global type u_tabpg_picture from u_base_tabpg string text = "Picture" cb_100pct cb_100pct cb_center cb_center cb_fromclipboard cb_fromclipboard cb_toclipboard cb_toclipboard cb_clear cb_clear cb_resource cb_resource cb_print cb_print cb_rotate cb_rotate cb_save cb_save cb_fromblob cb_fromblob cb_verticalfit cb_verticalfit cb_horizontalfit cb_horizontalfit st_zoom st_zoom cb_loadimage cb_loadimage uo_pict uo_pict end type global u_tabpg_picture u_tabpg_picture type prototypes Function long CreateFile ( & string lpFileName, & ulong dwDesiredAccess, & ulong dwShareMode, & ulong lpSecurityAttributes, & ulong dwCreationDisposition, & ulong dwFlagsAndAttributes, & ulong hTemplateFile & ) Library "kernel32.dll" Alias For "CreateFileA" Function boolean CloseHandle ( & long hObject & ) Library "kernel32.dll" Function boolean ReadFile ( & long hFile, & Ref blob lpBuffer, & ulong nNumberOfBytesToRead, & Ref ulong lpNumberOfBytesRead, & ulong lpOverlapped & ) Library "kernel32.dll" end prototypes forward prototypes private function boolean of_readfile (string as_filename, ref blob ablob_data) end prototypes private function boolean of_readfile (string as_filename, ref blob ablob_data);// constants for CreateFile API function Constant Long INVALID_HANDLE_VALUE = -1 Constant ULong GENERIC_READ = 2147483648 Constant ULong GENERIC_WRITE = 1073741824 Constant ULong FILE_SHARE_READ = 1 Constant ULong FILE_SHARE_WRITE = 2 Constant ULong CREATE_NEW = 1 Constant ULong CREATE_ALWAYS = 2 Constant ULong OPEN_EXISTING = 3 Constant ULong OPEN_ALWAYS = 4 Constant ULong TRUNCATE_EXISTING = 5 ULong lul_bytes, lul_length Long ll_hFile Blob lblob_filedata Boolean lb_result // get file length lul_length = FileLength(as_filename) // open file for read ll_hFile = CreateFile(as_filename, GENERIC_READ, & FILE_SHARE_READ, 0, OPEN_EXISTING, 0, 0) If ll_hFile = INVALID_HANDLE_VALUE Then Return False End If // read the entire file contents in one shot lblob_filedata = Blob(Space(lul_length)) lb_result = ReadFile(ll_hFile, lblob_filedata, & lul_length, lul_bytes, 0) ablob_data = BlobMid(lblob_filedata, 1, lul_length) // close the file CloseHandle(ll_hFile) Return lb_result end function on u_tabpg_picture.create int iCurrent call super::create this.cb_100pct=create cb_100pct this.cb_center=create cb_center this.cb_fromclipboard=create cb_fromclipboard this.cb_toclipboard=create cb_toclipboard this.cb_clear=create cb_clear this.cb_resource=create cb_resource this.cb_print=create cb_print this.cb_rotate=create cb_rotate this.cb_save=create cb_save this.cb_fromblob=create cb_fromblob this.cb_verticalfit=create cb_verticalfit this.cb_horizontalfit=create cb_horizontalfit this.st_zoom=create st_zoom this.cb_loadimage=create cb_loadimage this.uo_pict=create uo_pict iCurrent=UpperBound(this.Control) this.Control[iCurrent+1]=this.cb_100pct this.Control[iCurrent+2]=this.cb_center this.Control[iCurrent+3]=this.cb_fromclipboard this.Control[iCurrent+4]=this.cb_toclipboard this.Control[iCurrent+5]=this.cb_clear this.Control[iCurrent+6]=this.cb_resource this.Control[iCurrent+7]=this.cb_print this.Control[iCurrent+8]=this.cb_rotate this.Control[iCurrent+9]=this.cb_save this.Control[iCurrent+10]=this.cb_fromblob this.Control[iCurrent+11]=this.cb_verticalfit this.Control[iCurrent+12]=this.cb_horizontalfit this.Control[iCurrent+13]=this.st_zoom this.Control[iCurrent+14]=this.cb_loadimage this.Control[iCurrent+15]=this.uo_pict end on on u_tabpg_picture.destroy call super::destroy destroy(this.cb_100pct) destroy(this.cb_center) destroy(this.cb_fromclipboard) destroy(this.cb_toclipboard) destroy(this.cb_clear) destroy(this.cb_resource) destroy(this.cb_print) destroy(this.cb_rotate) destroy(this.cb_save) destroy(this.cb_fromblob) destroy(this.cb_verticalfit) destroy(this.cb_horizontalfit) destroy(this.st_zoom) destroy(this.cb_loadimage) destroy(this.uo_pict) end on event constructor;call super::constructor;uo_pict.SetMousePan(True) end event type cb_100pct from commandbutton within u_tabpg_picture integer x = 3291 integer y = 1568 integer width = 443 integer height = 100 integer taborder = 140 integer textsize = -8 integer weight = 400 fontcharset fontcharset = ansi! fontpitch fontpitch = variable! fontfamily fontfamily = swiss! string facename = "Tahoma" string text = "100 Pct" end type event clicked;uo_pict.SetZoom(100) st_zoom.text = "Zoom: " + String(uo_pict.ZoomPct, "###0.0###") end event type cb_center from commandbutton within u_tabpg_picture integer x = 3291 integer y = 1440 integer width = 443 integer height = 100 integer taborder = 130 integer textsize = -8 integer weight = 400 fontcharset fontcharset = ansi! fontpitch fontpitch = variable! fontfamily fontfamily = swiss! string facename = "Tahoma" string text = "Center" end type event clicked;uo_pict.Center() end event type cb_fromclipboard from commandbutton within u_tabpg_picture integer x = 3291 integer y = 1184 integer width = 443 integer height = 100 integer taborder = 110 integer textsize = -8 integer weight = 400 fontcharset fontcharset = ansi! fontpitch fontpitch = variable! fontfamily fontfamily = swiss! string facename = "Tahoma" string text = "From Clipboard" end type event clicked;// get image from Clipboard If Not uo_pict.LoadClipboard() Then MessageBox("Clipboard", error.Text, StopSign!) End If end event type cb_toclipboard from commandbutton within u_tabpg_picture integer x = 3291 integer y = 1312 integer width = 443 integer height = 100 integer taborder = 120 integer textsize = -8 integer weight = 400 fontcharset fontcharset = ansi! fontpitch fontpitch = variable! fontfamily fontfamily = swiss! string facename = "Tahoma" string text = "To Clipboard" end type event clicked;// send image to Clipboard If Not uo_pict.Clipboard() Then MessageBox("Clipboard", error.Text, StopSign!) End If end event type cb_clear from commandbutton within u_tabpg_picture integer x = 3291 integer y = 800 integer width = 443 integer height = 100 integer taborder = 80 integer textsize = -8 integer weight = 400 fontcharset fontcharset = ansi! fontpitch fontpitch = variable! fontfamily fontfamily = swiss! string facename = "Tahoma" string text = "Clear" end type event clicked;uo_pict.Clear() end event type cb_resource from commandbutton within u_tabpg_picture integer x = 3291 integer y = 160 integer width = 443 integer height = 100 integer taborder = 30 integer textsize = -8 integer weight = 400 fontcharset fontcharset = ansi! fontpitch fontpitch = variable! fontfamily fontfamily = swiss! string facename = "Tahoma" string text = "From Resource" end type event clicked;uo_pict.SetTransParent(True) // load PowerBuilder resource bitmap If Not uo_pict.LoadBitmap("Continue!") Then MessageBox("LoadBitmap", error.Text, StopSign!) End If end event type cb_print from commandbutton within u_tabpg_picture integer x = 3291 integer y = 928 integer width = 443 integer height = 100 integer taborder = 90 integer textsize = -8 integer weight = 400 fontcharset fontcharset = ansi! fontpitch fontpitch = variable! fontfamily fontfamily = swiss! string facename = "Tahoma" string text = "Print" end type event clicked;uo_pict.Print() end event type cb_rotate from commandbutton within u_tabpg_picture integer x = 3291 integer y = 672 integer width = 443 integer height = 100 integer taborder = 70 integer textsize = -8 integer weight = 400 fontcharset fontcharset = ansi! fontpitch fontpitch = variable! fontfamily fontfamily = swiss! string facename = "Tahoma" string text = "Rotate" end type event clicked;uo_pict.RotateFlip(uo_pict.Rotate90FlipNone) end event type cb_save from commandbutton within u_tabpg_picture integer x = 3291 integer y = 1056 integer width = 443 integer height = 100 integer taborder = 100 integer textsize = -8 integer weight = 400 fontcharset fontcharset = ansi! fontpitch fontpitch = variable! fontfamily fontfamily = swiss! string facename = "Tahoma" string text = "Save" end type event clicked;Integer li_rc String ls_pathname, ls_filename li_rc = GetFileSaveName("Save Image File", & ls_pathname, ls_filename, "", & "Bitmap (*.bmp),*.bmp," + & "GIF (*.gif),*.gif," + & "JPEG (*.jpg),*.jpg," + & "PNG (*.png),*.png," + & "TIFF (*.tif),*.tif") If li_rc = 1 Then If uo_pict.SaveImage(ls_pathname) Then MessageBox("SaveImage", "File saved: " + ls_filename) Else MessageBox("SaveImage", error.Text, StopSign!) End If End If end event type cb_fromblob from commandbutton within u_tabpg_picture integer x = 3291 integer y = 288 integer width = 443 integer height = 100 integer taborder = 40 integer textsize = -8 integer weight = 400 fontcharset fontcharset = ansi! fontpitch fontpitch = variable! fontfamily fontfamily = swiss! string facename = "Tahoma" string text = "From Blob" end type event clicked;Integer li_rc String ls_pathname, ls_filename Blob lblb_image li_rc = GetFileOpenName("Select Image File", & ls_pathname, ls_filename, "bmp", & "Supported Image Files, *.bmp;*.gif;*.jpg;" + & "*.jpeg;*.png;*.wmf;*.emf;*.tif;*.tiff") If li_rc = 1 Then If Lower(Right(ls_filename, 4)) = ".bmp" Then uo_pict.SetTransParent(True) Else uo_pict.SetTransParent(False) End If If of_ReadFile(ls_pathname, lblb_image) Then If Not uo_pict.LoadImage(lblb_image) Then MessageBox("LoadImage", error.Text, StopSign!) End If End If End If end event type cb_verticalfit from commandbutton within u_tabpg_picture integer x = 3291 integer y = 416 integer width = 443 integer height = 100 integer taborder = 50 integer textsize = -8 integer weight = 400 fontcharset fontcharset = ansi! fontpitch fontpitch = variable! fontfamily fontfamily = swiss! string facename = "Tahoma" string text = "Vertical Fit" end type event clicked;uo_pict.ZoomVertical() st_zoom.text = "Zoom: " + String(uo_pict.ZoomPct, "###0.0###") end event type cb_horizontalfit from commandbutton within u_tabpg_picture integer x = 3291 integer y = 544 integer width = 443 integer height = 100 integer taborder = 60 integer textsize = -8 integer weight = 400 fontcharset fontcharset = ansi! fontpitch fontpitch = variable! fontfamily fontfamily = swiss! string facename = "Tahoma" string text = "Horizontal Fit" end type event clicked;uo_pict.ZoomHorizontal() st_zoom.text = "Zoom: " + String(uo_pict.ZoomPct, "###0.0###") end event type st_zoom from statictext within u_tabpg_picture integer x = 3291 integer y = 1952 integer width = 443 integer height = 68 integer textsize = -8 integer weight = 400 fontcharset fontcharset = ansi! fontpitch fontpitch = variable! fontfamily fontfamily = swiss! string facename = "Tahoma" long textcolor = 33554432 long backcolor = 67108864 string text = "Zoom Pct: 100.0" boolean focusrectangle = false end type type cb_loadimage from commandbutton within u_tabpg_picture integer x = 3291 integer y = 32 integer width = 443 integer height = 100 integer taborder = 20 integer textsize = -8 integer weight = 400 fontcharset fontcharset = ansi! fontpitch fontpitch = variable! fontfamily fontfamily = swiss! string facename = "Tahoma" string text = "Load Image" end type event clicked;Integer li_rc String ls_pathname, ls_filename, ls_Extn li_rc = GetFileOpenName("Select Image File", & ls_pathname, ls_filename, "bmp", & "Supported Image Files, " + & "*.bmp;*.emf;*.gif;*.ico;*.jpg;" + & "*.jpeg;*.png;*.tif;*.tiff;*.wmf") If li_rc = 1 Then ls_Extn = Mid(ls_filename, Pos(ls_filename, ".")) If Lower(ls_Extn) = ".bmp" Or Lower(ls_Extn) = ".ico" Then uo_pict.SetTransParent(True) Else uo_pict.SetTransParent(False) End If If Lower(ls_Extn) = ".ico" Then If Not uo_pict.LoadLargeIcon(ls_pathname) Then MessageBox("LoadImage", error.Text, StopSign!) End If Else If Not uo_pict.LoadImage(ls_pathname) Then MessageBox("LoadImage", error.Text, StopSign!) End If End If End If end event type uo_pict from u_cst_picture within u_tabpg_picture event lbuttondblclk pbm_lbuttondblclk event rbuttondblclk pbm_rbuttondblclk integer x = 37 integer y = 32 integer width = 3186 integer height = 1988 integer taborder = 10 boolean zoombestfit = true boolean transparent = true end type event lbuttondblclk;If ZoomPct > 25 Then SetZoom(Integer(ZoomPct) - 25) End If st_zoom.text = "Zoom Pct: " + String(ZoomPct, "###0.0###") end event event rbuttondblclk;SetZoom(Integer(ZoomPct) + 25) st_zoom.text = "Zoom Pct: " + String(ZoomPct, "###0.0###") end event on uo_pict.destroy call u_cst_picture::destroy end on event afterload;call super::afterload;st_zoom.text = "Zoom Pct: " + String(ZoomPct, "###0.0###") end event
File: u_tabpg_picture.sru
Size: 14311
Date: Mon, 31 Dec 2018 21:14:38 +0100
Size: 14311
Date: Mon, 31 Dec 2018 21:14:38 +0100
- u_base_tabpg u_tabpg_picture(sru)
- commandbutton cb_100pct
- commandbutton cb_center
- commandbutton cb_fromclipboard
- commandbutton cb_toclipboard
- commandbutton cb_clear
- commandbutton cb_resource
- commandbutton cb_print
- commandbutton cb_rotate
- commandbutton cb_save
- commandbutton cb_fromblob
- commandbutton cb_verticalfit
- commandbutton cb_horizontalfit
- statictext st_zoom
- commandbutton cb_loadimage
- u_cst_picture uo_pict