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 [img]http://www.powerbasic.com/support/forums/wink.gif[/img]
'---------------------------------------------------------------------------------
'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: [url="http://www.gasinf.com.br/gros/pbhtmledit.zip"]http://www.gasinf.com.br/gros/pbhtmledit.zip[/url] (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
------------------
Comment