File: u_tabpg_picture.sru
Size: 14335
Date: Sun, 01 Aug 2021 16:39:44 +0200
$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 "CreateFileW"

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), EncodingAnsi!)
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)

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)

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 correctaspectratio = true
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