VBA.EXCEL PHOTO IMAGE RESIZE CROP ASSISTENT ENGINELIKE PHOTOSHOP

Effektiv Fotos bearbeiten, schneiden, skalieren via Excel VBA mit 3 vordefinierten Maskierungsrahmen [ Windows 7/8/10 x86 ]

Effectively edit, crop and scale using Excel VBA with 3 predefined masking frames [ Windows 7/8/10 x86 ]

FIRST ! Download & Install third party service provider @ ImageMagick "ImageMagick-7.0.5-7-Q16-x86-dll.exe" www.imagemagick.org/script/download.php

API
ImageMagick
CODE LANGUAGE
VBA Visual Basic for Applications
CODE LINES
<1442>

Stay Hungry, Stay Foolish -Steve Jobs Apple
'//// SOMETHING CODE ;)

'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'//// SCRIPT © REUTLINGER / WWW.PARIS-STUDIOS.DE - ALL RIGHTS RESERVED /////////////////////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Option Explicit
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal H_WINDOW As Long, ByVal lngWinIdx As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal H_WINDOW As Long, ByVal lngWinIdx As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal H_WINDOW As Long, ByVal crKey As Integer, ByVal bAlpha As Integer, ByVal dwFlags As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal H_WINDOW As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal H_WINDOW As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal H_WINDOW As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal H_WINDOW As Long, lpPoint As POINTAPI) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (p As tCursor) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function DwmSetWindowAttribute Lib "dwmapi" (ByVal hwnd As Long, ByVal attr As Integer, ByRef attrValue As Integer, ByVal attrSize As Integer) As Long
Private Declare Function DwmExtendFrameIntoClientArea Lib "dwmapi" (ByVal hwnd As Long, ByRef NEWMARGINS As MARGINS) As Long
Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Type BITMAP
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Dim M_SNG_LEFT_POS As Long
Dim M_SNG_TOP_POS As Long
Dim Z_SNG_LEFT_POS As Long
Dim Z_SNG_TOP_POS As Long
Dim SAVE_AREA As Boolean

'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Type POINTAPI
    X As Long
    Y As Long
End Type
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Type tCursor
    LEFT As Long
    TOP As Long
End Type
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Const GWL_STYLE = (-16)
Private Const WS_CAPTION = &HC00000 '//// WS_BORDER Or WS_DLGFRAME
Private Const WS_BORDER = &H800000
Private Const GWL_EXSTYLE As Long = (-20) '//// OFFSET OF WINDOW EXTENDED STYLE
Private Const WS_EX_DLGMODALFRAME As Long = &H1 '//// CONTROLS IF WINDOW HAS AN ICON
Private Const SC_CLOSE As Long = &HF060
Private Const SW_SHOW As Long = 5
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2
Private Const WS_EX_TRANSPARENT = &H20&
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Enum ESetWindowPosStyles
    SWP_SHOWWINDOW = &H40
    SWP_HIDEWINDOW = &H80
    SWP_FRAMECHANGED = &H20 '//// FRAME CHANGED SEND WM_NCCALCSIZE
    SWP_NOACTIVATE = &H10
    SWP_NOCOPYBITS = &H100
    SWP_NOMOVE = &H2
    SWP_NOOWNERZORDER = &H200 '// DONT DO OWNER Z ORDERING
    SWP_NOREDRAW = &H8
    SWP_NOREPOSITION = SWP_NOOWNERZORDER
    SWP_NOSIZE = &H1
    SWP_NOZORDER = &H4
    SWP_DRAWFRAME = SWP_FRAMECHANGED
    HWND_NOTOPMOST = -2
End Enum
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Type MARGINS
    leftWidth As Long
    rightWidth As Long
    topHeight As Long
    bottomHeight As Long
End Type
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Const HTCAPTION = 2
Private XWNDFORM, XWNDFORMEX As Long
Private Const WM_NCLBUTTONDOWN = &HA1
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Dim mPos As tCursor
Dim hdc As Long
Dim pointsPerPixelX, pointsPerPixelY  As Double
Dim WhereIsTheMouseAt As tCursor
Dim convertMouseToForm As tCursor
Dim FIRST_RUN As Boolean
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Const LOGPIXELSX = 88
Const LOGPIXELSY = 90
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub UserForm_Initialize()

    Dim ISTYLE, HWNDFORM As Long
    Dim btrans As Byte
    btrans = 128
    Dim NEWMARGINS As MARGINS
    
    HWNDFORM = FindWindow(vbNullString, Me.Caption) '//// GET WINDOW

    ISTYLE = GetWindowLong(HWNDFORM, GWL_STYLE) '//// BASIC WINDOW STYLE FLAGS FOR THE FORM
    ISTYLE = ISTYLE And Not WS_CAPTION '//// NO CAPTION AREA
    SetWindowLong HWNDFORM, GWL_STYLE, ISTYLE '//// SET BASIC WINDOW STYLES

    ISTYLE = GetWindowLong(HWNDFORM, GWL_EXSTYLE) '//// BUILD EXTENDED WINDOW STYLE
    ISTYLE = ISTYLE And Not WS_EX_DLGMODALFRAME '//// NO BORDER

    'ISTYLE = ISTYLE Or WS_EX_LAYERED '//// ADD ONE COLOR TRANSPARENCE
    'ISTYLE = ISTYLE Or WS_EX_TRANSPARENT '//// ADD SEMI-TRANSPARENT WINDOW

    SetWindowLong HWNDFORM, GWL_EXSTYLE, ISTYLE

    'SetLayeredWindowAttributes HWNDFORM, vbCyan, btrans, LWA_ALPHA     '//// SEMI TRANSPARENT WINDOW
    'SetLayeredWindowAttributes HWNDFORM, vbCyan, btrans, LWA_COLORKEY  '//// COLOR SCREEN TRNSPARENCY

    XWNDFORM = FindWindow("ThunderDFrame", vbNullString) '//// GET NEW WINDOW

    DwmSetWindowAttribute XWNDFORM, 2, 2, 4 '//// DWMAPI

    With NEWMARGINS
        .rightWidth = 1   '//// -1
        .leftWidth = 1   '//// -1
        .topHeight = 1 '//// -1
        .bottomHeight = 1  '//// -1
    End With

    DwmExtendFrameIntoClientArea XWNDFORM, NEWMARGINS '//// DWMAPI
    
    DrawMenuBar HWNDFORM '//// CLEAN MENU BAR
    
    Me.Height = 500
    
    Me.Width = Me.Width - 5 '//// FRAMECUT BALANCE OFFSET
    Me.Height = Me.Height - 24 '//// FRAMECUT BALANCE OFFSET
    
