PBMiner

$PBExportHeader$u_cst_picture.sru
forward
global type u_cst_picture from u_cst_canvas
end type
type st_name from statictext within u_cst_picture
end type
type bitmap from structure within u_cst_picture
end type
type gdiplusstartupinput from structure within u_cst_picture
end type
type gdiplusstartupoutput from structure within u_cst_picture
end type
type rect from structure within u_cst_picture
end type
type rectf from structure within u_cst_picture
end type
type clsid from structure within u_cst_picture
end type
type imagecodecinfo from structure within u_cst_picture
end type
type docinfo from structure within u_cst_picture
end type
end forward

type bitmap from structure
   long     bmtype
   long     bmwidth
   long     bmheight
   long     bmwidthbytes
   unsignedinteger      bmplanes
   unsignedinteger      bmbitsperpixel
   unsignedlong      bmbits
end type

type gdiplusstartupinput from structure
   long     gdiplusversion
   long     debugeventcallback
   long     suppressbackgroundthread
   long     suppressexternalcodecs
end type

type gdiplusstartupoutput from structure
   long     notificationhook
   long     notificationunhook
end type

type rect from structure
   long     left
   long     top
   long     right
   long     bottom
end type

type rectf from structure
   real     x
   real     y
   real     width
   real     height
end type

type clsid from structure
   long     data1
   long     data2
   long     data3
   long     data4
end type

type imagecodecinfo from structure
   clsid    classid
   clsid    formatid
   long     codecname
   long     dllname
   long     formatdescription
   long     filenameextension
   long     mimetype
   unsignedlong      flags
   unsignedlong      version
   unsignedlong      sigcount
   unsignedlong      sigsize
   long     sigpattern
   long     sigmask
end type

type docinfo from structure
   long     cbsize
   string      lpszdocname
   long     lpszoutput
   long     lpszdatatype
   long     fwtype
end type

global type u_cst_picture from u_cst_canvas
integer width = 1070
integer height = 612
long backcolor = 8421376
event lbuttondown pbm_lbuttondown
event lbuttonup pbm_lbuttonup
event mousemove pbm_mousemove
event afterload ( )
st_name st_name
end type
global u_cst_picture u_cst_picture

type prototypes
Function long FN_ResGetBitmapID_100( &
   string lpImageName &
   ) Library "pbvm100.dll" Alias For "FN_ResGetBitmapID"

Function long FN_ResGetBitmapID_105( &
   string lpImageName &
   ) Library "pbvm105.dll" Alias For "FN_ResGetBitmapID"

Function long FN_ResGetBitmapID_110( &
   string lpImageName &
   ) Library "pbvm110.dll" Alias For "FN_ResGetBitmapID"

Function long FN_ResGetBitmapID_115( &
   string lpImageName &
   ) Library "pbvm115.dll" Alias For "FN_ResGetBitmapID"

Function long FN_ResGetBitmapID_120( &
   string lpImageName &
   ) Library "pbvm120.dll" Alias For "FN_ResGetBitmapID"

Function long FN_ResGetBitmapID_125( &
   string lpImageName &
   ) Library "pbvm125.dll" Alias For "FN_ResGetBitmapID"

Function long FN_ResGetBitmapID_126( &
   string lpImageName &
   ) Library "pbvm126.dll" Alias For "FN_ResGetBitmapID"

Function long FN_ResGetBitmapID_170( &
   string lpImageName &
   ) Library "pbvm170.dll" Alias For "FN_ResGetBitmapID"

Function long FN_ResGetBitmapID_190( &
   string lpImageName &
   ) Library "pbvm190.dll" Alias For "FN_ResGetBitmapID"

Function long FN_ResGetBitmapID_Any( &
   string lpImageName &
   ) Library "pbvm.dll" Alias For "FN_ResGetBitmapID"

Function ulong ExtractIconEx( &
   string lpszFile, &
   long nIconIndex, &
   Ref long phIconLarge[], &
   Ref long phIconSmall[], &
   ulong nIcons &
   ) Library "shell32.dll" Alias For "ExtractIconExW"

Function boolean DestroyIcon ( &
   long hIcon &
   ) Library "user32.dll"

Function boolean DrawIconEx ( &
   ulong hdc, &
   long xLeft, &
   long yTop, &
   ulong hIcon, &
   long cxWidth, &
   long cyWidth, &
   ulong istepIfAniCur, &
   long hbrFlickerFreeDraw, &
   ulong diFlags &
   ) Library "user32.dll"

Function boolean GetClientRect( &
   long hWnd, &
   Ref RECT lpRect &
   ) Library "user32.dll"

Function long GdiplusStartup( &
   Ref ulong token, &
   GdiplusStartupInput input, &
   Ref GdiplusStartupOutput output &
   ) Library "gdiplus.dll"

Subroutine GdiplusShutdown( &
   ulong token &
   ) Library "gdiplus.dll"

Function long GdipDisposeImage( &
   ulong image &
   ) Library "gdiplus.dll"

Function long GdipCreateBitmapFromFileICM( &
   string filename, &
   Ref ulong bitmap &
   ) Library "gdiplus.dll"

Function long GdipCreateFromHDC( &
   ulong hdc, &
   Ref ulong graphics &
   ) Library "gdiplus.dll"

Function long GdipSetSmoothingMode( &
   ulong graphics, &
   ulong smoothingMode &
   ) Library "gdiplus.dll"

Function long GdipDrawImageRectRectI( &
   ulong graphics, &
   ulong image, &
   long dstx, &
   long dsty, &
   long dstwidth, &
   long dstheight, &
   long srcx, &
   long srcy, &
   long srcwidth, &
   long srcheight, &
   long srcUnit, &
   ulong imageAttributes, &
   long callback, &
   long callbackData &
   ) Library "gdiplus.dll"

Function long GdipDeleteGraphics( &
   ulong graphics &
   ) Library "gdiplus.dll"

Function long GdipGetImageBounds( &
   ulong image, &
   Ref RECTF srcRect, &
   Ref long srcUnit &
   ) Library "gdiplus.dll"

Function long GdipCreateImageAttributes( &
   Ref ulong gImgattr &
   ) Library "gdiplus.dll"

Function long GdipDisposeImageAttributes( &
   ulong gImgattr &
   ) Library "gdiplus.dll"

Function long GdipBitmapGetPixel( &
   ulong bitmap, &
   long lx, &
   long ly, &
   Ref ulong argb &
   ) Library "gdiplus.dll"

Function long GdipSetImageAttributesColorKeys( &
   ulong gImgattr, &
   long colorAdjustType, &
   boolean enableFlag, &
   ulong argbColorLow, &
   ulong argbColorHigh &
   ) Library "gdiplus.dll"

Function long GdipSetInterpolationMode( &
   ulong graphics, &
   long interpolationMode &
   ) Library "gdiplus.dll"

