Post by Walt Decker on Dec 20, 2020 15:48:52 GMT -5
The following is a small conversion of the editor I use at home. To run it you will need the attached zip file.
To do:
Devise a way to trap key strokes to determine if insert is set in order to change the caret.
Design a caret
Add menus
Add a toolbar (maybe)
Maybe include my dictionary
'/========================== WINDOWS EQUATES ================================/'
WM.SETFONT = HEXDEC("&H0030")
WM.GETFONT = HEXDEC("&H0031")
TRANSPARENT = 1
'/========================== WINDOWS EQUATES ================================/'
STRUCT tPnt, _
X AS LONG, _
Y AS LONG
STRUCT tRect, _
X AS LONG, _
Y AS LONG, _
X1 AS LONG, _
Y1 AS LONG
GLOBAL EdHndl
GLOBAL ChrCellX
GLOBAL ChrCellY
OPEN "gdi32" FOR DLL AS #GDI
OPEN "User32" FOR DLL AS #USER
OPEN "e:\pbwin10\dlls\FONTFUNDLL" FOR DLL AS #FNTDLL '<--- Change to your path
BackClr = 0
ChrCellX = 0
ChrCellY = 0
CaretWide = 0
CaretHigh = 0
BrushHndl = 0
WinHndl = 0
EdHndl = 0
WinDC = 0
T$ = ""
L = 0
'NOMAINWIN
UpperLeftX = 100
UpperLeftY = 100
WindowWidth = 300
WindowHeight = 300
OPEN "Win Test" FOR WINDOW AS #WIN
WinHndl = HWND(#WIN)
PRINT #WIN, "resizehandler Re.Size"
PRINT #WIN, "trapclose Endit"
CALL CreateEdit EdHndl
T$ = "Times New Roman" '<--- Change to your font
L = LEN(T$)
CALLDLL #FNTDLL, "FN_CreateFont", _ '<--- Creates a font
EdHndl AS ULONG, _ '<--- Handle returned from SUB CreateEdit
T$ AS PTR, _ '<--- Font name
10 AS LONG, _ '<--- Font size in points
1 AS LONG, _ '<--- Normal, 2 = BOLD
0 AS LONG, _ '<--- Italic
0 AS LONG, _ '<--- Underline
0 AS LONG, _ '<--- Strike-out
0 AS LONG, _ '<--- Font family; 0(zero) = don't care
FntHndl AS ULONG '<--- Return: handle of font,
' 0(zero) if failed
CLOSE #FNTDLL
CALL ResizeCtl '<--- Fit the multi-line edit control in the window
'/=================== SET THE FONT =======================================/'
CALLDLL #USER, "SendMessageA", EdHndl AS ULONG, WM.SETFONT AS ULONG, _
FntHndl AS ULONG, 1 AS ULONG, R AS VOID
'/========================================================================/'
' GET WIDTH & HEIGHT OF THE FONT
' With this I am not getting all the data I want. That will come later
'/========================================================================/'
CALLDLL #USER, "GetDC", EdHndl AS ULONG, WinDC AS ULONG
T$ = "Aa,Gg/=Xx!Tt{[\JjQq"
L = LEN(T$)
CALLDLL #GDI, "GetTextExtentPoint32A", _ '<--- Gets width and height in pixels
WinDC AS ULONG, _ '<--- Device context
T$ AS PTR, _ '<--- Text to calculae length
L AS ULONG, _ '<--- # of character in text
tPnt AS STRUCT, _ '<--- Width and height
R AS ULONG '<--- Return: 0(zero) on fail
ChrCellX = INT(tPnt.X.struct / L) '<--- Width of one character
ChrCellY = tPnt.Y.struct
'/================ THESE CALCULATE THE CARET WHEN IN INSERT MODE ========/'
CaretWide = ChrCellX
CaretHigh = INT(ChrCellY / (ChrCellY - 8))
CALLDLL #USER, "SetFocus", EdHndl AS ULONG, R AS ULONG
CALLDLL #USER, "CreateCaret", _ '<---
EdHndl AS ULONG, _ '<--- Handle of control or window
0 AS ULONG, _ '<--- Handle of bitmap obtained from
_ 'load image. 0(zero) for default caret
ChrCellX AS ULONG, _ '<--- Width of caret
ChrCellY AS ULONG, _ '<--- Height of caret
R AS ULONG '<--- Return: 0(zero) if failed
CALLDLL #USER, "SetCaretPos", 0 AS ULONG, ChrCellY AS ULONG, R AS ULONG
CALLDLL #USER, "ShowCaret", EdHndl AS ULONG, R AS ULONG
WAIT
END
'-------------------------------------------------------------------------------
'-------------------------------------------------------------------------------
'[Endit]
SUB Endit Hndl$
CLOSE #USER
CLOSE #GDI
CLOSE #WIN
END
END SUB
'-------------------------------------------------------------------------------
'-------------------------------------------------------------------------------
SUB Re.Size Hndl$
CALL ResizeCtl
CALLDLL #USER, "SetFocus", EdHndl AS ULONG, R AS LONG
'/==========================================================================/'
' RE-CREATE CARET
' Windows resets the caret when the focus is lost
'/==========================================================================/'
CALLDLL #USER, "CreateCaret", _ '<---
EdHndl AS ULONG, _ '<--- Handle of control or window
0 AS ULONG, _ '<--- Handle of bitmap obtained from
_ 'load image. 0(zero) for default caret
ChrCellX AS ULONG, _ '<--- Width of caret
ChrCellY AS ULONG, _ '<--- Height of caret
R AS ULONG '<--- Return: 0(zero) if failed
CALLDLL #USER, "ShowCaret", EdHndl AS ULONG, R AS ULONG
END SUB
'-------------------------------------------------------------------------------
'-------------------------------------------------------------------------------
SUB ResizeCtl
'/=========================== WINDOWS EQUATES ============================/'
SW.HIDE = 0
SW.SHOW = 5
SW.RESTORE = 9
'/========================================================================/'
WinHndl = 0
PosX = 0
PosY = 0
Wide = 0
High = 0
WinDc = 0
WinObj = 0
BrushHndl = 0
R = 0
IF INT(EdHndl) > 0 THEN
CALLDLL #USER, "ShowWindow", EdHndl AS ULONG, SW.HIDE AS ULONG, R AS ULONG
END IF
WinHndl = HWND(#WIN)
CALLDLL #USER, "GetClientRect", WinHndl AS ULONG, tRect AS STRUCT, R AS ULONG
BackClr = HEXDEC("&HAAE8EE")
CALLDLL #USER, "GetClientRect", WinHndl AS ULONG, tRect AS STRUCT, R AS LONG
CALLDLL #USER, "GetDC", WinHndl AS ULONG, WinDc AS ULONG
CALLDLL #GDI, "CreateSolidBrush", BackClr AS ULONG, BrushHndl AS ULONG
CALLDLL #GDI, "SelectObject", WinDc AS ULONG, BrushHndl AS ULONG, WinObj AS ULONG
PosX = 0
PosY = 0
Wide = tRect.X1.struct
High = tRect.Y1.struct
CALLDLL #GDI, "Rectangle", WinDc AS ULONG, PosX AS LONG, PosY AS LONG, _
Wide AS LONG, High AS LONG, R AS LONG
CALLDLL #GDI, "SelectObject", WinDc AS ULONG, WinObj AS ULONG, WinObj AS ULONG
CALLDLL #GDI, "DeleteObject", BrushHndl AS LONG, R AS LONG
CALLDLL #USER, "ReleaseDC", WinHndl AS ULONG, WinDc AS ULONG, R AS VOID
IF INT(EdHndl) < 1 THEN
EXIT SUB
END IF
CALLDLL #USER, "ShowWindow", EdHndl AS ULONG, SW.SHOW AS ULONG, R AS ULONG
PosX = 4
PosY = 4
Wide = tRect.X1.struct - 8
High = tRect.Y1.struct - 8
CALLDLL #USER, "MoveWindow", EdHndl AS ULONG, _
PosX AS LONG, _
PosY AS LONG, _
Wide AS LONG, _
High AS LONG, _
1 AS LONG, _
R AS LONG
END SUB
'-------------------------------------------------------------------------------
'-------------------------------------------------------------------------------
SUB CreateEdit BYREF EdHndl
EdStyle = 0
ExStyle = 0
TxtHnld = 0
WinHndl = 0
Instance = 0
PosX = 0
PosY = 0
Wide = 0
High = 0
EdId = 100
CLASSNAME$ = "EDIT"
TITLE$ = "EDIT"
ES.LEFT = 0000
ES.MULTILINE = 0004
ES.AUTOVSCROLL = HEXDEC("&H0040")
ES.NOHIDESEL = HEXDEC("&H0100")
ES.WANTRETURN = HEXDEC("&H1000")
WS.CHILD = HEXDEC("&H40000000")
WS.VISIBLE = HEXDEC("&H10000000")
WS.DLGFRAME = HEXDEC("&H00400000")
WS.TABSTOP = HEXDEC("&H00010000")
WS.VSCROLL = HEXDEC("&H00200000")
WS.EX.DLGMODALFRAME = HEXDEC("&H00000001")
WS.EX.TOPMOST = HEXDEC("&H00000008")
WS.EX.ACCEPTFILES = HEXDEC("&H00000010")
WS.EX.WINDOWEDGE = HEXDEC("&H00000100")
WS.EX.CLIENTEDGE = HEXDEC("&H00000200")
WS.EX.CONTEXTHELP = HEXDEC("&H00000400")
WS.EX.TRANSPARENT = HEXDEC("&H00000020")
WS.EX.LEFT = 00000000
WS.EX.RIGHTSCROLLBAR = 00000000
WS.EX.STATICEDGE = HEXDEC("&H00020000")
'/============================== GETWINDOWLONG ==============================/'
GWL.STYLE = -16
GWL.EXSTYLE = -20
GWL.ID = -12
GWL.WNDPROC = -4
GWL.HINSTANCE = -6
GWL.HWNDPARENT = -8
GWL.STYLE = -16
GWL.EXSTYLE = -20
GWL.USERDATA = -21
GWL.ID = -12
EdStyle = WS.CHILD OR WS.VISIBLE OR WS.DLGFRAME OR WS.TABSTOP OR _
WS.VSCROLL OR ES.LEFT OR ES.MULTILINE OR ES.NOHIDESEL OR _
ES.WANTRETURN
ExStyle = WS.EX.LEFT OR WS.EX.STATICEDGE OR WS.EX.ACCEPTFILES OR _
WS.EX.DLGMODALFRAME OR WS.EX.TRANSPARENT
WinHndl = HWND(#WIN)
CALLDLL #USER, "GetWindowLongA", WinHndl AS ULONG, GWL.HINSTANCE AS ULONG, _
Instance AS LONG
CALLDLL #USER, "GetClientRect", WinHndl AS ULONG, tRect AS STRUCT, PosX AS LONG
PosX = 4
PosY = 4
Wide = tRect.X1.struct - 8
High = tRect.Y1.struct - 8
CALLDLL #USER, "CreateWindowExA", _
ExStyle AS ULONG, _ '<--- extended window style
CLASSNAME$ AS PTR, _ '<--- pointer to registered class name
TITLE$ AS PTR, _ '<--- pointer to window name
EdStyle AS ULONG, _ '<--- window style
PosX AS LONG, _ '<--- horizontal position of window
PosY AS LONG, _ '<--- vertical position of window
Wide AS LONG, _ '<--- window width
High AS LONG, _ '<--- window height
WinHndl AS ULONG, _ '<--- handle to parent or owner window
EdId AS ULONG, _ '<--- handle to menu, or child-window identifier
Instance AS ULONG, _ '<--- handle to application instance
R AS ULONG, _ '<--- pointer to window-creation data
TxtHndl AS ULONG '<--- Return: 0(zero) if failed
EdHndl = TxtHndl
END SUB
FONTFUNDLL.ZIP (3.87 KB)