'    Me.LEFT = GUI_COCKPIT.LEFT + GUI_COCKPIT.Width / 2 - Me.Width / 2
'    Me.TOP = GUI_COCKPIT.TOP + GUI_COCKPIT.Height / 2 - Me.Height / 2
    
    LINE_BOTTOM.LEFT = 0
    LINE_BOTTOM.TOP = Me.Height - 3
    LINE_BOTTOM.Width = Me.Width
    LINE_BOTTOM.Height = 3

    LINE_TOP.TOP = 1
    LINE_TOP.LEFT = 0
    LINE_TOP.Width = Me.Width
    LINE_TOP.Height = 3
    
    MAIN_IMG.Visible = False
    
    FIRST_RUN = True
    
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub UserForm_Activate()

    If FIRST_RUN = True Then
        
        MAIN_IMG.Visible = False
    
        'Call INIT_STAGE
        
        Dim SELECT_LOGO As String
        
        SELECT_LOGO = GET_FILE_JPG
        
        ENV_IMAGE_ASSISTENT_IMPORT_FILE = SELECT_LOGO
        
        ENV_IMAGE_ASSISTENT_EXPORT_FILE = Mid(ENV_IMAGE_ASSISTENT_IMPORT_FILE, 1, Len(ENV_IMAGE_ASSISTENT_IMPORT_FILE) - 4) & "_CROP.jpg"
        
        If SELECT_LOGO <> "" Then Call INIT_STAGE
        
        Call SET_START_MASK
        
        FIRST_RUN = False
    
    End If
    
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub INIT_STAGE()
    
    MASK_IMG.Width = 240
    MASK_IMG.Height = 136
    
    Call SET_MASK_AREA
    
    L_TITEL.LEFT = MASK_IMG.LEFT - 6
    L_TITEL.TOP = MASK_IMG.TOP - 16
    
    L_TITEL.Caption = "IMAGE CROP 16:9"

    MAIN_IMG.Visible = False
    ZOOM_ITEM.Visible = False
    
    Call RESET_STAGE
    
    Call IMAGE_LOADER
    
    Call SET_MASK_AREA
    
    Call SET_ASPECT_RATIO_H
    
    Call SET_CENTER_Y
    
    Call SET_CENTER_X
    
    Call SET_ZOOM_FACTOR
    
    Call CHECK_SAVE_STATUS
    
    MAIN_IMG.Visible = True
    ZOOM_ITEM.Visible = True
    
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Public Sub SET_START_MASK()

'    MASK_IMG.Width = 240
'    MASK_IMG.Height = 136
'
    ENV_IMAGE_ASSISTENT_FORMAT(1) = 240
    ENV_IMAGE_ASSISTENT_FORMAT(2) = 240
    
    Call SET_MASK_AREA
    
    L_TITEL.LEFT = MASK_IMG.LEFT - 6
    L_TITEL.TOP = MASK_IMG.TOP - 16
    
    L_TITEL.Caption = "IMAGE CROP 16:9"
    
    'Call RESET_STAGE
    
    'Call IMAGE_LOADER
    
    Call SET_MASK_AREA
    
    Call SET_ASPECT_RATIO_H
    
    Call SET_CENTER_Y
    
    Call SET_CENTER_X
    
    'Call SET_ZOOM_FACTOR
    
    Call CHECK_SAVE_STATUS
    
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_CLOSE_Click()

    Unload Me
    
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub Userform_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
    If Button = 1 Then
    
        ReleaseCapture
        SendMessage XWNDFORM, WM_NCLBUTTONDOWN, HTCAPTION, 0&
        
    End If
    
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_MASK_169_Click()

    MASK_IMG.Width = 240
    MASK_IMG.Height = 136
    
    ENV_IMAGE_ASSISTENT_FORMAT(1) = MASK_IMG.Width
    ENV_IMAGE_ASSISTENT_FORMAT(2) = MASK_IMG.Height
    
    Call SET_MASK_AREA
    
    L_TITEL.LEFT = MASK_IMG.LEFT - 6
    L_TITEL.TOP = MASK_IMG.TOP - 16
    
    L_TITEL.Caption = "IMAGE CROP 16:9"
    
    'Call RESET_STAGE
    
    'Call IMAGE_LOADER
    
    Call SET_MASK_AREA
    
    Call SET_ASPECT_RATIO_H
    
    Call SET_CENTER_Y
    
    Call SET_CENTER_X
    
    'Call SET_ZOOM_FACTOR
    
    Call CHECK_SAVE_STATUS

End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_MASK_43_Click()

    MASK_IMG.Width = 240
    MASK_IMG.Height = 180
    
    ENV_IMAGE_ASSISTENT_FORMAT(1) = MASK_IMG.Width '4:3
    ENV_IMAGE_ASSISTENT_FORMAT(2) = MASK_IMG.Height '4:3
    
    Call SET_MASK_AREA
    
    L_TITEL.LEFT = MASK_IMG.LEFT - 6
    L_TITEL.TOP = MASK_IMG.TOP - 16
    
    L_TITEL.Caption = "IMAGE CROP 16:9"
    
    
        Call SET_MASK_AREA
    
    L_TITEL.LEFT = MASK_IMG.LEFT - 6
    L_TITEL.TOP = MASK_IMG.TOP - 16
    
    L_TITEL.Caption = "IMAGE CROP 4:3"

    
    'Call RESET_STAGE
    
    'Call IMAGE_LOADER
    
    Call SET_MASK_AREA
    
    Call SET_ASPECT_RATIO_H
    
    Call SET_CENTER_Y
    
    Call SET_CENTER_X
    
    'Call SET_ZOOM_FACTOR
    
    Call CHECK_SAVE_STATUS
    
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_MASK_A4_Click()

    MASK_IMG.Width = 210
    MASK_IMG.Height = 297

    ENV_IMAGE_ASSISTENT_FORMAT(1) = MASK_IMG.Width
    ENV_IMAGE_ASSISTENT_FORMAT(2) = MASK_IMG.Height
    
    Call SET_MASK_AREA
    
    L_TITEL.LEFT = MASK_IMG.LEFT - 6
    L_TITEL.TOP = MASK_IMG.TOP - 16
    
    L_TITEL.Caption = "IMAGE CROP A4 5:7"
    
    'Call RESET_STAGE
    
    'Call IMAGE_LOADER
    
    Call SET_MASK_AREA
    
    Call SET_ASPECT_RATIO_H
    
    Call SET_CENTER_Y
    
    Call SET_CENTER_X
    
    'Call SET_ZOOM_FACTOR
    
    Call CHECK_SAVE_STATUS
    
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_ZOOM_IN_Click()
    
    Dim C_ZOOM_H As Long
    Dim C_ZOOM_W As Long

    If MAIN_IMG.Width < (Me.IMPORT_W.Caption - 10) Then

        MAIN_IMG.Width = MAIN_IMG.Width + 10
        
        Call SET_ASPECT_RATIO_H
        
        Call SET_ZOOM_FACTOR
        
        Call CHECK_SAVE_STATUS
    
    End If
    
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_ZOOM_OUT_Click()
    
    If MAIN_IMG.Width > 20 Then
    
        MAIN_IMG.Width = MAIN_IMG.Width - 10
        
        Call SET_ASPECT_RATIO_H
        
        Call SET_ZOOM_FACTOR
        
        Call CHECK_SAVE_STATUS
    
    End If