Function long GdipCreateBitmapFromResource( &
   long hInstance, &
   string lpBitmapName, &
   Ref ulong bitmap &
   ) Library "gdiplus.dll"

Function long GdipGetImageHorizontalResolution( &
       ulong pImage, &
       Ref real resolution &
       ) Library "gdiplus.dll"

Function long GdipGetImageVerticalResolution( &
       ulong pImage, &
       Ref real resolution &
       ) Library "gdiplus.dll"

Function long LoadLibraryEx( &
   string lpFileName, &
   long hFile, &
   long dwFlags &
   ) Library "kernel32.dll" Alias For "LoadLibraryExW"

Function boolean FreeLibrary( &
   long hModule &
   ) Library "kernel32.dll"

Function ulong GlobalAlloc ( &
   ulong uFlags, &
   long dwBytes &
   ) Library "kernel32.dll"

Function ulong GlobalLock ( &
   ulong hMem &
   ) Library "kernel32.dll"

Subroutine CopyMemory ( &
   ulong Destination, &
   blob Source, &
   long Length &
   ) Library "kernel32.dll" Alias For "RtlMoveMemory"

Function long CreateStreamOnHGlobal( &
   ulong hGlobal, &
   boolean fDeleteOnRelease, &
   Ref ulong ppstm &
   ) Library "ole32.dll"

Function long GdipCreateBitmapFromStreamICM( &
   ulong stream, &
   Ref ulong bitmap &
   ) Library "gdiplus.dll"

Function ulong GlobalUnlock ( &
   ulong hMem &
   ) Library "kernel32.dll"

Function ulong GlobalFree ( &
   ulong hMem &
   ) Library "kernel32.dll"

Function long GdipGetImageEncodersSize( &
   Ref ulong numEncoders, &
   Ref ulong size &
   ) Library "gdiplus.dll"

Function long GdipGetImageEncoders( &
   ulong numEncoders, &
   ulong size, &
   Ref ImageCodecInfo gEncoders[] &
   ) Library "gdiplus.dll"

Function long GdipCloneImage( &
   ulong image, &
   Ref ulong cloneImage &
   ) Library "gdiplus.dll"

Function long GdipSaveImageToFile( &
   ulong image, &
   string filename, &
   Ref CLSID clsidEncoder, &
   long encoderParams &
   ) Library "gdiplus.dll"

Function long GdipImageRotateFlip( &
   ulong image, &
   long rfType &
   ) Library "gdiplus.dll"

Function Long GetDC( &
   Long hWnd &
   ) Library "user32.dll"

Function Long ReleaseDC( &
   Long hWnd, &
   Long hDC &
   ) Library "user32.dll"

Function ulong CreateDC( &
   ulong lpszDriver, &
   string lpszDevice, &
   ulong lpszOutput, &
   ulong lpInitData &
   ) Library "gdi32.dll" Alias For "CreateDCW"

Function ulong StartDoc( &
   ulong hdc, &
   DOCINFO lpdi &
   ) Library "gdi32.dll" Alias For "StartDocW"

Function ulong EndDoc( &
   ulong hdc &
   ) Library "gdi32.dll"

Function ulong StartPage( &
   ulong hdc &
   ) Library "gdi32.dll"

Function ulong EndPage( &
   ulong hdc &
   ) Library "gdi32.dll"

Function boolean GetDefaultPrinter( &
   Ref string pszBuffer, &
   Ref ulong pcchBuffer &
   ) Library "winspool.drv" Alias For "GetDefaultPrinterW"

Function Boolean StretchBlt( &
   Long hdcDest, &
   Integer nXOriginDest, &
   Integer nYOriginDest, &
   Integer nWidthDest, &
   Integer nHeightDest, &
   Long hdcSrc, &
   Integer nXOriginSrc, &
   Integer nYOriginSrc, &
   Integer nWidthSrc, &
   Integer nHeightSrc, &
   Long dwRop &
   ) Library "gdi32.dll"

Function Boolean OpenClipboard ( &
   Long hWndNewOwner &
   ) Library "user32.dll"

Function Boolean EmptyClipboard ( &
   ) Library "user32.dll"

Function Boolean CloseClipboard ( &
   ) Library "user32.dll"

Function Long SetClipboardData ( &
   UInt uFormat, &
   Long hMem &
   ) Library "user32.dll"

Function Long GetClipboardData ( &
   UInt uFormat &
   ) Library "user32.dll"

Function long GdipCreateBitmapFromHBITMAP( &
   ulong hbm, &
   ulong hpal, &
   Ref ulong pbitmap &
   ) Library "gdiplus.dll"

end prototypes

type variables
Public:

String ImageName
Boolean CorrectAspectRatio
Boolean StretchToFit
Boolean ZoomBestFit
Boolean ResizeControl
Boolean Transparent
Decimal{3} ZoomPct = 100

// rotate flip type
Constant Long RotateNoneFlipNone = 0
Constant Long Rotate90FlipNone   = 1
Constant Long Rotate180FlipNone  = 2
Constant Long Rotate270FlipNone  = 3
Constant Long RotateNoneFlipX    = 4
Constant Long Rotate90FlipX      = 5
Constant Long Rotate180FlipX     = 6
Constant Long Rotate270FlipX     = 7
Constant Long RotateNoneFlipY    = Rotate180FlipX
Constant Long Rotate90FlipY      = Rotate270FlipX
Constant Long Rotate180FlipY     = RotateNoneFlipX
Constant Long Rotate270FlipY     = Rotate90FlipX
Constant Long RotateNoneFlipXY   = Rotate180FlipNone
Constant Long Rotate90FlipXY     = Rotate270FlipNone
Constant Long Rotate180FlipXY    = RotateNoneFlipNone
Constant Long Rotate270FlipXY    = Rotate90FlipNone

Private:

Long il_hWnd, il_IconSize, il_LastStatus
ULong iul_hBitmap, iul_GdiToken, iul_hIcon
ULong iul_hGlobal, iul_pGlobalBuffer, iul_pImageStream
Boolean ib_MousePan
Real ir_AspectCorrection = 1.0

Integer ii_start_x, ii_start_y
Integer ii_click_x, ii_click_y

Constant Long STATUS_OK = 0
Constant Long QualityModeHigh = 2
Constant Long InterpolationModeHighQualityBicubic = QualityModeHigh + 5
Constant Long SmoothingModeHighQuality = QualityModeHigh
Constant Long ColorAdjustTypeBitmap = 1
Constant Long UnitPixel = 2
Constant ULong GMEM_MOVEABLE = 2

end variables

