Tweet
========== 1st CHUNK ===============
------------------
Code:
'PBHtmlEdit - WYSIWYG HTML EDITOR based on MS DHTML.OCX '====================================================== 'I needed to incorporate an HTML editor into a PB Mail application. After 'unsuccessful searches through these forums looking for anything to start from 'I decided to do it myself out of a MS VB example and some code found in these 'PB forums. This is a partial result. Many thanks to José Roca, Borje Hagsten 'among others '--------------------------------------------------------------------------------- 'Found a problem trying to retrieve (enumerate) the html formatting names 'through the command %DECMD_GETBLOCKFMTNAMES (see comments). Formatting is applied 'using format name strings. Worked around by setting the menu options with the 'fixed known names for the Formats (the correct would be to enumerate them 'from the object due to locale issues). Perhaps José may want to help us on this'--------------------------------------------------------------------------------- 'Another minor workaround in LoadDocument and SaveDocument methods (see comments) 'These methods don't recognize the second parameter to prompt user - always = 0 (?) '--------------------------------------------------------------------------------- 'I removed the table insertion operations because the Active-X control doesn't seem 'to show appropriate cursors for table manipulation: insert/delete cols, rows, 'cells etc. I just commented out the code and if someone wants to try, just remove 'them and adjust the menu options constants enumeration. '--------------------------------------------------------------------------------- 'Hope it may be of worth to someone here - Modify and use at your own risk '--------------------------------------------------------------------------------- 'Author: Heber Jorge da Silva, 03/24/2005 '================================================================================= 'For a short while you may download it here: http://www.gasinf.com.br/gros/pbhtmledit.zip (50K) #Compile Exe #Dim All ' Include files #Include "win32api.inc" #Include "commctrl.inc" #Include "comdlg32.inc" #Resource "pbhtmled.pbr" '++#Include "dprint.inc" 'template for initctls Declare Function InitiCommonControlsEx(iccex As INIT_COMMON_CONTROLSEX) As Long Macro InitComCtls(icc) MacroTemp iccex MacroTemp hLib MacroTemp pProc Dim iccex As INIT_COMMON_CONTROLSEX Dim hLib As Dword Dim pProc As Dword hLib = LoadLibrary("COMCTL32.DLL") If hLib Then pProc = GetProcAddress(hLib, "InitCommonControlsEx") If pProc Then iccex.dwSize = SizeOf(iccex) iccex.dwICC = icc Call Dword pProc Using InitiCommonControlsEx(iccex) Else InitCommonControls End If FreeLibrary hLib End If End Macro 'ImageList draw style constants. %IMG_DIS = 0 ' Disabled %IMG_NOR = 1 ' Normal %IMG_HOT = 2 ' Selected 'Sometimes, the text ovewrites the accel+erator key name or goes too close. In these cases, 'we need to add an extra width to the text to separe them. %OMENU_EXTRAWIDTH = 60 'Extra width in pixels %OMENU_CHECKEDICON = 58 'Identifier of the checked icon Global hOcx As Dword Global oOcx As Dispatch Global hMenu As Dword, hStatus As Dword Global hMenuTextBkBrush As Dword, hMenuHiBrush As Dword 'backgnd texto menu Global hImlHot As Dword, hImlDis As Dword, hImlNor As Dword 'imglist para os menus Global hTabMain As Dword, ImageListTab As Dword, hToolbarMain As Dword, hToolBarEdit As Dword Global hTab() As Dword Global MakeAbsString As String 'menu title that changes dynamically (make absolute in position menu) Global HtmlIsDirty As Long 'flag - edited html directly 'Initial declares - eliminate unnecessary macros in COMMCTRL.INC %NOANIMATE = 1 ' Animate control %NOBUTTON = 1 ' Button %NOCOMBO = 1 ' Combo box %NOCOMBOEX = 1 ' ComboBoxEx %NODATETIMEPICK = 1 ' Date/time picker %NODRAGLIST = 1 ' Drag list control %NOEDIT = 1 ' Edit control %NOFLATSBAPIS = 1 ' Flat scroll bar %NOHEADER = 1 ' Header control %NOHOTKEY = 1 ' HotKey control %NOIMAGELIST = 1 ' Image APIs %NOIPADDRESS = 1 ' IP Address edit control %NOLIST = 1 ' List box control %NOLISTVIEW = 1 ' ListView control %NOMENUHELP = 1 ' Menu help %NOMONTHCAL = 1 ' MonthCal %NOMUI = 1 ' MUI %NONATIVEFONTCTL = 1 ' Native Font control %NOPAGESCROLLER = 1 ' Pager %NOPROGRESS = 1 ' Progress control '%NOREBAR = 1 ' Rebar control %NOSTATUSBAR = 1 ' Status bar %NOTABCONTROL = 1 ' Tab control '%NOTOOLBAR = 1 ' Tool bar '%NOTOOLTIPS = 1 ' Tool tips %NOTRACKBAR = 1 ' Track bar %NOTRACKMOUSEEVENT = 1 ' Track Mouse Event %NOTREEVIEW = 1 ' TreeView %NOUPDOWN = 1 ' Up Down arrow control 'bitmaps tbmain %IDB_NORMAL = 100 %IDB_HOT = 101 'bitmaps tb16 %IDB_MNOR = 102 %IDB_MHOT = 103 %IDB_MDIS = 104 'edit toolbar buttons %IDC_BOLD = 200 %IDC_ITALIC = 201 %IDC_UNDERLINE = 202 %IDC_TXTBACKCOLOR = 203 'sep %IDC_INDENT = 204 %IDC_OUTDENT = 205 %IDC_ORDERLIST = 206 %IDC_UNORDERLIST = 207 'sep %IDC_JUSTIFYLEFT = 208 %IDC_JUSTIFYCENTER = 209 %IDC_JUSTIFYRIGHT = 210 'sep %IDC_UNDO = 211 %IDC_REDO = 212 'sep %IDC_IMAGE = 213 %IDC_LINE = 214 %IDC_HYPERLINK = 215 %IDC_UNLINK = 216 'sep %IDC_COPY = 217 %IDC_CUT = 218 %IDC_PASTE = 219 'menus %IDM_NEW = %WM_USER + 2048 %IDM_OPEN = %IDM_NEW + 1 %IDM_SAVE = %IDM_OPEN + 1 %IDM_SAVEAS = %IDM_SAVE + 1 %IDM_PRINT = %IDM_SAVEAS + 1 %IDM_EXIT = %IDM_PRINT + 1 %IDM_FIND = %IDM_EXIT + 1 %IDM_UNDO = %IDM_FIND + 1 %IDM_REDO = %IDM_UNDO + 1 %IDM_COPY = %IDM_REDO + 1 %IDM_CUT = %IDM_COPY + 1 %IDM_PASTE = %IDM_CUT + 1 %IDM_TEXTFORECOLOR = %IDM_PASTE + 1 %IDM_TEXTBACKCOLOR = %IDM_TEXTFORECOLOR + 1 %IDM_BACKCOLOR = %IDM_TEXTBACKCOLOR + 1 %IDM_BACKSOUND = %IDM_BACKCOLOR + 1 %IDM_BACKIMAGE = %IDM_BACKSOUND + 1 %IDM_SELALL = %IDM_BACKIMAGE + 1 %IDM_IMAGE = %IDM_SELALL + 1 %IDM_HTML = %IDM_IMAGE + 1 %IDM_LINE = %IDM_HTML + 1 %IDM_HYPERLINK = %IDM_LINE + 1 '%IDM_TABLE = %IDM_HYPERLINK + 1 '%IDM_TABINSLINE = %IDM_TABLE + 1 '%IDM_TABINSCOL = %IDM_TABINSLINE + 1 '%IDM_TABINSCELL = %IDM_TABINSCOL + 1 '%IDM_TABREMLINE = %IDM_TABINSCELL + 1 '%IDM_TABREMCOL = %IDM_TABREMLINE + 1 '%IDM_TABREMCELL = %IDM_TABREMCOL + 1 '%IDM_TABJOINCELLS = %IDM_TABREMCELL + 1 '%IDM_TABDIVCELLS = %IDM_TABJOINCELLS + 1 ' %IDM_NORMAL = %IDM_HYPERLINK + 1 '%IDM_TABDIVCELLS + 1 %IDM_FORMATTED = %IDM_NORMAL + 1 %IDM_ADDRESS = %IDM_FORMATTED + 1 %IDM_TIT1 = %IDM_ADDRESS + 1 %IDM_TIT2 = %IDM_TIT1 + 1 %IDM_TIT3 = %IDM_TIT2 + 1 %IDM_TIT4 = %IDM_TIT3 + 1 %IDM_TIT5 = %IDM_TIT4 + 1 %IDM_TIT6 = %IDM_TIT5 + 1 %IDM_ORDERLIST = %IDM_TIT6 + 1 %IDM_UNORDERLIST = %IDM_ORDERLIST + 1 %IDM_DIRLIST = %IDM_UNORDERLIST + 1 %IDM_MENULIST = %IDM_DIRLIST + 1 %IDM_DEFTERM = %IDM_MENULIST + 1 %IDM_DEFINITION = %IDM_DEFTERM + 1 %IDM_PARAGRAPH = %IDM_DEFINITION + 1 %IDM_MAKEABSOLUTE = %IDM_PARAGRAPH + 1 %IDM_SENDTOTOP = %IDM_MAKEABSOLUTE + 1 %IDM_SENDTOBOTTOM = %IDM_SENDTOTOP + 1 %IDM_BRINGTOFRONT = %IDM_SENDTOBOTTOM + 1 %IDM_SENDTOBACK = %IDM_BRINGTOFRONT + 1 %IDM_ABOVETEXT = %IDM_SENDTOBACK + 1 %IDM_BELOWTEXT = %IDM_ABOVETEXT + 1 %IDM_LOCKITEM = %IDM_BELOWTEXT + 1 %IDM_CONTENTS = %IDM_LOCKITEM + 1 %IDM_USING = %IDM_CONTENTS + 1 %IDM_ABOUT = %IDM_USING + 1 %IDM_SEPARATOR = %IDM_ABOUT + 1 ' Equates $APPTITLE = "PBHtmlEd - WYSIWYG Html Editor" %MAINTOOLBUTTONS = 5 %EDITTOOLBUTTONS = 25 %QD_ICOIMGLIST = 11 'qde icones nas img list %ID_REBAR = 1001 %ID_CBOFONTNAME = 1002 %ID_CBOFONTSIZE = 1003 %ID_TOOLBARMAIN = 1004 %ID_TOOLBAREDIT = 1005 %ID_TABMAIN = 1006 %ID_OCX = 1010 %ID_HTML = 1015 'Globals Global hDlgMain As Dword, hInst As Dword, hRebar As Dword, hNormal As Dword, hHot As Dword, hHtml As Dword Global hComboFN As Dword, hComboFS As Dword Global htmlFile As String Global Lg As Long Global TwoDCmd() As Long Global TabPage As Long 'current tab page 'Declarations Declare CallBack Function DialogCallback Declare CallBack Function Tab0Proc Declare CallBack Function Tab1Proc Declare Function CreateRebar(Byval hParent As Dword) As Long Declare Function CreateCombo(Byval hParent As Dword, Byval Id As Long) As Dword Declare CallBack Function DlgSoundCB Declare CallBack Function DlgBackgCB Declare Function CreateToolBarMain(Byval hParent As Dword) As Dword Declare Function CreateToolBarEdit(Byval hParent As Dword) As Dword Declare Sub DrawMenuItem(lp As Long) Declare Function Lgs(Byval Nr As Long) As String Declare Function GetLocaleCode() As Long Declare Sub BuildMenu(Byval hDlg As Dword) Declare Function GetMenuTextAndBitmap(Byval ItemId As Long, BmpNum As Long) As String Declare Function GetMenuBmpHandle(Byval BmpNum As Long, Byval nState As Long) As Long Declare Sub MeasureMenu(Byval hWnd As Dword, Byval lParam As Dword) Declare Function AppLoadBitmaps() As Long Declare Function EnumFontName(lf As LOGFONT, tm As TEXTMETRIC, Byval FontType As Long, lpData As Long) As Long Declare Sub FillFontCombo(Byval hCbo As Long) Declare Function SelectColor(Byval hParent As Long, Byval iStartColor As Long, Byval iUseExt As Long) As Long Declare Function GetFileNameToSave(Byval PATH As String, Byval xHwnd As Long, Byval xCaption As String, Byval xMask As String, Byval xDefault As String) As String Declare Function MsgBoxApi(Byval hParent As Long, Byval sMsg As String, Byval dwFlags As Dword, Byval sTitle As String) As Long Declare Sub SaveHtmlFile(Optional Byval PromptUser As Long) Declare Sub SetAppTitle() Declare Sub PasteHTML(Byval x As String) Declare Sub UpdateTbMainAndMenus() Declare Sub AddRemoveBackImage(Byval x As String, Byval Position As Long) Declare Sub AddRemoveBackSound(Byval x As String, Byval SoundParms As String) Declare Sub ShowSoundDialog() Declare Sub ShowBackgroundDialog() Declare Sub EnableToolbars(Byval Stat As Long) Declare Function MakeFont(Byval FontName As String, Byval PointSize As Long, Opt Byval Flags As String) As Long %WM_FORWARDMSG = &H37F ' (895) #Include "dhtmledit.inc" 'ATLAPI Declare Function AtlAxWinInit Lib "ATL.DLL" Alias "AtlAxWinInit" () As Long Declare Function AtlAxWinTerm() As Long Declare Function AtlAxGetControl Lib "ATL.DLL" Alias "AtlAxGetControl" _ (_ Byval hWnd As Dword, _ '[in] A handle to the window that is hosting the control. Byref pp As Dword _ '[out] The IUnknown of the control being hosted. ) As Dword 'uninitialize ATL Function AtlAxWinTerm() As Long UnregisterClass("AtlAxWin", GetModuleHandle(Byval %Null)) End Function 'puts the address of an object in a variant and marks it as containing a dispatch variable Sub AtlMakeDispatch(_ Byval lpObj As Dword, _ ' Address of the object instance Byref vObj As Variant _ ' Variant to contain this address ) Export Local lpvObj As VARIANTAPI Ptr 'Pointer to a VARIANTAPI structure Let vObj = Empty 'Make sure is empty to avoid memory leaks lpvObj = VarPtr(vObj) 'Get the VARIANT address @lpvObj.vt = %Vt_Dispatch 'Mark it as containing a dispatch variable @lpvObj.vd.pdispVal = lpObj 'Set the dispatch pointer address End Sub 'create comboboxes for fonts Function CreateCombo(Byval hParent As Dword, Byval Id As Long) As Dword Local i As Long, x As String Local hComboBox As Dword Control Add ComboBox, hParent, Id,, 0, 0, 0, 100, _ %WS_CHILD Or %WS_VISIBLE Or %CBS_DROPDOWNLIST Or %WS_VSCROLL _ Or %WS_CLIPSIBLINGS Or %WS_CLIPCHILDREN Control Handle hParent, Id To hComboBox If Id = %ID_CBOFONTSIZE Then 'Font Size For i = 1 To 7 x = Format$(i) SendMessage hComboBox, %CB_ADDSTRING, 0, StrPtr(x) Next SendMessage hComboBox, %CB_SETCURSEL, 0, 0 Else 'Font Names FillFontCombo hComboBox x = "Times New Roman" 'set as default i = SendMessage(hComboBox, %CB_FINDSTRINGEXACT, - 1, StrPtr(x)) If i = %CB_ERR Then SendMessage hComboBox, %CB_SETCURSEL, 0, 0 Else SendMessage hComboBox, %CB_SETCURSEL, i, 0 End If End If Function = hComboBox End Function '********************************************************************************************* ' Function : AppLoadBitmaps () ' Description : Loads the Applications Bitmaps from a Resource file. ' Return value : Returns the size of the bitmaps ' NOTE : If you use 24x24 Bitmaps for the ToolBars, you will have to ' add 16x16 Bitmaps Strips for the Menus! '********************************************************************************************* Function AppLoadBitmaps() As Long Local bm As Bitmap Local hBmpHot As Dword Local hBmpDis As Dword Local hBmpNor As Dword Local lBmpSize As Long ' Setup and Initialize the Menu, ToolBar Bitmaps and ImageLists. hBmpNor = LoadBitmap(hInst, Byval %IDB_MNOR) 'carrega bitmap normal hBmpHot = LoadBitmap(hInst, Byval %IDB_MHOT) 'carrega bitmap hot hBmpDis = LoadBitmap(hInst, Byval %IDB_MDIS) 'carrega bitmap disab ' Get and Save the Bitmap size for later use. GetObject hBmpNor, SizeOf(bm), bm ' Get the Bitmap's sizes. lBmpSize = bm.bmHeight ' Save Bitmap size for later use. ' Create the Menu and ToolBar ImageLists Hot Selected, Disabled and Normal. hImlHot = ImageList_Create(lBmpSize, lBmpSize, %ILC_COLORDDB Or %ILC_MASK, 1, 0) ImageList_AddMasked hImlHot, hBmpHot, Rgb(255, 0, 255) ImageList_Add hImlHot, hBmpHot, Rgb(255, 0, 255) hImlDis = ImageList_Create(lBmpSize, lBmpSize, %ILC_COLORDDB Or %ILC_MASK, 1, 0) ImageList_AddMasked hImlDis, hBmpDis, Rgb(255, 0, 255) ImageList_Add hImlDis, hBmpDis, Rgb(255, 0, 255) hImlNor = ImageList_Create(lBmpSize, lBmpSize, %ILC_COLORDDB Or %ILC_MASK, 1, 0) ImageList_AddMasked hImlNor, hBmpNor, Rgb(255, 0, 255) ImageList_Add hImlNor, hBmpNor, Rgb(255, 0, 255) ' Clean-Up and Delete the Bitmap Handles they are no longer need. If hBmpHot Then DeleteObject(hBmpHot) If hBmpDis Then DeleteObject(hBmpDis) If hBmpNor Then DeleteObject(hBmpNor) Function = lBmpSize End Function Function CreateToolBarMain(Byval hParent As Dword) As Dword Local hImage As Dword, i As Long, j As Long Local hToolBar As Dword Local Tbb() As TBBUTTON Dim Tbb(0 : %MAINTOOLBUTTONS - 1) As Local TBBUTTON Control Add "TOOLBARWINDOW32", hParent, %ID_TOOLBARMAIN, "", 0, 0, 0, 0, _ %WS_CHILD Or %WS_VISIBLE Or %TBSTYLE_TOOLTIPS Or %TBSTYLE_FLAT _ Or %WS_CLIPCHILDREN Or %WS_CLIPSIBLINGS Or %CCS_NODIVIDER Or %CCS_NORESIZE Control Handle hParent, %ID_TOOLBARMAIN To hToolBar 'create/initialize normal imagelist hNormal = ImageList_Create(32, 32, %ILC_COLORDDB Or %ILC_MASK, %QD_ICOIMGLIST, 0) If IsTrue hNormal Then 'seta a cor fundo para desenhar imagens ImageList_SetBkColor hNormal, %CLR_NONE 'adiciona imagens à imagelist hImage = LoadBitmap(hInst, Byval %IDB_NORMAL) 'load normal bitmap ImageList_AddMasked hNormal, hImage, Rgb(255, 0, 255) 'transparent color DeleteObject hImage End If 'create/initialize hot imagelist hHot = ImageList_Create(32, 32, %ILC_COLORDDB Or %ILC_MASK, %QD_ICOIMGLIST, 0) If IsTrue hHot Then 'seta a cor fundo para desenhar imagens ImageList_SetBkColor hHot, %CLR_NONE 'adiciona imagens à imagelist hImage = LoadBitmap(hInst, Byval %IDB_HOT) ImageList_AddMasked hHot, hImage, Rgb(255, 0, 255) 'transparent DeleteObject hImage End If 'Link imagelists to toolbar Control Send hParent, %ID_TOOLBARMAIN, %TB_SETIMAGELIST, 0, hNormal Control Send hParent, %ID_TOOLBARMAIN, %TB_SETHOTIMAGELIST, 0, hHot 'Init Tbb array. For i = 0 To %MAINTOOLBUTTONS - 1 'set the initial states for each button Tbb(i).iBitmap = 0 Tbb(i).idCommand = 0 Tbb(i).fsState = %TBSTATE_ENABLED Tbb(i).fsStyle = %TBSTYLE_BUTTON Tbb(i).dwData = 0 Tbb(i).iString = 0 Select Case As Long i Case 2 'gap creation buttons. Tbb(i).fsStyle = %TBSTYLE_SEP Case 0 Tbb(i).iBitmap = 0 Tbb(i).idCommand = %IDM_NEW Case 1 Tbb(i).iBitmap = 1 Tbb(i).idCommand = %IDM_OPEN Case 3 Tbb(i).iBitmap = 2 Tbb(i).idCommand = %IDM_SAVE Tbb(i).fsState = 0 'disabled Case 4 Tbb(i).iBitmap = 3 Tbb(i).idCommand = %IDM_PRINT Tbb(i).fsState = 0 'disabled End Select Next 'set the buttons Control Send hParent, %ID_TOOLBARMAIN, %TB_BUTTONSTRUCTSIZE, SizeOf(Tbb(0)), 0 Control Send hParent, %ID_TOOLBARMAIN, %TB_ADDBUTTONS, %MAINTOOLBUTTONS, VarPtr(Tbb(0)) 'set the tooltip background color to yellow j = SendMessage(hToolbar, %TB_GETTOOLTIPS, 0, 0) SendMessage hToolbar, %TB_GETTOOLTIPS, 0, 0 i = Rgb(255, 255, 134) 'yellow SendMessage j, %TTM_SETTIPBKCOLOR, i, 0 Function = hToolBar End Function Function CreateToolBarEdit(Byval hParent As Dword) As Dword Local i As Long, j As Long Local hToolBar As Dword 'Toolbar variables Local Tbb() As TBBUTTON Dim Tbb(0 : %EDITTOOLBUTTONS - 1) As Local TBBUTTON Call AppLoadBitmaps 'load menus and tb16 bitmaps Control Add "TOOLBARWINDOW32", hParent, %ID_TOOLBAREDIT, "", 0, 0, 0, 0, _ %WS_CHILD Or %WS_VISIBLE Or %TBSTYLE_TOOLTIPS Or %TBSTYLE_FLAT _ Or %WS_CLIPCHILDREN Or %WS_CLIPSIBLINGS Or %CCS_NODIVIDER Or %CCS_NORESIZE Control Handle hParent, %ID_TOOLBAREDIT To hToolBar 'Link imagelists to toolbar Control Send hParent, %ID_TOOLBAREDIT, %TB_SETIMAGELIST, 0, hImlNor Control Send hParent, %ID_TOOLBAREDIT, %TB_SETHOTIMAGELIST, 0, hImlHot ' Init Tbb array. For i = 0 To %EDITTOOLBUTTONS - 1 ' Set the initial states for each button Tbb(i).iBitmap = 0 Tbb(i).idCommand = 0 Tbb(i).fsState = %TBSTATE_ENABLED Tbb(i).fsStyle = %TBSTYLE_BUTTON Tbb(i).dwData = 0 Tbb(i).iString = 0 Select Case As Long i Case 4, 9, 13, 16, 21 Tbb(i).fsStyle = %TBSTYLE_SEP Case 0 Tbb(i).iBitmap = 0 Tbb(i).idCommand = %IDC_BOLD Case 1 Tbb(i).iBitmap = 1 Tbb(i).idCommand = %IDC_ITALIC Case 2 Tbb(i).iBitmap = 3 Tbb(i).idCommand = %IDC_UNDERLINE Case 3 Tbb(i).iBitmap = 2 Tbb(i).idCommand = %IDC_TXTBACKCOLOR Case 5 Tbb(i).iBitmap = 4 Tbb(i).idCommand = %IDC_INDENT Case 6 Tbb(i).iBitmap = 5 Tbb(i).idCommand = %IDC_OUTDENT Case 7 Tbb(i).iBitmap = 6 Tbb(i).idCommand = %IDC_ORDERLIST Case 8 Tbb(i).iBitmap = 7 Tbb(i).idCommand = %IDC_UNORDERLIST Case 10 Tbb(i).iBitmap = 9 Tbb(i).idCommand = %IDC_JUSTIFYLEFT Case 11 Tbb(i).iBitmap = 10 Tbb(i).idCommand = %IDC_JUSTIFYCENTER Case 12 Tbb(i).iBitmap = 11 Tbb(i).idCommand = %IDC_JUSTIFYRIGHT Case 14 Tbb(i).iBitmap = 12 Tbb(i).idCommand = %IDC_UNDO Case 15 Tbb(i).iBitmap = 13 Tbb(i).idCommand = %IDC_REDO Case 17 Tbb(i).iBitmap = 14 Tbb(i).idCommand = %IDC_IMAGE Case 18 Tbb(i).iBitmap = 15 Tbb(i).idCommand = %IDC_LINE Case 19 Tbb(i).iBitmap = 16 Tbb(i).idCommand = %IDC_HYPERLINK Case 20 Tbb(i).iBitmap = 17 Tbb(i).idCommand = %IDC_UNLINK Case 22 Tbb(i).iBitmap = 22 Tbb(i).idCommand = %IDC_COPY Case 23 Tbb(i).iBitmap = 23 Tbb(i).idCommand = %IDC_CUT Case 24 Tbb(i).iBitmap = 24 Tbb(i).idCommand = %IDC_PASTE End Select Next 'Set the buttons Control Send hParent, %ID_TOOLBAREDIT, %TB_BUTTONSTRUCTSIZE, SizeOf(Tbb(0)), 0 Control Send hParent, %ID_TOOLBAREDIT, %TB_ADDBUTTONS, %EDITTOOLBUTTONS, VarPtr(Tbb(0)) 'Set the tooltip background color to yellow j = SendMessage(hToolbar, %TB_GETTOOLTIPS, 0, 0) SendMessage hToolbar, %TB_GETTOOLTIPS, 0, 0 i = Rgb(255, 255, 134) 'yellow SendMessage j, %TTM_SETTIPBKCOLOR, i, 0 Function = hToolBar End Function Function CreateRebar(Byval hParent As Dword) As Long Local rbi As REBARINFO Local rbBand As REBARBANDINFO Local rc As RECT Local szCbText As Asciiz * 255 Local dwBtnSize As Dword Control Add $REBARCLASSNAME, hParent, %ID_REBAR, "", 0, 0, 0, 0, _ %WS_CHILD Or %WS_VISIBLE Or %WS_CLIPSIBLINGS Or %WS_CLIPCHILDREN Or _ %RBS_VARHEIGHT Or %RBS_BANDBORDERS Or %WS_BORDER '++Or %CCS_NODIVIDER Control Handle hParent, %ID_REBAR To hRebar 'Initialize and send the REBARINFO structure rbi.cbSize = SizeOf(rbi) rbi.fMask = 0 rbi.himl = 0 Control Send hParent, %ID_REBAR, %RB_SETBARINFO, 0, VarPtr(rbi) 'initialize REBARBANDINFO for all rebar bands rbBand.cbSize = SizeOf(rbBand) 'rbBand.fMask = %RBBIM_COLORS Or _ '// clrFore and clrBack are valid... rbBand.fMask = %RBBIM_CHILD Or _ '// hwndChild is valid %RBBIM_CHILDSIZE Or _ '// cxMinChild and cyMinChild are valid %RBBIM_STYLE Or _ '// fStyle is valid %RBBIM_ID Or _ '// wID is valid %RBBIM_SIZE Or _ '// cx is valid %RBBIM_TEXT Or _ '// lpText is valid %RBBIM_BACKGROUND '// hbmBack is valid 'rbBand.clrFore = Rgb(0, 0, 255) '// Red 'rbBand.clrBack = Rgb(223, 248, 104) '// Yellow rbBand.fStyle = %RBBS_NOVERT Or _ '// do not display in vertical orientation %RBBS_CHILDEDGE Or _ %RBBS_FIXEDBMP rbBand.hbmBack = 0 'backg bmp hToolbarMain = CreateToolBarMain(hParent) dwBtnSize = SendMessage(hToolbarMain, %TB_GETBUTTONSIZE, 0, 0) rbBand.hwndChild = hToolbarMain rbBand.wID = %ID_TOOLBARMAIN rbBand.cxMinChild = 230 rbBand.cyMinChild = HiWrd(dwBtnSize) rbBand.Cx = 250 'insert band into rebar Control Send hParent, %ID_REBAR, %RB_INSERTBAND, - 1, VarPtr(rbBand) 'insert font combo hComboFN = CreateCombo(hParent, %ID_CBOFONTNAME) szCbText = Lgs(100) rbBand.lpText = VarPtr(szCbText) rbBand.hwndChild = hComboFN rbBand.wID = %ID_CBOFONTNAME GetWindowRect hComboFN, rc rbBand.cxMinChild = 160 rbBand.cyMinChild = rc.nBottom - rc.nTop rbBand.Cx = 160 'insert band into rebar Control Send hParent, %ID_REBAR, %RB_INSERTBAND, - 1, VarPtr(rbBand) 'insert font size combo hComboFS = CreateCombo(hParent, %ID_CBOFONTSIZE) szCbText = Lgs(101) rbBand.lpText = VarPtr(szCbText) rbBand.hwndChild = hComboFS rbBand.wID = %ID_CBOFONTNAME GetWindowRect hComboFS, rc rbBand.cxMinChild = 40 rbBand.cyMinChild = rc.nBottom - rc.nTop rbBand.Cx = 40 'insert band into rebar Control Send hParent, %ID_REBAR, %RB_INSERTBAND, - 1, VarPtr(rbBand) 'insert toolbar edit hToolbarEdit = CreateToolBarEdit(hParent) dwBtnSize = SendMessage(hToolbarEdit, %TB_GETBUTTONSIZE, 0, 0) szCbText = "" rbBand.hwndChild = hToolbarEdit rbBand.wID = %ID_TOOLBAREDIT rbBand.cxMinChild = 230 rbBand.cyMinChild = HiWrd(dwBtnSize) rbBand.Cx = 250 'insert band into rebar Control Send hParent, %ID_REBAR, %RB_INSERTBAND, - 1, VarPtr(rbBand) End Function '================================================= ' Main entry point for the application '================================================= Function PbMain() As Long Local i As Long Local tTC_Item As TC_ITEM Local szBuf As Asciiz * 32 Local OcxName As Asciiz * 255 Local pUnk As Dword, dwCookie As Dword Local hWnd As Dword, hFont As Dword Local vVar As Variant Local uMsg As TAGMSG Redim hTab(0 To 1) As Global Dword 'handle dos 3 tabs hInst = GetModuleHandle(Byval 0) OcxName = "DHTMLEdit.DHTMLEdit.1" Call AtlAxWinInit 'initializes ATL Lg = GetLocaleCode() 'initialize the common control library InitComCtls(%ICC_WIN95_CLASSES Or %ICC_DATE_CLASSES Or %ICC_INTERNET_CLASSES Or %ICC_COOL_CLASSES Or %ICC_USEREX_CLASSES) 'creates the brushes for the submenu text background hMenuTextBkBrush = CreateSolidBrush(Rgb(249, 249, 249)) 'creates the brushes for the submenu highlighted text background hMenuHiBrush = CreateSolidBrush(Rgb(182, 209, 234)) 'no error trapping, we will handle it ourself On Error Resume Next ' OcxName must be formatted in one of the following ways: ' · A ProgID such as "MSCAL.Calendar.7" ' · A CLSID such as "{8E27C92B-1264-101C-8A2F-040224009C02}" ' · A URL such as "http://www.microsoft.com" ' · A reference to an Active document such as "file://\\Documents\MyDoc.doc" ' · A fragment of HTML such as "MSHTML:<HTML><BODY>This is a line of text</BODY></HTML>" ' Note "MSHTML:" must precede the HTML fragment so that it is designated as being an MSHTML stream. Dialog New %HWND_DESKTOP, $APPTITLE, 0, 0, _ 400, 300, %WS_OVERLAPPEDWINDOW Or %WS_MAXIMIZEBOX Or %WS_MINIMIZEBOX Or %WS_SYSMENU Or _ %WS_THICKFRAME Or %WS_CLIPCHILDREN Or %WS_CLIPSIBLINGS Or %DS_CENTER To hDlgMain Dialog Send hDlgMain, %WM_SETICON, %ICON_SMALL, LoadIcon(GetModuleHandle("" ), "APPLICA") Dialog Send hDlgMain, %WM_SETICON, %ICON_BIG, LoadIcon(GetModuleHandle("" ), "APPLICA") BuildMenu hDlgMain CreateRebar hDlgMain 'create tab ctl with 2 tabs Control Add "SysTabControl32", hDlgMain, %ID_TABMAIN, "SysTabControl321", 0, 60, 400, 220, _ %WS_CHILD Or %WS_VISIBLE Or %WS_TABSTOP Or %TCS_MULTILINE Or _ %TCS_RIGHTJUSTIFY Or %TCS_BOTTOM, %WS_EX_LEFT Or %WS_EX_LTRREADING Control Handle hDlgMain, %ID_TABMAIN To hTabMain ImageListTab = ImageList_Create(16, 16, %ILC_COLORDDB Or %ILC_MASK, 0, 4) i = LoadImage(GetModuleHandle(Byval 0&), "EDIT", %IMAGE_ICON, 16, 16, %LR_DEFAULTCOLOR Or %LR_SHARED) ImageList_AddIcon ImageListTab, i i = LoadImage(GetModuleHandle(Byval 0&), "HTML", %IMAGE_ICON, 16, 16, %LR_DEFAULTCOLOR Or %LR_SHARED) ImageList_AddIcon ImageListTab, i TabCtrl_SetImageList hTabMain, ImageListTab tTC_Item.Mask = %TCIF_TEXT Or %TCIF_IMAGE tTC_Item.pszText = VarPtr(szBuf) For i = 0 To 1 szBuf = Parse$(Lgs(114), "|", i + 1) tTC_Item.iImage = i TabCtrl_InsertItem hTabMain, i, tTC_Item Next 'TAB0 (OCX) Dialog New hTabMain, "", 0, 0, 400, 220, %WS_CHILD Or %WS_VISIBLE To hTab(0) Control Add "AtlAxWin", hTab(0), %ID_OCX, OcxName, 0, 0, 400, 220, %WS_VISIBLE Or %WS_CHILD Control Handle hTab(0), %ID_OCX To hOcx AtlAxGetControl(hOcx, pUnk) AtlMakeDispatch(pUnk, vVar) Set oOcx = vVar SetFocus(hOcx) Dialog Show ModeLess hTab(0), Call Tab0Proc Call SetAppTitle() 'TAB1 (TXT) Dialog New hTabMain, "", 0, 0, 400, 220, %WS_CHILD Or %WS_VISIBLE To hTab(1) Control Add TextBox, hTab(1), %ID_HTML, "", 0, 0, 400, 220, %ES_MULTILINE Or %ES_WANTRETURN Or %ES_NOHIDESEL _ Or %ES_AUTOVSCROLL Or %ES_AUTOHSCROLL Or %WS_BORDER Or %WS_VSCROLL Or %WS_HSCROLL Or %WS_TABSTOP Control Handle hTab(1), %ID_HTML To hHtml hfont = MakeFont("Arial", 8, "B") SendMessage hHtml, %WM_SETFONT, hFont, 0 Dialog Show ModeLess hTab(1), Call Tab1Proc ' create the status bar window hStatus = CreateStatusWindow(%WS_CHILD Or %WS_BORDER Or %WS_VISIBLE Or %SBS_SIZEGRIP, "", hDlgMain, 200) 'show tabs Dialog Show State hTab(0), %SW_SHOW Dialog Show State hTab(1), %SW_HIDE Dialog Show ModeLess hDlgMain Call DialogCallback 'get the handle of the ancestor of the control that has the focus hWnd = GetFocus While GetParent(hWnd) <> hTab(0) hWnd = GetParent(hWnd) Wend Call DHTMLEditEvents_ConnectEvents(Objptr(oOcx), dwCookie) While GetMessage(uMsg, %Null, 0, 0) 'Pass keyboard messages to the ancestor 'Returns 0 if the message was not processed, nonzero if it was If SendMessage(hWnd, %WM_FORWARDMSG, 0, VarPtr(uMsg)) = 0 Or TabPage = 1 Then If IsDialogMessage(hTab(0), uMsg) = %FALSE Then TranslateMessage uMsg DispatchMessage uMsg End If End If Wend Call DHTMLEditEvents_DisconnectEvents(Objptr(oOcx), dwCookie) DeleteObject hFont AtlAxWinTerm 'uninitializes ATL Set oOcx = Nothing End Function
------------------
// ----------------------------------------------------
IDM_NORMAL, "Normal"
IDM_FORMATTED, "
Comment