End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_LC_Click()

    MAIN_IMG.LEFT = MASK_IMG.LEFT
     
    MAIN_IMG.TOP = Round(SLIDE_AREA.TOP + (SLIDE_AREA.Height / 2) - (MAIN_IMG.Height / 2), 0)
     
    Call CHECK_SAVE_STATUS
    
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_RC_Click()

    MAIN_IMG.LEFT = (MASK_IMG.LEFT) - ((MASK_IMG.LEFT + MAIN_IMG.Width) - (MASK_IMG.LEFT + MASK_IMG.Width))
     
    MAIN_IMG.TOP = Round(SLIDE_AREA.TOP + (SLIDE_AREA.Height / 2) - (MAIN_IMG.Height / 2), 0)
     
    Call CHECK_SAVE_STATUS
    
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_TC_Click()

    MAIN_IMG.LEFT = Round(SLIDE_AREA.LEFT + (SLIDE_AREA.Width / 2) - (MAIN_IMG.Width / 2), 0)
     
    MAIN_IMG.TOP = MASK_IMG.TOP
     
    Call CHECK_SAVE_STATUS
    
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_BC_Click()

    MAIN_IMG.LEFT = Round(SLIDE_AREA.LEFT + (SLIDE_AREA.Width / 2) - (MAIN_IMG.Width / 2), 0)
     
    MAIN_IMG.TOP = (MASK_IMG.TOP) - ((MASK_IMG.TOP + MAIN_IMG.Height) - (MASK_IMG.TOP + MASK_IMG.Height))
     
    Call CHECK_SAVE_STATUS
    
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_LT_Click()

    MAIN_IMG.LEFT = MASK_IMG.LEFT
     
    MAIN_IMG.TOP = MASK_IMG.TOP
     
    Call CHECK_SAVE_STATUS
    
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_RT_Click()

    MAIN_IMG.LEFT = (MASK_IMG.LEFT) - ((MASK_IMG.LEFT + MAIN_IMG.Width) - (MASK_IMG.LEFT + MASK_IMG.Width))
     
    MAIN_IMG.TOP = MASK_IMG.TOP
     
    Call CHECK_SAVE_STATUS
    
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_LB_Click()

    MAIN_IMG.LEFT = MASK_IMG.LEFT
     
    MAIN_IMG.TOP = (MASK_IMG.TOP) - ((MASK_IMG.TOP + MAIN_IMG.Height) - (MASK_IMG.TOP + MASK_IMG.Height))
     
    Call CHECK_SAVE_STATUS
    
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_RB_Click()

    MAIN_IMG.LEFT = (MASK_IMG.LEFT) - ((MASK_IMG.LEFT + MAIN_IMG.Width) - (MASK_IMG.LEFT + MASK_IMG.Width))
     
    MAIN_IMG.TOP = (MASK_IMG.TOP) - ((MASK_IMG.TOP + MAIN_IMG.Height) - (MASK_IMG.TOP + MASK_IMG.Height))
     
    Call CHECK_SAVE_STATUS
    
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_CENTER_Y_Click()

    Call SET_CENTER_Y
    
    Call CHECK_SAVE_STATUS
    
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_CENTER_X_Click()

    Call SET_CENTER_X
    
    Call CHECK_SAVE_STATUS

End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_CENTER_XY_Click()

    Call SET_CENTER_X
    Call SET_CENTER_Y
    
    Call CHECK_SAVE_STATUS

End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_FIT_Y_Click()
    
    Call SET_FIT_Y
    
    Call SET_ASPECT_RATIO_W
    
    Call SET_CENTER_Y
    
    Call SET_CENTER_X
    
    Call CHECK_SAVE_STATUS
    
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_FIT_X_Click()

    Call SET_FIT_X
    
    Call SET_ASPECT_RATIO_H
    
    Call SET_CENTER_X
    
    Call SET_CENTER_Y
    
    Call CHECK_SAVE_STATUS

End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_OPEN_CLICK()
    
    Dim SELECT_LOGO As String
    
    SELECT_LOGO = GET_FILE_JPG
    
    ENV_IMAGE_ASSISTENT_IMPORT_FILE = SELECT_LOGO
    
    ENV_IMAGE_ASSISTENT_EXPORT_FILE = Mid(ENV_IMAGE_ASSISTENT_IMPORT_FILE, 1, Len(ENV_IMAGE_ASSISTENT_IMPORT_FILE) - 4) & "_CROP.jpg"
    
    If SELECT_LOGO <> "" Then Call INIT_STAGE

End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Function GET_FILE_JPG() As String

    Dim fldr As FileDialog
    Dim strPath As String
    Dim sItem As String
    
    Set fldr = Application.FileDialog(msoFileDialogFilePicker)
    
    With fldr
        
        .Filters.Clear
        .Filters.Add "JPG-Dateien (*.jpg)", "*.jpg"
        .Title = "Select a JPG FIle"
        .AllowMultiSelect = False
        .InitialFileName = strPath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
        
    End With
    
NextCode:

    GET_FILE_JPG = sItem
    Set fldr = Nothing
    
End Function
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Public Sub SET_MASK_AREA()

    MASK_IMG.LEFT = Round(SLIDE_AREA.LEFT + (SLIDE_AREA.Width / 2) - (MASK_IMG.Width / 2), 0)
    MASK_IMG.TOP = Round(SLIDE_AREA.TOP + (SLIDE_AREA.Height / 2) - (MASK_IMG.Height / 2), 0)

    B_TOP.LEFT = MASK_IMG.LEFT - 6
    B_TOP.TOP = MASK_IMG.TOP - 6
    B_TOP.Width = MASK_IMG.Width + 12
    B_TOP.Height = 6

    B_LEFT.LEFT = MASK_IMG.LEFT - 6
    B_LEFT.TOP = MASK_IMG.TOP
    B_LEFT.Width = 6
    B_LEFT.Height = MASK_IMG.Height

    B_RIGHT.LEFT = MASK_IMG.LEFT + MASK_IMG.Width
    B_RIGHT.TOP = MASK_IMG.TOP
    B_RIGHT.Width = 6
    B_RIGHT.Height = MASK_IMG.Height

    B_BOTTOM.LEFT = MASK_IMG.LEFT - 6
    B_BOTTOM.TOP = MASK_IMG.TOP + MASK_IMG.Height
    B_BOTTOM.Width = MASK_IMG.Width + 12
    B_BOTTOM.Height = 6
    
    MASK_IMG_FRAME.LEFT = MASK_IMG.LEFT
    MASK_IMG_FRAME.TOP = MASK_IMG.TOP
    MASK_IMG_FRAME.Width = MASK_IMG.Width
    MASK_IMG_FRAME.Height = MASK_IMG.Height
    
    SLIDE_AREA.Visible = False
    
    L_TITEL.LEFT = MASK_IMG.LEFT - 6
    L_TITEL.TOP = MASK_IMG.TOP - 16
    
    L_TITEL.Caption = "IMAGE CROP " & ENV_IMAGE_ASSISTENT_FORMAT(1) & "x" & ENV_IMAGE_ASSISTENT_FORMAT(2) & " | " & Me.IMPORT_W.Caption & "x" & Me.IMPORT_H.Caption & " (" & ENV_IMAGE_ASSISTENT_CROP_SIZE(5) & "px)"