forward prototypes
private subroutine of_mousepan (integer xpos, integer ypos)
public function string pbvmbitmapid (string as_imagename)
public subroutine center ()
public subroutine clear ()
public function boolean loadbitmap (string as_filename, string as_resourceid)
public function boolean loadbitmap (string as_imagename)
public function boolean loadimage (blob ablb_imagedata)
public function boolean loadimage (string as_filename)
public function boolean loadlargeicon (string as_filename)
public function boolean loadlargeicon (string as_filename, long al_index)
public function boolean loadsmallicon (string as_filename)
public function boolean loadsmallicon (string as_filename, long al_index)
private subroutine of_destroy ()
private function boolean of_drawbitmap (unsignedlong hdc)
private function boolean of_drawicon (unsignedlong hdc)
private function string of_gdistatusmsg ()
public function boolean print ()
public function boolean print (string as_printername)
public function boolean rotateflip (long al_rftype)
public function boolean saveimage (string as_filename)
public subroutine setmousepan (boolean ab_value)
public subroutine setresizecontrol (boolean ab_value)
public subroutine setstretchtofit (boolean ab_value)
public subroutine settransparent (boolean ab_value)
public subroutine setzoom (decimal adec_value)
public subroutine setzoombestfit (boolean ab_value)
public subroutine zoomhorizontal ()
public subroutine zoomvertical ()
public function boolean clipboard ()
public function boolean loadclipboard ()
end prototypes

event lbuttondown;// record click position
ii_click_x = xpos
ii_click_y = ypos

end event

event lbuttonup;// reset click position
ii_click_x = 0
ii_click_y = 0

end event

event mousemove;// slide the image the mouse
If ib_MousePan And flags = 1 Then
   of_MousePan(xpos, ypos)
End If

end event

event afterload();// this event is triggered after an image is loaded

end event

private subroutine of_mousepan (integer xpos, integer ypos);// -----------------------------------------------------------------------------
// SCRIPT:     u_cst_picture.of_MousePan
//
// PURPOSE:    This function calculates the starting point to draw the image
//             after being moved by the mouse.
//
// ARGUMENTS:  xpos  - X position of the mouse in pixels
//             ypos  - Y position of the mouse in pixels
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 07/01/2013  RolandS     Initial coding
// -----------------------------------------------------------------------------

RECT lstr_Rect
RECTF lstr_gRect
Integer li_offset_x, li_offset_y
Long ll_Width, ll_Height, ll_Units

// get control size
GetClientRect(il_hWnd, lstr_Rect)

// get image size
GdipGetImageBounds(iul_hBitmap, lstr_gRect, ll_Units)

li_offset_x = ii_click_x - xpos
li_offset_y = ii_click_y - ypos

ii_start_x = ii_start_x + (li_offset_x / 2)
If ii_start_x < 0 Then
   ii_start_x = 0
End If

ii_start_y = ii_start_y + (li_offset_y / 2)
If ii_start_y < 0 Then
   ii_start_y = 0
End If

ll_Width  = lstr_Rect.Right  * (100 / ZoomPct) * ir_AspectCorrection
ll_Height = lstr_Rect.Bottom * (100 / ZoomPct)

li_offset_x = lstr_gRect.Width  - ll_Width
If ii_start_x > li_offset_x Then
   ii_start_x = li_offset_x
End If
If ii_start_x < 0 Then
   ii_start_x = 0
End If

li_offset_y = lstr_gRect.Height - ll_Height
If ii_start_y > li_offset_y Then
   ii_start_y = li_offset_y
End If
If ii_start_y < 0 Then
   ii_start_y = 0
End If

ii_click_x = xpos
ii_click_y = ypos

SetRedraw(True)

end subroutine

public function string pbvmbitmapid (string as_imagename);// -----------------------------------------------------------------------------
// SCRIPT:     u_cst_picture.PBVMBitmapId
//
// PURPOSE:    This function returns PowerBuilder VM resource id for a named
//             bitmap.
//
// ARGUMENTS:  as_imagename   - The image name
//
// RETURN:     Resource ID
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 07/01/2013  RolandS     Initial coding
// 07/19/2021  RolandS     Added PB 2019 & higher
// -----------------------------------------------------------------------------

Environment le_env
String ls_return
Long ll_index

GetEnvironment(le_env)

choose case le_env.PBMajorRevision
   case 10
      If le_env.PBMinorRevision = 5 Then
         ll_index = FN_ResGetBitmapID_105(as_imagename)
      Else
         ll_index = FN_ResGetBitmapID_100(as_imagename)
      End If
   case 11
      If le_env.PBMinorRevision = 5 Then
         ll_index = FN_ResGetBitmapID_115(as_imagename)
      Else
         ll_index = FN_ResGetBitmapID_110(as_imagename)
      End If
   case 12
      choose case le_env.PBMinorRevision
         case 5
            ll_index = FN_ResGetBitmapID_125(as_imagename)
         case 6
            ll_index = FN_ResGetBitmapID_126(as_imagename)
         case else
            ll_index = FN_ResGetBitmapID_120(as_imagename)
      end choose
   case 17
      ll_index = FN_ResGetBitmapID_170(as_imagename)
   case 19
      If le_env.PBMinorRevision < 2 Then
         ll_index = FN_ResGetBitmapID_190(as_imagename)
      Else
         ll_index = FN_ResGetBitmapID_Any(as_imagename)
      End If
   case else
      ll_index = FN_ResGetBitmapID_Any(as_imagename)
end choose

If ll_index = 0 Then
   SetNull(ls_return)
Else
   ls_return = String(ll_index)
End If

Return ls_return

end function

public subroutine center ();// -----------------------------------------------------------------------------
// SCRIPT:     u_cst_picture.Center
//
// PURPOSE:    This function centers small images within the control.
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 07/01/2013  RolandS     Initial coding
// -----------------------------------------------------------------------------

RECT lstr_Rect
RECTF lstr_gRect
Long ll_Units

ZoomBestFit = False

// get control size
GetClientRect(il_hWnd, lstr_Rect)

// get image size
GdipGetImageBounds(iul_hBitmap, lstr_gRect, ll_Units)

// calculate center point
ii_start_x = -1 * ((lstr_Rect.Right - lstr_gRect.Width) / 2)
ii_start_y = -1 * ((lstr_Rect.Bottom - lstr_gRect.Height) / 2)

ZoomPct = 100

// trigger the OnPaint event
SetRedraw(True)

end subroutine

public subroutine clear ();// -----------------------------------------------------------------------------
// SCRIPT:     u_cst_picture.Clear
//
// PURPOSE:    This function clears the current image.
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 07/01/2013  RolandS     Initial coding
// -----------------------------------------------------------------------------

// initialize the control
of_Destroy()

// trigger the OnPaint event
SetRedraw(True)

end subroutine

public function boolean loadbitmap (string as_filename, string as_resourceid);// -----------------------------------------------------------------------------
// SCRIPT:     u_cst_picture.LoadBitmap
//
// PURPOSE:    This function is used to load a bitmap from a resource dll
//             into the control.
//
// ARGUMENTS:  as_filename    - The name of the resource file
//             as_resourceid  - The resource id number or name
//
// RETURN:     True=Success, False=Error
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 07/01/2013  RolandS     Initial coding
// -----------------------------------------------------------------------------

