Форум программистов, компьютерный форум, киберфорум
Наши страницы

Visual Basic .NET

Войти
Регистрация
Восстановить пароль
 
 
Рейтинг: Рейтинг темы: голосов - 8, средняя оценка - 5.00
Памирыч
Почетный модератор
20610 / 8650 / 1029
Регистрация: 11.04.2010
Сообщений: 11,008
#1

Visual Basic .NET FAQ. Готовые решения, полезные коды - Visual Basic .NET

18.08.2011, 22:44. Просмотров 245921. Ответов 194
Метки faq (Все метки)

Предлагаю в этой теме размещать ответы на часто задаваемые вопросы и просто делиться полезными кодами.
Обращаю внимание на некоторые моменты, которые являются дополнением к основным правилам
  1. Запрещается копировать материалы с других сайтов или форумов
  2. Решения должны быть написаны с использованием языка Visual Basic .NET
  3. Запрещено создавать посты с уточнениями и замечаниями. Такие вопросы задавайте на форуме
  4. Код, в котором присутствуют комментарии, читается и понимается намного легче и быстрее
  5. Длинные коды и объемные вопросы одного содержания заключайте в теги [SPОILER]Большой код[/SPОILER]
  6. При создании поста убедитесь, что этот вопрос не был освещен ранее
  7. Код должен быть написан грамотно, большие и неэффективные коды будут удаляться
  8. Список вопросов по конкретной теме нельзя "разрывать" на 2 и более поста

Просьба к постившим: не спешите постить решения "сгоряча", тщательно обдумайте список вопросов, их тематику и порядок
Если вы найдете информацию, которой можно было бы дополнить ваши предыдущие сообщения, что-то изменить или перегруппировать, пишите в л/с.


Примечание: некоторые коды приведены без учета строгой типизации (Параметр Strict), поэтому для их использования необходимо выполнить приведение типов
47
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
18.08.2011, 22:44
Здравствуйте! Я подобрал для вас темы с ответами на вопрос Visual Basic .NET FAQ. Готовые решения, полезные коды (Visual Basic .NET):

Visual Basic .Net и Visual Basic 6.0 - В чём разница - Visual Basic .NET
В общем возник вопрос: Visual Bisic.Net и Visual Basic - это два разных языка, или же .NET версия это лишь его улучшение. Я так понимаю что...

Visual Basic.Net и Visual Studio 2013 - в чем разница? - Visual Basic .NET
Visual Basic.Net и Visual Studio 2013 - в чем разница? Или это одно и тоже, просто называются по другому. Планирую перейти с VB6.0...

Visual Basic .NET vs Visual FoxPro 9.0 в рамках задач реляционной модели данных - Visual Basic .NET
Очень хочется обсудить следующую тему. Поставлена задача - написать некоторую программу обработки данных. Все данные, обрабатываемые...

Исходники на Visual Basic .NET - Visual Basic .NET
Кто-то читает книжки. Кто-то ищет информацию в Google... А кто-то набирается знаний, разбирая чужие исходники. В этой теме предлагается...

Литература и ресурсы по Visual Basic .NET - Visual Basic .NET
Литература по Visual Basic.NET 1. Виктор Зиборов "Visual Basic 2010 на примерах" Издательство: БХВ-Петербург Год издания: 2010...

Хорошие учебники по Visual Basic Net - Visual Basic .NET
Подскажите пожалуйста хорошие учебники по visual basic net,спасибо

194
Памирыч
Почетный модератор
20610 / 8650 / 1029
Регистрация: 11.04.2010
Сообщений: 11,008
06.12.2011, 22:20  [ТС] #16
Как написать простейший сервис (Службу Windows)
Наша служба будет предельно простой. В ее задачу будет входить лишь ведение бесполезного лога в файл.

Вся задача сводится к двум моментам:
  1. Непосредственно написание программы
  2. Установка и удаление службы

Чтобы приступить к написанию программного кода, необходимо выбрать соответствующий шаблон в составе Visual Studio (рис. 1)
Visual Basic .NET FAQ. Готовые решения, полезные коды

Предполагается, что у нашего сервиса не будет визуального интерфейса.
Нам понадобится таймер, но не тот, что мы привыкли использовать в WinForms
На рис. 2 показан этот таймер в момент его выбора и размещения на панели инструментов.
Visual Basic .NET FAQ. Готовые решения, полезные коды

Добавляем его в проект привычным двойным щелчком (рис. 3)
Visual Basic .NET FAQ. Готовые решения, полезные коды
Настраиваем его свойства, в частности, интервал, пусть это будет 1 секунда. Активность таймера выставлять не будем, пусть за нас это сделает сам сервис.

В редакторе кода код будет выглядеть следующим образом:
vb.net
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Public Class Service1
 
    Protected Overrides Sub OnStart(ByVal args() As String)
        ' Добавьте здесь код запуска службы. Этот метод должен настроить все необходимое
        ' для успешной работы службы.
        Timer1.Start() 'Запускаем таймер
    End Sub
 
    Protected Overrides Sub OnStop()
        ' Добавьте здесь код для завершающих операций перед остановкой службы.
    End Sub
 
    Private Sub Timer1_Elapsed(ByVal sender As System.Object, ByVal e As System.Timers.ElapsedEventArgs) Handles Timer1.Elapsed
        My.Computer.FileSystem.WriteAllText("C:\LOG.txt", "Сообщение сервиса в " & Now.ToLongTimeString & ": Успешно" & vbCrLf, True)
    End Sub
End Class
Вот, пожалуй, и все, что необходимо.
По желанию можно зайти в свойства проекта и настроить его.

Компилируем сервис как обычно - Меню - Построение - Построить <Имя Вашего сервиса>
После этого в папке Release появится исполняемый файл. Здесь же отмечу, что такие файлы двойным щелчком не запускаются и так же по F5;
В этом случае VS пояснит, что служба не может быть запущена непосредственно из-под отладчика.

Как бы там ни было, файл готов. И мы хотим видеть его работу.
Чтобы это сделать, нам придется установить сервис в систему. Для этого воспользуемся одним из методов.
Создадим Bat-файл в той же директории, что и сам файл сервиса.
Содержание файла:
Код
set current_dir=%~dp0
sc create MyTestService binPath= "%current_dir%WindowsService1.exe" start= "auto"
sc start MyTestService
pause
Второй строкой мы устанавливаем службу с параметром автозапуска "Автоматический"
Третьей строкой запускаем службу.
Результат показан на рис. 4
Visual Basic .NET FAQ. Готовые решения, полезные коды
Достаточно простой установки, а настройку можно произвести в:
Панель управления - Администрирование - Службы


Сразу же замечу, что в такой службе не будет визуализации, даже MsgBox

Написанное ниже применимо к ОС Windows XP.
Чтобы сообщения были видны пользователю, нужно, чтобы служба работала в интерактивном режиме.
Для этого в настройках службы (Панель управления - Администрирование - Службы) нужно поставить флаг "Разрешить взаимодействие с рабочим столом"

Либо установить службу немного иначе:
Код
set current_dir=%~dp0
sc create MyTestService binPath= "%current_dir%WindowsService1.exe" type= interact type= own
sc start MyTestService
pause
После всех экспериментов не забывайте удалить службу:
Код
sc delete MyTestService
20
prog13
Ефрейтор
173 / 144 / 6
Регистрация: 20.07.2009
Сообщений: 226
09.12.2011, 11:59 #17
как очень легко изменить цвет заголовка столбцов (ColumnHeaders) в DataGridView, без использование описания стилей
vb.net
1
DataGridView2.ColumnHeadersDefaultCellStyle.SelectionBackColor = Color.Blue
очень важно
к этому коду нужно установить свойство грида
EnableHeadersVisualStyles = False


програмно изменить шрифт в DataGridView
vb.net
1
2
3
4
5
6
Dim Font1 As New Font_(GridView.DefaultCellStyle.Font.FontFamily, 8)
Try
 GridView.DefaultCellStyle.Font = Font1
Finally
 Font1.Dispose()
End Try


програмно изменить шрифт в DataGridView конкретного столбца
vb.net
1
2
3
4
5
6
Dim Font2 As New Font(GridView.DefaultCellStyle.Font.FontFamily, 10, FontStyle.Underline)
Try
 GridView.Columns("Наименование").DefaultCellStyle.Font = Font2
Finally
 Font2.Dispose()
End Try
5
Памирыч
Почетный модератор
20610 / 8650 / 1029
Регистрация: 11.04.2010
Сообщений: 11,008
11.12.2011, 02:34  [ТС] #18
Сохранение в файл классов, коллекций и структур

Разберем это на примере коллекции классов, т.к. принцип применим и к классам в отдельности, и структурам.

Для демонстрации напишем простой класс с двумя свойствами, тип Integer и тип String. Разумеется, в классе могут быть и методы, и события, и коллекции и другие классы, и все, что угодно.
Листинг класса:
vb.net
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
<System.Serializable()> Public Class Test 'Класс должен быть сериализуемым
    Dim Str As String
    Dim Int As Integer
 
    Property MyStr() As String
        Get
            Return Str
        End Get
        Set(ByVal value As String)
            Str = value
        End Set
    End Property
 
    Property MyInt() As Integer
        Get
            Return Int
        End Get
        Set(ByVal value As Integer)
            Int = value
        End Set
    End Property
 
    Public Overrides Function ToString() As String
        Return String.Format("Str = {0}; Int = {1}", Str, Int)
    End Function
End Class
На форме у нас 3 кнопки
  1. Добавление класса в коллекцию
  2. Сохранение коллекции в файл
  3. Чтение коллекции из файла

В классе формы мы объявляем коллекцию наших классов
vb.net
1
    Dim ListTest As New List(Of Test)
Предпочтительно, чтобы это были именно коллекции, поскольку это существенно облегчает операции с добавлением, заменой и удалением элементов.

Класс формы:

vb.net
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Public Class Form1
    Dim ListTest As New List(Of Test) ' Создаем коллекцию наших классов
    Dim Rand As New Random
 
    Private Sub ДобавитьКлассВКоллекцию(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim TmpTest As New Test 'Создаем экземпляр нашего класса
        With TmpTest 'Задаем свойства
            .MyInt = Rand.NextDouble * 10
            .MyStr = "Tostring " & .MyInt
        End With
        ListTest.Add(TmpTest) 'Добавляем новый экземпляр в коллекцию
        MsgBox("Последнее добавленное значение: " & ListTest(ListTest.Count - 1).ToString & vbCrLf & "Количество классов в коллекции: " & ListTest.Count)
    End Sub
 
    Private Sub СохранитьКоллекциюНаДиск(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        Dim formatter As New Runtime.Serialization.Formatters.Binary.BinaryFormatter()
        Using stream As IO.Stream = IO.File.Create("C:\ListTest.bin")
            formatter.Serialize(stream, ListTest) 'Пишем в файл
        End Using
        MsgBox("Коллекция классов сохранена в файл. Количество элементов: " & ListTest.Count)
    End Sub
 
    Private Sub ЗагрузитьКоллекциюИзФайла(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
        Dim formatter As New Runtime.Serialization.Formatters.Binary.BinaryFormatter()
        Using stream As IO.Stream = IO.File.Open("C:\ListTest.bin", IO.FileMode.Open)
            ListTest = formatter.Deserialize(stream) 'Читаем из файла
        End Using
        MsgBox("Коллекция классов загружена из файла. Количество элементов: " & ListTest.Count)
        Dim Show As Integer = 5
        If ListTest.Count < 5 Then Show = ListTest.Count
        MsgBox("Просмотр первых " & Show & " элементов коллекции...")
        For I As Integer = 0 To Show - 1 'Просматриваем
            MsgBox(ListTest(I).ToString)
        Next
    End Sub
End Class
Вся соль в этих кусках кода:
vb.net
1
2
3
4
        Dim formatter As New Runtime.Serialization.Formatters.Binary.BinaryFormatter()
        Using stream As IO.Stream = IO.File.Create("C:\ListTest.bin")
            formatter.Serialize(stream, <Объект>)
        End Using
vb.net
1
2
3
4
        Dim formatter As New Runtime.Serialization.Formatters.Binary.BinaryFormatter()
        Using stream As IO.Stream = IO.File.Open("C:\ListTest.bin", IO.FileMode.Open)
            <Объект> = formatter.Deserialize(stream) 'Читаем из файла
        End Using
Объектом может выступать все то, о чем говорилось в самом начале.

Любой из них, я еще раз подчеркиваю, дожен быть сериализуемым
14
Памирыч
Почетный модератор
20610 / 8650 / 1029
Регистрация: 11.04.2010
Сообщений: 11,008
14.12.2011, 21:54  [ТС] #19
Динамическая компиляция

Рассмотрим 2 основных, и я полагаю, не единственных, способа, как можно откомпилировать исходный код.

В первом случае мы будем компилировать код не из файла, а из текстового поля формы.
В результате этого мы получим исполняемый exe-файл, который по окончании формирования мы можем запустить на выполнение.

vb.net
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Imports Microsoft.VisualBasic
Imports System.CodeDom.Compiler
 
Public Class Form1
 
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim Compiler As VBCodeProvider = CodeDomProvider.CreateProvider("VB")
        Dim Param As New CompilerParameters()
        Param.GenerateExecutable = True
        Param.OutputAssembly = "1.exe"
        Param.IncludeDebugInformation = False
        Dim Asm As System.Reflection.Assembly
        For Each Asm In AppDomain.CurrentDomain.GetAssemblies()
            Param.ReferencedAssemblies.Add(Asm.Location)
        Next
        Dim Results As CompilerResults
        Results = Compiler.CompileAssemblyFromSource(Param, TextBox1.Text)
        If Results.Errors.Count > 0 Then
            Dim Err As CompilerError
            Dim ErrorString As String
            For Each Err In Results.Errors
                ErrorString &= Err.ToString()
            Next
            MessageBox.Show(ErrorString)
        Else
            Dim ProcessInfo As New ProcessStartInfo("1.exe")
            Shell("1.exe", AppWinStyle.Hide)
        End If
    End Sub
End Class
То, что должно быть в TextBox:

vb.net
1
2
3
4
5
6
7
8
9
10
Imports System
Imports Microsoft.VisualBasic
'==============================
Public Module CompileTest
    Sub Main()
        '|||||||||
        MsgBox("Привет")
        '|||||||||
    End Sub
End Module

Второй способ – компиляция из командной строки. Предполагает наличие файла с исходным кодом программы
Синтаксис:

Код
C:\WINDOWS\Microsoft.NET\Framework\v2.0.50727\vbc /target:winexe 2.vb
Pause
Компилировать проще всего через Bat-файл, именно в вышеизложенном виде для того, чтобы посмотреть предупреждения и ошибки компиляции, если таковые, конечно, имеются.

В данном случае приложение будет работать, используя версию 2.0 .NET Framework, В команде можно указать другую.
target:winexe
Это указывает на то, что при работе приложения не будет показано консольное окно.
2.vb – непосредственно сам файл с исходным кодом, который должен находиться в одном каталоге с Бат-файлом.
Содержание файла прежнее:

vb.net
1
2
3
4
5
6
7
8
9
10
11
12
Imports System
Imports System.Drawing
Imports System.Diagnostics
Imports Microsoft.VisualBasic
'==============================
Public Module CompileTest
    Sub Main()
        '|||||||||
        MsgBox("Привет")
        '|||||||||
    End Sub
End Module
Обращаю внимание на импортирование пространств имен. В этом случае все они, конечно, не нужны. Их список зависит от задач, которые мы возлагаем на приложение.
Например, если программа делает скриншот экрана, сохраняет в файл и запускает, то, по крайней мере, нужно будет точно использовать

vb.net
1
2
Imports System.Drawing
Imports System.Diagnostics
Ниже приведены дополнительные параметры компиляции

Чтобы получить следующий результатИспользование
Компиляция файла File.vb и создание файла File.exevbc /reference:Microsoft.VisualBasic.dll File.vb
Компиляция файла File.vb и создание файла File.dllvbc /target:library File.vb
Компиляция файла File.vb и создание файла My.exevbc /out:My.exe File.vb
Компиляция всех файлов Visual Basic в текущем каталоге с включенной оптимизацией и определенным символом DEBUG для получения файла File2.exevbc /define:DEBUG=1 /optimize /out:File2.exe *.vb
Компиляция всех файлов Visual Basic в текущем каталоге, создание отладочной версии File2.dll без отображения эмблемы или предупрежденийvbc /target:library /out:File2.dll /nowarn /nologo /debug *.vb
Компиляция всех файлов Visual Basic в текущем каталоге для получения файла Something.dllvbc /target:library /out:Something.dll *.vb

Компиляцию оконных приложений здесь мы рассматривать не будем
11
Юпатов Дмитрий
1598 / 1110 / 223
Регистрация: 23.12.2010
Сообщений: 1,489
15.12.2011, 15:55 #20
Обмен данными в локальной сети по UDP-протоколу
Базовые процедуры, переменные и константы (объявляются на уровне модуля):
vb.net
1
2
3
4
5
Friend Const LocalPort As Integer = 22259 'через этот порт происходит обмен сообщениями между членами чата
    Dim Client_UDP_output As New System.Net.Sockets.UdpClient ' этот клиент будет отправлять сообщения на удаленный порт
    Dim Client_UDP_input As New System.Net.Sockets.UdpClient(LocalPort) ' этот клиент будет слушать локальный порт
    Dim RemoteIpEndPoint As New IPEndPoint(IPAddress.Any, 0)
    Dim ListenerThread As Threading.Thread
Эта процедура выполняется в отдельном потоке и отвечает за постоянное прослушивание локального порта на предмет входящих сообщений:
vb.net
1
2
3
4
5
6
7
8
9
10
11
Private Sub DoListen()
        Do While Not ListenerThread Is Nothing
            Try
                Dim receiveBytes As Byte() = Client_UDP_input.Receive(RemoteIpEndPoint)
                Dim returnData As String = System.Text.Encoding.Default.GetString(receiveBytes)
                Me.ReturnData_toMainThread(returnData)
            Catch ex As Exception
                ListenerThread.Abort()
            End Try
        Loop
    End Sub
Собственно, ее запуск в отдельном потоке:
vb.net
1
2
3
4
5
6
7
Private Sub start_thread()
        Try
            ListenerThread = New Threading.Thread(AddressOf DoListen)
            ListenerThread.Start()
        Catch ex As Exception
        End Try
    End Sub
Эту процедуру надо запустить (например, при загрузке формы):
vb.net
1
2
3
Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        Me.start_thread()
    End Sub
Теперь перед нами задача вернуть полученные данные в основной поток, когда они будут приняты в дополнительном:
vb.net
1
2
3
4
5
6
7
8
9
10
Private Delegate Sub MSG_Delegate(ByVal Text As String)
 
    Private Sub ReturnData_toMainThread(ByVal Text As String)
        If Not Me.InvokeRequired Then
            Me.UDP_DataArrival(Text)
        Else
            Dim d As System.Delegate = New MSG_Delegate(AddressOf ReturnData_toMainThread)
            Me.BeginInvoke(d, New String() {Text})
        End If
    End Sub
Как видим, финишная обработка полученных данных будет выполняться в процедуре Me.UDP_DataArrival(Text) Text - это то что мы приняли в дополнительном потоке и направили в основной. Вод код финишной процедуры:
vb.net
1
2
3
4
5
6
Private Sub UDP_DataArrival(ByVal DataSTR As String)
        Me.txtSendedMSG.SelectionLength = 0
        Me.txtSendedMSG.SelectionStart = Me.txtSendedMSG.Text.Length
        Me.txtSendedMSG.SelectedRtf = DataSTR
        Me.txtSendedMSG.ScrollToCaret()
    End Sub
Тут я полученные данные (они содержат текст и другую инфу в формате RichText) просто вывожу в RichTextBox под именем txtSendedMSG

Ну все, принимать мы научились, возьмемся за передачу данных на нужный адрес
vb.net
1
2
3
4
5
6
7
8
Friend Sub SendData_to_LocalNet(ByVal strData As String, ByVal RemoteAddress As IPAddress)
        Try
            Dim sendBytes As [Byte]() = System.Text.Encoding.Default.GetBytes(strData)
            Client_UDP_output.Send(sendBytes, sendBytes.Length, New IPEndPoint(RemoteAddress, LocalPort))
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub
Входные параметры: строка данных (она затем конвертится перед передачей в массив байт), адрес удаленного компа (можно также отправлять широковещательно на IPAddress.Broadcast).

Все, база есть. Осталось получить список компов в сети (чтобы ручками не вбивать адреса). Можно просто получить все компы (я не буду приводить код, можно найти по ключам: "список компьютеров всети" или аналогично).
Но это не совсем то... было бы неплохо получать список только тех компов, где запущена аналогичная программа, способная принять и отобразить сообщение.
Для этого я усложнил процедуру UDP_DataArrival
vb.net
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Private Sub UDP_DataArrival(ByVal DataSTR As String)
        If DataSTR.StartsWith("INC_CMP") = True Then 'извещение о подключении члена чата
            Me.Inc_out_cmp(DataSTR, True)
            Exit Sub
        End If
        If DataSTR.StartsWith("OUT_CMP") = True Then 'извещение об отключении члена чата
            Me.Inc_out_cmp(DataSTR, False)
            Exit Sub
        End If
        'If DataSTR.Contains("DSTR_ME") = True Then 'закрываем приложение
        '    Me.Close()
        '    Exit Sub
        'End If
        Me.txtSendedMSG.SelectionLength = 0
        Me.txtSendedMSG.SelectionStart = Me.txtSendedMSG.Text.Length
        Me.txtSendedMSG.SelectedRtf = DataSTR
        Me.txtSendedMSG.ScrollToCaret()
        ' если свернуто основное окно
        If Me.WindowState = FormWindowState.Minimized Then
            Me.ShowNotifyWin(DataSTR)
        Else
            Me.niMain.BalloonTipText = "Новое сообщение!"
            Me.niMain.ShowBalloonTip(60000)
            Me.ShowNotifyWin(DataSTR)
        End If
    End Sub
Теперь она проверяет наличие в принятом сообщении определенных сочетаний символов и по их наличию добавляет комп в список или удаляет из него).
Естественно, наша прога должна в определенный момент (у меня при старте) тоже отправить кодовое сообщение (мол, я вот она) причем широковещательно:
vb.net
1
2
3
4
5
6
7
8
9
10
11
12
Private Sub Me_inc_out(ByVal inc As Boolean)
        Dim cmd As String = ""
        Dim endip = IPAddress.Broadcast
        Dim MyIP As IPAddress = System.Net.Dns.GetHostAddresses(My.Computer.Name.ToString).GetValue(1)
        Select Case inc
            Case Is = True
                cmd = "INC_CMP"
            Case Is = False
                cmd = "OUT_CMP"
        End Select
        Me.SendData_to_LocalNet(cmd & ":" & My.Computer.Name & ":" & MyIP.ToString, endip)
    End Sub
Ну и процедура, которая обрабатывает сервисные сообщения (собственно, корректирует список компов, она вызывается в процедуре UDP_DataArrival:
vb.net
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub Inc_out_cmp(ByVal data As String, ByVal add As Boolean)
        Dim sep = ":"
        Dim hname As String = data.Split(sep).GetValue(1)
        Dim hip As String = data.Split(sep).GetValue(2)
        If hname.ToUpper.Equals(My.Computer.Name.ToUpper) Then Exit Sub ' себя в список не добавляем :)
        Select Case add
            Case Is = True
                Me.ChlbComps.Items.Add(hname & ":" & hip, False)
                Me.ChlbComps.Refresh()
            Case Is = False
                Me.ChlbComps.Items.Remove(hname & ":" & hip)
                Me.ChlbComps.Refresh()
        End Select
    End Sub
Итого, для того, чтобы нас увидели другие, нам надо вызвать при старте Me_inc_out с параметром True (входим в чат и появляемся в чужих списках). И при закрытии программы вызвать ее же с параметром False (удаляемся из списков).
Ну и конечно, при закрытии программы нам надо прервать поток, в котором ведется прослушивание порта входящих сообщений:
vb.net
1
2
3
4
Private Sub Form1_FormClosed(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
        Me.Me_inc_out(False) ' выходим из чата
        Me.Client_UDP_input.Close() ' прекращаем поток прослушивания
    End Sub
Это скелет. Во вложении проект готового чата, выполненного на его основе. Там есть: всплывающее окошко со входящим сообщением (если окно свернуто), редактор RTF (простенький) в котором формируется исходящее сообщение, опять же, входящие в RTF отображаются. Сохранение истории сообщений в файлы RTF (1 файл на каждые сутки), просмотровщик истории (тоже RTF).
Ну и, естественно, комплект изображений, которые я использовал в интерфейсе.
Проект выполнен в студии версии 2008. Если у кого более старая версия - открывайте сорцы блокнотом и собирайте проект с нуля.
Проект скомпилен под .Net Framework 2.0, готовый экзешник не требует установки и весит немного (примерно 0,5МБ), история сохраняется в папке с экзешником.
Проверено и эксплуатируется на работе в локальной сетке на 20 компов.
22
Вложения
Тип файла: rar UDPchat.rar (1.57 Мб, 829 просмотров)
abbat81
29 / 29 / 2
Регистрация: 20.07.2011
Сообщений: 390
30.12.2011, 21:00 #21
Как влючить компютер по сети или "Wake on LAN" (WOL)

На компютере, который нужно включать по сети, в BIOS должна быть включена функция Wake on LAN = Enabled

vb.net
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
Imports System.Net
Imports System.Net.Sockets
Imports System.Text
 
Public Class clsWOL
    Const lenHeader As Integer = 6
    Const lenMAC As Integer = 6
    Const repMAC As Integer = 16
 
    Dim mEndPoint As IPEndPoint
    Dim mMACAddress As Byte()
    Dim mBytesSent As Integer = 0
    Dim mPacketSent As String
 
    ''' <summary>
    ''' The IPEndPoint object that will act as a trasport for the packet.
    ''' It is automatically created by New statement, but you can modify it or read it.
    ''' </summary>
    ''' <value>An IPEndPoint object</value>
    ''' <returns>An IPEndPoint object</returns>
    ''' <remarks>Normally there is no need to change this manually.</remarks>
    Public Property endPoint() As IPEndPoint
        Get
            Return mEndPoint
        End Get
        Set(ByVal value As IPEndPoint)
            mEndPoint = value
        End Set
    End Property
    ''' <summary>
    ''' The target machine Network Interface Card MAC address.
    ''' It must be dash-separated, i.e. in the 11-22-33-44-55-66 form
    ''' </summary>
    ''' <value>A string with dash-separated values</value>
    ''' <returns>A string with dash-separated values</returns>
    ''' <remarks>The standard (IEEE 802) separator for cotet are dash (-) and semicolon (:). I resolved to use dashes only in order to avoid any possible confusion and misunderstanding with upcoming IPv6 addressing space.</remarks>
    Public Property macAddress() As String
        Get
            Dim textMAC As New StringBuilder
 
            For Each currByte As Byte In mMACAddress
                textMAC.Append("-")
                textMAC.Append(currByte.ToString("X2"))
            Next
 
            Return textMAC.ToString.Substring(1)
        End Get
        Set(ByVal value As String)
            Dim values As Byte()
 
            For Each currByte As String In value.Split("-")
                If values Is Nothing Then
                    ReDim values(0)
                Else
                    ReDim Preserve values(values.GetUpperBound(0) + 1)
                End If
                values(values.GetUpperBound(0)) = Byte.Parse(currByte, Globalization.NumberStyles.HexNumber)
            Next
 
            mMACAddress = values
        End Set
    End Property
    ''' <summary>
    ''' Total bytes sent by WakeIt method. It is 0 until the method is called at least once for this class instance.
    ''' </summary>
    ''' <returns>Integer value, total bytes trasmitted</returns>
    ''' <remarks></remarks>
    Public ReadOnly Property bytesSent() As Integer
        Get
            Return mBytesSent
        End Get
    End Property
    ''' <summary>
    ''' It represent the Magic Packet broadcasted.
    ''' </summary>
    ''' <returns>String containing the text parsing of the Magic Packet</returns>
    ''' <remarks></remarks>
    Public ReadOnly Property packetSent() As String
        Get
            Return mPacketSent
        End Get
    End Property
    ''' <summary>
    ''' Creates a WOL Magic Packet, the datagram that will awake the target PC updon broadcast on the network.
    ''' </summary>
    ''' <param name="macAddress">An array of byte representing the target machine Network Interface Card MAC address</param>
    ''' <returns>An array of byte representing the Magic Packet</returns>
    ''' <remarks>This method can be used indipendently from the rest of the class. If necessary it can create a Magic Packet just providing the MAC address.</remarks>
    Public Function magicPacket(ByVal macAddress As Byte()) As Byte()
        Dim payloadData As Byte()
        Dim packet As New StringBuilder
 
        Try
            ReDim payloadData(lenHeader + lenMAC * repMAC)
 
            For i As Integer = 0 To lenHeader - 1
                payloadData(i) = Byte.Parse("FF", Globalization.NumberStyles.HexNumber)
            Next
            For i As Integer = 0 To repMAC - 1
                For j As Integer = 0 To lenMAC - 1
                    payloadData(lenHeader + i * lenMAC + j) = macAddress(j)
                Next
            Next
 
            For Each currLoad As Byte In payloadData
                packet.Append("-")
                packet.Append(currLoad.ToString("X2"))
            Next
 
            mPacketSent = packet.ToString.Substring(1)
        Catch ex As Exception
            mPacketSent = "EXCEPTION: " & ex.ToString
        End Try
 
        Return payloadData
    End Function
 
    Function sendUDP(ByVal payload As Byte(), ByVal endPoint As IPEndPoint) As Integer
        Dim byteSend As Integer
        Dim socketClient As Socket
 
        If (payload IsNot Nothing) AndAlso (endPoint IsNot Nothing) Then
            socketClient = New Socket(endPoint.AddressFamily, SocketType.Dgram, ProtocolType.Udp)
            socketClient.Connect(endPoint)
            byteSend = socketClient.Send(payload, 0, payload.Length, SocketFlags.None)
 
            socketClient.Close()
        Else
            byteSend = 0
        End If
 
        Return byteSend
    End Function
    ''' <summary>
    ''' It is the main method of the class. It must be called after the MAC address has been set. It does not return any code, you can see the result of the operation with the bytesSent and packetSent properties of this class.
    ''' </summary>
    ''' <remarks></remarks>
    Public Sub wakeIt()
        mBytesSent = sendUDP(magicPacket(mMACAddress), mEndPoint)
    End Sub
    ''' <summary>
    ''' No parameter is required. The new statement just created the IPEndPoint object.
    ''' </summary>
    ''' <remarks>The default IPEndPoint transmit on port 7. Other choices for WOL are port 0 or 9</remarks>
    Sub New()
        mEndPoint = New IPEndPoint(IPAddress.Broadcast, 7)
    End Sub
    ''' <summary>
    ''' The IPEndPoint object is created to the specified port
    ''' </summary>
    ''' <param name="epPort">A valid port number</param>
    ''' <remarks>If the port number is invalid, the IPEndPoint is created to port 7. Ports normally used for WOL are 0, 7 or 9.</remarks>
    Sub New(ByVal epPort As Integer)
        If epPort >= 0 AndAlso epPort < 65535 Then
            mEndPoint = New IPEndPoint(IPAddress.Broadcast, epPort)
        Else
            mEndPoint = New IPEndPoint(IPAddress.Broadcast, 7)
        End If
    End Sub
End Class

vb.net
1
2
3
4
5
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim WOL As New clsWOL
        WOL.macAddress = "00-30-05-84-03-76"
        WOL.wakeIt()
    End Sub
4
Памирыч
Почетный модератор
20610 / 8650 / 1029
Регистрация: 11.04.2010
Сообщений: 11,008
01.01.2012, 21:54  [ТС] #22
Небольшие вопросы на разную тематику

Разделение Gif-файла на кадры с сохранением в папку (автор кода eJ_Studio)
Разделение Gif-файла на кадры с сохранением в папку (автор кода eJ_Studio)
vb.net
1
2
3
4
5
6
7
        Dim Im As Bitmap = Image.FromFile("C:\1.gif")
        Dim tmpIm_ As New Imaging.FrameDimension(Im.FrameDimensionsList(0))
 
        For i As Integer = 0 To Im.GetFrameCount(tmpIm_) - 1
            Im.SelectActiveFrame(tmpIm_, i)
            Im.Save(String.Format("C:\{0}.bmp", i), Imaging.ImageFormat.Bmp)
        Next


Узнать глобально раскладку клавиатуры (автор кода Дмитрий Юпатов)
Узнать глобально раскладку клавиатуры (автор кода Дмитрий Юпатов)
vb.net
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Imports System.Runtime.InteropServices
Public Class Form1
    <DllImport("user32.dll", SetLastError:=True)> _
   Private Shared Function GetWindowThreadProcessId(<[In]()> ByVal hWnd As IntPtr, <Out(), [Optional]()> ByVal lpdwProcessId As IntPtr) As Integer
    End Function
    <DllImport("user32.dll", SetLastError:=True)> _
    Private Shared Function GetForegroundWindow() As IntPtr
    End Function
    <DllImport("user32.dll", SetLastError:=True)> _
    Private Shared Function GetKeyboardLayout(<[In]()> ByVal idThread As Integer) As UShort
    End Function
    Private Function GetKeyboardLayout() As UShort
        Return GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow(), IntPtr.Zero))
    End Function
    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        Label1.Text = GetKeyboardLayout()
    End Sub
End Class


Узнать и установить раскладку для нашего приложения. Информация об установленных языках (автор кода Дмитрий Юпатов)
Узнать и установить раскладку для нашего приложения. Информация об установленных языках (автор кода Дмитрий Юпатов)
vb.net
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        'Устанавливаем русскую раскладку
        System.Windows.Forms.InputLanguage.CurrentInputLanguage = InputLanguage.FromCulture(System.Globalization.CultureInfo.GetCultureInfo(1049))
        Info()
    End Sub
 
    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        'Устанавливаем английскую раскладку
        System.Windows.Forms.InputLanguage.CurrentInputLanguage = InputLanguage.FromCulture(System.Globalization.CultureInfo.GetCultureInfo(1033))
        Info()
    End Sub
 
    Sub Info() 'Отображаем текущую раскладку для нашего окна и установленные языки
        Me.Label1.Text = "Активная раскладка: " & System.Windows.Forms.InputLanguage.CurrentInputLanguage.LayoutName
        Me.Label1.Text = Me.Label1.Text & vbCrLf & "Активный язык ввода: " & System.Windows.Forms.InputLanguage.CurrentInputLanguage.Culture.NativeName
        Me.Label1.Text = Me.Label1.Text & vbCrLf & vbCrLf & "Установленные языки:"
        For Each IL As System.Windows.Forms.InputLanguage In System.Windows.Forms.InputLanguage.InstalledInputLanguages
            Me.Label1.Text = Me.Label1.Text & vbCrLf & IL.Culture.NativeName
            Me.Label1.Text = Me.Label1.Text & vbCrLf & IL.Culture.LCID
        Next
    End Sub


Вступление изменений в реестре в силу без перезагрузки компьютера
Вступление изменений в реестре в силу без перезагрузки компьютера
vb.net
1
2
3
4
5
6
7
8
9
10
11
12
Imports System.Runtime.InteropServices
 
Public Class Form1
    Const SHCNE_ASSOCCHANGED As Long = &H8000000L
    Const SHCNF_IDLIST As UInteger = &H0UI
    <DllImport("shell32.dll", CharSet:=CharSet.Auto, SetLastError:=True)> _
Public Shared Sub SHChangeNotify(ByVal wEventId As UInt32, ByVal uFlags As UInt32, ByVal dwItem1 As IntPtr, ByVal dwItem2 As IntPtr)
 
    End Sub
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, IntPtr.Zero, IntPtr.Zero)
    End Sub


Привести числовой массив к строковому (автор кода SSTREGG)
Привести числовой массив к строковому (автор кода SSTREGG)
vb.net
1
2
        Dim arr As Integer() = New Integer() {10, 56, 5647, 12, 78}
        Dim t = arr.[Select](Function(x) x.ToString()).ToArray()


Извлечь иконки из файлов и библиотек
Извлечь иконки из файлов и библиотек
vb.net
1
2
3
4
5
6
7
8
9
10
11
12
    Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Integer, ByVal lpszExeFileName As String, ByVal nIconIndex As Integer) As Integer
 
    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        Dim file As String = ("c:\windows\system32\taskmgr.exe") 'Путь к носителю иконок
        Dim IconCount As Integer = ExtractIcon(Me.Handle, file, -1) 'Узнаем количество иконок в файле
        For I As Integer = 0 To IconCount - 1
            Dim ico As Icon = Icon.FromHandle(ExtractIcon(Me.Handle, file, I))
            Me.Icon = ico 'Показываем 
            PictureBox1.BackgroundImage = ico.ToBitmap 'Показываем
            If MsgBox("Следующая?", MsgBoxStyle.Question + MsgBoxStyle.YesNo) = MsgBoxResult.No Then Exit Sub
        Next
    End Sub
В данном примере рассматривается исполняемый файл taskmgr.exe, разумеется, путь можно указать и к библиотеке, например, shell32.dll

Если нам нужна иконка файла, можно использовать простой код:
vb.net
1
2
        Dim ico As Icon = Icon.ExtractAssociatedIcon("C:\WINDOWS\system32\spider.exe")
        Me.Icon = ico
Здесь мы получим изображение иконки файла независимо от расширения, именно ту, которую мы видим в проводнике. Это может быть исполняемый файл, библиотека, кника Excel, текстовый документ или вовсе файл без расширения
13
Юпатов Дмитрий
1598 / 1110 / 223
Регистрация: 23.12.2010
Сообщений: 1,489
12.01.2012, 22:37 #23
Рассмотрим на примере надстройки Excel 2007. Создадим простейшую надстройку, которая при запуске создает Вкладку на ленте, группу для элементов управления на вкладке и размещает в группе 2 кнопки.
При нажатии на кнопки отображаются сообщения (см. рис.1).
Итак, приступим.
В окне выбора проекта для создания выбираем "Другие типы проектов">"Общая надстройка" и далее следуем указаниям мастера создания в студии (см. рис.2)
В итоге мы получим решение, включающее в себя 2 проекта: собственно, надстройку и ее установщик. Перво-наперво в проекте установки переходим к редактору реестра и правим там согласно рис.3.
Дело в том, что если оставить как есть, то надстройка нормально стартует только на той машине, где компилилась. Такой вот баг...
Теперь переходим к проекту надстройки. Добавляем недостающие ссылки в него (см. рис.4)

Добавляем в ресурсы xml файл. Я его назвал SimpleExcelAddinRibbon
Он содержит описание вкладки на ленте для нашей надстройки
Листинг файла SimpleExcelAddinRibbon.xml
XML
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
<?xml version="1.0" encoding="utf-8"?>
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui"
          xmlns:x = "SimpleExcelAddinRibbon_namespace"
          onLoad="Ribbon_Load"
          loadImage="GetImages">
  <ribbon>
    <tabs>
      <tab idQ="x:MyTab" label="MyTab">
        <group id="SimpleExcelAddinRibbon" label="SimpleExcelAddinRibbon">
          <button id="btnTest1"
                  supertip="Суперподсказка1"
                  label="Тест1"
                  size="large"
                  image="Test1Img"
                  onAction="onAction"/>
          <button id="btnTest2"
                  supertip="Суперподсказка2"
                  label="Тест2"
                  size="large"
                  image="Test2Img"
                  onAction="onAction"/>
          <dialogBoxLauncher>
            <button id="btnDialogBoxLauncher"
                    label="О программе"
                    supertip="Информация о надстройке SimpleExcelAddinRibbon"
                    onAction="onAction"/>
          </dialogBoxLauncher>
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>

Добавляем в ресурсы также пару картинок (можно png с прозрачностью 128х128), которые будут отображаться на кнопках, я их назвал Test1Img и Test2Img.
В целом, можно в ресурсы и не добавлять, а включить в дистрибут файлы и читать оттуда в рантайме
Далее, создаем новый класс с именем ConvertImage. В нем будет только одна функция, которая картинку переводит в структуру IPictureDisp, которую понимает офис.
Листинг класса ConvertImage.vb
vb.net
1
2
3
4
5
6
7
Imports System.ServiceProcess
Public Class ConvertImage
    Inherits System.Windows.Forms.AxHost
    Public Shared Function Convert(ByVal Image As System.Drawing.Image) As stdole.IPictureDisp
        Convert = GetIPictureFromPicture(Image)
    End Function
End Class
Теперь открываем созданный автоматически класс Connect и правим его:
Листинг класса Connect.vb
vb.net
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
Imports Extensibility
Imports System.Runtime.InteropServices
Imports Microsoft.Office.Core
 
<GuidAttribute("ADCAAEE8-E111-4419-93B2-6F8A9447648F"), ProgIdAttribute("SimpleExcelAddin.Connect")> _
Public Class Connect
 
    Implements Extensibility.IDTExtensibility2, Microsoft.Office.Core.IRibbonExtensibility
    Dim WithEvents applicationObject As Microsoft.Office.Interop.Excel.Application
    Dim addInInstance As Object
    Friend ribbonX As Microsoft.Office.Core.IRibbonUI
 
    Public Sub OnBeginShutdown(ByRef custom As System.Array) Implements Extensibility.IDTExtensibility2.OnBeginShutdown
        ' Функция создается автоматом, естественно пустая :)
    End Sub
 
    Public Sub OnAddInsUpdate(ByRef custom As System.Array) Implements Extensibility.IDTExtensibility2.OnAddInsUpdate
        ' Функция создается автоматом, естественно пустая :)
        ' происходит при установке более новой версии
    End Sub
 
    Public Sub OnStartupComplete(ByRef custom As System.Array) Implements Extensibility.IDTExtensibility2.OnStartupComplete
        ' Функция создается автоматом, естественно пустая :)
        ' происходит по окончании старта
    End Sub
 
    Public Sub OnDisconnection(ByVal RemoveMode As Extensibility.ext_DisconnectMode, ByRef custom As System.Array) Implements Extensibility.IDTExtensibility2.OnDisconnection
        ' Функция создается автоматом, естественно пустая :)
        ' происходит при рассоединении надстройки с Экселем
    End Sub
 
    Public Sub OnConnection(ByVal application As Object, ByVal connectMode As Extensibility.ext_ConnectMode, ByVal addInInst As Object, ByRef custom As System.Array) Implements Extensibility.IDTExtensibility2.OnConnection
        ' Функция создается автоматом, естественно пустая :)
        ' происходит при соединении надстройки с Экселем
        applicationObject = application
        addInInstance = addInInst
        If (connectMode <> Extensibility.ext_ConnectMode.ext_cm_Startup) Then
            Call OnStartupComplete(custom)
        End If
    End Sub
 
    Function GetCustomUI(ByVal CustomUI As String) As String Implements IRibbonExtensibility.GetCustomUI
        ' эта функция загрузит нашу вкладку на ленту. Функция набирается ручками
        Return My.Resources.SimpleExcelAddinRibbon
    End Function
 
    ' все что ниже набрано ручками
    Public Sub Ribbon_Load(ByVal ribbon As IRibbonUI)
        ' эта процедура упомянута в xml файле. Тут мы загоняем отрисованную для нас вкладку в переменную
        ribbonX = ribbon
    End Sub
 
    Public Sub onAction(ByVal control As IRibbonControl)
        ' выполняется при нажатии кнопки. Одна процедура может быть использована для нескольких контролов. А можно и разные, главное правильно указать имя процедуры для свойства контрола в xml файле. И обязательно Public, иначе не вызовется
        Select Case control.Id
            Case "btnTest1"
                Button1Click()
            Case "btnTest2"
                Button2Click()
            Case "btnDialogBoxLauncher"
                btnDialogBoxLauncherClick()
        End Select
    End Sub
 
    Private Function getImage(ByVal image As System.Drawing.Image) As stdole.IPictureDisp
        Dim tempImage As stdole.IPictureDisp = Nothing
        Try
            tempImage = ConvertImage.Convert(image)
        Catch ex As Exception
        End Try
        Return tempImage
    End Function
 
 
    Public Function GetImages(ByVal image_id As String) As stdole.IPictureDisp
        ' функция задаст картинки для кнопок. См. xml, там она упомянута. И обязательно Public, иначе не вызовется
        Select Case image_id
            Case "Test1Img"
                Return Me.getImage(My.Resources.Test1Img)
            Case "Test2Img"
                Return Me.getImage(My.Resources.Test2Img)
        End Select
    End Function
 
    ' ну и процедуры, выполняющиеся при нажатиях
    Private Sub Button1Click()
        MsgBox("Нажали кнопку1")
    End Sub
    Private Sub Button2Click()
        MsgBox("Нажали кнопку2")
    End Sub
    Private Sub btnDialogBoxLauncherClick()
        MsgBox("Нажали уголок внизу группы")
    End Sub
 
End Class

Ну... в коде даны пояснения в комментариях.
Чтобы потестить надо:
  1. Скомпилить библиотеку.
  2. Скомпилить дистрибут
  3. установить дистрибут
  4. Запустить Эксель.
Дальше можно будет править код и перекомпилить библиотеку. При этом дистрибут можно не трогать, изменения должны вноситься и так. Следите только, чтоб при компиляции надстройки Эксель не был запущен.

Надстройка видна в списке таких же в Экселе (рис.5). Удаляется через "Установку и удаление программ", где она видна под именем проекта установки.

P.S.
Создание сборки для более ранних версий отличается только наличием кода создания панели инструментов и контролов на ней. Ну и плюс, если надстройка универсальная - перед созданием панели проверяем номер версии экселя: если 11 или меньше - панель надо (версия не более 2003), если 12 или больше - панель не надо, имеем 2008 или старше.

Полный архив с тестовой надстройкой прилагается к посту.

Добавлю: при создании проекта надстройки с целевой версией .NetFramework версии 2.0 нужно также скачать и установить заплатку от Microsoft, которая это исправляет. Также ее надо будет подключать к проекту установки, т.е. вносить в список необходимых компонентов.
При распространении дистрибута надо будет распространять весть комплект, который создается в папке bin проекта установщика (файлы msi, exe и папка с установщиком заплатки) и установку производить через запуск файла msi для автоустановки заплатки на конечной машине.
Зачем нужна эта заплатка? Потому что надстройка работает только на той машине, где компилилась. Заплатка этот баг устраняет.
Ну а если речь идет о версии .NetFramework 3.0 или старше, то все в порядке, заплата не нужна.

Кроме того, надстройки можно создавать с помощью инструментария MS Visual Studio Tools For Office. Что касается работы с лентой, там все намного удобнее - можно работать визуально, а можно открыть xml.

Кроме того, дополнительно о ленте можно почитать тут и тут.
Ну и погуглить по словам Fluent Ribbon

Добавлено через 22 минуты
Вот! Нашел наконец-то довольно ценную статью от Microsoft. Охватывает и ленту и создание AddIn. Читаем
9
Миниатюры
Visual Basic .NET FAQ. Готовые решения, полезные коды   Visual Basic .NET FAQ. Готовые решения, полезные коды   Visual Basic .NET FAQ. Готовые решения, полезные коды  

Visual Basic .NET FAQ. Готовые решения, полезные коды   Visual Basic .NET FAQ. Готовые решения, полезные коды   Visual Basic .NET FAQ. Готовые решения, полезные коды  

Вложения
Тип файла: rar SimpleExcelAddin.rar (1.00 Мб, 161 просмотров)
SergKr
65 / 39 / 3
Регистрация: 07.12.2010
Сообщений: 321
26.03.2012, 17:19 #24
Печать RichTextBox на принтере с сохранением форматирования
Новый проект. На нём только кнопка.
Проект -> Добавить класс...
Имя класса пишем RichTextBoxPrintCtrl
Вставляем код:

Класс компонента
vb.net
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
Option Explicit On
 
Imports System
Imports System.Windows.Forms
Imports System.Drawing
Imports System.Runtime.InteropServices
Imports System.Drawing.Printing
 
Namespace RichTextBoxPrintCtrl
    Public Class RichTextBoxPrintCtrl
        Inherits RichTextBox
 
        ' Convert the unit that is used by the .NET framework 
        ' (1/100 inch) and the unit that is used by Win32 API calls  
        ' (twips 1/1440 inch)
        Private Const AnInch As Double = 14.4
 
        Private WithEvents m_PrintDocument As Printing.PrintDocument
        Private intCharactersToPrint As Integer
        Private intCurrentPosition As Integer
 
        <StructLayout(LayoutKind.Sequential)> _
        Private Structure RECT
            Public Left As Integer
            Public Top As Integer
            Public Right As Integer
            Public Bottom As Integer
        End Structure
 
        <StructLayout(LayoutKind.Sequential)> _
        Private Structure CHARRANGE
            ' First character of range (0 for start of doc)
            Public cpMin As Integer
            ' Last character of range (-1 for end of doc)
            Public cpMax As Integer
        End Structure
 
        <StructLayout(LayoutKind.Sequential)> _
        Private Structure FORMATRANGE
            ' Actual DC to draw on
            Public hdc As IntPtr
            ' Target DC for determining text formatting
            Public hdcTarget As IntPtr
            ' Region of the DC to draw to (in twips)
            Public rc As Rect
            ' Region of the whole DC (page size) (in twips)
            Public rcPage As Rect
            ' Range of text to draw (see above declaration)
            Public chrg As CHARRANGE
        End Structure
 
        Private Const WM_USER As Integer = &H400
        Private Const EM_FORMATRANGE As Integer = WM_USER + 57
 
        Private Declare Function SendMessage Lib "USER32" Alias _
            "SendMessageA" (ByVal hWnd As IntPtr, ByVal msg As Integer, _
            ByVal wp As IntPtr, ByVal lp As IntPtr) As IntPtr
 
        Public Sub SelPrint()
 
            'print only the selected text if any is selected
            If Me.SelectionLength > 0 Then
                intCharactersToPrint = Me.SelectionStart + Me.SelectionLength
                intCurrentPosition = Me.SelectionStart
            Else
                'otherwise print the entire document
                intCharactersToPrint = Me.TextLength
                intCurrentPosition = 0
            End If
 
            m_PrintDocument.Print()
 
        End Sub
        ' Render the contents of the RichTextBox for printing
        ' Return the last character printed + 1 (printing start from 
        ' this point for next page)
        Private Function Print(ByVal charFrom As Integer, _
ByVal charTo As Integer, ByVal e As PrintPageEventArgs) As Integer
 
            ' Mark starting and ending character
            Dim cRange As CHARRANGE
            cRange.cpMin = charFrom
            cRange.cpMax = charTo
 
            ' Calculate the area to render and print
            Dim rectToPrint As RECT
            rectToPrint.Top = e.MarginBounds.Top * AnInch
            rectToPrint.Bottom = e.MarginBounds.Bottom * AnInch
            rectToPrint.Left = e.MarginBounds.Left * AnInch
            rectToPrint.Right = e.MarginBounds.Right * AnInch
 
            ' Calculate the size of the page
            Dim rectPage As RECT
            rectPage.Top = e.PageBounds.Top * AnInch
            rectPage.Bottom = e.PageBounds.Bottom * AnInch
            rectPage.Left = e.PageBounds.Left * AnInch
            rectPage.Right = e.PageBounds.Right * AnInch
 
            Dim hdc As IntPtr = e.Graphics.GetHdc()
 
            Dim fmtRange As FORMATRANGE
            ' Indicate character from to character to
            fmtRange.chrg = cRange
            ' Use the same DC for measuring and rendering
            fmtRange.hdc = hdc
            ' Point at printer hDC
            fmtRange.hdcTarget = hdc
            ' Indicate the area on page to print
            fmtRange.rc = rectToPrint
            ' Indicate whole size of page
            fmtRange.rcPage = rectPage
 
            Dim res As IntPtr = IntPtr.Zero
 
            Dim wparam As IntPtr = IntPtr.Zero
            wparam = New IntPtr(1)
 
            ' Move the pointer to the FORMATRANGE structure in 
            ' memory
            Dim lparam As IntPtr = IntPtr.Zero
            lparam = _
Marshal.AllocCoTaskMem(Marshal.SizeOf(fmtRange))
            Marshal.StructureToPtr(fmtRange, lparam, False)
 
            ' Send the rendered data for printing
            res = _
SendMessage(Handle, EM_FORMATRANGE, wparam, lparam)
 
            ' Free the block of memory allocated
            Marshal.FreeCoTaskMem(lparam)
 
            ' Release the device context handle obtained by a 
            ' previous call
            e.Graphics.ReleaseHdc(hdc)
 
            'return the last + 1 character printed
            Return res.ToInt32
 
        End Function
        Public ReadOnly Property PrintDocument() As Printing.PrintDocument
            Get
                If m_PrintDocument Is Nothing Then
                    m_PrintDocument = New Printing.PrintDocument
                End If
 
                Return m_PrintDocument
            End Get
        End Property
 
        Private Sub m_PrintDocument_PrintPage(ByVal sender As _
Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs) _
Handles m_PrintDocument.PrintPage
            ' Print the content of the RichTextBox. 
            ' Store the last character printed.
 
            intCurrentPosition = Me.Print(intCurrentPosition, _
intCharactersToPrint, e)
 
            ' Look for more pages by checking 
            If intCurrentPosition < intCharactersToPrint Then
                e.HasMorePages = True
            Else
                e.HasMorePages = False
            End If
 
        End Sub
    End Class
End Namespace
Теперь на форме добавляем: RichTextBoxPrintCtrl
Кидаем PrintDialog на форму.
В кнопку пишем код:
vb.net
1
2
3
4
5
PrintDialog1.Document = Me.RichTextBoxPrintCtrl1.PrintDocument
 
        If PrintDialog1.ShowDialog() = DialogResult.OK Then
            Me.RichTextBoxPrintCtrl1.SelPrint()
        End If
9
Russiablackbird
61 / 61 / 1
Регистрация: 23.01.2012
Сообщений: 254
30.03.2012, 09:42 #25
Снчала на форму кинем label1 и labe2 в первом вес файла во 2 скорость скачивания и ещё progressbar для показа степени загрузки файла ,BackgroundWorker и кнопку .
Теперь перейдём к коду
vb.net
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
Imports System.Net
Public Class mainForm
 
    Dim whereToSave As String 'Where the program save the file
 
    Delegate Sub ChangeTextsSafe(ByVal length As Long, ByVal position As Integer, ByVal percent As Integer, ByVal speed As Double)
    Delegate Sub DownloadCompleteSafe(ByVal cancelled As Boolean)
 
    Public Sub DownloadComplete(ByVal cancelled As Boolean)
        Me.Button1.Enabled = True
        If cancelled Then
 
 
            MessageBox.Show("Обновление отменено", "Отмена", MessageBoxButtons.OK, MessageBoxIcon.Information)
 
 
        Else
 
            MessageBox.Show("Обновление завершено", "Ок", MessageBoxButtons.OK, MessageBoxIcon.Information)
 
 
        End If
 
        Me.ProgressBar1.Value = 0
        Me.Label1.Text = "Размер файла: "
        Me.Label2.Text = "Скорость загрузки: "
 
    End Sub
 
    Public Sub ChangeTexts(ByVal length As Long, ByVal position As Integer, ByVal percent As Integer, ByVal speed As Double)
 
        Me.Label1.Text = "Размер файла: " & Math.Round((length / 1024), 2) & " Кб"
 
 
        If speed = -1 Then
            Me.Label2.Text = "Подсчёт скорости"
        Else
            Me.Label2.Text = "Скорость: " & Math.Round((speed / 1024), 2) & " Кб/с"
        End If
 
        Me.ProgressBar1.Value = percent
 
 
    End Sub
 
    Private Sub btnDownload_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
 
        Me.Button1.Enabled = False
        Me.BackgroundWorker1.RunWorkerAsync() 'Начинаем загрузку
    End Sub
 
    Private Sub BackgroundWorker1_DoWork(ByVal sender As System.Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
 
        Dim theResponse As HttpWebResponse
        Dim theRequest As HttpWebRequest
        Try
 
            theRequest = WebRequest.Create("http://globalmods.16mb.com/Test.zip")
            theResponse = theRequest.GetResponse
        Catch ex As Exception
 
            MessageBox.Show("An error occurred while downloading file. Possibe causes:" & ControlChars.CrLf & _
                            "1) File doesn't exist" & ControlChars.CrLf & _
                            "2) Remote server error", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
 
            Dim cancelDelegate As New DownloadCompleteSafe(AddressOf DownloadComplete)
 
            Me.Invoke(cancelDelegate, True)
 
            Exit Sub
        End Try
        Dim length As Long = theResponse.ContentLength
 
        Dim safedelegate As New ChangeTextsSafe(AddressOf ChangeTexts)
        Me.Invoke(safedelegate, length, 0, 0, 0)
 
        Dim writeStream As New IO.FileStream("C:\Users\Alexandr\Desktop\minecraft.rar", IO.FileMode.Create)
 
 
        Dim nRead As Integer
 
 
        Dim speedtimer As New Stopwatch
        Dim currentspeed As Double = -1
        Dim readings As Integer = 0
 
        Do
 
            If BackgroundWorker1.CancellationPending Then
                Exit Do
            End If
 
            speedtimer.Start()
 
            Dim readBytes(4095) As Byte
            Dim bytesread As Integer = theResponse.GetResponseStream.Read(readBytes, 0, 4096)
 
            nRead += bytesread
            Dim percent As Short = nRead / length * 100
 
            Me.Invoke(safedelegate, length, nRead, percent, currentspeed)
 
            If bytesread = 0 Then Exit Do
 
            writeStream.Write(readBytes, 0, bytesread)
 
            speedtimer.Stop()
 
            readings += 1
            If readings >= 5 Then
                currentspeed = 20480 / (speedtimer.ElapsedMilliseconds / 1000)
                speedtimer.Reset()
                readings = 0
            End If
        Loop
 
 
        theResponse.GetResponseStream.Close()
        writeStream.Close()
 
        If Me.BackgroundWorker1.CancellationPending Then
 
            IO.File.Delete(Me.whereToSave)
 
            Dim cancelDelegate As New DownloadCompleteSafe(AddressOf DownloadComplete)
 
            Me.Invoke(cancelDelegate, True)
 
            Exit Sub
 
        End If
 
        Dim completeDelegate As New DownloadCompleteSafe(AddressOf DownloadComplete)
 
        Me.Invoke(completeDelegate, False)
 
    End Sub
 
    Private Sub Label3_Click(sender As System.Object, e As System.EventArgs) Handles Label1.Click
 
    End Sub
 
    Private Sub mainForm_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
 
    End Sub
End Class
8
вадим2
91 / 91 / 3
Регистрация: 01.12.2011
Сообщений: 94
02.04.2012, 19:27 #26
Сегодня решил написать о скриншотах, а именно: как сфотографировать окно по заголовку, как сфотографировать объект system.windows.forms, сфотографировать рабочий стол и рабочий стол с панелью задач.
фотографирование окна по заголовку

Класс для работы
vb.net
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
Imports System.Runtime.InteropServices
Public Class СкриншотОкнаПоЗаголовку
    <DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
 Private Shared Function FindWindow( _
      ByVal lpClassName As String, _
      ByVal lpWindowName As String) As IntPtr
    End Function
    Public Shared Function FindWindow1(ByVal windowName As String, ByVal wait As Boolean) As Integer
        Dim hWnd As Integer = FindWindow(Nothing, windowName)
        While wait AndAlso hWnd = 0
            System.Threading.Thread.Sleep(500)
            hWnd = FindWindow(Nothing, windowName)
        End While
        Return hWnd
    End Function
    Function скрин_отдельного_окна(ByVal заголовок_окна As String) As Image
        Return CaptureWindow(FindWindow1(заголовок_окна, False))
    End Function
    Public Shared Function CaptureWindow(ByVal WindowHandle As IntPtr) As Image
 
        Dim windowRect As New User32.RECT()
        User32.GetWindowRect(WindowHandle, windowRect)
        Dim width As Integer = windowRect.right - windowRect.left + 1
        Dim height As Integer = windowRect.bottom - windowRect.top + 1
 
        User32.SetWindowPos(WindowHandle, CType(User32.HWND_TOPMOST, System.IntPtr), 0, 0, 0, 0, _
         User32.SWP_NOMOVE Or User32.SWP_NOSIZE Or User32.SWP_FRAMECHANGED)
 
        Dim hdcSrc As IntPtr = User32.GetWindowDC(WindowHandle)
        Dim hdcDest As IntPtr = GDI32.CreateCompatibleDC(hdcSrc)
 
        Dim hBitmap As IntPtr = GDI32.CreateCompatibleBitmap(hdcSrc, width, height)
 
        Dim hOld As IntPtr = GDI32.SelectObject(hdcDest, hBitmap)
 
        GDI32.BitBlt(hdcDest, 0, 0, width, height, hdcSrc, _
         0, 0, GDI32.SRCCOPY)
 
        User32.SetWindowPos(WindowHandle, CType(User32.HWND_NOTOPMOST, System.IntPtr), 0, 0, 0, 0, _
         User32.SWP_NOMOVE Or User32.SWP_NOSIZE Or User32.SWP_FRAMECHANGED)
 
        GDI32.SelectObject(hdcDest, hOld)
        GDI32.DeleteDC(hdcDest)
        User32.ReleaseDC(WindowHandle, hdcSrc)
        Dim img As Image = Image.FromHbitmap(hBitmap)
        GDI32.DeleteObject(hBitmap)
        Return img
    End Function
    Private Class User32
 
        Public Const SWP_FRAMECHANGED As Integer = &H20
        Public Const SWP_NOMOVE As Integer = &H2
        Public Const SWP_NOSIZE As Integer = &H1
        Public Const SWP_NOZORDER As Integer = &H4
        Public Const HWND_TOPMOST As Integer = -1
        Public Const HWND_NOTOPMOST As Integer = -2
 
        <StructLayout(LayoutKind.Sequential)> _
        Public Structure RECT
            Public left As Integer
            Public top As Integer
            Public right As Integer
            Public bottom As Integer
        End Structure
 
        <DllImport("user32.dll")> _
        Public Shared Function GetWindowDC(ByVal hWnd As IntPtr) As IntPtr
        End Function
 
        <DllImport("user32.dll")> _
        Public Shared Function ReleaseDC(ByVal hWnd As IntPtr, ByVal hDC As IntPtr) As IntPtr
        End Function
 
        <DllImport("user32.dll")> _
        Public Shared Function GetWindowRect(ByVal hWnd As IntPtr, ByRef rect As RECT) As IntPtr
        End Function
 
        <DllImport("user32.dll", SetLastError:=True)> _
        Public Shared Function SetWindowPos(ByVal hWnd As IntPtr, ByVal hWndInsertAfter As IntPtr, ByVal x As Integer, ByVal y As Integer, ByVal cx As Integer, ByVal cy As Integer, _
         ByVal uFlags As UInteger) As <MarshalAs(UnmanagedType.Bool)> Boolean
        End Function
    End Class
    Private Class GDI32
 
        Public Const SRCCOPY As Integer = &HCC0020
 
        <DllImport("gdi32.dll")> _
        Public Shared Function BitBlt(ByVal hObject As IntPtr, ByVal nXDest As Integer, ByVal nYDest As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hObjectSource As IntPtr, _
         ByVal nXSrc As Integer, ByVal nYSrc As Integer, ByVal dwRop As Integer) As Boolean
        End Function
 
        <DllImport("gdi32.dll")> _
        Public Shared Function CreateCompatibleBitmap(ByVal hDC As IntPtr, ByVal nWidth As Integer, ByVal nHeight As Integer) As IntPtr
        End Function
 
        <DllImport("gdi32.dll")> _
        Public Shared Function CreateCompatibleDC(ByVal hDC As IntPtr) As IntPtr
        End Function
 
        <DllImport("gdi32.dll")> _
        Public Shared Function DeleteDC(ByVal hDC As IntPtr) As Boolean
        End Function
 
        <DllImport("gdi32.dll")> _
        Public Shared Function DeleteObject(ByVal hObject As IntPtr) As Boolean
        End Function
 
        <DllImport("gdi32.dll")> _
        Public Shared Function SelectObject(ByVal hDC As IntPtr, ByVal hObject As IntPtr) As IntPtr
        End Function
    End Class
End Class


Пример использования этого класса
vb.net
1
2
3
4
5
6
Dim классскрина As New СкриншотОкнаПоЗаголовку
        If TextBox1.Text = Nothing Then
            MsgBox("а заголовок где?")
        Else
            PictureBox1.Image = классскрина.скрин_отдельного_окна(TextBox1.Text)
        End If
скриншот обьекта system.windows.forms
функция для фотографирования
vb.net
1
2
3
4
5
6
7
8
9
    Function скрин_объект(ByVal obj As System.Windows.Forms.Control)
        Dim bmp As New Bitmap(obj.Width, obj.Height)
        obj.DrawToBitmap(bmp, New Rectangle(New Point(0, 0), obj.Size))
        Dim loc As Point = New Point(0, 0)
        bmp = bmp.Clone(New Rectangle(loc, obj.Size), Imaging.PixelFormat.Undefined)
        Dim a = IO.Path.GetTempFileName.Replace(".tmp", ".jpg")
        bmp.Save(a)
        Return a
    End Function
Пример использования
vb.net
1
2
3
PictureBox1.ImageLocation = скрин_объект(Button1)
PictureBox1.ImageLocation = скрин_объект(Me)
'и так можно любой объект
скриншот рабочего стола
функции использования
для фотографирования только экрана
vb.net
1
2
3
4
5
6
7
8
9
10
11
12
13
Function скрин() As String
        Dim fileName As String
        fileName = My.Computer.FileSystem.GetTempFileName()
        Dim sw, sh As Integer
        sw = My.Computer.Screen.WorkingArea.Size.Width
        sh = My.Computer.Screen.WorkingArea.Size.Height
        Dim scrpic As New System.Drawing.Bitmap(sw, sh)
        Dim gscrpic As Graphics = Graphics.FromImage(scrpic)
        gscrpic.Clear(Color.FromArgb(13, 11, 12))
        gscrpic.CopyFromScreen(New Point(0, 0), New Point(0, 0), New Size(sw, sh))
        scrpic.Save(fileName, Imaging.ImageFormat.Bmp) ' ВНИМАНИЕ!! тут формат рисунка
        Return fileName
    End Function
для фотографирования экрана и панели задач
vb.net
1
2
3
4
5
6
7
8
9
10
11
12
13
 Function скрин_с_панелью_задач() As String
        Dim fileName As String
        fileName = My.Computer.FileSystem.GetTempFileName()
        Dim sw, sh As Integer
        sw = My.Computer.Screen.Bounds.Size.Width
        sh = My.Computer.Screen.Bounds.Size.Height
        Dim scrpic As New System.Drawing.Bitmap(sw, sh)
        Dim gscrpic As Graphics = Graphics.FromImage(scrpic)
        gscrpic.Clear(Color.FromArgb(13, 11, 12))
        gscrpic.CopyFromScreen(New Point(0, 0), New Point(0, 0), New Size(sw, sh))
        scrpic.Save(fileName, Imaging.ImageFormat.Bmp) ' ВНИМАНИЕ!! тут формат рисунка
        Return fileName
    End Function
пример использования
vb.net
1
2
3
4
'для экрана
PictureBox1.ImageLocation = скрин()
'для экрана и панели задач
 PictureBox1.ImageLocation = скрин_с_панелью_задач()
Во влажениях эти примеры.
Вот и всё. Спасибо за внимание!
10
Вложения
Тип файла: zip скиншот объекта.zip (100.1 Кб, 231 просмотров)
Тип файла: zip Скриншот по заголовку.zip (71.8 Кб, 142 просмотров)
Тип файла: zip скриншот рабочего стола.zip (103.3 Кб, 140 просмотров)
вадим2
91 / 91 / 3
Регистрация: 01.12.2011
Сообщений: 94
11.04.2012, 19:41 #27
все мы знаем, как управлять прозрачностью формы:


vb.net
1
Me.Opacity = 1

однако это не та прозрачность, просмотрите во вложениях скриншот формы, код:


vb.net
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Imports System.Runtime.InteropServices
Public Class Form1
<Runtime.InteropServices.StructLayout(Runtime.InteropServices.LayoutKind.Sequential)> Public Structure MARGINS
        Public LeftWidth As Integer
        Public RightWidth As Integer
        Public TopHeight As Integer
        Public Buttomheight As Integer
    End Structure
    <Runtime.InteropServices.DllImport("dwmapi.dll")> Public Shared Function DwmExtendFrameIntoClientArea(ByVal hWnd As IntPtr, ByRef pMarinset As MARGINS) As Integer
    End Function
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Try
            Me.TransparencyKey = Color.Cyan 'контралах не используйте этот цвет, или меняйте
            Me.BackColor = Color.Cyan ''контралах не используйте этот цвет, или меняйте
            Dim margins As MARGINS = New MARGINS
            margins.LeftWidth = -1
            margins.RightWidth = -1
            margins.TopHeight = -1
            margins.Buttomheight = -1
            Dim result As Integer = DwmExtendFrameIntoClientArea(Me.Handle, margins)
        Catch ex As Exception
            MsgBox("ошибика" & Err.Description, vbCritical, "Fatal Error")
            Application.Exit()
        End Try
    End Sub
End Class
24
Миниатюры
Visual Basic .NET FAQ. Готовые решения, полезные коды  
Юпатов Дмитрий
1598 / 1110 / 223
Регистрация: 23.12.2010
Сообщений: 1,489
11.05.2012, 13:28 #28
Создание собственного элемента управления
Попробуем создать собственный ProgressBar (известно, что штатный далеко не всегда отвечает требованиям разработчика).
1. Создаем новый проект WindowsForms
2. Добавляем к проекту файл класса с именем UserProgressBar и заполняем его
следующим кодом
vb.net
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
Public Class UserProgressBar
    Inherits System.Windows.Forms.Control ' наследуем Control
    Dim min As UInteger
    Dim max As UInteger
    Dim CurVal As UInteger
    Dim orient As OrientationEnum
    Dim UText As String
    Dim Pimg As Bitmap
    Dim Gr As Graphics
    Dim Fclr As Color
    Dim WrText As WTenum
    Dim FS As FillStyleEnum
 
#Region "PublicProperties"
    Public Property Minimum() As UInteger
        Get
            Minimum = min
        End Get
        Set(ByVal value As UInteger)
            min = value
            DrawProgress()
        End Set
    End Property
    Public Property Maximum() As UInteger
        Get
            Maximum = max
        End Get
        Set(ByVal value As UInteger)
            max = value
            DrawProgress()
        End Set
    End Property
    Public Property CurrentValue() As UInteger
        Get
            CurrentValue = CurVal
        End Get
        Set(ByVal value As UInteger)
            CurVal = value
            DrawProgress()
        End Set
    End Property
    Public Property ProgressOrientation() As OrientationEnum
        Get
            ProgressOrientation = orient
        End Get
        Set(ByVal value As OrientationEnum)
            orient = value
            DrawProgress()
        End Set
    End Property
    Public Property FillColor() As Color
        Get
            FillColor = Fclr
        End Get
        Set(ByVal value As Color)
            Fclr = value
            DrawProgress()
        End Set
    End Property
    Public Property WrittenText() As WTenum
        Get
            WrittenText = WrText
        End Get
        Set(ByVal value As WTenum)
            WrText = value
            DrawProgress()
        End Set
    End Property
    Public Property FillStyle() As FillStyleEnum
        Get
            FillStyle = FS
        End Get
        Set(ByVal value As FillStyleEnum)
            FS = value
            DrawProgress()
        End Set
    End Property
#End Region
 
#Region "Enums"
    Public Enum OrientationEnum As Integer
        Horisontal = 0
        Vertical = 1
    End Enum
    Public Enum WTenum As Integer
        Text = 0
        Percentage = 1
        PercentageWithSumbol = 2
        PartOfOne = 3
        None = 4
    End Enum
    Public Enum FillStyleEnum As Integer
        Solid = 0
        Texture = 1
    End Enum
#End Region
 
    Public Sub New()
        ' задаем значения по-умолчанию и отрисовываем
        Me.Minimum = 0
        Me.Maximum = 100
        Me.CurrentValue = 0
        Me.WrText = WTenum.PercentageWithSumbol
        Me.ProgressOrientation = OrientationEnum.Horisontal
        Me.Size = New Size(100, 23)
        Me.BackgroundImageLayout = ImageLayout.Stretch
        Me.FillColor = Color.Green
        Me.BackColor = SystemColors.Window
        Me.FillStyle = FillStyleEnum.Solid
        DrawProgress()
    End Sub
 
    Private Sub DrawProgress()
        Try
            Me.Pimg = New Bitmap(Me.Width, Me.Height, Imaging.PixelFormat.Format32bppArgb)
            Gr = Graphics.FromImage(Pimg)
            Gr.CompositingQuality = Drawing2D.CompositingQuality.HighQuality
            Gr.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAliasGridFit
            ' создаем кисть с учетом стиля заливки и ориентации
            Dim br As Brush
            If Me.FillStyle = FillStyleEnum.Solid Then
                br = New SolidBrush(Me.FillColor)
            Else
                If Me.ProgressOrientation = OrientationEnum.Horisontal Then
                    br = New TextureBrush(My.Resources.h_fillelement)
                Else
                    br = New TextureBrush(My.Resources.v_fillelement)
                End If
            End If
            ' объявляем прясоугольник заполненной области и вычисляем его размеры с учетом состояния свойства ProgressOrientation
            Dim FillRect As Rectangle
            If Me.ProgressOrientation = OrientationEnum.Horisontal Then
                FillRect = New Rectangle(0, 0, CInt(CurVal / max * Me.Width), Me.Height)
            Else
                FillRect = New Rectangle(0, Me.Height - CInt(CurVal / max * Me.Height), Me.Width, CInt(CurVal / max * Me.Height))
            End If
            ' заливаем прямоугольник
            Gr.FillRectangle(br, FillRect)
            ' формируем строку для рисования с учетом свойства WrittenText
            Dim s As String = String.Empty
            Select Case WrittenText
                Case Is = WTenum.None
                    s = String.Empty
                Case Is = WTenum.PartOfOne
                    s = CInt(CurVal / max)
                Case Is = WTenum.Percentage
                    s = CInt(CurVal / max * 100)
                Case Is = WTenum.PercentageWithSumbol
                    s = CInt(CurVal / max * 100) & "%"
                Case Is = WTenum.Text
                    s = Me.Text
            End Select
            ' форматируем строку ( выравнивание - в центр области, поворот - по свойству ProgressOrientation)
            Dim drawformat As New StringFormat
            drawformat.Alignment = StringAlignment.Center
            drawformat.LineAlignment = StringAlignment.Center
            If Me.ProgressOrientation = OrientationEnum.Vertical Then drawformat.FormatFlags = StringFormatFlags.DirectionVertical
            ' рисуем строку
            Gr.DrawString(s, Me.Font, New SolidBrush(Me.ForeColor), New Rectangle(0, 0, Me.Width, Me.Height), drawformat)
            Me.BackgroundImage = Pimg
        Catch
        End Try
    End Sub
 
    ' в этом событии отслеживаются события контрола, при которых нам потребуется его перерисовка
    Private Sub UserProgressBar_Changed(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Resize, Me.ForeColorChanged, Me.FontChanged, Me.BackColorChanged
        Me.Pimg = New Bitmap(Me.Width, Me.Height, Imaging.PixelFormat.Format32bppArgb)
        DrawProgress()
    End Sub
End Class

4. В ресурсы проекта добавляем рисунки, служащие заливкой бара (2шт - для вертикального и горизонтального стилей (имена h_fillelement и v_fillelement соответственно). Рисунки во вложениях №1 и 2)
5. Создаем решение
6. На панели инструментов (если перейти в конструктор формы) мы увидим, что добавлен контрол UserProgressbar
7. Создаем тестоую форму: при создании проекта студия нам добавила пустую форму, вот ею и воспользуемся. Размещаем на форме 4 наших прогрессбара и NumericUpDown
Прогрессбар2 - устанавливаем свойство FillStyle=Texture
Прогрессбар3 - свойство ProgressOrientation=Vertical
Прогрессбар4 - свойства ProgressOrientation=Vertical и FillStyle=Texture
Больше ничего не меняем.
8. Открываем код формы и меняем его
следующим образом
vb.net
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Public Class Form1
    Private Sub NumericUpDown1_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles NumericUpDown1.ValueChanged
        Me.UserProgressBar1.CurrentValue = Me.NumericUpDown1.Value
        Me.UserProgressBar2.CurrentValue = Me.NumericUpDown1.Value
        Me.UserProgressBar3.CurrentValue = Me.NumericUpDown1.Value
        Me.UserProgressBar4.CurrentValue = Me.NumericUpDown1.Value
    End Sub
 
    Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        With Me.NumericUpDown1
            .Minimum = Me.UserProgressBar1.Minimum
            .Maximum = Me.UserProgressBar1.Maximum
            .Value = Me.UserProgressBar1.CurrentValue
        End With
    End Sub
End Class

9. Запускаем проект нажатием F5. Если все выполнено верно, появится форма (см. вложение №3). Попробуйте менять значения в NumericUpDown1

А теперь немного о коде класса UserProgressBar.
Класс унаследован от Control.
В регионе Enums содержатся перечисления, необходимые для красивого задания свойств нашего контрола:
OrientationEnum - ориентация направления заполнения бара (горизонт и вертикаль)
WTenum - отображаемый текст на контроле (строка из свойства Text, число процентов заливки, число процентов заливки со значком процента, доля заливки (0...1), ничего)
FillStyleEnum - стиль заливки (сплошным цветом или текстурой (вспоминаем о картинках в ресурсах)

В регионе PublicProperties содержатся свойства, которые добавляются нами как недостающие и доступны в панели свойств проекта (см. вложение №4):
Minimum, Maximum, CurrentValue - имеют тип Uinteger (целое не меньше 0 то есть) и думаю, значение их понятно.
ProgressOrientation - ориентация заливки (горизонт и вертикаль)
FillColor - цвет заливки при выбранном стиле заливки Solid
WrittenText - выбор типа отображаемого текста (см. перечисление WTenum)
FillStyle - стиль заливки (см перечисление FillStyleEnum)


Процедура New - выполняется при создании нового экземпляра UserProgressBar (независимо от того, программное создание или в конструкторе). Тут задаются значения по умолчанию для свойств контрола

Процедура DrawProgress - вот она и рисует полосу прогресса с учетом свойств. Обратите внимание, что для немедленной перерисовки процедура вызывается в каждом свойстве (см. код региона PublicProperties)
Процедура UserProgressBar_Changed - тут также вызывается перерисовка прогресса при некоторых унаследованных событиях. В данном случае это происходит при изменении размера, смены цвета подложки, и цвета шрифта, типа шрифта. Все это также повышает удобство пользования.

Ну и напоследок: Для изменения шрифта текста, который отрисовывается на баре используются свойства контрола Font и ForeColor, при установленном в позицию Text свойстве WrittenText рисуется строка из свойства Text элемента управления.

Весь проект лежит в архиве во вложении №5
Проект написан в VS 2008/
25
Миниатюры
Visual Basic .NET FAQ. Готовые решения, полезные коды   Visual Basic .NET FAQ. Готовые решения, полезные коды  
Изображения
  
Вложения
Тип файла: rar UserProgressBar.rar (184.8 Кб, 334 просмотров)
Russiablackbird
61 / 61 / 1
Регистрация: 23.01.2012
Сообщений: 254
11.05.2012, 20:45 #29
Для работы,добавляем в проект и импортируем штатную библиотеку shell32.dll Потом для упаковки пишем
vb.net
1
2
3
4
5
6
7
8
Sub Zip()
        Dim sh As New Shell32.Shell()
        Dim input As Shell32.Folder = sh.NameSpace("D:\Должностные инструкции")
        Dim ifs As IO.FileStream = IO.File.Create("d:\архив.zip")
        ifs.Close()
        Dim output As Shell32.Folder = sh.NameSpace("d:\архив.zip")
        output.CopyHere(input.Items, 4)
    End Sub
А для распаковки
vb.net
1
2
3
4
5
6
7
Sub UnZip()
        Dim sh As New Shell32.Shell()
        IO.Directory.CreateDirectory("d:\новая папка")
        Dim output As Shell32.Folder = sh.NameSpace("d:\новая папка")
        Dim input As Shell32.Folder = sh.NameSpace("d:\архив.zip")
        output.CopyHere(input.Items, 4)
    End Sub
21
Ciberst
503 / 416 / 18
Регистрация: 16.12.2010
Сообщений: 939
07.07.2012, 21:56 #30
Сбор мусора. (используется в основном при DDoS-атаках использование компонента WebBrowser и других разного рода вещей, когда вы наблюдаете рост памяти)
vb.net
1
GC.Collect
MSDN о GC.Collect
Цитата Сообщение от http://msdn.microsoft.com
Принудительно запускает немедленную сборку мусора для всех поколений.
Цитата Сообщение от http://msdn.microsoft.com
Используйте этот метод, чтобы попытаться высвободить всю недоступную память.
Сборке мусора подвергаются все объекты, вне зависимости от времени их нахождения в памяти. Однако объекты, на которые имеются ссылки в управляемом коде, не освобождаются. Используйте этот метод, чтобы принудительно предпринять попытку высвободить максимальный объем доступной памяти.
7
07.07.2012, 21:56
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
07.07.2012, 21:56
Привет! Вот еще темы с ответами:

Вопросы к экзамену по курсу Visual Basic .NET - Visual Basic .NET
Помогите ответить на вопросы по Visual Basic. Завтра зачет. Пропускал лекции т.к все время уезжал. Помогите. Желательно развернутый ответ....

Перевести код с VBA на Visual Basic.NET - Visual Basic .NET
Здравствуйте! Прошу помощи. Переведите, пожалуйста, код ниже с VBA (Эксель) на Visual Basic.NET. Обращаюсь вынужденно, поскольку не...

Популярные программы, написанные на Visual basic.NET - Visual Basic .NET
Сейчас есть множество популярных программ, написанных на разных языках программирования. А есть ли популярные или известные программы,...

Для чего нужен Visual Basic.Net? - Visual Basic .NET
Здравствуйте. Объясните пожалуйста для какой деятельности нужен Visual Basic и Visual Basic.Net? То есть для чего там делают программы? И...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
30
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2017, vBulletin Solutions, Inc.
Рейтинг@Mail.ru