End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Public Sub IMAGE_LOADER()

    MAIN_IMG.LEFT = SLIDE_AREA.LEFT
    MAIN_IMG.TOP = SLIDE_AREA.TOP
    
    MAIN_IMG.Visible = False
    MAIN_IMG.Picture = Nothing
    MAIN_IMG.Picture = LoadPicture("")

    MAIN_IMG.Visible = False
    MAIN_IMG.Picture = Nothing
    MAIN_IMG.Picture = LoadPicture(ENV_IMAGE_ASSISTENT_IMPORT_FILE, , , Color)
    MAIN_IMG.Visible = True
            
    Call GET_EXIF(ENV_IMAGE_ASSISTENT_IMPORT_FILE)
    
    Application.Wait (Now + TimeValue("0:00:01"))
    
    MAIN_IMG.Width = 400

End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Public Sub GET_EXIF(ByVal MYIMAGE As String)

     Dim objPic As IPictureDisp
     Dim udtBMP As BITMAP
    
     Set objPic = LoadPicture(MYIMAGE)
     GetObjectAPI objPic.Handle, Len(udtBMP), udtBMP
     Me.IMPORT_W.Caption = udtBMP.bmWidth
     Me.IMPORT_H.Caption = udtBMP.bmHeight
 
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Public Sub SET_FIT_Y()
    
    MAIN_IMG.Height = MASK_IMG.Height
    
    If MAIN_IMG.Width < MASK_IMG.Width Then
    
        MAIN_IMG.Width = MASK_IMG.Width
        Call SET_ASPECT_RATIO_H
    
    End If
    
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Public Sub SET_FIT_X()
    
    MAIN_IMG.Width = MASK_IMG.Width
    
    If MAIN_IMG.Height < MASK_IMG.Height Then
    
        MAIN_IMG.Height = MASK_IMG.Height
        Call SET_ASPECT_RATIO_W
    
    End If

End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Public Sub SET_ASPECT_RATIO_H()
    
    MAIN_IMG.Height = Round(((MAIN_IMG.Width * Me.IMPORT_H.Caption) / Me.IMPORT_W.Caption), 0)

End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Public Sub SET_ASPECT_RATIO_W()
    
    MAIN_IMG.Width = Round(((MAIN_IMG.Height * Me.IMPORT_W.Caption) / Me.IMPORT_H.Caption), 0)

End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Public Sub SET_CENTER_Y()

    MAIN_IMG.TOP = Round(SLIDE_AREA.TOP + (SLIDE_AREA.Height / 2) - (MAIN_IMG.Height / 2), 0)
    
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Public Sub SET_CENTER_X()

    MAIN_IMG.LEFT = Round(SLIDE_AREA.LEFT + (SLIDE_AREA.Width / 2) - (MAIN_IMG.Width / 2), 0)
    
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Public Sub SET_ZOOM_FACTOR()

    ZOOM_FACTOR.Caption = Round(((100 * MAIN_IMG.Width) / Me.IMPORT_W.Caption), 1)

End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Public Sub CMD_SAVE_Click()

    CMD_SAVE.Visible = False
    BACK_SAVE.Visible = False
    
    LOCK_PLANE.Visible = True
    
    LOCK_PLANE.LEFT = -20
    LOCK_PLANE.TOP = -20
    LOCK_PLANE.Width = Me.Width + 100
    LOCK_PLANE.Height = Me.Height + 100
    
    STANDBY_ICON.Visible = False
    
    STANDBY_ICON.LEFT = (Me.Width / 2) - (STANDBY_ICON.Width / 2)
    STANDBY_ICON.TOP = (Me.Height / 2) - (STANDBY_ICON.Height / 2)
        
    'Call START_LOADING_CIRCLE(Me)
    
    STANDBY_ICON.Visible = True
    
    Call SET_COORDINATES
    
    Call CROP_RESIZE_IMAGE_IMAGEMAGICK_ENGINE
    
    LOCK_PLANE.Visible = False
    STANDBY_ICON.Visible = False
    
    Call SPLASH_FORM
    
    'Unload Me

End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_SAVE_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    'CMD_SAVE.ForeColor = ENV_COLOR_WHITE
    BACK_SAVE.BackStyle = fmBackStyleOpaque

End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Public Sub SET_COORDINATES()
    
    '//// MASK SIZE RELATION
    L_MASK_W_GUI.Caption = WorksheetFunction.RoundUp(((MASK_IMG.Width * 100) / (MAIN_IMG.Width)), 1)
    L_MASK_H_GUI.Caption = WorksheetFunction.RoundUp(((MASK_IMG.Height * 100) / (MAIN_IMG.Height)), 1)
         
    L_MASK_W_EXPORT.Caption = WorksheetFunction.RoundUp(((Me.IMPORT_W.Caption * L_MASK_W_GUI.Caption) / 100), 1)
    L_MASK_H_EXPORT.Caption = WorksheetFunction.RoundUp(((Me.IMPORT_H.Caption * L_MASK_H_GUI.Caption) / 100), 1)
    
    '//// MASK OFFSET RELATION
    L_MASK_OFFSET_L_GUI.Caption = WorksheetFunction.RoundUp((MASK_IMG.LEFT - MAIN_IMG.LEFT), 1)
    L_MASK_OFFSET_T_GUI.Caption = WorksheetFunction.RoundUp((MASK_IMG.TOP - MAIN_IMG.TOP), 1)
 
    ZOOM_FACTOR.Caption = WorksheetFunction.RoundUp(((100 * MAIN_IMG.Width) / Me.IMPORT_W.Caption), 1)
    
    L_MASK_OFFSET_L_EXPORT.Caption = Replace(WorksheetFunction.RoundUp((L_MASK_OFFSET_L_GUI.Caption * 100) / (ZOOM_FACTOR.Caption), 1), "-", "")
    L_MASK_OFFSET_T_EXPORT.Caption = Replace(WorksheetFunction.RoundUp((L_MASK_OFFSET_T_GUI.Caption * 100) / (ZOOM_FACTOR.Caption), 1), "-", "")
    
    ENV_IMAGE_ASSISTENT_CROP_SIZE(1) = L_MASK_W_EXPORT.Caption
    ENV_IMAGE_ASSISTENT_CROP_SIZE(2) = L_MASK_H_EXPORT.Caption
    ENV_IMAGE_ASSISTENT_CROP_SIZE(3) = L_MASK_OFFSET_L_EXPORT.Caption
    ENV_IMAGE_ASSISTENT_CROP_SIZE(4) = L_MASK_OFFSET_T_EXPORT.Caption
    
    If ENV_IMAGE_ASSISTENT_CROP_SIZE(5) = 0 Then ENV_IMAGE_ASSISTENT_CROP_SIZE(5) = IMPORT_W.Caption 'ORIGINAL SIZE
    
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub SPLASH_FORM()

    ENV_ACTIVE_GUI_SETUP(0) = ENV_COLOR_LIME_DARK
    ENV_ACTIVE_GUI_SETUP(1) = GUI_IMAGE_ASSISTENT.LEFT
    ENV_ACTIVE_GUI_SETUP(2) = GUI_IMAGE_ASSISTENT.TOP
    ENV_ACTIVE_GUI_SETUP(3) = GUI_IMAGE_ASSISTENT.Width
    ENV_ACTIVE_GUI_SETUP(4) = GUI_IMAGE_ASSISTENT.Height
    GUI_SPLASH_FX.Show

