Mini Kabibi Habibi
Imports Microsoft.VisualBasic
Imports System
Imports System.Drawing
Imports System.Collections
Imports System.ComponentModel
Imports System.Windows.Forms
Imports System.Data
Imports System.IO
Imports System.Diagnostics
Imports DevExpress.XtraEditors
Imports DevExpress.Skins
Imports DevExpress.XtraBars.Ribbon
Imports DevExpress.XtraBars.Ribbon.Gallery
Imports DevExpress.Utils.Drawing
Imports DevExpress.Utils
Imports DevExpress.Tutorials.Controls
Imports DevExpress.XtraEditors.Controls
Imports DevExpress.LookAndFeel
Namespace DevExpress.XtraBars.Demos.RibbonSimplePad
Partial Public Class frmMain
Inherits DevExpress.XtraBars.Ribbon.RibbonForm
Public Sub New()
InitializeComponent()
CreateColorPopup(popupControlContainer1)
InitSkinGallery()
InitFontGallery()
InitColorGallery()
InitEditors()
InitSchemeCombo()
AddHandler UserLookAndFeel.Default.StyleChanged, AddressOf OnLookAndFeelStyleChanged
UserLookAndFeel.Default.SetSkinStyle("Office 2013")
End Sub
Private documentIndex As Integer = 0
Private cp As ColorPopup
Private dlgFind As frmFind = Nothing
Private dlgReplace As frmReplace = Nothing
Private fCurrentFontItem, fCurrentColorItem As GalleryItem
Private ReadOnly Property DocumentName() As String
Get
Return String.Format("New Document {0}", documentIndex)
End Get
End Property
Private Sub OnLookAndFeelStyleChanged(ByVal sender As Object, ByVal e As EventArgs)
UpdateSchemeCombo()
End Sub
Private Sub InitSchemeCombo()
For Each obj As Object In System.Enum.GetValues(GetType(RibbonControlColorScheme))
repositoryItemComboBox1.Items.Add(obj)
Next obj
beScheme.EditValue = RibbonControlColorScheme.Yellow
End Sub
Private Sub CreateNewDocument()
CreateNewDocument(Nothing)
End Sub
Sub InitEditors()
riicStyle.Items.Add(New ImageComboBoxItem("Office 2007", RibbonControlStyle.Office2007, -1))
riicStyle.Items.Add(New ImageComboBoxItem("Office 2010", RibbonControlStyle.Office2010, -1))
riicStyle.Items.Add(New ImageComboBoxItem("Office 2013", RibbonControlStyle.Office2013, -1))
riicStyle.Items.Add(New ImageComboBoxItem("MacOffice", RibbonControlStyle.MacOffice, -1))
biStyle.EditValue = ribbonControl1.RibbonStyle
End Sub
Public Sub ShowHideFormatCategory()
Dim selectionCategory As RibbonPageCategory = TryCast(Ribbon.PageCategories(0), RibbonPageCategory)
If selectionCategory Is Nothing Then
Return
End If
If CurrentRichTextBox Is Nothing Then
selectionCategory.Visible = False
Else
selectionCategory.Visible = CurrentRichTextBox.SelectionLength <> 0
End If
If selectionCategory.Visible Then
Ribbon.SelectedPage = selectionCategory.Pages(0)
End If
End Sub
Private Sub CreateNewDocument(ByVal fileName As String)
documentIndex += 1
Dim pad As frmPad = New frmPad()
If Not fileName Is Nothing Then
pad.LoadDocument(fileName)
Else
pad.DocName = DocumentName
End If
pad.MdiParent = Me
AddHandler pad.Closed, AddressOf Pad_Closed
AddHandler pad.ShowPopupMenu, AddressOf Pad_ShowPopupMenu
AddHandler pad.ShowMiniToolbar, AddressOf Pad_ShowMiniToolbar
pad.Show()
InitNewDocument(pad.RTBMain)
End Sub
Private Sub Pad_Closed(ByVal sender As Object, ByVal e As EventArgs)
CloseFind()
End Sub
Private Sub Pad_ShowMiniToolbar(ByVal sender As Object, ByVal e As EventArgs)
If String.IsNullOrEmpty(CType(sender, RichTextBox).SelectedText) Then
Return
End If
ShowSelectionMiniToolbar()
End Sub
Private Sub Pad_ShowPopupMenu(ByVal sender As Object, ByVal e As EventArgs)
pmMain.RibbonToolbar = selectionMiniToolbar
pmMain.ShowPopup(Control.MousePosition)
End Sub
Private Sub ShowSelectionMiniToolbar()
Dim pt As Point = Control.MousePosition
pt.Offset(0, -11)
Me.selectionMiniToolbar.Alignment = ContentAlignment.TopRight
Me.selectionMiniToolbar.PopupMenu = Nothing
Me.selectionMiniToolbar.Show(pt)
End Sub
Private Sub CloseFind()
If Not dlgFind Is Nothing AndAlso Not dlgFind.RichText Is CurrentRichTextBox Then
dlgFind.Close()
dlgFind = Nothing
End If
If Not dlgReplace Is Nothing AndAlso Not dlgReplace.RichText Is CurrentRichTextBox Then
dlgReplace.Close()
dlgReplace = Nothing
End If
End Sub
Private Sub CreateColorPopup(ByVal container As PopupControlContainer)
cp = New ColorPopup(container, iFontColor, Me)
End Sub
#Region "Init"
Private Sub frmMain_Activated(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Activated
InitPaste()
End Sub
Public Sub UpdateText()
ribbonControl1.ApplicationCaption = "Ribbon Simple Pad"
If CurrentModified Then
ribbonControl1.ApplicationDocumentCaption = CurrentDocName + ("*")
Else
ribbonControl1.ApplicationDocumentCaption = CurrentDocName + ("")
End If
'Text = string.Format("Ribbon Simple Pad ({0})", CurrentDocName);
siDocName.Caption = String.Format(" {0}", CurrentDocName)
End Sub
Sub ChangeActiveForm()
UpdateText()
InitCurrentDocument(CurrentRichTextBox)
rtPad_SelectionChanged(CurrentRichTextBox, EventArgs.Empty)
CloseFind()
End Sub
Private Sub frmMain_MdiChildActivate(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.MdiChildActivate
ChangeActiveForm()
End Sub
Private Sub xtraTabbedMdiManager1_FloatMDIChildDeactivated(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles xtraTabbedMdiManager1.FloatMDIChildDeactivated
BeginInvoke(New MethodInvoker(AddressOf ChangeActiveForm))
End Sub
Private Sub rtPad_SelectionChanged(ByVal sender As Object, ByVal e As System.EventArgs)
ShowHideFormatCategory()
Dim rtPad As RichTextBox = TryCast(sender, RichTextBox)
InitFormat()
Dim line As Integer = 0, col As Integer = 0
If Not rtPad Is Nothing Then
InitEdit(rtPad.SelectionLength > 0)
line = rtPad.GetLineFromCharIndex(rtPad.SelectionStart) + 1
col = rtPad.SelectionStart + 1
Else
InitEdit(False)
End If
siPosition.Caption = String.Format(" Line: {0} Position: {1} ", line, col)
CurrentFontChanged()
End Sub
Private Sub rtPad_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs)
If CurrentForm Is Nothing Then
Return
End If
CurrentForm.Modified = True
InitCurrentDocument(CurrentRichTextBox)
End Sub
Protected Sub InitFormat()
iBold.Enabled = Not SelectFont Is Nothing
iItalic.Enabled = Not SelectFont Is Nothing
iUnderline.Enabled = Not SelectFont Is Nothing
iFont.Enabled = Not SelectFont Is Nothing
iFontColor.Enabled = Not SelectFont Is Nothing
If Not SelectFont Is Nothing Then
iBold.Down = SelectFont.Bold
iItalic.Down = SelectFont.Italic
iUnderline.Down = SelectFont.Underline
End If
Dim enabled As Boolean = Not CurrentRichTextBox Is Nothing
iProtected.Enabled = enabled
iBullets.Enabled = enabled
iAlignLeft.Enabled = enabled
iAlignRight.Enabled = enabled
iCenter.Enabled = enabled
rgbiFont.Enabled = enabled
rgbiFontColor.Enabled = enabled
ribbonPageGroup9.ShowCaptionButton = enabled
rpgFont.ShowCaptionButton = enabled
rpgFontColor.ShowCaptionButton = enabled
If (Not enabled) Then
ClearFormats()
End If
If Not CurrentRichTextBox Is Nothing Then
iProtected.Down = CurrentRichTextBox.SelectionProtected
iBullets.Down = CurrentRichTextBox.SelectionBullet
Select Case CurrentRichTextBox.SelectionAlignment
Case HorizontalAlignment.Left
iAlignLeft.Down = True
Case HorizontalAlignment.Center
iCenter.Down = True
Case HorizontalAlignment.Right
iAlignRight.Down = True
End Select
End If
End Sub
Private Sub ClearFormats()
iBold.Down = False
iItalic.Down = False
iUnderline.Down = False
iProtected.Down = False
iBullets.Down = False
iAlignLeft.Down = False
iAlignRight.Down = False
iCenter.Down = False
End Sub
Protected Sub InitPaste()
Dim enabledPase As Boolean = Not CurrentRichTextBox Is Nothing AndAlso CurrentRichTextBox.CanPaste(DataFormats.GetFormat(0))
iPaste.Enabled = enabledPase
sbiPaste.Enabled = enabledPase
End Sub
Private Sub InitUndo()
If Not CurrentRichTextBox Is Nothing Then
iUndo.Enabled = CurrentRichTextBox.CanUndo
Else
iUndo.Enabled = False
End If
iLargeUndo.Enabled = iUndo.Enabled
End Sub
Protected Sub InitEdit(ByVal enabled As Boolean)
iCut.Enabled = enabled
iCopy.Enabled = enabled
iClear.Enabled = enabled
If Not CurrentRichTextBox Is Nothing Then
iSelectAll.Enabled = CurrentRichTextBox.CanSelect
Else
iSelectAll.Enabled = False
End If
InitUndo()
End Sub
Private Sub InitNewDocument(ByVal rtbControl As RichTextBox)
AddHandler rtbControl.SelectionChanged, AddressOf rtPad_SelectionChanged
AddHandler rtbControl.TextChanged, AddressOf rtPad_TextChanged
End Sub
Private Sub InitCurrentDocument(ByVal rtbControl As RichTextBox)
Dim enabled As Boolean = Not rtbControl Is Nothing
iSaveAs.Enabled = enabled
iClose.Enabled = enabled
iPrint.Enabled = enabled
sbiSave.Enabled = enabled
sbiFind.Enabled = enabled
iFind.Enabled = enabled
iReplace.Enabled = enabled
iSave.Enabled = CurrentModified
SetModifiedCaption()
InitPaste()
InitFormat()
End Sub
Private Sub SetModifiedCaption()
If CurrentForm Is Nothing Then
siModified.Caption = ""
Return
End If
If CurrentModified Then
siModified.Caption = " Modified "
Else
siModified.Caption = ""
End If
End Sub
#End Region
#Region "Properties"
Private ReadOnly Property CurrentForm() As frmPad
Get
If Me.ActiveMdiChild Is Nothing Then
Return Nothing
End If
If Not xtraTabbedMdiManager1.ActiveFloatForm Is Nothing Then
Return TryCast(xtraTabbedMdiManager1.ActiveFloatForm, frmPad)
End If
Return TryCast(Me.ActiveMdiChild, frmPad)
End Get
End Property
Public ReadOnly Property CurrentRichTextBox() As RichTextBox
Get
If CurrentForm Is Nothing Then
Return Nothing
End If
Return CurrentForm.RTBMain
End Get
End Property
Private ReadOnly Property CurrentDocName() As String
Get
If CurrentForm Is Nothing Then
Return ""
End If
Return CurrentForm.DocName
End Get
End Property
Private ReadOnly Property CurrentModified() As Boolean
Get
If CurrentForm Is Nothing Then
Return False
End If
Return CurrentForm.Modified
End Get
End Property
#End Region
#Region "File"
Private Sub idNew_ItemClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.ItemClickEventArgs) Handles idNew.ItemClick, iNew.ItemClick
CreateNewDocument()
End Sub
Private Sub iClose_ItemClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.ItemClickEventArgs) Handles iClose.ItemClick
If Not CurrentForm Is Nothing Then
CurrentForm.Close()
End If
End Sub
Public Sub OpenFile()
Dim dlg As OpenFileDialog = New OpenFileDialog()
dlg.Filter = "Rich Text Files (*.rtf)|*.rtf"
dlg.Title = "Open"
If dlg.ShowDialog() = System.Windows.Forms.DialogResult.OK Then
OpenFile(dlg.FileName)
End If
End Sub
Public Sub OpenFile(ByVal name As String)
CreateNewDocument(name)
AddToMostRecentFiles(name, arMRUList)
AddToMostRecentFiles(name, recentItemsControl1.MRUFileList)
AddToMostRecentFolders(name, recentItemsControl1.MRUFolderList)
End Sub
Private Sub AddToMostRecentFiles(ByVal name As String, ByVal arMRUList As MRUArrayList)
arMRUList.InsertElement(name)
End Sub
Private Sub AddToMostRecentFolders(ByVal name As String, ByVal arMRUList As MRUArrayList)
name = Path.GetFullPath(name)
arMRUList.InsertElement(Path.GetDirectoryName(name))
End Sub
Private Sub iOpen_ItemClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.ItemClickEventArgs) Handles iOpen.ItemClick
OpenFile()
End Sub
Private Sub iPrint_ItemClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.ItemClickEventArgs) Handles iPrint.ItemClick
DevExpress.XtraEditors.XtraMessageBox.Show(Me, "Note that you can use the XtraPrinting Library to print the contents of the standard RichTextBox control." + vbNewLine + "For more information, see the main XtraPrinting demo.", Me.Text, MessageBoxButtons.OK, MessageBoxIcon.Information)
End Sub
Private Sub iSave_ItemClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.ItemClickEventArgs) Handles iSave.ItemClick
Save()
End Sub
Private Sub iSaveAs_ItemClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.ItemClickEventArgs) Handles iSaveAs.ItemClick
SaveAs()
End Sub
Private Sub Save()
If CurrentForm Is Nothing Then
Return
End If
If CurrentForm.NewDocument Then
SaveAs()
Else
CurrentRichTextBox.SaveFile(CurrentDocName, RichTextBoxStreamType.RichText)
CurrentForm.Modified = False
End If
SetModifiedCaption()
End Sub
Private Sub SaveAs()
If Not CurrentForm Is Nothing Then
Dim s As String = CurrentForm.SaveAs()
If s <> String.Empty Then
AddToMostRecentFiles(s, arMRUList)
AddToMostRecentFiles(s, recentItemsControl1.MRUFileList)
AddToMostRecentFolders(s, recentItemsControl1.MRUFolderList)
End If
UpdateText()
End If
End Sub
Private Sub iExit_ItemClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.ItemClickEventArgs) Handles iExit.ItemClick
Close()
End Sub
Private Sub frmMain_Closing(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles MyBase.Closing
End Sub
Private Sub ribbonPageGroup1_CaptionButtonClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.Ribbon.RibbonPageGroupEventArgs) Handles ribbonPageGroup1.CaptionButtonClick
OpenFile()
End Sub
Private Sub ribbonPageGroup9_CaptionButtonClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.Ribbon.RibbonPageGroupEventArgs) Handles ribbonPageGroup9.CaptionButtonClick
SaveAs()
End Sub
#End Region
#Region "Format"
Private Function rtPadFontStyle() As FontStyle
Dim fs As FontStyle = New FontStyle()
If iBold.Down Then
fs = fs Or FontStyle.Bold
End If
If iItalic.Down Then
fs = fs Or FontStyle.Italic
End If
If iUnderline.Down Then
fs = fs Or FontStyle.Underline
End If
Return fs
End Function
Private Sub iBullets_ItemClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.ItemClickEventArgs) Handles iBullets.ItemClick
If CurrentRichTextBox Is Nothing Then
Return
End If
CurrentRichTextBox.SelectionBullet = iBullets.Down
InitUndo()
End Sub
Private Sub iFontStyle_ItemClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.ItemClickEventArgs) Handles iBold.ItemClick, iItalic.ItemClick, iUnderline.ItemClick
If CurrentRichTextBox Is Nothing Then
Return
End If
CurrentRichTextBox.SelectionFont = New Font(SelectFont, rtPadFontStyle())
End Sub
Private Sub iProtected_ItemClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.ItemClickEventArgs) Handles iProtected.ItemClick
If CurrentRichTextBox Is Nothing Then
Return
End If
CurrentRichTextBox.SelectionProtected = iProtected.Down
End Sub
Private Sub iAlign_ItemClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.ItemClickEventArgs) Handles iCenter.ItemClick, iAlignLeft.ItemClick, iAlignRight.ItemClick
If CurrentRichTextBox Is Nothing Then
Return
End If
If iAlignLeft.Down Then
CurrentRichTextBox.SelectionAlignment = HorizontalAlignment.Left
End If
If iCenter.Down Then
CurrentRichTextBox.SelectionAlignment = HorizontalAlignment.Center
End If
If iAlignRight.Down Then
CurrentRichTextBox.SelectionAlignment = HorizontalAlignment.Right
End If
InitUndo()
End Sub
Protected ReadOnly Property SelectFont() As Font
Get
If Not CurrentRichTextBox Is Nothing Then
Return CurrentRichTextBox.SelectionFont
End If
Return Nothing
End Get
End Property
Private Sub ShowFontDialog()
If CurrentRichTextBox Is Nothing Then
Return
End If
Dim dialogFont As Font = Nothing
If Not SelectFont Is Nothing Then
dialogFont = CType(SelectFont.Clone(), Font)
Else
dialogFont = CurrentRichTextBox.Font
End If
Dim dlg As XtraFontDialog = New XtraFontDialog(dialogFont)
If dlg.ShowDialog() = System.Windows.Forms.DialogResult.OK Then
CurrentRichTextBox.SelectionFont = dlg.ResultFont
beiFontSize.EditValue = dlg.ResultFont.Size
End If
End Sub
Private Sub iFont_ItemClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.ItemClickEventArgs) Handles iFont.ItemClick
ShowFontDialog()
End Sub
Private Sub iFontColor_ItemClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.ItemClickEventArgs) Handles iFontColor.ItemClick
If CurrentRichTextBox Is Nothing Then
Return
End If
CurrentRichTextBox.SelectionColor = cp.ResultColor
End Sub
#End Region
#Region "Edit"
Private Sub iUndo_ItemClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.ItemClickEventArgs) Handles iUndo.ItemClick, iLargeUndo.ItemClick
If CurrentRichTextBox Is Nothing Then
Return
End If
CurrentRichTextBox.Undo()
CurrentForm.Modified = CurrentRichTextBox.CanUndo
SetModifiedCaption()
InitUndo()
InitFormat()
End Sub
Private Sub iCut_ItemClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.ItemClickEventArgs) Handles iCut.ItemClick
If CurrentRichTextBox Is Nothing Then
Return
End If
CurrentRichTextBox.Cut()
InitPaste()
End Sub
Private Sub iCopy_ItemClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.ItemClickEventArgs) Handles iCopy.ItemClick
If CurrentRichTextBox Is Nothing Then
Return
End If
CurrentRichTextBox.Copy()
InitPaste()
End Sub
Private Sub iPaste_ItemClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.ItemClickEventArgs) Handles iPaste.ItemClick
If CurrentRichTextBox Is Nothing Then
Return
End If
CurrentRichTextBox.Paste()
End Sub
Private Sub iClear_ItemClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.ItemClickEventArgs) Handles iClear.ItemClick
If CurrentRichTextBox Is Nothing Then
Return
End If
CurrentRichTextBox.SelectedRtf = ""
End Sub
Private Sub iSelectAll_ItemClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.ItemClickEventArgs) Handles iSelectAll.ItemClick
If CurrentRichTextBox Is Nothing Then
Return
End If
CurrentRichTextBox.SelectAll()
End Sub
Private Sub ribbonPageGroup2_CaptionButtonClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.Ribbon.RibbonPageGroupEventArgs) Handles ribbonPageGroup2.CaptionButtonClick
pmMain.ShowPopup(ribbonControl1.Manager, MousePosition)
End Sub
#End Region
#Region "SkinGallery"
Private Sub InitSkinGallery()
DevExpress.XtraBars.Helpers.SkinHelper.InitSkinGallery(rgbiSkins, True)
End Sub
#End Region
#Region "FontGallery"
Private Function GetFontImage(ByVal width As Integer, ByVal height As Integer, ByVal fontName As String, ByVal fontSize As Integer) As Image
Dim rect As Rectangle = New Rectangle(0, 0, width, height)
Dim fontImage As Image = New Bitmap(width, height)
Try
Using fontSample As Font = New Font(fontName, fontSize)
Dim g As Graphics = Graphics.FromImage(fontImage)
g.FillRectangle(Brushes.White, rect)
Using fs As StringFormat = New StringFormat()
fs.Alignment = StringAlignment.Center
fs.LineAlignment = StringAlignment.Center
g.TextRenderingHint = System.Drawing.Text.TextRenderingHint.AntiAlias
g.DrawString("Aa", fontSample, Brushes.Black, rect, fs)
g.Dispose()
End Using
End Using
Catch
End Try
Return fontImage
End Function
Private Sub InitFont(ByVal groupDropDown As GalleryItemGroup, ByVal galleryGroup As GalleryItemGroup)
Dim fonts() As FontFamily = FontFamily.Families
For i As Integer = 0 To fonts.Length - 1
If (Not FontFamily.Families(i).IsStyleAvailable(FontStyle.Regular)) Then
Continue For
End If
Dim fontName As String = fonts(i).Name
Dim item As New GalleryItem()
item.Caption = fontName
item.Image = GetFontImage(32, 28, fontName, 12)
item.HoverImage = item.Image
item.Description = fontName
item.Hint = fontName
Try
item.Tag = New Font(fontName, 9)
If DevExpress.Utils.ControlUtils.IsSymbolFont(CType(item.Tag, Font)) Then
item.Tag = New Font(DevExpress.Utils.AppearanceObject.DefaultFont.FontFamily, 9)
item.Description &= " (Symbol Font)"
End If
Catch
Continue For
End Try
groupDropDown.Items.Add(item)
galleryGroup.Items.Add(item)
Next i
End Sub
Private Sub InitFontGallery()
InitFont(gddFont.Gallery.Groups(0), rgbiFont.Gallery.Groups(0))
beiFontSize.EditValue = 8
End Sub
Private Sub SetFont(ByVal fontName As String, ByVal item As GalleryItem)
If CurrentRichTextBox Is Nothing Then
Return
End If
CurrentRichTextBox.SelectionFont = New Font(fontName, Convert.ToInt32(beiFontSize.EditValue), rtPadFontStyle())
If Not item Is Nothing Then
CurrentFontItem = item
End If
End Sub
Private Sub gddFont_Gallery_ItemClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.Ribbon.GalleryItemClickEventArgs) Handles gddFont.GalleryItemClick
SetFont(e.Item.Caption, e.Item)
End Sub
Private Sub rpgFont_CaptionButtonClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.Ribbon.RibbonPageGroupEventArgs) Handles rpgFont.CaptionButtonClick
ShowFontDialog()
End Sub
Private Sub rgbiFont_Gallery_ItemClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.Ribbon.GalleryItemClickEventArgs) Handles rgbiFont.Gallery.ItemClick
SetFont(e.Item.Caption, e.Item)
End Sub
Private Sub gddFont_Gallery_CustomDrawItemText(ByVal sender As Object, ByVal e As GalleryItemCustomDrawEventArgs) Handles gddFont.GalleryCustomDrawItemText
Dim itemInfo As DevExpress.XtraBars.Ribbon.ViewInfo.GalleryItemViewInfo = TryCast(e.ItemInfo, DevExpress.XtraBars.Ribbon.ViewInfo.GalleryItemViewInfo)
itemInfo.PaintAppearance.ItemDescriptionAppearance.Normal.DrawString(e.Cache, e.Item.Description, itemInfo.DescriptionBounds)
Dim app As AppearanceObject = TryCast(itemInfo.PaintAppearance.ItemCaptionAppearance.Normal.Clone(), AppearanceObject)
app.Font = CType(e.Item.Tag, Font)
Try
e.Cache.Graphics.DrawString(e.Item.Caption, app.Font, app.GetForeBrush(e.Cache), itemInfo.CaptionBounds)
Catch
End Try
e.Handled = True
End Sub
#End Region
#Region "ColorGallery"
Private Sub InitColorGallery()
gddFontColor.BeginUpdate()
For Each color As Color In DevExpress.XtraEditors.Popup.ColorListBoxViewInfo.WebColors
If color = System.Drawing.Color.Transparent Then
Continue For
End If
Dim item As GalleryItem = New GalleryItem()
item.Caption = color.Name
item.Tag = color
item.Hint = color.Name
gddFontColor.Gallery.Groups(0).Items.Add(item)
rgbiFontColor.Gallery.Groups(0).Items.Add(item)
Next color
For Each color As Color In DevExpress.XtraEditors.Popup.ColorListBoxViewInfo.SystemColors
Dim item As GalleryItem = New GalleryItem()
item.Caption = color.Name
item.Tag = color
gddFontColor.Gallery.Groups(1).Items.Add(item)
Next color
gddFontColor.EndUpdate()
End Sub
Private Sub gddFontColor_Gallery_CustomDrawItemImage(ByVal sender As Object, ByVal e As GalleryItemCustomDrawEventArgs) Handles rgbiFontColor.Gallery.CustomDrawItemImage, gddFontColor.GalleryCustomDrawItemImage
Dim clr As Color = CType(e.Item.Tag, Color)
Using brush As Brush = New SolidBrush(clr)
e.Cache.FillRectangle(brush, e.Bounds)
e.Handled = True
End Using
End Sub
Private Sub SetResultColor(ByVal color As Color, ByVal item As GalleryItem)
If CurrentRichTextBox Is Nothing Then
Return
End If
cp.ResultColor = color
CurrentRichTextBox.SelectionColor = cp.ResultColor
If Not item Is Nothing Then
CurrentColorItem = item
End If
End Sub
Private Sub gddFontColor_Gallery_ItemClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.Ribbon.GalleryItemClickEventArgs) Handles gddFontColor.GalleryItemClick
SetResultColor(CType(e.Item.Tag, Color), e.Item)
End Sub
Private Sub rpgFontColor_CaptionButtonClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.Ribbon.RibbonPageGroupEventArgs) Handles rpgFontColor.CaptionButtonClick
If CurrentRichTextBox Is Nothing Then
Return
End If
If cp Is Nothing Then
CreateColorPopup(popupControlContainer1)
End If
popupControlContainer1.ShowPopup(ribbonControl1.Manager, MousePosition)
End Sub
Private Sub rgbiFontColor_Gallery_ItemClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.Ribbon.GalleryItemClickEventArgs) Handles rgbiFontColor.Gallery.ItemClick
SetResultColor(CType(e.Item.Tag, Color), e.Item)
End Sub
#End Region
Private Sub iFind_ItemClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.ItemClickEventArgs) Handles iFind.ItemClick
If CurrentRichTextBox Is Nothing Then
Return
End If
If Not dlgReplace Is Nothing Then
dlgReplace.Close()
End If
If Not dlgFind Is Nothing Then
dlgFind.Close()
End If
dlgFind = New frmFind(CurrentRichTextBox, Bounds)
AddOwnedForm(dlgFind)
dlgFind.Show()
End Sub
Private Sub iReplace_ItemClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.ItemClickEventArgs) Handles iReplace.ItemClick
If CurrentRichTextBox Is Nothing Then
Return
End If
If Not dlgReplace Is Nothing Then
dlgReplace.Close()
End If
If Not dlgFind Is Nothing Then
dlgFind.Close()
End If
dlgReplace = New frmReplace(CurrentRichTextBox, Bounds)
AddOwnedForm(dlgReplace)
dlgReplace.Show()
End Sub
Private Sub iWeb_ItemClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.ItemClickEventArgs) Handles iWeb.ItemClick
Dim process As Process = New Process()
process.StartInfo.FileName = "http://www.devexpress.com"
process.StartInfo.Verb = "Open"
process.StartInfo.WindowStyle = ProcessWindowStyle.Normal
process.Start()
End Sub
Private Sub iAbout_ItemClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.ItemClickEventArgs) Handles iAbout.ItemClick
DevExpress.Utils.About.AboutForm.Show(New DevExpress.Utils.About.ProductInfo(String.Empty, GetType(frmMain), DevExpress.Utils.About.ProductKind.DXperienceWin, DevExpress.Utils.About.ProductInfoStage.Registered))
End Sub
Private Function TextByCaption(ByVal caption As String) As String
Return caption.Replace("&", "")
End Function
Private Sub frmMain_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Load
arMRUList = New MRUArrayList(pcAppMenuFileLabels, imageCollection3.Images(0), imageCollection3.Images(1))
AddHandler arMRUList.LabelClicked, AddressOf OnMRUFileLabelClicked
InitMostRecentFiles(arMRUList)
InitMostRecentFiles(recentItemsControl1.MRUFileList)
ribbonControl1.ForceInitialize()
Dim skins As New GalleryDropDown()
skins.Ribbon = ribbonControl1
DevExpress.XtraBars.Helpers.SkinHelper.InitSkinGalleryDropDown(skins)
iPaintStyle.DropDownControl = skins
CreateNewDocument()
BarEditItem1.EditValue = CType(DevExpress.Utils.ResourceImageHelper.CreateImageFromResources("online.gif", GetType(frmMain).Assembly), Bitmap)
End Sub
#Region "GalleryItemsChecked"
Private Function GetColorItemByColor(ByVal color As Color, ByVal gallery As BaseGallery) As GalleryItem
For Each galleryGroup As GalleryItemGroup In gallery.Groups
For Each item As GalleryItem In galleryGroup.Items
If item.Caption = color.Name Then
Return item
End If
Next item
Next galleryGroup
Return Nothing
End Function
Private Function GetFontItemByFont(ByVal fontName As String, ByVal gallery As BaseGallery) As GalleryItem
For Each galleryGroup As GalleryItemGroup In gallery.Groups
For Each item As GalleryItem In galleryGroup.Items
If item.Caption = fontName Then
Return item
End If
Next item
Next galleryGroup
Return Nothing
End Function
Private Property CurrentFontItem() As GalleryItem
Get
Return fCurrentFontItem
End Get
Set(ByVal value As GalleryItem)
If fCurrentFontItem Is value Then
Return
End If
If Not fCurrentFontItem Is Nothing Then
fCurrentFontItem.Checked = False
End If
fCurrentFontItem = value
If Not fCurrentFontItem Is Nothing Then
fCurrentFontItem.Checked = True
MakeFontVisible(fCurrentFontItem)
End If
End Set
End Property
Private Sub MakeFontVisible(ByVal item As GalleryItem)
gddFont.Gallery.MakeVisible(fCurrentFontItem)
rgbiFont.Gallery.MakeVisible(fCurrentFontItem)
End Sub
Private Property CurrentColorItem() As GalleryItem
Get
Return fCurrentColorItem
End Get
Set(ByVal value As GalleryItem)
If fCurrentColorItem Is value Then
Return
End If
If Not fCurrentColorItem Is Nothing Then
fCurrentColorItem.Checked = False
End If
fCurrentColorItem = value
If Not fCurrentColorItem Is Nothing Then
fCurrentColorItem.Checked = True
MakeColorVisible(fCurrentColorItem)
End If
End Set
End Property
Private Sub MakeColorVisible(ByVal item As GalleryItem)
gddFontColor.Gallery.MakeVisible(fCurrentColorItem)
rgbiFontColor.Gallery.MakeVisible(fCurrentColorItem)
End Sub
Private Sub CurrentFontChanged()
If CurrentRichTextBox Is Nothing OrElse CurrentRichTextBox.SelectionFont Is Nothing Then
Return
End If
CurrentFontItem = GetFontItemByFont(CurrentRichTextBox.SelectionFont.Name, rgbiFont.Gallery)
CurrentColorItem = GetColorItemByColor(CurrentRichTextBox.SelectionColor, rgbiFontColor.Gallery)
End Sub
Private Sub gddFont_Popup(ByVal sender As Object, ByVal e As System.EventArgs) Handles gddFont.Popup
MakeFontVisible(CurrentFontItem)
If CurrentRichTextBox Is Nothing Then Return
beiFontSize.EditValue = CurrentRichTextBox.SelectionFont.Size
End Sub
Private Sub gddFontColor_Popup(ByVal sender As Object, ByVal e As System.EventArgs) Handles gddFontColor.Popup
MakeColorVisible(CurrentColorItem)
End Sub
#End Region
#Region "MostRecentFiles"
Private arMRUList As MRUArrayList = Nothing
Private Sub frmMain_FormClosing(ByVal sender As Object, ByVal e As FormClosingEventArgs) Handles MyBase.FormClosing
SaveMostRecentFiles(arMRUList, Application.StartupPath & "\" & MRUArrayList.MRUFileName)
SaveMostRecentFiles(recentItemsControl1.MRUFolderList, Application.StartupPath & "\" & MRUArrayList.MRUFolderName)
End Sub
Private Sub InitMostRecentFiles(ByVal arList As MRUArrayList)
Dim fileName As String = Application.StartupPath & "\" & MRUArrayList.MRUFileName
Dim folderName As String = Application.StartupPath & "\" & MRUArrayList.MRUFolderName
arMRUList.Init(fileName, "Document1.rtf")
recentItemsControl1.MRUFileList.Init(fileName, "Document1.rtf")
recentItemsControl1.MRUFolderList.Init(folderName, Application.StartupPath)
End Sub
Private Sub SaveMostRecentFiles(ByVal arList As MRUArrayList, ByVal fileName As String)
Try
Dim sw As System.IO.StreamWriter = System.IO.File.CreateText(fileName)
For i As Integer = arList.Count - 1 To 0 Step -1
sw.WriteLine(String.Format("{0},{1}", arList(i).ToString(), arList.GetLabelChecked(arList(i).ToString())))
Next i
sw.Close()
Catch
End Try
End Sub
Private Sub OnMRUFileLabelClicked(ByVal sender As Object, ByVal e As EventArgs)
pmAppMain.HidePopup()
Me.Refresh()
OpenFile(sender.ToString())
End Sub
#End Region
Private Sub BarEditItem1_ItemPress(ByVal sender As System.Object, ByVal e As DevExpress.XtraBars.ItemClickEventArgs) Handles BarEditItem1.ItemPress
System.Diagnostics.Process.Start("http://www.devexpress.com")
End Sub
Private Sub xtraTabbedMdiManager1_FloatMDIChildActivated(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles xtraTabbedMdiManager1.FloatMDIChildActivated
ChangeActiveForm()
End Sub
Private Sub biStyle_EditValueChanged(ByVal sender As Object, ByVal e As EventArgs) Handles biStyle.EditValueChanged
Dim style As RibbonControlStyle = CType(biStyle.EditValue, RibbonControlStyle)
ribbonControl1.RibbonStyle = style
If style = RibbonControlStyle.Office2010 OrElse style = RibbonControlStyle.MacOffice OrElse style = RibbonControlStyle.Office2013 Then
ribbonControl1.ApplicationButtonDropDownControl = Me.backstageViewControl1
Else
ribbonControl1.ApplicationButtonDropDownControl = pmAppMain
End If
UpdateSchemeCombo()
UpdateLookAndFeel()
End Sub
Private Sub UpdateLookAndFeel()
Dim skinName As String
Dim style As RibbonControlStyle = ribbonControl1.RibbonStyle
Select Case style
Case RibbonControlStyle.Default, RibbonControlStyle.Office2007
skinName = "Office 2007 Blue"
Case RibbonControlStyle.Office2013
skinName = "Office 2013"
Case Else
skinName = "Office 2010 Blue"
End Select
UserLookAndFeel.Default.SetSkinStyle(skinName)
End Sub
Private Sub UpdateSchemeCombo()
If ribbonControl1.RibbonStyle = RibbonControlStyle.MacOffice OrElse ribbonControl1.RibbonStyle = RibbonControlStyle.Office2010 OrElse ribbonControl1.RibbonStyle = RibbonControlStyle.Office2013 Then
If UserLookAndFeel.Default.ActiveSkinName.Contains("Office 2010") Then
beScheme.Visibility = BarItemVisibility.Always
Else
beScheme.Visibility = BarItemVisibility.Never
End If
Else
beScheme.Visibility = BarItemVisibility.Never
End If
End Sub
Private Sub sbExit_Click(ByVal sender As Object, ByVal e As EventArgs) Handles sbExit.Click
Me.Close()
End Sub
Private Sub beiFontSize_EditValueChanged(ByVal sender As Object, ByVal e As EventArgs) Handles beiFontSize.EditValueChanged
If CurrentRichTextBox Is Nothing Then
Return
End If
CurrentRichTextBox.SelectionFont = New Font(CurrentRichTextBox.SelectionFont.FontFamily, Convert.ToSingle(beiFontSize.EditValue), CurrentRichTextBox.SelectionFont.Style)
End Sub
Private Sub bvTabPrint_SelectedChanged(ByVal sender As Object, ByVal e As BackstageViewItemEventArgs) Handles bvTabPrint.SelectedChanged
If e.Item.Equals(bvTabPrint) Then
If CurrentRichTextBox IsNot Nothing Then
Me.printControl1.RtfText = CurrentRichTextBox.Rtf
Else
Me.printControl1.RtfText = ""
End If
End If
End Sub
Private Sub ribbonControl1_BeforeApplicationButtonContentControlShow(ByVal sender As Object, ByVal e As EventArgs) Handles ribbonControl1.BeforeApplicationButtonContentControlShow
If CurrentRichTextBox Is Nothing Then
Me.printControl1.RtfText = ""
Else
Me.printControl1.RtfText = CurrentRichTextBox.Rtf
End If
If CurrentRichTextBox Is Nothing Then
Me.exportControl1.RtfText = ""
Else
Me.exportControl1.RtfText = CurrentRichTextBox.Rtf
End If
End Sub
Private Sub bvItemSave_ItemClick(ByVal sender As Object, ByVal e As BackstageViewItemEventArgs) Handles bvItemSave.ItemClick
Save()
End Sub
Private Sub bvItemSaveAs_ItemClick(ByVal sender As Object, ByVal e As BackstageViewItemEventArgs) Handles bvItemSaveAs.ItemClick
SaveAs()
End Sub
Private Sub bvItemOpen_ItemClick(ByVal sender As Object, ByVal e As BackstageViewItemEventArgs) Handles bvItemOpen.ItemClick
OpenFile()
End Sub
Private Sub bvItemClose_ItemClick(ByVal sender As Object, ByVal e As BackstageViewItemEventArgs) Handles bvItemClose.ItemClick
If xtraTabbedMdiManager1.SelectedPage IsNot Nothing Then
xtraTabbedMdiManager1.SelectedPage.MdiChild.Close()
End If
End Sub
Private Sub bvItemExit_ItemClick(ByVal sender As Object, ByVal e As BackstageViewItemEventArgs) Handles bvItemExit.ItemClick
Close()
End Sub
Private Sub beScheme_EditValueChanged(ByVal sender As Object, ByVal e As EventArgs) Handles beScheme.EditValueChanged
ribbonControl1.ColorScheme = (CType(beScheme.EditValue, RibbonControlColorScheme))
End Sub
Private Sub ribbonControl1_ResetLayout(ByVal sender As System.Object, ByVal e As DevExpress.XtraBars.Ribbon.ResetLayoutEventArgs) Handles ribbonControl1.ResetLayout
ShowHideFormatCategory()
End Sub
End Class
End Namespace