RECTF lstr_gRect
BITMAP lstr_Bitmap
Constant Long LOAD_LIBRARY_AS_IMAGE_RESOURCE = 32
Long ll_Index, ll_Module, ll_Bitmap, ll_Units
String ls_ResourceID

// release handles
of_Destroy()

// load the library into memory
ll_Module = LoadLibraryEx(as_filename, 0, &
                  LOAD_LIBRARY_AS_IMAGE_RESOURCE)
If ll_Module <= 0 Then
   Return False
End If

// prefix # for numbered resource
If IsNumber(as_resourceid) Then
   ls_ResourceID = "#" + as_resourceid
Else
   ls_ResourceID = as_resourceid
End If

// load the resource into memory
il_LastStatus = GdipCreateBitmapFromResource(ll_Module, ls_ResourceID, iul_hBitmap)
If il_LastStatus <> STATUS_OK Then
   PopulateError(il_LastStatus, of_GdiStatusMsg())
   Return False
End If

// get image size
GdipGetImageBounds(iul_hBitmap, lstr_gRect, ll_Units)

// resize the control to match the image
If Not StretchToFit Then
   If ResizeControl Then
      this.Width  = PixelsToUnits(lstr_gRect.Width, XPixelsToUnits!)
      this.Height = PixelsToUnits(lstr_gRect.Height, YPixelsToUnits!)
   End If
End If

// free the library
FreeLibrary(ll_Module)

ZoomPct = 100

// trigger the OnPaint event
SetRedraw(True)

TriggerEvent("afterload")

Return True

end function

public function boolean loadbitmap (string as_imagename);// -----------------------------------------------------------------------------
// SCRIPT:     u_cst_picture.LoadBitmap
//
// PURPOSE:    This function is used to load an image bitmap from the
//             PowerBuilder VM into the control.
//
// ARGUMENTS:  as_imagename   - The name of the PowerBuilder image
//
// RETURN:     True=Success, False=Error
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 07/01/2013  RolandS     Initial coding
// -----------------------------------------------------------------------------

String ls_resource

// get Resource ID of PowerBuilder picturename
ls_resource = PBVMBitmapId(as_imagename)

If IsNull(ls_resource) Then
   PopulateError(0, "PowerBuilder PictureName not found!")
   Return False
Else
   // load bitmap from resource
   Return LoadBitmap(PBVMName(), ls_resource)
End If

end function

public function boolean loadimage (blob ablb_imagedata);// -----------------------------------------------------------------------------
// SCRIPT:     u_cst_picture.LoadImage
//
// PURPOSE:    This function is used to load an image blob into the control.
//
//             Supported file formats:
//
//                Windows Bitmap                .bmp
//                Graphics Interchange Format   .gif
//                JPEG                          .jpg, .jpeg
//                Portable Network Graphics     .png
//                Windows Metafile              .wmf
//                Enhanced Metafile             .emf
//                Tagged Image File Format      .tif, .tiff
//
// ARGUMENTS:  ablb_imagedata - A blob variable containing the image data
//
// RETURN:     True=Success, False=Error
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 07/01/2013  RolandS     Initial coding
// -----------------------------------------------------------------------------

RECTF lstr_gRect
Long ll_Units, ll_Length

// release handles
of_Destroy()

ll_Length = Len(ablb_imagedata)

// Allocate memory to hold the image
iul_hGlobal = GlobalAlloc(GMEM_MOVEABLE, ll_Length)
If iul_hGlobal > 0 Then
   // Lock the memory
   iul_pGlobalBuffer = GlobalLock(iul_hGlobal)
   If iul_pGlobalBuffer > 0 Then
      // Copy the image from the string buffer to global memory
      CopyMemory(iul_pGlobalBuffer, ablb_imagedata, ll_Length)
      // Create a stream in global memory
      If CreateStreamOnHGlobal(iul_hGlobal, False, iul_pImageStream) = 0 Then
         // Create bitmap from the data contained in the stream
         il_LastStatus = GdipCreateBitmapFromStreamICM(iul_pImageStream, iul_hBitmap)
         If il_LastStatus <> STATUS_OK Then
            // record error message
            PopulateError(il_LastStatus, of_GdiStatusMsg())
            Return False
         End If
      End If
   End If
End If

// get image size
GdipGetImageBounds(iul_hBitmap, lstr_gRect, ll_Units)

// resize the control to match the image
If Not StretchToFit Then
   If ResizeControl Then
      // resize control
      this.Width  = PixelsToUnits(lstr_gRect.Width, XPixelsToUnits!)
      this.Height = PixelsToUnits(lstr_gRect.Height, YPixelsToUnits!)
   End If
End If

ZoomPct = 100

// trigger the OnPaint event
SetRedraw(True)

TriggerEvent("afterload")

Return True

end function

public function boolean loadimage (string as_filename);// -----------------------------------------------------------------------------
// SCRIPT:     u_cst_picture.LoadImage
//
// PURPOSE:    This function is used to load an image file into the control.
//
//             Supported file formats:
//
//                Windows Bitmap                .bmp
//                Graphics Interchange Format   .gif
//                JPEG                          .jpg, .jpeg
//                Portable Network Graphics     .png
//                Windows Metafile              .wmf
//                Enhanced Metafile             .emf
//                Tagged Image File Format      .tif, .tiff
//
// ARGUMENTS:  as_filename - The name of the file to load
//
// RETURN:     True=Success, False=Error
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 07/01/2013  RolandS     Initial coding
// 07/27/2021  RolandS     Added Horizontal/Vertical Resolution
// -----------------------------------------------------------------------------

RECTF lstr_gRect
Long ll_Units
Real lr_HorizRes, lr_VertRes

// release handles
of_Destroy()

// load the file into memory
il_LastStatus = GdipCreateBitmapFromFileICM(as_filename, iul_hBitmap)
If il_LastStatus <> STATUS_OK Then
   PopulateError(il_LastStatus, of_GdiStatusMsg())
   Return False
End If

ImageName = as_filename

// get image size
GdipGetImageBounds(iul_hBitmap, lstr_gRect, ll_Units)

// correct the aspect ratio
If CorrectAspectRatio Then
   ir_AspectCorrection = 1.0
   il_LastStatus = GdipGetImageHorizontalResolution(iul_hBitmap, lr_HorizRes)
   If il_LastStatus = STATUS_OK Then
      il_LastStatus = GdipGetImageVerticalResolution(iul_hBitmap, lr_VertRes)
      If il_LastStatus = STATUS_OK Then
         If lr_VertRes > 0 Then ir_AspectCorrection = lr_HorizRes / lr_VertRes
         If ir_AspectCorrection <= 0 Then ir_AspectCorrection = 1.0
      Else
         PopulateError(il_LastStatus, of_GdiStatusMsg())
         Return False
      End If
   Else
      PopulateError(il_LastStatus, of_GdiStatusMsg())
      Return False
   End If