End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Public Sub CHECK_SAVE_STATUS()

    CMD_SAVE.ForeColor = ENV_COLOR_TITAN
    L_INFO.ForeColor = ENV_COLOR_TITAN
    
    CMD_MASK_43.ForeColor = ENV_COLOR_TITAN
    CMD_MASK_169.ForeColor = ENV_COLOR_TITAN
    CMD_MASK_A4.ForeColor = ENV_COLOR_TITAN
    L_MAINTITEL.ForeColor = ENV_COLOR_TITAN
    CMD_CLOSE.ForeColor = ENV_COLOR_TITAN
    
    CMD_PARISB.ForeColor = ENV_COLOR_TITAN
    
    
    If MAIN_IMG.TOP < (LINE_0.TOP - 30) Then
    
        CMD_MASK_43.ForeColor = ENV_COLOR_WHITE
        CMD_MASK_169.ForeColor = ENV_COLOR_WHITE
        CMD_MASK_A4.ForeColor = ENV_COLOR_WHITE
        L_MAINTITEL.ForeColor = ENV_COLOR_WHITE
        
    End If
    
    If MAIN_IMG.TOP < (LINE_0.TOP - 40) Then
    
        CMD_CLOSE.ForeColor = ENV_COLOR_WHITE
        
    End If
    
    
    If MAIN_IMG.LEFT + MAIN_IMG.Width > CMD_SAVE.LEFT + CMD_SAVE.Width - 5 Then CMD_SAVE.ForeColor = ENV_COLOR_WHITE
    If MAIN_IMG.LEFT + MAIN_IMG.Width > L_INFO.LEFT + L_INFO.Width - 5 Then L_INFO.ForeColor = ENV_COLOR_WHITE
    
    
    
    
    
    SAVE_AREA = False

    B_TOP.BackColor = ENV_COLOR_MAGENTA
    B_LEFT.BackColor = ENV_COLOR_MAGENTA
    B_RIGHT.BackColor = ENV_COLOR_MAGENTA
    B_BOTTOM.BackColor = ENV_COLOR_MAGENTA
    
    CMD_SAVE.Visible = False
    BACK_SAVE.Visible = False
    
    L_TITEL.ForeColor = &H8D7467
    If MAIN_IMG.TOP < (MASK_IMG.TOP - 14) Then L_TITEL.ForeColor = &HFFFFFF
    
    If MAIN_IMG.Width < MASK_IMG.Width Then Exit Sub
    If MAIN_IMG.Height < MASK_IMG.Height Then Exit Sub
    
    If MAIN_IMG.Width + MAIN_IMG.LEFT < MASK_IMG.Width + MASK_IMG.LEFT Then Exit Sub
    If MAIN_IMG.Height + MAIN_IMG.TOP < MASK_IMG.Height + MASK_IMG.TOP Then Exit Sub
    
    If MAIN_IMG.LEFT > MASK_IMG.LEFT Then Exit Sub
    If MAIN_IMG.TOP > MASK_IMG.TOP Then Exit Sub

    B_TOP.BackColor = ENV_COLOR_LIME_DARK
    B_LEFT.BackColor = ENV_COLOR_LIME_DARK
    B_RIGHT.BackColor = ENV_COLOR_LIME_DARK
    B_BOTTOM.BackColor = ENV_COLOR_LIME_DARK
    
    SAVE_AREA = True
    CMD_SAVE.Visible = True
    BACK_SAVE.Visible = True

End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Public Sub MAIN_IMG_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
    If Button = 1 Then

        M_SNG_LEFT_POS = X
        M_SNG_TOP_POS = Y
    
    End If
    
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Public Sub MAIN_IMG_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
    Dim SNG_LEFT As Single
    Dim SNG_TOP As Single
    
    ZOOM_ITEM.BackColor = ENV_COLOR_LIME
    
    If Button = 1 Then

        With MAIN_IMG
        
            '//// LEFT AREA
            SNG_LEFT = (.LEFT + X) - M_SNG_LEFT_POS
                       
                '//// LOCK AREA
                'If SNG_LEFT < SLIDE_AREA.LEFT Then SNG_LEFT = SLIDE_AREA.LEFT
                'If (SNG_LEFT + .Width) > (SLIDE_AREA.LEFT + SLIDE_AREA.Width) Then SNG_LEFT = SLIDE_AREA.LEFT + SLIDE_AREA.Width - .Width
                '//// LOCK AREA
            
            '//// HEIGHT AREA
            SNG_TOP = (.TOP + Y) - M_SNG_TOP_POS

                '//// LOCK AREA
                'If SNG_TOP < SLIDE_AREA.TOP Then SNG_TOP = SLIDE_AREA.TOP
                'If (SNG_TOP + .Height) > (SLIDE_AREA.TOP + SLIDE_AREA.Height) Then SNG_TOP = SLIDE_AREA.TOP + SLIDE_AREA.Height - .Height
                '//// LOCK AREA
            
            .Move SNG_LEFT, SNG_TOP
            
        End With
    
    End If
    
    Call RESET_STAGE
    
    Call CHECK_SAVE_STATUS
    
    Call SET_COORDINATES
    
    Call SET_SCALE_ICON

