This can be done without coding in C.
Code: Select all
#include 'hmg.ch'
FUNCTION Main()
SET FONT TO 'MS Shell Dlg', 8
DEFINE WINDOW MainWA;
MAIN;
WIDTH 380;
HEIGHT 230;
TITLE 'Path Compact';
NOMAXIMIZE;
NOSIZE
DEFINE LABEL PathLA
ROW 10
COL 10
WIDTH 350
HEIGHT 13
VALUE 'Path to compact:'
END LABEL
DEFINE TEXTBOX PathTE
ROW 25
COL 10
WIDTH 310
HEIGHT 20
MAXLENGTH 259
VALUE CurDir()
ONCHANGE CompactPaths()
END TEXTBOX
DEFINE BUTTON PathBU
ROW 25
COL 330
WIDTH 30
HEIGHT 20
CAPTION '>>'
ACTION SetPath()
END BUTTON
DEFINE LABEL CompCharLA
ROW 55
COL 10
WIDTH 350
HEIGHT 13
VALUE 'Compact path - length in characters:'
END LABEL
DEFINE TEXTBOX CompCharTE
ROW 70
COL 10
WIDTH 310
HEIGHT 20
MAXLENGTH 259
READONLY .T.
DISABLEDBACKCOLOR {224, 224, 224}
ONGOTFOCUS SendMessage(MainWA.CompCharTE.HANDLE, 177 /*EM_SETSEL*/, 0, -1)
END TEXTBOX
DEFINE TEXTBOX CharsTE
ROW 70
COL 330
WIDTH 30
HEIGHT 20
VALUE 30
DATATYPE NUMERIC
RIGHTALIGN .T.
INPUTMASK '999'
ONCHANGE CompactPaths()
END TEXTBOX
DEFINE LABEL CompPixLA
ROW 100
COL 10
WIDTH 350
HEIGHT 13
VALUE 'Compact path - length in pixels:'
END LABEL
DEFINE TEXTBOX CompPixTE
ROW 115
COL 10
WIDTH 310
HEIGHT 20
MAXLENGTH 259
READONLY .T.
DISABLEDBACKCOLOR {224, 224, 224}
ONGOTFOCUS SendMessage(MainWA.CompPixTE.HANDLE, 177 /*EM_SETSEL*/, 0, -1)
END TEXTBOX
DEFINE TEXTBOX PixelsTE
ROW 115
COL 330
WIDTH 30
HEIGHT 20
VALUE 120
DATATYPE NUMERIC
INPUTMASK '999'
RIGHTALIGN .T.
ONCHANGE CompactPaths()
END TEXTBOX
DEFINE LABEL CompWndLA
ROW 145
COL 10
WIDTH 350
HEIGHT 13
VALUE 'Compact path to control width:'
END LABEL
DEFINE TEXTBOX CompWndTE
ROW 160
COL 10
WIDTH 310
HEIGHT 20
MAXLENGTH 259
READONLY .T.
DISABLEDBACKCOLOR {224, 224, 224}
ONGOTFOCUS SendMessage(MainWA.CompWndTE.HANDLE, 177 /*EM_SETSEL*/, 0, -1)
END TEXTBOX
DEFINE TEXTBOX WidthTE
ROW 160
COL 330
WIDTH 30
HEIGHT 20
VALUE 160
DATATYPE NUMERIC
INPUTMASK '999'
RIGHTALIGN .T.
ONCHANGE (MainWA.CompWndTE.WIDTH := If(MainWA.WidthTE.VALUE < 0, 0, MainWA.WidthTE.VALUE), CompactPaths())
END TEXTBOX
ON KEY ESCAPE ACTION MainWA.RELEASE
END WINDOW
MainWA.CENTER
MainWA.ACTIVATE
RETURN NIL
FUNCTION SetPath()
LOCAL cPath := GetFile()
IF ! Empty(cPath)
MainWA.PathTE.VALUE := cPath
ENDIF
RETURN NIL
FUNCTION CompactPaths()
IF IsControlDefined(CompCharTE, MainWA)
MainWA.CompCharTE.VALUE := GetCompactPathChar(MainWA.PathTE.VALUE, MainWA.CharsTE.VALUE)
ENDIF
IF IsControlDefined(CompPixTE, MainWA)
MainWA.CompPixTE.VALUE := GetCompactPathPix(MainWA.PathTE.VALUE, MainWA.PixelsTE.VALUE, MainWA.CompPixTE.HANDLE)
ENDIF
IF IsControlDefined(CompWndTE, MainWA)
MainWA.CompWndTE.VALUE := GetCompactPathWnd(MainWA.PathTE.VALUE, MainWA.CompWndTE.HANDLE)
ENDIF
RETURN NIL
FUNCTION GetCompactPathChar(cPath, nChars)
LOCAL cPathComp
IF ++nChars < 0
nChars := 0
ENDIF
cPathComp := Space(nChars)
RETURN If(HMG_CallDLL('Shlwapi.dll', 0, 'PathCompactPathEx', @cPathComp, cPath, nChars, NIL) == 0, cPath, cPathComp)
FUNCTION GetCompactPathPix(cPath, nPixels, nHWnd)
LOCAL nHDC := GetDC(nHWnd)
LOCAL nHFont := HMG_CallDLL('Gdi32.dll', 0, 'SelectObject', nHDC, SendMessage(nHWnd, 49 /*WM_GETFONT*/, 0, 0))
IF nPixels < 0
nPixels := 0
ENDIF
HMG_CallDLL('Shlwapi.dll', 0, 'PathCompactPath', nHDC, @cPath, nPixels)
HMG_CallDLL('Gdi32.dll', 0, 'SelectObject', nHDC, nHFont)
ReleaseDC(nHWnd, nHDC)
RETURN cPath
FUNCTION GetCompactPathWnd(cPath, nHWnd)
RETURN GetCompactPathPix(cPath, GetClientAreaWidth(nHWnd), nHWnd)
//#pragma BEGINDUMP
// #include "SET_COMPILE_HMG_UNICODE.ch"
// #include "HMG_UNICODE.h"
//
// #include <windows.h>
// #include <shlwapi.h>
// #include "hbapi.h"
//
// //this function does not work, error while linking: undefined reference to `_imp__PathCompactPathW@12'
// //PathCompactPix(cPath, nPix, nHWnd)
// HB_FUNC ( PATHCOMPACTPIX )
// {
// LPTSTR lpszPath = (LPTSTR) HMG_parc (1);
// UINT dx = (UINT) hb_parni (2);
// HWND hWnd = (HWND) HMG_parnl(3);
// HDC hDC = GetDC(hWnd);
// HFONT hFont = SelectObject(hDC, (HFONT) SendMessage(hWnd, WM_GETFONT, 0, 0));
//
// PathCompactPath(hDC, lpszPath, dx);
//
// SelectObject(hDC, hFont);
// ReleaseDC(hWnd, hDC);
// HMG_retc(lpszPath);
// }
//
//#pragma ENDDUMP