End If

// resize the control to match the image
If Not StretchToFit Then
   If ResizeControl Then
      this.Width  = PixelsToUnits(lstr_gRect.Width, XPixelsToUnits!)
      this.Height = PixelsToUnits(lstr_gRect.Height, YPixelsToUnits!)
   End If
End If

ZoomPct = 100

// trigger the OnPaint event
SetRedraw(True)

TriggerEvent("afterload")

Return True

end function

public function boolean loadlargeicon (string as_filename);// -----------------------------------------------------------------------------
// SCRIPT:     u_cst_picture.LoadLargeIcon
//
// PURPOSE:    This function is used to load a large icon from a file
//             into the control.
//
// ARGUMENTS:  as_filename - The name of the icon file
//
// RETURN:     True=Success, False=Error
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 07/01/2013  RolandS     Initial coding
// -----------------------------------------------------------------------------

Return LoadLargeIcon(as_filename, 0)

end function

public function boolean loadlargeicon (string as_filename, long al_index);// -----------------------------------------------------------------------------
// SCRIPT:     u_cst_picture.LoadLargeIcon
//
// PURPOSE:    This function is used to load a large icon from a file
//             into the control.
//
// ARGUMENTS:  as_filename - The name of the icon or resource file
//             al_index    - The index of the icon to be loaded
//
// RETURN:     True=Success, False=Error
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 07/01/2013  RolandS     Initial coding
// -----------------------------------------------------------------------------

Long ll_LargeIcons[], ll_SmallIcons[], ll_rtn

// release handles
of_Destroy()

// extract icon from file and load into memory
ll_rtn = ExtractIconEx(as_FileName, al_index, &
               ll_LargeIcons, ll_SmallIcons, 1)

If ll_rtn = 0 Then
   Return False
End If

iul_hIcon = ll_LargeIcons[1]
DestroyIcon(ll_SmallIcons[1])
il_IconSize = 32

ZoomPct = 100

// trigger the OnPaint event
SetRedraw(True)

TriggerEvent("afterload")

Return True

end function

public function boolean loadsmallicon (string as_filename);// -----------------------------------------------------------------------------
// SCRIPT:     u_cst_picture.LoadSmallIcon
//
// PURPOSE:    This function is used to load a small icon from a file
//             into the control.
//
// ARGUMENTS:  as_filename - The name of the icon file
//
// RETURN:     True=Success, False=Error
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 07/01/2013  RolandS     Initial coding
// -----------------------------------------------------------------------------

Return LoadSmallIcon(as_filename, 0)

end function

public function boolean loadsmallicon (string as_filename, long al_index);// -----------------------------------------------------------------------------
// SCRIPT:     u_cst_picture.LoadSmallIcon
//
// PURPOSE:    This function is used to load a small icon from a file
//             into the control.
//
// ARGUMENTS:  as_filename - The name of the icon or resource file
//             al_index    - The index of the icon to be loaded
//
// RETURN:     True=Success, False=Error
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 07/01/2013  RolandS     Initial coding
// -----------------------------------------------------------------------------

Long ll_LargeIcons[], ll_SmallIcons[], ll_rtn

// release handles
of_Destroy()

// extract icon from file and load into memory
ll_rtn = ExtractIconEx(as_FileName, al_index, &
               ll_LargeIcons, ll_SmallIcons, 1)

If ll_rtn = 0 Then
   Return False
End If

iul_hIcon = ll_SmallIcons[1]
DestroyIcon(ll_LargeIcons[1])
il_IconSize = 16

ZoomPct = 100

// trigger the OnPaint event
SetRedraw(True)

TriggerEvent("afterload")

Return True

end function

private subroutine of_destroy ();// -----------------------------------------------------------------------------
// SCRIPT:     u_cst_picture.of_Destroy
//
// PURPOSE:    This function performs cleanup tasks.
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 07/01/2013  RolandS     Initial coding
// -----------------------------------------------------------------------------

// release icon handle
If iul_hIcon > 0 Then
   DestroyIcon(iul_hIcon)
   iul_hIcon = 0
End If

// release bitmap handle
If iul_hBitmap > 0 Then
   GdipDisposeImage(iul_hBitmap)
   iul_hBitmap = 0
End If

// release blob memory
If iul_hGlobal > 0 Then
   // Unlock the memory
   GlobalUnlock(iul_pGlobalBuffer)
   // Free the memory
   GlobalFree(iul_hGlobal)
   // clear pointers
   iul_pImageStream = 0
   iul_pGlobalBuffer = 0
   iul_hGlobal = 0
End If

// reset instance vars
ii_click_x = 0
ii_click_y = 0
ii_start_x = 0
ii_start_y = 0
ZoomPct = 100
ir_AspectCorrection = 1.0

end subroutine

private function boolean of_drawbitmap (unsignedlong hdc);// -----------------------------------------------------------------------------
// SCRIPT:     u_cst_picture.of_DrawBitmap
//
// PURPOSE:    This function draws the current bitmap onto the control.
//
// ARGUMENTS:  hdc   - Handle to the DC passed to the onpaint event
//
// RETURN:     True=Success, False=Error
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 07/01/2013  RolandS     Initial coding
// -----------------------------------------------------------------------------

RECT lstr_Rect
RECTF lstr_gRect
Long ll_Width, ll_Height, ll_Units
ULong lul_Graphic, lul_Attribs, lul_Color
Decimal{3} HorzZoom, VertZoom

// get control size
GetClientRect(il_hWnd, lstr_Rect)

// get image size
GdipGetImageBounds(iul_hBitmap, lstr_gRect, ll_Units)

GdipCreateFromHDC(hdc, lul_Graphic)

GdipSetSmoothingMode(lul_Graphic, SmoothingModeHighQuality)

GdipSetInterpolationMode(lul_Graphic, InterpolationModeHighQualityBicubic)

// set background color transparent
If Transparent Then
   GdipCreateImageAttributes(lul_Attribs)
   GdipBitmapGetPixel(iul_hBitmap, 0, 0, lul_Color)   // get color at pixel 0,0
   il_LastStatus = GdipSetImageAttributesColorKeys(lul_Attribs, &
                        ColorAdjustTypeBitmap, True, lul_Color, lul_Color)
End If

// draw the image
If StretchToFit Then
   ll_Width  = lstr_gRect.Width
   ll_Height = lstr_gRect.Height
   il_LastStatus = GdipDrawImageRectRectI(lul_Graphic, iul_hBitmap, &
                        0, 0, lstr_Rect.Right, lstr_Rect.Bottom, &
                        0, 0, &
                        ll_Width, ll_Height, &
                        UnitPixel, lul_Attribs, 0, 0)