End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub SET_SCALE_ICON()

    ZOOM_ITEM.LEFT = MAIN_IMG.LEFT + MAIN_IMG.Width - 24
    ZOOM_ITEM.TOP = MAIN_IMG.TOP + MAIN_IMG.Height - 24
    ZOOM_ITEM_W.LEFT = MAIN_IMG.LEFT + MAIN_IMG.Width - 28
    ZOOM_ITEM_W.TOP = MAIN_IMG.TOP + MAIN_IMG.Height - 28
    
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Public Sub ZOOM_ITEM_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
    If Button = 1 Then

        Z_SNG_LEFT_POS = X
        Z_SNG_TOP_POS = Y
    
    End If
    
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Public Sub ZOOM_ITEM_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
    Dim SNG_LEFT As Single
    Dim SNG_TOP As Single
    
    ZOOM_ITEM.BackColor = ENV_COLOR_MAGENTA
    
    If Button = 1 Then

        With ZOOM_ITEM
        
            '//// LEFT AREA
            SNG_LEFT = (.LEFT + X) - Z_SNG_LEFT_POS
                       
                '//// LOCK AREA
                'If SNG_LEFT < SLIDE_AREA.LEFT Then SNG_LEFT = SLIDE_AREA.LEFT
                'If (SNG_LEFT + .Width) > (SLIDE_AREA.LEFT + SLIDE_AREA.Width) Then SNG_LEFT = SLIDE_AREA.LEFT + SLIDE_AREA.Width - .Width
                '//// LOCK AREA
            
            '//// HEIGHT AREA
            SNG_TOP = (.TOP + Y) - Z_SNG_TOP_POS

                '//// LOCK AREA
                'If SNG_TOP < SLIDE_AREA.TOP Then SNG_TOP = SLIDE_AREA.TOP
                'If (SNG_TOP + .Height) > (SLIDE_AREA.TOP + SLIDE_AREA.Height) Then SNG_TOP = SLIDE_AREA.TOP + SLIDE_AREA.Height - .Height
                '//// LOCK AREA
            
            .Move SNG_LEFT, SNG_TOP
            
        End With
        
        MAIN_IMG.Width = ZOOM_ITEM.LEFT - MAIN_IMG.LEFT + ZOOM_ITEM.Width
        MAIN_IMG.Height = Round(((MAIN_IMG.Width * Me.IMPORT_H.Caption) / Me.IMPORT_W.Caption), 0)
        
        ZOOM_ITEM_W.LEFT = MAIN_IMG.LEFT + MAIN_IMG.Width - 28
        ZOOM_ITEM_W.TOP = MAIN_IMG.TOP + MAIN_IMG.Height - 28
    
    End If
    
    Call CHECK_SAVE_STATUS
    
    Call SET_COORDINATES
    
    Call SET_SCALE_ICON
    
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_ZOOM_IN_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    L_INFO.Caption = "ZOOM IN"
     Call SET_SCALE_ICON
       
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_ZOOM_OUT_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    L_INFO.Caption = "ZOOM OUT"
      Call SET_SCALE_ICON
      
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_CENTER_Y_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    L_INFO.Caption = "Y CENTER"
      Call SET_SCALE_ICON
      
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_CENTER_X_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    L_INFO.Caption = "X CENTER"
    Call SET_SCALE_ICON
    
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_CENTER_XY_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    L_INFO.Caption = "X&Y CENTER"
       Call SET_SCALE_ICON
     
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_FIT_Y_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
    L_INFO.Caption = "Y FIT"
      Call SET_SCALE_ICON
      
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_FIT_X_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
    L_INFO.Caption = "X FIT"
      Call SET_SCALE_ICON
      
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_TC_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
    L_INFO.Caption = "TOP CENTER"
      Call SET_SCALE_ICON
      
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_RC_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
    L_INFO.Caption = "RIGHT CENTER"
      Call SET_SCALE_ICON
      
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_BC_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
    L_INFO.Caption = "BOTTOM CENTER"
     Call SET_SCALE_ICON
       
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_LC_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
    L_INFO.Caption = "LEFT CENTER"
    Call SET_SCALE_ICON
        
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_LT_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
    L_INFO.Caption = "LEFT TOP"
     Call SET_SCALE_ICON
       
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_RT_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
    L_INFO.Caption = "RIGHT TOP"
    Call SET_SCALE_ICON
       
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_LB_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
    L_INFO.Caption = "LEFT BOTTOM"
    Call SET_SCALE_ICON
        
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_RB_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
    L_INFO.Caption = "RIGHT BOTTOM"
    Call SET_SCALE_ICON
    
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub CMD_OPEN_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
    L_INFO.Caption = "OPEN IMAGE FILE"
    
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    Call RESET_STAGE

