API tools faq
paste
Advertisement
Guest User

Unicode Editor (Source)

a guest
Nov 28th, 2018
156
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VisualBasic 42.32 KB | None | 0 0
raw download clone embed print report
  1. Imports System.Runtime.InteropServices
  2. Imports System.IO
  3. Imports System.Windows.Forms.OpenFileDialog
  4. Imports System.Windows.Forms.SaveFileDialog
  5.  
  6. Public Class UnicodeEditor
  7.  
  8.     Private Const CLASS_NAME As String = "UED"
  9.     Private Const APP_TITLE As String = "Unicode Editor"
  10.     Private Const WS_CAPTION As Integer = &HC00000
  11.     Private Const WS_MAXIMIZEBOX As Integer = &H10000
  12.     Private Const WS_MINIMIZEBOX As Integer = &H20000
  13.     Private Const WS_OVERLAPPED As Integer = &H0
  14.     Private Const WS_SYSMENU As Integer = &H80000
  15.     Private Const WS_THICKFRAME As Integer = &H40000
  16.     Private Const WS_OVERLAPPEDWINDOW As Integer = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
  17.     Private Const CS_HREDRAW As Integer = &H2
  18.     Private Const CS_VREDRAW As Integer = &H1
  19.     Private Const IDI_APPLICATION As Integer = 32512
  20.     Private Const IDC_ARROW As Integer = 32512
  21.     Private Const LTGRAY_BRUSH As Integer = 1
  22.     Private Const SW_SHOWNORMAL As Integer = 1
  23.     Private Const WM_USER = &H400
  24.     Private Const WM_SIZE = &H5
  25.     Private Const WM_COMMAND = &H111
  26.     Private Const WM_DESTROY As Integer = &H2
  27.     Private Const WM_LBUTTONDOWN As Integer = &H201
  28.     Private Const WM_ACTIVATEAPP = &H1C
  29.     Private Const WM_CLOSE = &H10
  30.     Private Const WM_SETTEXT = &HC
  31.     Private Const WM_GETTEXT = &HD
  32.     Private Const WM_GETTEXTLENGTH = &HE
  33.     Private Const WM_NOTIFY = &H4E
  34.     Private Const WM_RBUTTONDOWN = &H204
  35.     Private Const WM_PARENTNOTIFY = &H210
  36.     Private Const WM_CONTEXTMENU As Long = &H7B
  37.     Private Const WM_INITMENUPOPUP = &H117
  38.  
  39.     Private Const MB_OK As Integer = &H0
  40.  
  41.     Private Const EN_SETFOCUS = &H100
  42.     Private Const EN_KILLFOCUS = &H200
  43.     Private Const EN_CHANGE = &H300
  44.     Private Const EN_UPDATE = &H400
  45.     Private Const EN_ERRSPACE = &H500
  46.     Private Const EN_MAXTEXT = &H501
  47.     Private Const EN_HSCROLL = &H601
  48.     Private Const EN_VSCROLL = &H602
  49.     Private Const EN_SelChanged = &h702
  50.     Private Const ENM_CHANGE = &h1
  51.     Private Const ENM_SELCHANGE = &h80000
  52.     Private Const ENM_MOUSEEVENTS = &h20000
  53.  
  54.     Private Const EC_LEFTMARGIN = &H1
  55.     Private Const EC_RIGHTMARGIN = &H2
  56.     Private Const EC_USEFONTINFO = &HFFFF
  57.     Private Const EMSIS_COMPOSITIONSTRING = &H1
  58.     Private Const EIMES_GETCOMPSTRATONCE = &H1
  59.     Private Const EIMES_CANCELCOMPSTRINFOCUS = &H2
  60.     Private Const EIMES_COMPLETECOMPSTRKILLFOCUS = &H4
  61.     Private Const EM_AUTOURLDETECT = WM_USER + 91
  62.     Private Const EM_GETAUTOURLDETECT = WM_USER + 92
  63.  
  64.     Private Const EM_GETSEL = &HB0
  65.     Private Const EM_SETSEL = &HB1
  66.     Private Const EM_GETRECT = &HB2
  67.     Private Const EM_SETRECT = &HB3
  68.     Private Const EM_SETRECTNP = &HB4
  69.     Private Const EM_SCROLL = &HB5
  70.     Private Const EM_LINESCROLL = &HB6
  71.     Private Const EM_SCROLLCARET = &HB7
  72.     Private Const EM_GETMODIFY = &HB8
  73.     Private Const EM_SETMODIFY = &HB9
  74.     Private Const EM_GETLINECOUNT = &HBA
  75.     Private Const EM_LINEINDEX = &HBB
  76.     Private Const EM_SETHANDLE = &HBC
  77.     Private Const EM_GETHANDLE = &HBD
  78.     Private Const EM_GETTHUMB = &HBE
  79.     Private Const EM_LINELENGTH = &HC1
  80.     Private Const EM_REPLACESEL = &HC2
  81.     Private Const EM_GETLINE = &HC4
  82.     Private Const EM_LIMITTEXT = &HC5
  83.     Private Const EM_CANUNDO = &HC6
  84.     Private Const EM_UNDO = &HC7
  85.     Private Const EM_FMTLINES = &HC8
  86.     Private Const EM_LINEFROMCHAR = &HC9
  87.     Private Const EM_SETTABSTOPS = &HCB
  88.     Private Const EM_SETPASSWORDCHAR = &HCC
  89.     Private Const EM_EMPTYUNDOBUFFER = &HCD
  90.     Private Const EM_GETFIRSTVISIBLELINE = &HCE
  91.     Private Const EM_SETREADONLY = &HCF
  92.     Private Const EM_SETWORDBREAKPROC = &HD0
  93.     Private Const EM_GETWORDBREAKPROC = &HD1
  94.     Private Const EM_GETPASSWORDCHAR = &HD2
  95.     Private Const EM_SETMARGINS = &HD3
  96.     Private Const EM_GETMARGINS = &HD4
  97.     Private Const EM_GETLIMITTEXT = &HD5
  98.     Private Const EM_POSFROMCHAR = &HD6
  99.     Private Const EM_CHARFROMPOS = &HD7
  100.     Private Const EM_SETIMESTATUS = &HD8
  101.     Private Const EM_GETIMESTATUS = &HD9
  102.     Private Const EM_SETOPTIONS = (&H400 + 77)
  103.     Private Const EM_SETLANGOPTIONS = (&H400 + 120)
  104.     Private Const EM_GETLANGOPTIONS = (&H400 + 121)
  105.  
  106.     Private Const EM_CANPASTE = (&H400 + 50)
  107.     Private Const EM_EXLIMITTEXT = (&H400 + 53)
  108.     Private Const EM_SETUNDOLIMIT = (&H400 + 82)
  109.     Private Const EM_REDO = (&H400 + 84)
  110.     Private Const EM_CANREDO = (&H400 + 85)
  111.     Private Const EM_GETUNDONAME = (&H400 + 86)
  112.     Private Const EM_GETREDONAME = (&H400 + 87)
  113.     Private Const EM_STOPGROUPTYPING = (&H400 + 88)
  114.     Private Const EM_PASTESPECIAL = (&H400 + 64)
  115.     Private Const EM_GETOPTIONS = (&H400 + 78)
  116.     Private Const EM_GETTEXTRANGE = &H400 + 75
  117.     Private Const EM_GETOLEINTERFACE = (&H400 + 60)
  118.     Private Const EM_SETTARGETDEVICE = (&H400 + 72)
  119.     Private Const EM_SETEVENTMASK = (&H400 + 69)
  120.     Private Const EM_GETEVENTMASK = (&H400 + 59)
  121.  
  122.  
  123.     'Extended edit style specific messages
  124.     Private Const EM_SETEDITSTYLE = (&H400 + 204)
  125.     Private Const EM_GETEDITSTYLE = (&H400 + 205)
  126.     Private Const EM_SETTYPOGRAPHYOPTIONS = (&H400 + 202)
  127.     Private Const EM_GETTYPOGRAPHYOPTIONS = (&H400 + 203)
  128.     Private Const EM_GETCTFOPENSTATUS = (&H400 + 240)
  129.     Private Const EM_SETCTFOPENSTATUS = (&H400 + 241)
  130.     Private Const EM_SETZOOM = &h400 + 225
  131.  
  132.     ' Extended edit style masks
  133.     Private Const SES_EMULATESYSEDIT = 1
  134.     Private Const SES_BEEPONMAXTEXT = 2
  135.     Private Const SES_EXTENDBACKCOLOR = 4
  136.     Private Const SES_MAPCPS = 8           ' (obsolete)
  137.     Private Const SES_EMULATE10 = 16           ' (obsolete)
  138.     Private Const SES_USECRLF = 32         ' (obsolete)
  139.     Private Const SES_NOXLTSYMBOLRANGE = 32
  140.     Private Const SES_USEAIMM = 64
  141.     Private Const SES_NOIME = 128
  142.     Private Const SES_ALLOWBEEPS = 256
  143.     Private Const SES_UPPERCASE = 512
  144.     Private Const SES_LOWERCASE = 1024
  145.     Private Const SES_NOINPUTSEQUENCECHK = 2048
  146.     Private Const SES_BIDI = 4096
  147.     Private Const SES_SCROLLONKILLFOCUS = 8192
  148.     Private Const SES_XLTCRCRLFTOCR = 16384
  149.     Private Const SES_DRAFTMODE = 32768
  150.     Private Const SES_USECTF = &H10000
  151.     Private Const SES_HIDEGRIDLINES = &H20000
  152.     Private Const SES_USEATFONT = &H40000
  153.     Private Const SES_CUSTOMLOOK = &H80000
  154.     Private Const SES_LBSCROLLNOTIFY = &H100000
  155.     Private Const SES_CTFALLOWEMBED = &H200000
  156.     Private Const SES_CTFALLOWSMARTTAG = &H400000
  157.     Private Const SES_CTFALLOWPROOFING = &H800000
  158.  
  159.     Private Const EM_SETTEXTMODE = (&H400 + 89)
  160.     Private Const EM_GETTEXTMODE = (&H400 + 90)
  161.     Private Const TM_PLAINTEXT = 1
  162.     Private Const TM_RICHTEXT = 2
  163.     Private Const TM_SINGLELEVELUNDO = 4
  164.     Private Const TM_MULTILEVELUNDO = 8
  165.     Private Const TM_SINGLECODEPAGE = 16
  166.     Private Const TM_MULTICODEPAGE = 32
  167.  
  168.     Private Const ECO_AUTOWORDSELECTION = &H1
  169.     Private Const ECO_AUTOVSCROLL = &H40
  170.     Private Const ECO_AUTOHSCROLL = &H80
  171.     Private Const ECO_NOHIDESEL = &H100
  172.     Private Const ECO_READONLY = &H800
  173.     Private Const ECO_WANTRETURN = &H1000
  174.     Private Const ECO_SAVESEL = &H8000
  175.     Private Const ECO_SELECTIONBAR = &H1000000
  176.     Private Const ECOOP_SET = &H1
  177.     Private Const ECOOP_OR = &H2
  178.     Private Const ECOOP_AND = &H3
  179.     Private Const ECOOP_XOR = &H4
  180.  
  181.     Private Const TO_ADVANCEDTYPOGRAPHY = 1
  182.     Private Const TO_SIMPLELINEBREAK = 2
  183.     Private Const TO_DISABLECUSTOMTEXTOUT = 4
  184.     Private Const TO_ADVANCEDLAYOUT = 8
  185.     Private Const TO_None = 0
  186.  
  187.     Private Const WB_LEFT = 0
  188.     Private Const WB_RIGHT = 1
  189.     Private Const WB_ISDELIMITER = 2
  190.     Private Const WB_CLASSIFY = 3
  191.     Private Const WB_MOVEWORDLEFT = 4
  192.     Private Const WB_MOVEWORDRIGHT = 5
  193.     Private Const WB_LEFTBREAK = 6
  194.     Private Const WB_RIGHTBREAK = 7
  195.     Private Const EM_FINDWORDBREAK = (&H400 + 76)
  196.     Private Const WBF_ISWHITE = &H10
  197.     Private Const WBF_BREAKLINE = &H20
  198.     Private Const WBF_BREAKAFTER = &H40
  199.  
  200.     Private Const IMF_AUTOKEYBOARD = &H1
  201.     Private Const IMF_AUTOFONT = &H2
  202.     Private Const IMF_IMECANCELCOMPLETE = &H4      'High completes comp string when aborting, low cancels
  203.     Private Const IMF_IMEALWAYSSENDNOTIFY = &H8
  204.     Private Const IMF_AUTOFONTSIZEADJUST = &H10   '16
  205.     Private Const IMF_UIFONTS = &H20              '32
  206.     Private Const IMF_DUALFONT = &H80             '128
  207.     Private Const IMF_None = &H0             '0
  208.     Private Const IMF_SPELLCHECKING = &H800
  209.     Private Const CP_ACP = 0                             ' default to ANSI code page
  210.     Private Const CP_OEMCP = 1                           ' default to OEM  code page
  211.     Private Const CP_MACCP = 2                           ' default to MAC  code page
  212.     Private Const CP_THREAD_ACP = 3                      ' current thread's ANSI code page
  213.     Private Const CP_SYMBOL = 42                         ' SYMBOL translations
  214.     Private Const CP_Unicode = 1200                        ' Unicode
  215.     Private Const CP_UTF7 = 65000                        ' UTF-7 translation
  216.     Private Const CP_UTF8 = 65001                        ' UTF-8 translation
  217.     Private Const ES_AUTOHSCROLL = &H80&
  218.     Private Const ES_AUTOVSCROLL = &H40&
  219.     Private Const ES_CENTER = &H1&
  220.     Private Const ES_LEFT = &H0&
  221.     Private Const ES_LOWERCASE = &H10&
  222.     Private Const ES_MULTILINE = &H4&
  223.     Private Const ES_NOHIDESEL = &H100&
  224.     Private Const ES_OEMCONVERT = &H400&
  225.     Private Const ES_PASSWORD = &H20&
  226.     Private Const ES_READONLY = &H800&
  227.     Private Const ES_RIGHT = &H2&
  228.     Private Const ES_UPPERCASE = &H8&
  229.     Private Const ES_WANTRETURN = &H1000&
  230.     Private Const ES_NUMBER = &H2000
  231.  
  232.     Private Const WS_BORDER = &H800000
  233.     Private Const WS_CHILD = &H40000000
  234.     Private Const WS_CHILDWINDOW = (&H40000000)
  235.     Private Const WS_CLIPCHILDREN = &H2000000
  236.     Private Const WS_CLIPSIBLINGS = &H4000000
  237.     Private Const WS_DISABLED = &H8000000
  238.     Private Const WS_DLGFRAME = &H400000
  239.     Private Const WS_EX_ACCEPTFILES = &H10&
  240.     Private Const WS_EX_APPWINDOW = &H40000
  241.     Private Const WS_EX_CLIENTEDGE = &H200
  242.     Private Const WS_EX_COMPOSITED = &H2000000
  243.     Private Const WS_EX_CONTEXTHELP = &H400
  244.     Private Const WS_EX_CONTROLPARENT = &H10000
  245.     Private Const WS_EX_DLGMODALFRAME = &H1
  246.     Private Const WS_EX_LAYERED = &H80000
  247.     Private Const WS_EX_LAYOUTRTL = &H400000           ' Right to left mirroring
  248.     Private Const WS_EX_LEFT = &H0
  249.     Private Const WS_EX_LEFTSCROLLBAR = &H4000
  250.     Private Const WS_EX_LTRREADING = &H0
  251.     Private Const WS_EX_MDICHILD = &H40
  252.     Private Const WS_EX_NOACTIVATE = &H8000000
  253.     Private Const WS_EX_NOINHERITLAYOUT = &H100000     ' Disable inheritence of mirroring by children
  254.     Private Const WS_EX_NOPARENTNOTIFY = &H4
  255. '   Private Const WS_EX_OVERLAPPEDWINDOW = (WS_EX_WINDOWEDGE + WS_EX_CLIENTEDGE)
  256. '   Private Const WS_EX_PALETTEWINDOW = (WS_EX_WINDOWEDGE + WS_EX_TOOLWINDOW + WS_EX_TOPMOST)
  257.     Private Const WS_EX_RIGHT = &H1000
  258.     Private Const WS_EX_RIGHTSCROLLBAR = &H0
  259.     Private Const WS_EX_RTLREADING = &H2000
  260.     Private Const WS_EX_STATICEDGE = &H20000
  261.     Private Const WS_EX_TOOLWINDOW = &H80
  262.     Private Const WS_EX_TOPMOST = &H8
  263.     Private Const WS_EX_TRANSPARENT = &H20&
  264.     Private Const WS_EX_WINDOWEDGE = &H100
  265.     Private Const WS_GROUP = &H20000
  266.     Private Const WS_HSCROLL = &H100000
  267.     Private Const WS_ICONIC = &H1000000
  268.     Private Const WS_POPUP = &H80000000
  269. '   Private Const WS_POPUPWINDOW = (WS_POPUP + WS_B + DER + WS_SYSMENU)
  270.     Private Const WS_SIZEBOX = &H40000
  271.     Private Const WS_TABSTOP = &H10000
  272.     Private Const WS_TILED = &H0&
  273.     Private Const WS_TILEDWINDOW = (&H0& + &HC00000 + &H80000 + &H40000 + &H20000 + &H10000)
  274.     Private Const WS_VISIBLE = &H10000000
  275.     Private Const WS_VSCROLL = &H200000
  276.     Private Const HWND_NOTOPMOST = -2
  277.     Private Const SWP_SHOWWINDOW = &H40
  278.     Private Const SWP_NOZORDER = &H4
  279.     Private Const SWP_NOSIZE = &H1
  280.     Private Const SWP_NOREPOSITION = &H200
  281.     Private Const SWP_NOREDRAW = &H8
  282.     Private Const SWP_NOOWNERZORDER = &H200      '  Don't do owner Z ordering
  283.     Private Const SWP_NOMOVE = &H2
  284.     Private Const SWP_NOCOPYBITS = &H100
  285.     Private Const SWP_NOACTIVATE = &H10
  286.     Private Const SWP_HIDEWINDOW = &H80
  287.     Private Const SWP_FRAMECHANGED = &H20        '  The frame changed: send WM_NCCALCSIZE
  288.     Private Const SWP_DRAWFRAME = &H20
  289.     Private Const MF_POPUP = &H10
  290.     Private Const MF_SEPARATOR = &H800
  291.     Private Const TPM_RIGHTBUTTON = &H2
  292.     Private Const TPM_LEFTALIGN = &H0
  293.     Private Const TPM_NONOTIFY = &H80
  294.     Private Const TPM_RETURNCMD = &H100
  295.  
  296.     Private Const MF_BYCOMMAND = &H0&
  297.     Private Const MF_GRAYED = &H1&
  298.     Private Const MF_ENABLED = &H0&
  299.     Private Const MF_UNCHECKED = &H0&
  300.     Private Const MF_CHECKED = &H8&
  301.  
  302.     Private Const CF_UNICODETEXT= 13
  303.  
  304.     Private Const OFN_READONLY = &H1
  305.     Private Const OFN_OVERWRITEPROMPT = &H2
  306.     Private Const OFN_HIDEREADONLY = &H4
  307.     Private Const OFN_NOCHANGEDIR = &H8
  308.     Private Const OFN_SHOWHELP = &H10
  309.     Private Const OFN_ENABLEHOOK = &H20
  310.     Private Const OFN_ENABLETEMPLATE = &H40
  311.     Private Const OFN_ENABLETEMPLATEHANDLE = &H80
  312.     Private Const OFN_NOVALIDATE = &H100
  313.     Private Const OFN_ALLOWMULTISELECT = &H200
  314.     Private Const OFN_EXTENSIONDIFFERENT = &H400
  315.     Private Const OFN_PATHMUSTEXIST = &H800
  316.     Private Const OFN_FILEMUSTEXIST = &H1000
  317.     Private Const OFN_CREATEPROMPT = &H2000
  318.     Private Const OFN_SHAREAWARE = &H4000
  319.     Private Const OFN_NOREADONLYRETURN = &H8000
  320.     Private Const OFN_NOTESTFILECREATE = &H10000
  321.     Private Const OFN_NONETWORKBUTTON = &H20000
  322.     Private Const OFN_NOLONGNAMES = &H40000                      '  force no long names for 4.x modules
  323.     Private Const OFN_EXPLORER = &H80000                         '  new look commdlg
  324.     Private Const OFN_NODEREFERENCELINKS = &H100000
  325.     Private Const OFN_LONGNAMES = &H200000                       '  force long names for 3.x modules
  326.     Private Const OFN_SHAREFALLTHROUGH = 2
  327.     Private Const OFN_SHARENOWARN = 1
  328.     Private Const OFN_SHAREWARN = 0
  329.     Private const OFN_FORCESHOWHIDDEN = &h10000000
  330.  
  331.     Private Const FVIRTKEY = True          '  Assumed to be == TRUE
  332.     Private Const FNOINVERT = &H2
  333.     Private Const FSHIFT = &H4
  334.     Private Const FCONTROL = &H8
  335.     Private Const FALT = &H10
  336.  
  337.  
  338.     Private Delegate Function WndProcDelgate(ByVal hWnd As IntPtr, ByVal Message As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
  339.  
  340.     <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)> _
  341.     Private Structure WNDCLASSEX
  342.         Public cbSize As Integer ' Size in bytes of the WNDCLASSEX structure
  343.         Public style As Integer ' Class style
  344.         Public lpfnWndProc As WndProcDelgate ' Pointer to the classes Window Procedure
  345.         Public cbClsExtra As Integer ' Number of extra bytes to allocate for class
  346.         Public cbWndExtra As Integer ' Number of extra bytes to allocate for window
  347.         Public hInstance As IntPtr ' Applications instance handle Class
  348.         Public hIcon As IntPtr ' Handle to the classes icon
  349.         Public hCursor As IntPtr ' Handle to the classes cursor
  350.         Public hbrBackground As IntPtr ' Handle to the classes background brush
  351.         Public lpszMenuName As String ' Resource name of class menu
  352.         Public lpszClassName As String ' Name of the Window Class
  353.         Public hIconSm As IntPtr ' Handle to the classes small icon
  354.     End Structure
  355.  
  356.      <StructLayout(LayoutKind.Sequential)> _
  357.     Private Structure POINTAPI
  358.         Public x As Integer ' X-Coordinate in pixels
  359.         Public y As Integer ' Y-Coordinate in pixels
  360.      End Structure
  361.  
  362.      <StructLayout(LayoutKind.Sequential)> _
  363.     Private Structure RECTL    
  364.         Public Left As Integer
  365.         Public Top As Integer
  366.         Public Right As Integer
  367.         Public Bottom As Integer
  368.     End Structure
  369.  
  370.      <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)> _
  371.     Private Structure MSG
  372.         Public hWnd As IntPtr ' Window handle of the associated window
  373.         Public Message As Integer ' Message identifier
  374.         Public wParam As IntPtr ' Additional message info
  375.         Public lParam As IntPtr ' Additional message info
  376.         Public time As Integer ' Time message was posted
  377.         Public pt As POINTAPI ' Cursor position when message was posted
  378.      End Structure
  379.  
  380.      <StructLayout(LayoutKind.Sequential)> _
  381.     Private Structure nmhdr
  382.         Public hwndFrom As IntPtr
  383.         Public idFrom As IntPtr
  384.         Public code As IntPtr
  385.      End Structure
  386.  
  387.      <StructLayout(LayoutKind.Sequential)> _
  388.     Private Structure charrange
  389.         Public cpMin As Integer
  390.         Public cpMax As Integer
  391.      End Structure
  392.  
  393.      <StructLayout(LayoutKind.Sequential)> _
  394.     Private Structure selchange
  395.         Public nmhdr As NMHDR
  396.         Public chrg As CharRange
  397.         Public seltyp As Short
  398.      End Structure
  399.  
  400.      <StructLayout(LayoutKind.Sequential)> _
  401.     Private Structure ACCEL
  402.         Public fVirt As Byte
  403.         Public key As Short
  404.         Public cmd As Short
  405.      End Structure
  406.  
  407.     Private Declare Function CreateAcceleratorTableW Lib "user32" (lpaccl As ACCEL, ByVal cEntries As Integer) As IntPtr
  408.     Private Declare Function TranslateAcceleratorW Lib "user32" (ByVal hwnd As IntPtr, ByVal hAccTable As IntPtr, lpMsg As MSG) As Integer
  409.     Private Declare Function DestroyAcceleratorTable Lib "user32" (ByVal haccel As IntPtr) As Integer
  410.     Private Declare Auto Function LoadCursor Lib "user32" (ByVal hInstance As IntPtr,  ByVal lpCursorName As IntPtr) As IntPtr
  411.     Private Declare Auto Function LoadIcon Lib "user32" (ByVal hInstance As IntPtr, ByVal lpIconName As IntPtr) As IntPtr
  412.     Private Declare Unicode Function LoadLibraryW Lib "kernel32" (ByVal lpLibFileName As String) As Integer
  413.     Private Declare Unicode Function RegisterClassExW Lib "user32" (ByRef pcWndClassEx As WNDCLASSEX) As Integer
  414.     Private Declare Unicode Function CreateWindowExW Lib "user32" (ByVal dwExStyle As Integer, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Integer, ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hWndParent As IntPtr, ByVal hMenu As IntPtr, ByVal hInstance As IntPtr, ByVal lpParam As IntPtr) As IntPtr
  415.     Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As IntPtr, ByVal nCmdShow As Integer) As Boolean
  416.     Private Declare Function UpdateWindow Lib "user32" (ByVal hWnd As IntPtr) As Boolean
  417.     Private Declare Auto Function GetMessage Lib "user32" (ByRef lpMsg As MSG, ByVal hWnd As IntPtr, ByVal wMsgFilterMin As Integer, ByVal wMsgFilterMax As Integer) As Boolean
  418.     Private Declare Function TranslateMessage Lib "user32" (ByRef lpMsg As MSG) As Boolean
  419.     Private Declare Auto Function DispatchMessage Lib "user32" (ByRef lpMsg As MSG) As IntPtr
  420.     Private Declare Sub PostQuitMessage Lib "user32" (ByVal nExitCode As Integer)
  421.     Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Integer) As IntPtr
  422.     Private Declare Unicode Function MessageBoxW Lib "user32" (ByVal hWnd As IntPtr, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Integer) As Integer
  423.     Private Declare Function SetFocus Lib "user32" (ByVal hWnd As IntPtr) As IntPtr
  424.     Private Declare Auto Function DefWindowProc Lib "user32" (ByVal hWnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
  425.     Private Declare Auto Function SendMessageW Lib "user32" (ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
  426.     Private Declare Unicode Function SendMessageObj Lib "user32" alias "SendMessageW" (ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As IntPtr, <Runtime.InteropServices.MarshalAs(Runtime.InteropServices.UnmanagedType.Interface)> ByRef lparam As Object) As Integer
  427.     Private Declare Unicode Function SendMessageStr Lib "user32" alias "SendMessageW" (ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As IntPtr, ByVal lParam as String) As Integer
  428.     Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  429.     Private Declare Unicode Function LoadMenuW Lib "user32" (ByVal hInstance As Integer, ByVal lpString As String) As Integer
  430.     Private Declare Function SetMenu Lib "user32" Alias "SetMenu" (ByVal hwnd As Integer, ByVal hMenu As Integer) As Integer
  431.     Private Declare Function CreateMenu Lib "user32" () As Integer
  432.     Private Declare Function CreatePopupMenu Lib "user32" () As Integer
  433.     Private Declare Function DrawMenuBar Lib "user32" (ByVal hMenuBar as Integer) As Integer
  434.     Private Declare Unicode Function AppendMenuW Lib "user32" (ByVal hMenu As Integer, ByVal wFlags As Integer, ByVal wIDNewItem As Integer, ByVal lpNewItem As String) As Integer
  435.     Private Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Intptr, ByVal wFlags As Integer, ByVal x As Integer, ByVal y As Integer, ByVal nReserved As Integer, ByVal hwnd As Intptr, ByVal ptrToNothing as intptr) As Integer
  436.     Private Declare Function GetSubMenu Lib "user32" Alias "GetSubMenu" (ByVal hMenu As IntPtr, ByVal nPos As Integer) As IntPtr
  437.     Private Declare Function DestroyMenu Lib "User32" (ByVal hMenu as Intptr) as Integer
  438.     Private Declare Function EnableMenuItem Lib "user32" (ByVal hMenu As Intptr, ByVal wIDEnableItem As Integer, ByVal wEnable As Integer) As Integer
  439.     Private Declare Function CheckMenuItem Lib "user32" (ByVal hMenu As IntPtr, ByVal wIDEnableItem As Integer, ByVal wEnable As Integer) As Integer
  440.     Private Declare Function CheckMenuRadioItem Lib "user32" (ByVal hMenu As IntPtr, ByVal un1 As Integer, ByVal un2 As Integer, ByVal un3 As Integer, ByVal un4 As Integer) As Integer
  441. '   Private Declare Function GetOpenFileNameW Lib "comdlg32.dll" (ByVal pOpenfilename As OPENFILENAME) As Integer
  442. '   Private Declare Function GetSaveFileNameW Lib "comdlg32.dll" (pOpenfilename As OPENFILENAME) As Integer
  443. '   Private Declare Function GetFileTitleW Lib "comdlg32.dll" (ByVal lpszFile As String, ByVal lpszTitle As String, ByVal cbBuf As Integer) As Short
  444.     Private Declare Function GetDC Lib "user32" (ByVal hwnd As IntPtr) As IntPtr
  445.  
  446.     '==============================
  447.     'Global variables
  448.     '===============================
  449.  
  450.     Public Dim Ret as Integer
  451.     Public  Dim gRTFHwnd as Intptr
  452.     Public Dim RTFID as Integer
  453.     Public Dim hWnd as Intptr
  454.     Public Dim hInstance as IntPtr
  455.  
  456.     Public Dim TomDoc as Object
  457.     Public Dim TomSel as Object
  458.  
  459.     Public Dim hMenuBar As Intptr
  460.     Public Dim hFileMenu As Intptr
  461.     Public Dim hFileSaveAsFormatMenu As Intptr
  462.     Public Dim hHelpMenu As Intptr
  463.     Public Dim hContextMenu as Intptr
  464.     Public Dim hEditMenu as Intptr
  465.     Public Dim hViewMenu as Intptr
  466.  
  467.     Public Dim gFileIsDirty as Boolean
  468.     Public Dim gFileHasName as Boolean
  469.  
  470.     Public Dim WshShell as Object
  471.     Public Dim FSO as Object
  472.  
  473.     '==============================
  474.     'Main program start called by sub main.
  475.     '===============================
  476.  
  477.     Public Sub New()
  478.         Dim wndClass As WNDCLASSEX
  479.         Dim hWnd As IntPtr
  480.         Dim Message As MSG
  481.        
  482.         hInstance = Marshal.GetHINSTANCE(GetType(UnicodeEditor).Module)
  483.  
  484.         '======================================
  485.         'Register and create the main window
  486.         '------------------------------------------------
  487.         With wndClass
  488.             .style = CS_HREDRAW Or CS_VREDRAW      
  489.             .lpfnWndProc = New WndProcDelgate(AddressOf WndProc)
  490.             .cbClsExtra = 0
  491.             .cbWndExtra = 0
  492.             .hInstance = hInstance
  493.             .hIcon = LoadIcon(hInstance, New IntPtr(IDI_APPLICATION))
  494.             .hIconSm = LoadIcon(hInstance, New IntPtr(IDI_APPLICATION))
  495.             .hCursor = LoadCursor(hInstance, New IntPtr(IDC_ARROW))
  496.             .hbrBackground = GetStockObject(LTGRAY_BRUSH)
  497.             .lpszMenuName = Nothing
  498.             .lpszClassName = CLASS_NAME
  499.             .cbSize = Marshal.SizeOf(wndClass)
  500.          End With
  501.    
  502.          RegisterClassExW (wndClass)
  503.         hWnd = CreateWindowExW (0, CLASS_NAME, APP_TITLE, WS_OVERLAPPEDWINDOW, 300, 200, 640, 480, IntPtr.Zero, nothing , hInstance, IntPtr.Zero)
  504.  
  505.         '======================================
  506.         'Register and create the RTF window
  507.         '------------------------------------------------
  508.         Dim DLLModule as Integer
  509.         Dim Flags as Integer
  510.         DLLModule = LoadLibraryW("c:\windows\system32\MSFTEDIT.dll")
  511.         If DLLModule = 0 Then MsgBox("Load Lib " & Err.LastDllError)
  512.         Flags = WS_CHILD + WS_HSCROLL + WS_VSCROLL + WS_VISIBLE + ES_MULTILINE + ES_AUTOHSCROLL + ES_AUTOVSCROLL + ES_NOHIDESEL + ES_WANTRETURN
  513.         Dim RTFClassName As String
  514.         RTFID =  &hff00
  515.         RTFClassName = "RICHEDIT50W" & vbNullChar
  516.         gRtfHwnd = CreateWindowExW(WS_EX_ACCEPTFILES + WS_EX_CLIENTEDGE, RTFClassName, "", Flags, 0, 0, 600, 400, hwnd, RTFID, DLLModule, IntPtr.Zero)
  517.  
  518.         '======================================
  519.         'Create Menus
  520.         '------------------------------------------------
  521.         hMenuBar = CreateMenu()
  522.  
  523.         'SaveAs format Menu
  524.         hFileSaveAsFormatMenu = CreatePopupMenu()
  525.         If AppendMenuW(hFileSaveAsFormatMenu, 0, 190, "&Dos") = 0 then Msgbox("Append " & Err.LastDllError)
  526.         If AppendMenuW(hFileSaveAsFormatMenu, 0, 191, "A&NSI") = 0 then Msgbox("Append " & Err.LastDllError)
  527.         If AppendMenuW(hFileSaveAsFormatMenu, 0, 192, "&UTF8") = 0 then Msgbox("Append " & Err.LastDllError)
  528.         If AppendMenuW(hFileSaveAsFormatMenu, 0, 193, "U&TF16") = 0 then Msgbox("Append " & Err.LastDllError)
  529.         If AppendMenuW(hFileSaveAsFormatMenu, MF_Separator, 999, "") = 0 then Msgbox("Append " & Err.LastDllError)
  530.         If AppendMenuW(hFileSaveAsFormatMenu, 0, 194, "&Auto") = 0 then Msgbox("Append " & Err.LastDllError)
  531.         Ret = CheckMenuRadioItem(hFileSaveAsFormatMenu, 190, 194, 191, mf_bycommand)
  532.  
  533.         'File Menu
  534.         hFileMenu = CreatePopupMenu()
  535.         If AppendMenuW(hFileMenu, 0, 101, "&New" & vbtab & "Ctrl+N") = 0 then Msgbox("Append " & Err.LastDllError)
  536.         If AppendMenuW(hFileMenu, 0, 102, "O&pen ..." & vbtab & "Ctrl+O") = 0 then Msgbox("Append " & Err.LastDllError)
  537.         If AppendMenuW(hFileMenu, 0, 103, "S&ave" & vbtab & "Ctrl+S") = 0 then Msgbox("Append " & Err.LastDllError)
  538.         If AppendMenuW(hFileMenu, 0, 104, "Save A&s ...") = 0 then Msgbox("Append " & Err.LastDllError)
  539.         If AppendMenuW(hFileMenu, MF_Separator, 999, "") = 0 then Msgbox("Append " & Err.LastDllError)
  540.         If AppendMenuW(hFileMenu, MF_Popup, hFileSaveAsFormatMenu, "Save &Format") = 0 then Msgbox("Append " & Err.LastDllError)
  541.         If AppendMenuW(hFileMenu, MF_Separator, 999, "") = 0 then Msgbox("Append " & Err.LastDllError)
  542.         If AppendMenuW(hFileMenu, 0, 105, "E&xit" & vbtab & "Alt+F4") = 0 then Msgbox("Append " & Err.LastDllError)
  543.  
  544.  
  545.  
  546.         'Help Menu
  547.         hHelpMenu = CreatePopupMenu()
  548.         If AppendMenuW(hHelpMenu, 0, 901, "&Help" & vbtab & "F1") = 0 then Msgbox("Append " & Err.LastDllError)
  549.         If AppendMenuW(hHelpMenu, 0, 902, "&Programming") = 0 then Msgbox("Append " & Err.LastDllError)
  550.         If AppendMenuW(hHelpMenu, MF_Separator, 999, "") = 0 then Msgbox("Append " & Err.LastDllError)
  551.         If AppendMenuW(hHelpMenu, 0, 903, "&About") = 0 then Msgbox("Append " & Err.LastDllError)
  552.  
  553.  
  554.         'Edit Menu - this is almost the same as the context menu.
  555.         hEditMenu = CreatePopupMenu()
  556.         If AppendMenuW(hEditMenu, 0, 201, "&Undo" & vbtab & "Ctrl+Z") = 0 then Msgbox("Append " & Err.LastDllError)
  557.         If AppendMenuW(hEditMenu, 0, 202, "&Redo" & vbtab & "Ctrl+Y") = 0 then Msgbox("Append " & Err.LastDllError)
  558.         If AppendMenuW(hEditMenu, MF_Separator, 999, "") = 0 then Msgbox("Append " & Err.LastDllError)
  559.         If AppendMenuW(hEditMenu, 0, 203, "Cu&t" & vbtab & "Ctrl+X") = 0 then Msgbox("Append " & Err.LastDllError)
  560.         If AppendMenuW(hEditMenu, 0, 204, "&Copy" & vbtab & "Ctrl+C") = 0 then Msgbox("Append " & Err.LastDllError)
  561.         If AppendMenuW(hEditMenu, 0, 205, "&Paste" & vbtab & "Ctrl+V") = 0 then Msgbox("Append " & Err.LastDllError)
  562.         If AppendMenuW(hEditMenu, 0, 206, "De&lete" & vbtab & "Del") = 0 then Msgbox("Append " & Err.LastDllError)
  563.         If AppendMenuW(hEditMenu, MF_Separator, 999, "") = 0 then Msgbox("Append " & Err.LastDllError)
  564.         If AppendMenuW(hEditMenu, 0, 207, "Select &All" & vbtab & "Ctrl+A") = 0 then Msgbox("Append " & Err.LastDllError)
  565.  
  566.         'Context Menu
  567.         hContextMenu = CreatePopupMenu()
  568.         If AppendMenuW(hContextMenu, 0, 201, "&Undo" & vbtab & "Ctrl+Z") = 0 then Msgbox("Append " & Err.LastDllError)
  569.         If AppendMenuW(hContextMenu, 0, 202, "&Redo" & vbtab & "Ctrl+Y") = 0 then Msgbox("Append " & Err.LastDllError)
  570.         If AppendMenuW(hContextMenu, MF_Separator, 999, "") = 0 then Msgbox("Append " & Err.LastDllError)
  571.         If AppendMenuW(hContextMenu, 0, 203, "Cu&t" & vbtab & "Ctrl+X") = 0 then Msgbox("Append " & Err.LastDllError)
  572.         If AppendMenuW(hContextMenu, 0, 204, "&Copy" & vbtab & "Ctrl+C") = 0 then Msgbox("Append " & Err.LastDllError)
  573.         If AppendMenuW(hContextMenu, 0, 205, "&Paste" & vbtab & "Ctrl+V") = 0 then Msgbox("Append " & Err.LastDllError)
  574.         If AppendMenuW(hContextMenu, 0, 206, "De&lete" & vbtab & "Del") = 0 then Msgbox("Append " & Err.LastDllError)
  575.         If AppendMenuW(hContextMenu, MF_Separator, 999, "") = 0 then Msgbox("Append " & Err.LastDllError)
  576.         If AppendMenuW(hContextMenu, 0, 207, "Select &All" & vbtab & "Ctrl+A") = 0 then Msgbox("Append " & Err.LastDllError)
  577.  
  578.         'View Menu
  579.         hViewMenu = CreatePopupMenu()
  580.         If AppendMenuW(hViewMenu, 0, 301, "&Wordwrap") = 0 then Msgbox("Append " & Err.LastDllError)
  581.         If AppendMenuW(hViewMenu, MF_Separator, 999, "") = 0 then Msgbox("Append " & Err.LastDllError)
  582.         If AppendMenuW(hViewMenu, 0, 302, "&Zoom 100%" & vbtab & "Ctrl+Wheel") = 0 then Msgbox("Append " & Err.LastDllError)
  583.  
  584.         'MenuBar
  585.         If SetMenu(hWnd, hMenuBar) = 0 then Msgbox("SetM " & Err.LastDllError)
  586.         If AppendMenuW(hMenuBar, MF_Popup, hFileMenu, "&File") = 0 then Msgbox("Append " & Err.LastDllError)
  587.         If AppendMenuW(hMenuBar, MF_Popup, hEditMenu, "&Edit") = 0 then Msgbox("Append " & Err.LastDllError)
  588.         If AppendMenuW(hMenuBar, MF_Popup, hViewMenu, "&View") = 0 then Msgbox("Append " & Err.LastDllError)
  589.         If AppendMenuW(hMenuBar, MF_Popup, hHelpMenu, "&Help") = 0 then Msgbox("Append " & Err.LastDllError)
  590.         If DrawMenuBar(hWnd) = 0 then Msgbox(Err.LastDllError)
  591.  
  592.  
  593.         '======================================
  594.         'Setting up Accelerator keys
  595.         '------------------------------------------------
  596.  
  597.         Dim hAccTable as IntPtr
  598.         Dim AccTable(1) as Accel
  599.         With AccTable(0)
  600.             .fvirt = fcontrol
  601.             .key = &h4e
  602.             .cmd = 101
  603.         End With
  604.         hAccTable = CreateAcceleratorTableW(AccTable(0), 1)
  605. console.writeline("hacctable = " & CStr(hAccTable))
  606.         '======================================
  607.         'Setting editing options - there are probably over 100
  608.         '------------------------------------------------
  609.         Ret = SendMessageStr(gRtfHwnd, WM_SETTEXT, 0, "")
  610.         Ret = SendMessageW(gRtfHwnd, EM_SETTEXTMODE, TM_MULTILEVELUNDO + TM_PLAINTEXT + TM_MULTICODEPAGE, 0)
  611.         If GetTextMode(gRtfHwnd) <> 41 Then MsgBox("get Text mode = " & GetTextMode(gRtfHwnd))
  612.         Ret = SendMessageW(gRtfHwnd, EM_SETEDITSTYLE, SES_ALLOWBEEPS + SES_USECRLF + SES_CTFALLOWPROOFING + SES_CTFALLOWSMARTTAG + SES_USECTF + SES_CTFALLOWEMBED, SES_ALLOWBEEPS + SES_USECRLF + SES_CTFALLOWPROOFING + SES_CTFALLOWSMARTTAG + SES_USECTF + SES_CTFALLOWEMBED)
  613. '       Uncomment to turn on spellchecking
  614. '       Ret = SendMessageW(gRtfHwnd, EM_SETLANGOPTIONS, IMF_SPELLCHECKING, IMF_SPELLCHECKING)
  615.         If GetTextMode(gRtfHwnd) <> 41 Then MsgBox("get Text mode (2) = " & GetTextMode(gRtfHwnd))
  616.         Ret = SendMessageW(gRtfHwnd, EM_SETTYPOGRAPHYOPTIONS, TO_None, TO_None)
  617.         Ret = SendMessageW(gRtfHwnd, EM_SETOPTIONS, ECO_AUTOHSCROLL + ECO_AUTOVSCROLL + ECO_NOHIDESEL + ECO_WANTRETURN, ECOOP_OR)
  618.         Ret = SendMessageW(gRtfHwnd, EM_EXLIMITTEXT, 0, 2000000)
  619.         Ret = SendMessageW(gRTFhWnd, EM_SETOPTIONS, ECOOP_OR, ECO_SELECTIONBAR)
  620.         Ret = SendMessageW(gRtfHwnd, EM_SetEventMask, 0, ENM_SelChange + ENM_Change)
  621.  
  622.         'Getting TOM object
  623.         Ret = SendMessageObj(gRtfHwnd, EM_GETOLEINTERFACE, 0, TomDoc)
  624.         TomSel = TomDoc.Selection
  625.  
  626.         'Showing the window
  627.         ShowWindow(hWnd, SW_SHOWNORMAL)
  628.         UpdateWindow (hWnd)
  629.         ShowWindow(gRTFhWnd, SW_SHOWNORMAL)
  630.         UpdateWindow (gRTFhWnd)
  631.         SetFocus (gRTFhWnd)
  632.  
  633.         'set initial global saved status
  634.         gFileIsDirty = False
  635.         gFileHasName =  False
  636.  
  637.         console.writeline(System.Windows.Forms.Application.ExecutablePath)
  638.  
  639.         'Create global utility objects wscript.shell for registry and shelling (eg help) and FSO for read support files
  640.         WshShell = CreateObject("WScript.Shell")
  641.         FSO =  CreateObject("Scripting.FileSystemObject")
  642.        
  643.         Console.Writeline("Command line is: " & Command())
  644.         If Command() <> "" then
  645.             TomDoc.Open(Replace(Command(),"""", ""), &h442, 0)
  646.         End If
  647.         '======================================
  648.         'This is the program message loop. All further code is run in the window procedure till the window closes then this loop exits and the program exits.
  649.         '------------------------------------------------
  650.         Do While GetMessage(Message, IntPtr.Zero, 0, 0)
  651.             TranslateAcceleratorW(hWnd, hAccTable, Message)
  652. '           TranslateMessage (Message)
  653.             If TranslateAcceleratorW(hWnd, hAccTable, Message) <> 0  and err.lastdllerror = 0 then
  654.                 TranslateMessage (Message)
  655.             End If
  656.             DispatchMessage (Message)
  657.         Loop
  658.         Ret = DestroyMenu(hContextMenu)
  659.         Ret = DestroyAcceleratorTable(hAccTable)
  660.         'This is pointless code so I get to see shutdown output before the console window disappears
  661.         'It is expoential to the number of spaces
  662.         Dim i as intptr
  663.         Do
  664.             i = i + 1
  665.             If Cint(i) > &h8fff then Exit Do
  666.             RTFClassName = RTFClassName & "      "
  667.         Loop
  668.     End Sub
  669.  
  670.     '======================================
  671.     'Main window procedure.
  672.     '------------------------------------------------
  673.     Private Function WndProc(ByVal hWnd As IntPtr, ByVal Message As Integer, ByVal wParam As Intptr, ByVal lParam As Intptr ) As IntPtr
  674. '       Console.WriteLine  ("Message " & Message)
  675. '       Console.WriteLine  ("Filestatus " & gFileIsDirty & " " & gFileHasName)
  676.         Select Case Message
  677.             Case WM_LBUTTONDOWN
  678.                 MessageBoxW(hWnd, "Left Mouse Button Pressed", APP_TITLE, MB_OK)
  679.                 WndProc = IntPtr.Zero
  680.             Case WM_RBUTTONDOWN
  681.                 MessageBoxW(hWnd, "Right Mouse Button Pressed", APP_TITLE, MB_OK)
  682.                 WndProc = IntPtr.Zero
  683.             Case WM_DESTROY
  684.                 PostQuitMessage (0)
  685.                 WndProc = IntPtr.Zero
  686.             Case WM_SIZE
  687.                 Ret = SetWindowPos(gRtfHwnd, HWND_NOTOPMOST, 0, 0, CLng(LParam) AND &h0000ffff, CLng(LParam) >> 16, SWP_NOZORDER + SWP_NOOWNERZORDER)
  688.                 WndProc = IntPtr.Zero
  689.             Case WM_COMMAND
  690.                 Console.WriteLine  ("Command " & (CInt(wParam) >> 16) & "   " & (CInt(wParam) and &Hffff) & "  " & Cint(lparam))
  691.                 If (CInt(wParam) >> 16) > 1 Then
  692. '                   console.Writeline("WmCommand " & (CInt(wParam) >> 16))
  693.                     If (CInt(wParam) >> 16) = EN_Change then Console.WriteLine("Edited")
  694.                     If (CInt(wParam) >> 16) = EN_Change then gFileIsDirty = True
  695.                     WndProc = DefWindowProc(hWnd, Message, wParam, lParam)
  696.                 Else
  697.                     Dim MenuCommand as Integer
  698.                     MenuCommand = CInt(wParam) and &Hffff
  699.                     console.Writeline("Menu " & MenuCommand)
  700.                     Select Case MenuCommand
  701.                         Case 105   'Exit
  702.                             Ret = SendMessageW(Hwnd, WM_Close, 0, 0)
  703.                             WndProc = IntPtr.Zero
  704.                         Case 101   'New
  705.                             If gFileIsDirty = True Then
  706.                                 console.writeline("saving")
  707.                                 Ret = Msgbox("File has changed. Do you want to save?", vbyesnocancel, "Editor")
  708.                                 If Ret = vbyes then
  709.                                     Savefile()
  710.                                 ElseIf Ret = vbno then
  711.                                     Ret = SendMessageStr(gRtfHwnd, WM_SETTEXT, 0, "")
  712.                                     gFileisDirty = False
  713.                                     gFileHasName = False
  714.                                 End If
  715.                             Else
  716.                                 Ret = SendMessageStr(gRtfHwnd, WM_SETTEXT, 0, "")
  717.                                 gFileisDirty = False
  718.                                 gFileHasName = False
  719.                             End If
  720.                             WndProc = IntPtr.Zero
  721.                         Case 190   'Dos
  722.                             Ret = CheckMenuRadioItem(hFileSaveAsFormatMenu, 190, 194, 190, mf_bycommand)
  723.                             WndProc = IntPtr.Zero
  724.                         Case 191   'ANSI
  725.                             Ret = CheckMenuRadioItem(hFileSaveAsFormatMenu, 190, 194, 191, mf_bycommand)
  726.                             WndProc = IntPtr.Zero
  727.                         Case 192   'UTF8
  728.                             Ret = CheckMenuRadioItem(hFileSaveAsFormatMenu, 190, 194, 192, mf_bycommand)
  729.                             WndProc = IntPtr.Zero
  730.                         Case 193   'UTF16
  731.                             Ret = CheckMenuRadioItem(hFileSaveAsFormatMenu, 190, 194, 193, mf_bycommand)
  732.                             WndProc = IntPtr.Zero
  733.                         Case 194   'Auto
  734.                             Ret = CheckMenuRadioItem(hFileSaveAsFormatMenu, 190, 194, 194, mf_bycommand)
  735.                             WndProc = IntPtr.Zero
  736.                         Case 901   'Help
  737.                             WshShell.Run("""" & System.Windows.Forms.Application.StartupPath & "\Unicode Editor Help.hta""")
  738.                             WndProc = IntPtr.Zero
  739.                         Case 902   'Programming
  740.                             WshShell.Run("""" & System.Windows.Forms.Application.StartupPath & "\Unicode Editor.hta""")
  741.                             WndProc = IntPtr.Zero
  742.                         Case 903   'About
  743.                             Msgbox ("Unicode Editor" & vbcrlf & vbcrlf & "An editor built around Windows API calls." & vbcrlf & vbcrlf & "Created in Windows notepad and compiled with the built in to Windows Visual Basic .NET compiler." & vbcrlf & vbcrlf & "It is meant to be an easily changed program so people can experiment with, and as all the basic plumbing is already hooked up, won't need to spend months making the basics work right.", , "About Unicode Editor")
  744.                             WndProc = IntPtr.Zero
  745.                         Case 201 'undo
  746.                             If SendMessageW(grtfhwnd, em_canundo, 0, 0) <> 0 then
  747.                                 Ret = SendMessageW(grtfhwnd, em_undo, 0, 0)
  748.                             End If
  749.                             WndProc = IntPtr.Zero
  750.                         Case 202 'redo
  751.                             If SendMessageW(grtfhwnd, em_canredo, 0, 0) <> 0 then
  752.                                 Ret = SendMessageW(grtfhwnd, em_redo, 0, 0)
  753.                             End If
  754.                             WndProc = IntPtr.Zero
  755.                         Case 203
  756.                             If TomSel.Type = 2 then
  757.                                 TomSel.Cut(vbnull)
  758.                             End If
  759.                             WndProc = IntPtr.Zero
  760.                         Case 204
  761.                             If TomSel.Type = 2 then
  762.                                 TomSel.Copy(vbnull)
  763.                             End If
  764.                             WndProc = IntPtr.Zero
  765.                         Case 205
  766.                             If tomsel.canpaste(vbnull, CF_UNICODETEXT) = true  
  767.                                 tomsel.paste(vbnull, CF_UNICODETEXT)
  768.                             End If
  769.                             WndProc = IntPtr.Zero
  770.                         Case 206
  771.                             If TomSel.Type = 2 then
  772.                                 Ret=TomSel.Delete(0, 0)
  773.                             End If
  774.                             WndProc = IntPtr.Zero
  775.                         Case 207 'select all
  776.                             Ret = tomsel.expand(6)
  777.                             WndProc = IntPtr.Zero
  778.                         Case 301 'Zoom 100%
  779.                             Ret = SendMessageW(gRtfHwnd, EM_SETTARGETDEVICE, GetDC(gRtfHwnd), -1800)
  780.                             WndProc = IntPtr.Zero
  781.                         Case 302 'Zoom 100%
  782.                             Ret = SendMessageW(grtfhwnd, em_setzoom, 0, 0)
  783.                             WndProc = IntPtr.Zero
  784.                         Case Else
  785.                             WndProc = DefWindowProc(hWnd, Message, wParam, lParam)
  786.                     End Select 
  787.                 End If
  788.             Case WM_Notify
  789.                 Dim hdr As selchange = Marshal.PtrToStructure(lparam , GetType(selchange))
  790.                 If hdr.nmhdr.Code = En_SelChanged then
  791.                     Console.Writeline ("SelChanged")
  792.                     WndProc = DefWindowProc(hWnd, Message, wParam, lParam)
  793.                 Else
  794.                     Console.Writeline ("Notify " & Cstr(hdr.nmhdr.Code))
  795.                     WndProc = DefWindowProc(hWnd, Message, wParam, lParam)
  796.                 End If
  797.             Case WM_ACTIVATEAPP
  798.                 WndProc = DefWindowProc(hWnd, Message, wParam, lParam)
  799.             Case WM_PARENTNOTIFY
  800. '               Console.WriteLine  ("ParentNotify " & (CInt(wParam) >> 16) & "   " & (CInt(wParam) and &Hffff) & "  " & Cint(lparam))
  801. '               If (CInt(wParam) and &Hffff) = WM_RBUTTONDOWN Then Console.WriteLine ("Right button down")
  802.                 WndProc = DefWindowProc(hWnd, Message, wParam, lParam)
  803.             Case WM_CONTEXTMENU
  804. '               Console.WriteLine  ("Context Menu " & (CInt(wParam) >> 16) & "   " & (CInt(wParam) and &Hffff) & "  " & Cint(lparam))
  805.                 If wParam = gRTFhWnd Then
  806.                     Console.WriteLine ("Edit Context Menu")
  807.                     Console.writeline(CStr(hcontextmenu))
  808. '                   Dim hmenuTrackPopup as IntPtr
  809. '                   hmenuTrackPopup = GetSubMenu(hContextMenu, 0)
  810.                     Ret = TrackPopupMenu(hContextMenu, TPM_RightButton, (CInt(lParam) and &Hffff), (CInt(lParam) >> 16), 0, hWnd, &h0)
  811.                     WndProc = 0
  812.                 Else
  813.                     Console.WriteLine ("Another Context Menu")
  814.                     WndProc = DefWindowProc(hWnd, Message, wParam, lParam)
  815.                 End If
  816.             Case WM_INITMENUPOPUP
  817.                 If wParam = hContextMenu Then
  818. '                   Console.WriteLine  ("Init Menu" & (CInt(wParam) >> 16) & "   " & (CInt(wParam) and &Hffff) & "  " & Cint(lparam))
  819.                     If SendMessageW(grtfhwnd, em_canundo, 0, 0) <> 0 then
  820.                         Ret = EnableMenuItem(hcontextmenu, 201, mf_bycommand + mf_enabled)
  821.                     Else
  822.                         Ret = EnableMenuItem(hcontextmenu, 201, mf_bycommand + mf_grayed)
  823.                     End If
  824.                     If SendMessageW(grtfhwnd, em_canredo, 0, 0) <> 0 then
  825.                         Ret = EnableMenuItem(hcontextmenu, 202, mf_bycommand + mf_enabled)
  826.                     Else
  827.                         Ret = EnableMenuItem(hcontextmenu, 202, mf_bycommand + mf_grayed)
  828.                     End If
  829.                     If tomsel.canpaste(vbnull, CF_UNICODETEXT) = true then  
  830.                         Ret = EnableMenuItem(hcontextmenu, 205, mf_bycommand + mf_enabled)
  831.                     Else
  832.                         Ret = EnableMenuItem(hcontextmenu, 205, mf_bycommand + mf_grayed)
  833.                     End If                         
  834.                     If tomsel.type() = 1 then 'normal insertion
  835.                         Ret = EnableMenuItem(hcontextmenu, 203, mf_bycommand + mf_grayed)
  836.                         Ret = EnableMenuItem(hcontextmenu, 204, mf_bycommand + mf_grayed)
  837.                         Ret = EnableMenuItem(hcontextmenu, 206, mf_bycommand + mf_grayed)
  838.                     else
  839.                         Ret = EnableMenuItem(hcontextmenu, 203, mf_bycommand + mf_enabled)
  840.                         Ret = EnableMenuItem(hcontextmenu, 204, mf_bycommand + mf_enabled)
  841.                         Ret = EnableMenuItem(hcontextmenu, 206, mf_bycommand + mf_enabled)
  842.                     End If
  843.                 End If
  844.                 If wParam = hEditMenu Then
  845. '                   Console.WriteLine  ("Init Menu" & (CInt(wParam) >> 16) & "   " & (CInt(wParam) and &Hffff) & "  " & Cint(lparam))
  846.                     If SendMessageW(grtfhwnd, em_canundo, 0, 0) <> 0 then
  847.                         Ret = EnableMenuItem(heditmenu, 201, mf_bycommand + mf_enabled)
  848.                     Else
  849.                         Ret = EnableMenuItem(heditmenu, 201, mf_bycommand + mf_grayed)
  850.                     End If
  851.                     If SendMessageW(grtfhwnd, em_canredo, 0, 0) <> 0 then
  852.                         Ret = EnableMenuItem(heditmenu, 202, mf_bycommand + mf_enabled)
  853.                     Else
  854.                         Ret = EnableMenuItem(heditmenu, 202, mf_bycommand + mf_grayed)
  855.                     End If
  856.                     If tomsel.canpaste(vbnull, CF_UNICODETEXT) = true then  
  857.                         Ret = EnableMenuItem(heditmenu, 205, mf_bycommand + mf_enabled)
  858.                     Else
  859.                         Ret = EnableMenuItem(heditmenu, 205, mf_bycommand + mf_grayed)
  860.                     End If                         
  861.                     If tomsel.type() = 1 then 'normal insertion
  862.                         Ret = EnableMenuItem(heditmenu, 203, mf_bycommand + mf_grayed)
  863.                         Ret = EnableMenuItem(heditmenu, 204, mf_bycommand + mf_grayed)
  864.                         Ret = EnableMenuItem(heditmenu, 206, mf_bycommand + mf_grayed)
  865.                     else
  866.                         Ret = EnableMenuItem(heditmenu, 203, mf_bycommand + mf_enabled)
  867.                         Ret = EnableMenuItem(heditmenu, 204, mf_bycommand + mf_enabled)
  868.                         Ret = EnableMenuItem(heditmenu, 206, mf_bycommand + mf_enabled)
  869.                     End If
  870.                 End If
  871.                 WndProc = DefWindowProc(hWnd, Message, wParam, lParam)
  872.             Case Else
  873.                 WndProc = DefWindowProc(hWnd, Message, wParam, lParam)
  874.          End Select
  875.     End Function
  876.    
  877.     '======================================
  878.     'This is the starting sub. It calls the main sub New()
  879.     '------------------------------------------------
  880.  
  881.     Public Shared Sub Main()
  882.         Dim wnd As New UnicodeEditor
  883.     End Sub
  884.  
  885.     '======================================
  886.     'Assorted functions
  887.     '------------------------------------------------
  888.  
  889.     Public Function GetTextMode(lhwnd as IntPtr) As Integer
  890.             Dim Ret As Integer
  891.             Ret = SendMessageW(lhwnd, EM_GETTEXTMODE, 0, 0)
  892.             GetTextMode = Ret
  893.     End Function
  894.  
  895.     Private Sub OpenFile()
  896.         Dim ofn as New System.Windows.Forms.OpenFileDialog
  897.         With ofn
  898.             .Filename = "*.*"
  899.             .ShowDialog
  900.         End With
  901.         Console.writeline(ofn.filename)
  902. '       Ret = GetOpenFileNameW(ofn)
  903. '       Console.writeline(Len(ofn.file))
  904. '       Console.writeline(ofn.file)
  905. '       console.writeline("OFN " & Ret & "   " & err.lastdllerror)
  906.     End Sub
  907.  
  908.  
  909.     Private Sub SaveFile()
  910.         Dim ofn as New System.Windows.Forms.OpenFileDialog
  911.         With ofn
  912.             .Filename = "*.*"
  913.             .ShowDialog
  914.         End With
  915.         Console.writeline(ofn.filename)
  916. '       Ret = GetOpenFileNameW(ofn)
  917. '       Console.writeline(Len(ofn.file))
  918. '       Console.writeline(ofn.file)
  919. '       console.writeline("OFN " & Ret & "   " & err.lastdllerror)
  920.     End Sub
  921.  
  922. End Class
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!