Else
   If ZoomBestFit Then
      // calculate horizontal and vertical zoom percents
      If lstr_gRect.Width > lstr_Rect.Right Then
         HorzZoom = (lstr_Rect.Right / lstr_gRect.Width) * 100 * ir_AspectCorrection
      End If
      If lstr_gRect.Height > lstr_Rect.Bottom Then
         VertZoom = (lstr_Rect.Bottom / lstr_gRect.Height) * 100
      End If
      // decide which one to use
      If HorzZoom = 0 Then
         If VertZoom = 0 Then
            ZoomPct = 100
         Else
            ZoomPct = VertZoom
         End If
      Else
         If VertZoom = 0 Then
            ZoomPct = HorzZoom
         Else
            If HorzZoom < VertZoom Then
               ZoomPct = HorzZoom
            Else
               ZoomPct = VertZoom
            End If
         End If
      End If
      ii_start_x = 0
      ii_start_y = 0
   End If
   ll_Width  = lstr_Rect.Right  * (100 / ZoomPct) * ir_AspectCorrection
   ll_Height = lstr_Rect.Bottom * (100 / ZoomPct)
   il_LastStatus = GdipDrawImageRectRectI(lul_Graphic, iul_hBitmap, &
                        0, 0, lstr_Rect.Right, lstr_Rect.Bottom, &
                        ii_start_x, ii_start_y, &
                        ll_Width, ll_Height, &
                        UnitPixel, lul_Attribs, 0, 0)
End If
If il_LastStatus <> STATUS_OK Then
   PopulateError(il_LastStatus, of_GdiStatusMsg())
   Return False
End If

// cleanup
If Transparent Then
   GdipDisposeImageAttributes(lul_Attribs)
End If
GdipDeleteGraphics(lul_Graphic)

Return True

end function

private function boolean of_drawicon (unsignedlong hdc);// -----------------------------------------------------------------------------
// SCRIPT:     u_cst_picture.of_DrawIcon
//
// PURPOSE:    This function draws the current icon onto the control.
//
// ARGUMENTS:  hdc   - Handle to the DC passed to the onpaint event
//
// RETURN:     True=Success, False=Error
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 07/01/2013  RolandS     Initial coding
// -----------------------------------------------------------------------------

Constant Long DI_NORMAL = 3

Return DrawIconEx(hdc, 0, 0, iul_hIcon, &
               il_IconSize, il_IconSize, 0, 0, DI_NORMAL)

end function

private function string of_gdistatusmsg ();// -----------------------------------------------------------------------------
// SCRIPT:     u_cst_picture.of_GDIStatusMsg
//
// PURPOSE:    This function returns a status message from il_LastStatus.
//
// RETURN:     GDIPlus status message
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 07/01/2013  RolandS     Initial coding
// -----------------------------------------------------------------------------

String ls_message

choose case il_LastStatus
   case 0
      ls_message = "OK"
   case 1
      ls_message = "GenericError"
   case 2
      ls_message = "InvalidParameter"
   case 3
      ls_message = "OutOfMemory"
   case 4
      ls_message = "ObjectBusy"
   case 5
      ls_message = "InsufficientBuffer"
   case 6
      ls_message = "NotImplemented"
   case 7
      ls_message = "Win32Error"
   case 8
      ls_message = "WrongState"
   case 9
      ls_message = "Aborted"
   case 10
      ls_message = "FileNotFound"
   case 11
      ls_message = "ValueOverflow"
   case 12
      ls_message = "AccessDenied"
   case 13
      ls_message = "UnknownImageFormat"
   case 14
      ls_message = "FontFamilyNotFound"
   case 15
      ls_message = "FontStyleNotFound"
   case 16
      ls_message = "NotTrueTypeFont"
   case 17
      ls_message = "UnsupportedGdiplusVersion"
   case 18
      ls_message = "GdiplusNotInitialized"
   case 19
      ls_message = "PropertyNotFound"
   case 20
      ls_message = "PropertyNotSupported"
   case 21
      ls_message = "ProfileNotFound"
end choose

Return ls_message

end function

public function boolean print ();// -----------------------------------------------------------------------------
// SCRIPT:     u_cst_picture.Print
//
// PURPOSE:    This function prints the current image to the current printer.
//
// RETURN:     True=Success, False=Error
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 07/01/2013  RolandS     Initial coding
// -----------------------------------------------------------------------------

String ls_Printer
ULong lul_Size

// Get the default printer name
lul_Size = 250
ls_Printer = Space(lul_Size)
GetDefaultPrinter(ls_Printer, lul_Size)

Return Print(ls_Printer)

end function

public function boolean print (string as_printername);// -----------------------------------------------------------------------------
// SCRIPT:     u_cst_picture.Print
//
// PURPOSE:    This function prints the current image.
//
// ARGUMENTS:  as_printername - Name of the printer to print on
//
// RETURN:     True=Success, False=Error
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 07/01/2013  RolandS     Initial coding
// -----------------------------------------------------------------------------

Constant ulong NULL = 0
DOCINFO lstr_docInfo
RECTF lstr_gRect
ULong lul_hdcPrint, lul_Graphic, lul_image
Long ll_Units, ll_Width, ll_Height
Decimal{3} ldec_ZoomPct = 100

// get image size
GdipGetImageBounds(iul_hBitmap, lstr_gRect, ll_Units)

// Get a device context for the printer.
lul_hdcPrint = CreateDC(NULL, as_PrinterName, NULL, NULL)

lstr_docInfo.cbSize = 20
lstr_docInfo.lpszDocName = "PicturePrint"

StartDoc(lul_hdcPrint, lstr_docInfo)
StartPage(lul_hdcPrint)

GdipCreateFromHDC(lul_hdcPrint, lul_Graphic)

GdipSetSmoothingMode(lul_Graphic, SmoothingModeHighQuality)

GdipSetInterpolationMode(lul_Graphic, InterpolationModeHighQualityBicubic)

GdipCloneImage(iul_hBitmap, lul_image)

ll_Width  = lstr_gRect.Width * ir_AspectCorrection
ll_Height = lstr_gRect.Height

If ll_Width > 800 Then
   ldec_ZoomPct = (800 / lstr_gRect.Width * ir_AspectCorrection) * 100
   ll_Width  = lstr_gRect.Width  * (100 / ldec_ZoomPct) * ir_AspectCorrection
   ll_Height = lstr_gRect.Height * (100 / ldec_ZoomPct)
End If

GdipDrawImageRectRectI(lul_Graphic, lul_image, 0, 0, &
               lstr_gRect.Width, lstr_gRect.Height, &
               0, 0, &
               ll_Width, ll_Height, &
               UnitPixel, 0, 0, 0)