End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub RESET_STAGE()
    
    BACK_SAVE.BackStyle = fmBackStyleTransparent
    CMD_SAVE.ForeColor = ENV_COLOR_TITAN
    L_INFO.Caption = ""
    ZOOM_ITEM.BackColor = ENV_COLOR_LIME_DARK
    
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'//// SCRIPT © REUTLINGER / WWW.PARIS-STUDIOS.DE - ALL RIGHTS RESERVED /////////////////////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'//// SCRIPT © REUTLINGER / WWW.PARIS-STUDIOS.DE - ALL RIGHTS RESERVED /////////////////////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Public Function CROP_RESIZE_IMAGE_IMAGEMAGICK_ENGINE() As String

    Dim CMD_CACHE As String
    Dim TEMP_IMAGE As String
    Dim EXPORT_THUMB_IMAGE As String
    Dim objStream
    
    TEMP_IMAGE = "C:\temp\imagecropcache.jpg"
    EXPORT_THUMB_IMAGE = Mid(ENV_IMAGE_ASSISTENT_EXPORT_FILE, 1, Len(ENV_IMAGE_ASSISTENT_EXPORT_FILE) - 4) & "_P.JPG"
    
    On Error Resume Next
    
        Kill ENV_IMAGE_ASSISTENT_EXPORT_FILE
    
    On Error GoTo 0
    
    On Error Resume Next
    
        Kill TEMP_IMAGE
    
    On Error GoTo 0
    
    On Error Resume Next
    
        Kill EXPORT_THUMB_IMAGE
    
    On Error GoTo 0

    FileCopy ENV_IMAGE_ASSISTENT_IMPORT_FILE, TEMP_IMAGE
    
    'Call TRY_FILE_CHECK(TEMP_IMAGE)
    
    
    '/
    '//
    '///
    '////
    CMD_CACHE = CMD_CACHE & "chcp 65001" & vbCrLf
    CMD_CACHE = CMD_CACHE & "CD " & ENV_ROOT_FOLDER & "ROOT\SERVICES\" & vbCrLf
    CMD_CACHE = CMD_CACHE & Mid(ENV_ROOT_FOLDER, 1, 2) & vbCrLf
    
    'CROP
    CMD_CACHE = CMD_CACHE & "magick.exe " & Chr(34) & TEMP_IMAGE & Chr(34) & " -crop " & ENV_IMAGE_ASSISTENT_CROP_SIZE(1) & "x" & ENV_IMAGE_ASSISTENT_CROP_SIZE(2) & "+" & ENV_IMAGE_ASSISTENT_CROP_SIZE(3) & "+" & ENV_IMAGE_ASSISTENT_CROP_SIZE(4) & " " & Chr(34) & ENV_IMAGE_ASSISTENT_EXPORT_FILE & Chr(34) & vbCrLf
    
    CMD_CACHE = CMD_CACHE & "timeout /T 1 /nobreak" & vbCrLf
    
    'RESIZE
    CMD_CACHE = CMD_CACHE & "magick.exe convert -scale " & ENV_IMAGE_ASSISTENT_CROP_SIZE(5) & " " & Chr(34) & ENV_IMAGE_ASSISTENT_EXPORT_FILE & Chr(34) & " " & Chr(34) & ENV_IMAGE_ASSISTENT_EXPORT_FILE & Chr(34) & vbCrLf
    
    'RESIZE THUMB
    CMD_CACHE = CMD_CACHE & "magick.exe convert -scale " & ENV_IMAGE_ASSISTENT_CROP_SIZE(6) & " " & Chr(34) & ENV_IMAGE_ASSISTENT_EXPORT_FILE & Chr(34) & " " & Chr(34) & EXPORT_THUMB_IMAGE & Chr(34) & vbCrLf
    '////
    '///
    '//
    '/
    
    
    
    '/
    '//
    '///
    '////
    Set objStream = CreateObject("ADODB.Stream")
    
    objStream.Charset = "utf-8" '"ascii" '"utf-8" '"ascii""
    
    objStream.Open

    objStream.WriteText CMD_CACHE '//// WRITE STREAM

    objStream.SaveToFile ENV_ROOT_FOLDER & "ROOT\SERVICES\CROPIMAGE.CMD", 2  ' 1 Default, creates a new file 2 Completely overwrite data in an existing file

    objStream.Close
        
    Set objStream = Nothing
    '////
    '///
    '//
    '/
    
    'Call TRY_FILE_CHECK(ENV_ROOT_FOLDER & "ROOT\SERVICES\CROPIMAGE.CMD")
    
    Dim X
    RUNFILE = (ENV_ROOT_FOLDER & "ROOT\SERVICES\CROPIMAGE.CMD")
    X = Shell(RUNFILE, vbMinimizeocus)
    
    'Call TRY_FILE_CHECK(ENV_IMAGE_ASSISTENT_EXPORT_FILE)
    'Call TRY_FILE_CHECK(EXPORT_THUMB_IMAGE)
    
