Mini Kabibi Habibi

Current Path : C:/Users/Public/Documents/DXperience 13.1 Demos/WinForms/VB/BarTutorials/Gallery/
Upload File :
Current File : C:/Users/Public/Documents/DXperience 13.1 Demos/WinForms/VB/BarTutorials/Gallery/Gallery.vb

Imports Microsoft.VisualBasic
Imports System
Imports System.Collections
Imports System.ComponentModel
Imports System.Drawing
Imports System.Data
Imports System.Windows.Forms
Imports DevExpress.XtraBars.Ribbon
Imports DevExpress.Utils

Namespace DevExpress.XtraBars.Demos.Tutorials
	''' <summary>
	''' Summary description for Gallery.
	''' </summary>
	Public Partial Class Gallery
		Inherits TutorialControl
		Public Sub New()
			' This call is required by the Windows.Forms Form Designer.
			InitializeComponent()
			' TODO: Add any initialization after the InitForm call

		End Sub
		Private initValues As Boolean = False
		Private fCurrentFont As GalleryItem
		Private Sub Gallery_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Load
			InitFont(gddFont.Gallery.Groups(0), rgbiFont.Gallery.Groups(0))
			For i As Integer = 8 To 50 Step 2
				repositoryItemComboBox1.Items.Add(i)
			Next i
			InitFontValues()
		End Sub
        Public Overrides ReadOnly Property SetNewWhatsThisPadding() As Boolean
            Get
                Return True
            End Get
        End Property
		Private Sub InitFontValues()
			initValues = True
			For Each item As GalleryItem In rgbiFont.Gallery.Groups(0).Items
				If item.Caption = labelControl1.Font.Name Then
				CurrentFont = item
				End If
			Next item
			beiFontSize.EditValue = CInt(Fix(labelControl1.Font.Size))
			biBold.Down = labelControl1.Font.Bold
			biItalic.Down = labelControl1.Font.Italic
			biUnderline.Down = labelControl1.Font.Underline
			initValues = False
		End Sub

		Private ReadOnly Property CurrentFontStyle() As FontStyle
			Get
				Dim fs As FontStyle = New FontStyle()
				If biBold.Down Then
				fs = fs Or FontStyle.Bold
				End If
				If biItalic.Down Then
				fs = fs Or FontStyle.Italic
				End If
				If biUnderline.Down Then
				fs = fs Or FontStyle.Underline
				End If
				Return fs
			End Get
		End Property

		'<ribbonControl1>
		Private Sub InitFont(ByVal groupDropDown As GalleryItemGroup, ByVal galleryGroup As GalleryItemGroup)
			Dim i As Integer = 0
			Do While i < FontFamily.Families.Length
				Dim fontName As String = FontFamily.Families(i).Name
				Dim item As GalleryItem = 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
					i += 1
					Continue Do
				End Try
				groupDropDown.Items.Add(item)
				galleryGroup.Items.Add(item)
				i += 1
			Loop
		End Sub
		'</ribbonControl1>

		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 gddFont_Gallery_CustomDrawItemText(ByVal sender As Object, ByVal e As DevExpress.XtraBars.Ribbon.GalleryItemCustomDrawEventArgs) Handles gddFont.Gallery.CustomDrawItemText
			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

		Private Sub rgbiFont_Gallery_ItemClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.Ribbon.GalleryItemClickEventArgs) Handles rgbiFont.Gallery.ItemClick
			SetFont(e.Item)
		End Sub

		Private Sub gddFont_Gallery_ItemClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.Ribbon.GalleryItemClickEventArgs) Handles gddFont.Gallery.ItemClick
			SetFont(e.Item)
		End Sub


		Private Property CurrentFont() As GalleryItem
			Get
				Return fCurrentFont
			End Get
			Set
				If CurrentFont Is Value Then
				Return
				End If
				If Not CurrentFont Is Nothing Then
				CurrentFont.Checked = False
				End If
				fCurrentFont = Value
				If Not CurrentFont Is Nothing Then
					CurrentFont.Checked = True
					SetMakeVisible()
				End If
			End Set
		End Property
		Private Sub SetFont(ByVal item As GalleryItem)
			If initValues Then
			Return
			End If
			If Not item Is Nothing Then
				CurrentFont = item
			End If
			If CurrentFont Is Nothing Then
			Return
			End If
			labelControl1.Font = New Font(CurrentFont.Caption, Convert.ToInt32(beiFontSize.EditValue), CurrentFontStyle)
		End Sub

		Private Sub beiFontSize_EditValueChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles beiFontSize.EditValueChanged
			SetFont(Nothing)
		End Sub

		Private Sub bi_DownChanged(ByVal sender As Object, ByVal e As DevExpress.XtraBars.ItemClickEventArgs) Handles biBold.DownChanged, biItalic.DownChanged, biUnderline.DownChanged
			SetFont(Nothing)
		End Sub

		Private Sub rpgFont_CaptionButtonClick(ByVal sender As Object, ByVal e As DevExpress.XtraBars.Ribbon.RibbonPageGroupEventArgs) Handles rpgFont.CaptionButtonClick
			Dim dlg As DevExpress.Tutorials.Controls.XtraFontDialog = New DevExpress.Tutorials.Controls.XtraFontDialog(labelControl1.Font)
			If dlg.ShowDialog() = System.Windows.Forms.DialogResult.OK Then
				labelControl1.Font = dlg.ResultFont
				InitFontValues()
			End If
		End Sub

		Private Sub gddFont_Popup(ByVal sender As Object, ByVal e As System.EventArgs) Handles gddFont.Popup
			SetMakeVisible()
		End Sub

		Private Sub SetMakeVisible()
			If CurrentFont Is Nothing Then
			Return
			End If
			gddFont.Gallery.MakeVisible(CurrentFont)
			rgbiFont.Gallery.MakeVisible(CurrentFont)
		End Sub
	End Class
End Namespace