GdipDisposeImage(lul_image)

GdipDeleteGraphics(lul_Graphic)

EndPage(lul_hdcPrint)
EndDoc(lul_hdcPrint)

DeleteDC(lul_hdcPrint)

Return True

end function

public function boolean rotateflip (long al_rftype);// -----------------------------------------------------------------------------
// SCRIPT:     u_cst_picture.RotateFlip
//
// PURPOSE:    This function is used to rotate and or flip the image.
//
// ARGUMENTS:  al_rfType   - The type of action (see instance constants)
//
// RETURN:     True=Success, False=Error
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 07/01/2013  RolandS     Initial coding
// -----------------------------------------------------------------------------
      
il_LastStatus = GdipImageRotateFlip(iul_hBitmap, al_rfType)
If il_LastStatus <> STATUS_OK Then
   PopulateError(il_LastStatus, of_GdiStatusMsg())
   Return False
End If

SetRedraw(True)

Return True

end function

public function boolean saveimage (string as_filename);// -----------------------------------------------------------------------------
// SCRIPT:     u_cst_picture.SaveImage
//
// PURPOSE:    This function is used to saved an image to a file.
//
//             Supported file formats:
//
//                Windows Bitmap                .bmp
//                Graphics Interchange Format   .gif
//                JPEG                          .jpg, .jpeg
//                Portable Network Graphics     .png
//                Tagged Image File Format      .tif, .tiff
//
// ARGUMENTS:  as_filename - The name of the file to create
//
// RETURN:     True=Success, False=Error
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 07/01/2013  RolandS     Initial coding
// -----------------------------------------------------------------------------

ImageCodecInfo lstr_Empty
ImageCodecInfo ImageCodecs[]
ULong lul_numEncoders, lul_Size, lul_Image
Long ll_idx, ll_max
String ls_Extn, ls_SaveType, ls_type

SetPointer(HourGlass!)

If iul_hBitmap = 0 Then
   PopulateError(999, "There is not an image in the control!")
   Return False
End If

ls_Extn = Mid(as_filename, Pos(as_filename, "."))
choose case Lower(ls_Extn)
   case ".bmp"
      ls_SaveType = "image/bmp"
   case ".gif"
      ls_SaveType = "image/gif"
   case ".jpg", ".jpeg"
      ls_SaveType = "image/jpeg"
   case ".png"
      ls_SaveType = "image/png"
   case ".tif", ".tiff"
      ls_SaveType = "image/tiff"
   case else
      PopulateError(999, "Image file extension not supported!")
      Return False
end choose

il_LastStatus = GdipGetImageEncodersSize(lul_numEncoders, lul_Size)
If il_LastStatus <> STATUS_OK Then
   PopulateError(il_LastStatus, of_GdiStatusMsg())
   Return False
End If

ImageCodecs[(lul_Size / 76) + 1] = lstr_Empty

il_LastStatus = GdipGetImageEncoders(lul_numEncoders, lul_Size, ImageCodecs)
If il_LastStatus <> STATUS_OK Then
   PopulateError(il_LastStatus, of_GdiStatusMsg())
   Return False
End If

il_LastStatus = GdipCloneImage(iul_hBitmap, lul_image)
If il_LastStatus <> STATUS_OK Then
   PopulateError(il_LastStatus, of_GdiStatusMsg())
   Return False
End If

ll_max = lul_numEncoders
For ll_idx = 1 To ll_max
   ls_type = String(ImageCodecs[ll_idx].MimeType, "address")
   If ls_type = ls_SaveType Then
      If FileExists(as_filename) Then
         FileDelete(as_filename)
      End If
      il_LastStatus = GdipSaveImageToFile(lul_image, as_filename, ImageCodecs[ll_idx].classID, 0)
      If il_LastStatus <> STATUS_OK Then
         PopulateError(il_LastStatus, of_GdiStatusMsg())
         Return False
      End If
      Exit
   End If
Next

GdipDisposeImage(lul_image)

Return True

end function

public subroutine setmousepan (boolean ab_value);// -----------------------------------------------------------------------------
// SCRIPT:     u_cst_picture.SetMousePan
//
// PURPOSE:    This function turns the mouse panning option on/off.
//
// ARGUMENTS:  ab_value - True or False
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 07/01/2013  RolandS     Initial coding
// -----------------------------------------------------------------------------

ib_MousePan = ab_value

If ib_MousePan Then
   Pointer = "HyperLink!"
Else
   Pointer = ""
End If

SetRedraw(True)

end subroutine

public subroutine setresizecontrol (boolean ab_value);// -----------------------------------------------------------------------------
// SCRIPT:     u_cst_picture.SetResizeControl
//
// PURPOSE:    This function turns the ResizeControl option on/off.
//
// ARGUMENTS:  ab_value - True or False
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 07/01/2013  RolandS     Initial coding
// -----------------------------------------------------------------------------

ResizeControl = ab_value

SetRedraw(True)

end subroutine

public subroutine setstretchtofit (boolean ab_value);// -----------------------------------------------------------------------------
// SCRIPT:     u_cst_picture.SetStretchToFit
//
// PURPOSE:    This function turns the StretchToFit option on/off.
//
// ARGUMENTS:  ab_value - True or False
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 07/01/2013  RolandS     Initial coding
// -----------------------------------------------------------------------------

StretchToFit = ab_value

SetRedraw(True)

end subroutine

public subroutine settransparent (boolean ab_value);// -----------------------------------------------------------------------------
// SCRIPT:     u_cst_picture.SetTransparent
//
// PURPOSE:    This function turns the Transparent option on/off.
//
// ARGUMENTS:  ab_value - True or False
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 07/01/2013  RolandS     Initial coding
// -----------------------------------------------------------------------------

Transparent = ab_value

SetRedraw(True)

end subroutine

public subroutine setzoom (decimal adec_value);// -----------------------------------------------------------------------------
// SCRIPT:     u_cst_picture.SetZoom
//
// PURPOSE:    This function sets the zoom level.
//
// ARGUMENTS:  adec_value  - The zoom level to be set.
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 07/01/2013  RolandS     Initial coding
// -----------------------------------------------------------------------------

ZoomBestFit = False

ZoomPct = adec_value

SetRedraw(True)

end subroutine

public subroutine setzoombestfit (boolean ab_value);// -----------------------------------------------------------------------------
// SCRIPT:     u_cst_picture.SetZoomBestFit
//
// PURPOSE:    This function turns the ZoomBestFit option on/off.
//
// ARGUMENTS:  ab_value - True or False
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 07/01/2013  RolandS     Initial coding
// -----------------------------------------------------------------------------

ZoomBestFit = ab_value

SetRedraw(True)

end subroutine