End Function
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'Usage: convert [options ...] file [ [options ...] file ...] [options ...] file
'///// -adjoin              join images into a single multi-image file
'///// -affine matrix       affine transform matrix
'///// -annotate geometry text                       annotate the image with text
'///// -antialias           remove pixel-aliasing
'///// -append              append an image sequence
'///// -authenticate value  decrypt image with this password
'///// -average             average an image sequence
'///// -background color    background color
'///// -bias value          add bias when convolving an image
'///// -black-threshold value                       forces all pixels below the threshold into black
'///// -blue-primary point  chromaticity blue primary point
'///// -blur geometry       blur the image
'///// -border geometry     surround image with a border of color
'///// -bordercolor color   border color
'///// -channel type        apply option to select image channels
'///// -charcoal radius     simulate a charcoal drawing
'///// -chop geometry       remove pixels from the image interior
'///// -clip                clip along the first path from the 8BIM profile
'///// -clip-path id        clip along a named path from the 8BIM profile
'///// -clone index         clone an image
'///// -coalesce            merge a sequence of images
'///// -colorize value      colorize the image with the fill color
'///// -colors value        preferred number of colors in the image
'///// -colorspace type     alternate image colorspace
'///// -combine             combine a sequence of images
'///// -comment string      annotate image with comment
'///// -compose operator    set image composite operator
'///// -composite           composite image
'///// -compress type       type of pixel compression when writing the image
'///// -contrast            enhance or reduce the image contrast
'///// -convolve coefficients                       apply a convolution kernel to the image
'///// -crop geometry       cut out a rectangular region of the image
'///// -cycle amount        cycle the image colormap
'///// -debug events        display copious debugging information
'///// -define format:option                       define one or more image format options
'///// -deconstruct         break down an image sequence into constituent parts
'///// -delay value         display the next image after pausing
'///// -delete index        delete the image from the image sequence
'///// -density geometry    horizontal and vertical density of the image
'///// -depth value         image depth
'///// -despeckle           reduce the speckles within an image
'///// -display server      get image or font from this X server
'///// -dispose method      GIF disposal method
'///// -dither              apply Floyd/Steinberg error diffusion to image
'///// -draw string         annotate the image with a graphic primitive
'///// -edge radius         apply a filter to detect edges in the image
'///// -emboss radius       emboss an image
'///// -encoding type       text encoding type
'///// -endian type         endianness (MSB or LSB) of the image
'///// -enhance             apply a digital filter to enhance a noisy image
'///// -equalize            perform histogram equalization to an image
'///// -evaluate operator value                       evaluate an arithmetic, relational, or logical expression
'///// -extent geometry     set the image size
'///// -extract geometry    extract area from image
'///// -family name         render text with this font family
'///// -fill color          color to use when filling a graphic primitive
'///// -filter type         use this filter when resizing an image
'///// -flatten             flatten a sequence of images
'///// -flip                flip image in the vertical direction
'///// -floodfill geometry color                       floodfill the image with color
'///// -flop                flop image in the horizontal direction
'///// -font name           render text with this font
'///// -format "string"     output formatted image characteristics
'///// -frame geometry      surround image with an ornamental border
'///// -fuzz distance       colors within this distance are considered equal
'///// -fx expression       apply mathematical expression to an image channel(s)
'///// -gamma value         level of gamma correction
'///// -gaussian geometry   gaussian blur an image
'///// -geometry geometry   perferred size or location of the image
'///// -green-primary point chromaticity green primary point
'///// -gravity type        horizontal and vertical text placement
'///// -help                print program options
'///// -identify            identify the format and characteristics of the image
'///// -implode amount      implode image pixels about the center
'///// -insert index        insert last image into the image sequence
'///// -intent type         type of rendering intent when managing the image color
'///// -interlace type      type of image interlacing scheme
'///// -label name          assign a label to an image
'///// -lat geometry        local adaptive thresholding
'///// -level value         adjust the level of image contrast
'///// -limit type value    pixel cache resource limit
'///// -log format          format of debugging information
'///// -loop iterations     add Netscape loop extension to your GIF animation
'///// -map filename        transform image colors to match this set of colors
'///// -mask filename       set the image clip mask
'///// -matte               store matte channel if the image has one
'///// -mattecolor color    frame color
'///// -median radius       apply a median filter to the image
'///// -modulate value      vary the brightness, saturation, and hue
'///// -monitor             monitor progress
'///// -monochrome          transform image to black and white
'///// -morph value         morph an image sequence
'///// -mosaic              create a mosaic from an image sequence
'///// -motion-blur geometry                       simulate motion blur
'///// -negate              replace every pixel with its complementary color
'///// -noise radius        add or reduce noise in an image
'///// -normalize           transform image to span the full range of colors
'///// -opaque color        change this color to the fill color
'///// -ordered-dither NxN                       ordered dither the image
'///// -orient type         image orientation
'///// -page geometry       size and location of an image canvas (setting)
'///// -paint radius        simulate an oil painting
'///// -ping                efficiently determine image attributes
'///// -pointsize value     font point size
'///// -posterize levels    reduce the image to a limited number of color levels
'///// -preview type        image preview type
'///// -profile filename    add, delete, or apply an image profile
'///// -quality value       JPEG/MIFF/PNG compression level
'///// -quiet               suppress all error or warning messages
'///// -radial-blur angle   radial blur the image
'///// -raise value         lighten/darken image edges to create a 3-D effect
'///// -random-threshold low,high                       random threshold the image
'///// -region geometry     apply options to a portion of the image
'///// -raise value         lighten/darken image edges to create a 3-D effect
'///// -red-primary point   chromaticity red primary point
'///// -render              render vector graphics
'///// -repage geometry     size and location of an image canvas
'///// -resample geometry   change the resolution of an image
'///// -resize geometry     resize the image
'///// -roll geometry       roll an image vertically or horizontally
'///// -rotate degrees      apply Paeth rotation to the image
'///// -sample geometry     scale image with pixel sampling
'///// -sampling-factor geometry                       horizontal and vertical sampling factor
'///// -scale geometry      scale the image
'///// -scene value         image scene number
'///// -seed value          pseudo-random number generator seed value
'///// -segment values      segment an image
'///// -separate            separate an image channel into a grayscale image
'///// -sepia-tone threshold                       simulate a sepia-toned photo
'///// -set attribute value set an image attribute
'///// -shade degrees       shade the image using a distant light source
'///// -shadow geometry     simulate an image shadow
'///// -sharpen geometry    sharpen the image
'///// -shave geometry      shave pixels from the image edges
'///// -shear geometry      slide one edge of the image along the X or Y axis
'///// -sigmodial-contrast geometry                       lightness rescaling using sigmoidal contrast enhancement
'///// -size geometry       width and height of image
'///// -solarize threshold  negate all pixels above the threshold level
'///// -splice geometry     splice the background color into the image
'///// -spread amount       displace image pixels by a random amount
'///// -strip               strip image of all profiles and comments
'///// -stroke color        graphic primitive stroke color
'///// -strokewidth value   graphic primitive stroke width
'///// -stretch type        render text with this font stretch
'///// -style type          render text with this font style
'///// -support factor      resize support: > 1.0 is blurry, < 1.0 is sharp
'///// -swap indexes        swap two images in the image sequence
'///// -swirl degrees       swirl image pixels about the center
'///// -texture filename    name of texture to tile onto the image background
'///// -threshold value     threshold the image
'///// -thumbnail geometry  create a thumbnail of the image
'///// -tile filename       tile image when filling a graphic primitive
'///// -tint value          tint the image with the fill color
'///// -transform           affine transform image
'///// -transparent color   make this color transparent within the image
'///// -treedepth value     color tree depth
'///// -trim                trim image edges
'///// -type type           image type
'///// -undercolor color    annotation bounding box color
'///// -units type          the units of image resolution
'///// -unsharp geometry    sharpen the image
'///// -verbose             print detailed information about the image
'///// -version             print version information
'///// -view                FlashPix viewing transforms
'///// -virtual-pixel method                       virtual pixel access method
'///// -wave geometry       alter an image along a sine wave
'///// -weight type         render text with this font weight
'///// -white-point point   chromaticity white point
'///// -white-threshold value                       forces all pixels above the threshold into white
'///// -write filename      write images to this file
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'//// SCRIPT © REUTLINGER / WWW.PARIS-STUDIOS.DE - ALL RIGHTS RESERVED /////////////////////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'//// SCRIPT © REUTLINGER / WWW.PARIS-STUDIOS.DE - ALL RIGHTS RESERVED /////////////////////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Option Explicit
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Public ENV_SOFTWARE_VERSION As String
Public ENV_ROOT_FOLDER As String
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Public ENV_COLOR_LIME As Long
Public ENV_COLOR_LIME_DARK As Long
Public ENV_COLOR_LIGHT As Long
Public ENV_COLOR_TITAN_DARK As Long
Public ENV_COLOR_TITAN As Long
Public ENV_COLOR_WHITE As Long
Public ENV_COLOR_GLASS As Long
Public ENV_COLOR_MAGENTA As Long
Public ENV_ACTIVE_GUI_SETUP(5) As String
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Public ENV_IMAGE_ASSISTENT_IMPORT_FILE As String
Public ENV_IMAGE_ASSISTENT_FORMAT(2) As Long 'MASK FORMAT
Public ENV_IMAGE_ASSISTENT_CROP_SIZE(6) As Long '1=WIDTH, 2=HEIGTH, 3=LEFT, 4=TOP, 5=SIZE 6=SIZETHUMB
Public ENV_IMAGE_ASSISTENT_EXPORT_FILE As String
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Public Sub SET_ENVIRONMENT_PUBLIC_VARIABLE()

    ENV_ROOT_FOLDER = Application.ActiveWorkbook.Path & "\"

    ENV_COLOR_LIME = &H1FDDB
    ENV_COLOR_LIME_DARK = &HDFBE&
    ENV_COLOR_LIGHT = &HF8F5F3
    ENV_COLOR_GLASS = &HF9F8F7
    ENV_COLOR_TITAN = &HAFA096
    ENV_COLOR_TITAN_DARK = &H8C8078
    ENV_COLOR_WHITE = &HFFFFFF
    ENV_COLOR_MAGENTA = &H9900CC

    ENV_IMAGE_ASSISTENT_CROP_SIZE(5) = 1080 'IMAGE SIZE
    ENV_IMAGE_ASSISTENT_CROP_SIZE(6) = 200 'IMAGE THUMB SIZE
    
End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub START_CROP_ENGINE(control As IRibbonControl)

    Call SET_ENVIRONMENT_PUBLIC_VARIABLE

    GUI_IMAGE_ASSISTENT.Show

End Sub
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'//// SCRIPT © REUTLINGER / WWW.PARIS-STUDIOS.DE - ALL RIGHTS RESERVED /////////////////////////////////////////////////////////////////////////////////
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

Cookies make it easier for us to provide you with our services. With the usage of our services you permit us to use cookies.
More information Ok