public subroutine zoomhorizontal ();// -----------------------------------------------------------------------------
// SCRIPT:     u_cst_picture.ZoomHorizontal
//
// PURPOSE:    This function calculates and then sets the zoom percentage that
//             would fit the image to the horizontal size of the control.
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 07/01/2013  RolandS     Initial coding
// -----------------------------------------------------------------------------

RECT lstr_Rect
RECTF lstr_gRect
Long ll_Units

ZoomBestFit = False

// get control size
GetClientRect(il_hWnd, lstr_Rect)

// get image size
GdipGetImageBounds(iul_hBitmap, lstr_gRect, ll_Units)

ZoomPct = (lstr_Rect.Right / lstr_gRect.Width) * 100 * ir_AspectCorrection

ii_start_x = 0
ii_start_y = 0

SetRedraw(True)

end subroutine

public subroutine zoomvertical ();// -----------------------------------------------------------------------------
// SCRIPT:     u_cst_picture.ZoomVertical
//
// PURPOSE:    This function calculates and then sets the zoom percentage that
//             would fit the image to the vertical size of the control.
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 07/01/2013  RolandS     Initial coding
// -----------------------------------------------------------------------------

RECT lstr_Rect
RECTF lstr_gRect
Long ll_Units

ZoomBestFit = False

// get control size
GetClientRect(il_hWnd, lstr_Rect)

// get image size
GdipGetImageBounds(iul_hBitmap, lstr_gRect, ll_Units)

ZoomPct = (lstr_Rect.Bottom / lstr_gRect.Height) * 100

ii_start_x = 0
ii_start_y = 0

SetRedraw(True)

end subroutine

public function boolean clipboard ();// -----------------------------------------------------------------------------
// SCRIPT:     u_cst_picture.Clipboard
//
// PURPOSE:    This function copies the current image to the clipboard.
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 07/17/2013  RolandS     Initial coding
// -----------------------------------------------------------------------------

Constant Long SRCCOPY = 13369376
Constant UInt CF_BITMAP = 2
RECT lstr_Rect
Long ll_hdc, ll_hdcMem, ll_hBitmap

If iul_hBitmap = 0 Then
   PopulateError(999, "There is not an image in the control!")
   Return False
End If

// get control size
GetClientRect(il_hWnd, lstr_Rect)

// Get the device context of window and allocate memory
ll_hdc = GetDC(il_hWnd)
ll_hdcMem = CreateCompatibleDC(ll_hdc)
ll_hBitmap = CreateCompatibleBitmap(ll_hdc, lstr_Rect.Right, lstr_Rect.Bottom)

If ll_hBitmap <> 0 Then
   // Select an object into the specified device context
   SelectObject(ll_hdcMem, ll_hBitmap)
   // Copy the bitmap from the source to the destination
   StretchBlt(ll_hdcMem, 0, 0, lstr_Rect.Right, lstr_Rect.Bottom, &
         ll_hdc, 0, 0, lstr_Rect.Right, lstr_Rect.Bottom, SRCCOPY)
   // paste bitmap to clipboard
   If OpenClipboard(il_hWnd) Then
      EmptyClipboard()
      SetClipboardData(CF_BITMAP, ll_hBitmap)
      CloseClipboard()
   End If
End If

// Clean up handles
DeleteDC(ll_hdcMem)
ReleaseDC(il_hWnd, ll_hdc)

Return True

end function

public function boolean loadclipboard ();// -----------------------------------------------------------------------------
// SCRIPT:     u_cst_picture.LoadClipboard
//
// PURPOSE:    This function loads a bitmap from the clipboard.
//
// DATE        PROG/ID     DESCRIPTION OF CHANGE / REASON
// ----------  --------    -----------------------------------------------------
// 07/17/2013  RolandS     Initial coding
// -----------------------------------------------------------------------------

Constant UInt CF_BITMAP = 2
RECTF lstr_gRect
Long ll_hBitmap, ll_Units

// release handles
of_Destroy()

If Not OpenClipboard(il_hWnd) Then
   PopulateError(999, "Failed to open clipboard!")
   Return False
End If

SetTransParent(False)

// get a handle to clipboard data
ll_hBitmap = GetClipboardData(CF_BITMAP)
If ll_hBitmap = 0 Then
   // record error message
   PopulateError(999, "Bitmap not found in the clipboard!")
   CloseClipboard()
   Return False
End If

// Create bitmap from the data contained in the clipboard
il_LastStatus = GdipCreateBitmapFromHBITMAP(ll_hBitmap, 0, iul_hBitmap)
If il_LastStatus <> STATUS_OK Then
   // record error message
   PopulateError(il_LastStatus, of_GdiStatusMsg())
   CloseClipboard()
   Return False
End If

CloseClipboard()

// get image size
GdipGetImageBounds(iul_hBitmap, lstr_gRect, ll_Units)

// resize the control to match the image
If Not StretchToFit Then
   If ResizeControl Then
      // resize control
      this.Width  = PixelsToUnits(lstr_gRect.Width, XPixelsToUnits!)
      this.Height = PixelsToUnits(lstr_gRect.Height, YPixelsToUnits!)
   End If
End If

ZoomPct = 100

// trigger the OnPaint event
SetRedraw(True)

TriggerEvent("afterload")

Return True

end function

on u_cst_picture.create
int iCurrent
call super::create
this.st_name=create st_name
iCurrent=UpperBound(this.Control)
this.Control[iCurrent+1]=this.st_name
end on

on u_cst_picture.destroy
call super::destroy
destroy(this.st_name)
end on

event constructor;call super::constructor;GdiplusStartupInput  lstr_input
GdiplusStartupOutput lstr_output
String ls_Extn

// save control handle
il_hWnd = Handle(this)

// initialize GDIPlus
lstr_input.GdiplusVersion = 1
GdiplusStartup(iul_GdiToken, lstr_input, lstr_output)

// set control transparency
of_SetTransparent(True)

// load default image
If ImageName <> "" Then
   ls_Extn = Mid(ImageName, Pos(ImageName, "."))
   If Lower(ls_Extn) = ".bmp" Then
      SetTransParent(True)
   Else
      SetTransParent(False)
   End If
   LoadImage(ImageName)
End if

end event

event onpaint;call super::onpaint;// paint the image

// draw icon
If iul_hIcon > 0 Then
   of_DrawIcon(hdc)
End If

// draw bitmap
If iul_hBitmap > 0 Then
   of_DrawBitmap(hdc)
End If

Return 0

end event

event destructor;call super::destructor;// release handles
of_Destroy()

// cleanup GDIPlus
GdiplusShutdown(iul_GdiToken)

end event

type st_name from statictext within u_cst_picture
integer x = 37
integer y = 32
integer width = 517
integer height = 68
integer textsize = -8
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Tahoma"
long textcolor = 16777215
long backcolor = 8421376
string text = "Picture"
boolean focusrectangle = false
end type

event constructor;this.Visible = False

end event