ИнтеллигенцияX

Функция LoadCursorFromFile создает курсор, основанный на данных, содержащихся в файле. Файл определен его именем или идентификатором курсора системы. Функция возвращает значение дескриптора недавно созданного курсора. Файлы, содержащие данные курсора могут быть или в формате курсора (.CUR) или "живого указателя" (.ANI).

Благодаря этой функции можно применять различные курсоры в своих программах.

Подробней об функции LoadCursorFromFile

Imports System.Runtime.InteropServices
Public Class Form1
    <DllImport("user32.dll", EntryPoint:="LoadCursorFromFileW", CharSet:=CharSet.Unicode)> _
    Public Shared Function LoadCursorFromFile(ByVal str As [String]) As IntPtr
    End Function
    Private cursorHandle As IntPtr = IntPtr.Zero
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Dim OFD As New OpenFileDialog
        With OFD
            .FileName = Nothing
            .Filter = "Cursors|*cur;*ani"
            If .ShowDialog = DialogResult.OK Then
                cursorHandle = LoadCursorFromFile(.FileName)
                Cursor = New Cursor(cursorHandle)
            End If
        End With
    End Sub
End Class

Загрузить проект (внутри курсоры)

Исправил прошлую версию.

Загрузить проект (исправлено)

Если будут пожелания, то могу реализовать график приема.

Бывают различные ситуации, когда обычный вид формы не подходит для поставленных целей, так что смотрим на простом примере, как сделать овальную форму не используя WIN API.

Imports System.Drawing.Drawing2D
Public Class Form1
    Public Sub New()
        InitializeComponent()
        Me.FormBorderStyle = FormBorderStyle.None
        Me.BackColor = Color.Black
    End Sub
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Dim g As New GraphicsPath
        Dim gr As Graphics = Me.CreateGraphics()
        Dim Frm As Rectangle = Me.ClientRectangle
        Frm.Inflate(-1, -1)
        g.AddEllipse(Frm)
        Me.Region = New Region(g)
        gr.Dispose()
    End Sub
End Class

Привет всем!

Здесь я хочу немного рассказать об UAC и о том как же взаимодействовать с ним в NET'е.

Для начала давайте вспомним что же такое этот UAC:

Контроль учётных записей пользователей (англ. User Account Control, UAC) — компонент операционных систем Microsoft Windows, впервые появившийся в Windows Vista. Этот компонент запрашивает подтверждение действий, требующих прав администратора, в целях защиты от несанкционированного использования компьютера.

Как видно из цитаты в Окнах без UAC никуда. И дабы не отставать от моды давайте рассмотрим пару примеров написанных на VB.NET.

Функция проверки на наличие прав Администратора у программы:

Private Function CheckAdmin() As Boolean
    Dim wp As New System.Security.Principal.WindowsPrincipal(System.Security.Principal.WindowsIdentity.GetCurrent())
    Return wp.IsInRole(System.Security.Principal.WindowsBuiltInRole.Administrator)
End Function

Запуск программы с правами Администратора (с UAC, то бишь вылетит вопрошающие окно):

Dim startInfo As New ProcessStartInfo(Application.ExecutablePath)
startInfo.UseShellExecute = True
startInfo.WorkingDirectory = Environment.CurrentDirectory
startInfo.Verb = "runas"

Try
    Process.Start(startInfo)
Catch ex As System.ComponentModel.Win32Exception
    MsgBox(ex.Message)
End Try

Добавить на Button красивый щит, как бы говоря конечному пользователю "У нас всё серьёзно!":

'Импорт:
Private Declare Auto Function SendMessage Lib "user32.dll" _
         (ByVal hwnd As IntPtr, _
          ByVal msg As UInteger, _
          ByVal wParam As UInteger, _
          ByVal lParam As UInteger) As UInteger

'В процедуру/функцию/куда угодно:
ИМЯ_КНОПКИ.FlatStyle = FlatStyle.System
SendMessage(ИМЯ_КНОПКИ.Handle, 5644, 0, &HFFFFFFFFUI)

Вот так это выглядит: 

Статью и примеры для вас подготовил Gemorg. Прошу любить и жаловать)

P.S. Должно работать на Окнах старше XP (не включая).

P.P.S. Тестировалось только на Win 8.

До этого мы разбирали пример, решения выражения с помощью метода Eval из VBS, а сегодня разберем, как средствами .NET вычислить результат строки (выражения)

Решение.NET.zip

Imports System.CodeDom.Compiler
Imports System.Reflection
Public Class Form1
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Label1.Text = "Ответ: " & Решить(TextBox1.Text)
    End Sub
    Public Function Решить(ByVal выражение As String) As String
        Dim myCode As CodeDomProvider = CodeDomProvider.CreateProvider("VB")
        Dim myPar As New CompilerParameters()
        'формируем виртуальный класс, в котором будет производиться расчет
        Dim myCodeBody As New System.Text.StringBuilder()
        myCodeBody.AppendLine("Public Class MyCalculator")
        myCodeBody.AppendLine("Public Function Calc() As Double")
        'TextBox1.Text.ToLower().Replace(«x», TextBox2.Text) — меняем икс в формуле (TextBox1) на число указанное в TextBox2
        '.Replace(«,», «.») — меняем запятые на точки, т.к. в VB в качестве десятичного разделителя используются точки
        myCodeBody.AppendLine(String.Format("Return {0}", выражение))
        myCodeBody.AppendLine("End Function")
        myCodeBody.AppendLine("End Class")
        'компилируем
        Dim myResult As CompilerResults = myCode.CompileAssemblyFromSource(myPar, myCodeBody.ToString())
        If myResult.Errors.HasErrors Then
            'какие-то ошибки
            For i As Integer = 0 To myResult.Errors.Count - 1
                If myResult.Errors(i).ErrorText = "Ожидалось выражение." Then
                    MsgBox(myResult.Errors(i).ErrorText, MsgBoxStyle.Critical, "Ошибка")
                End If
            Next
            Return "Ошибка!"
        End If
        'ошибок нет, выдергиваем наш класс
        Dim myAsm As Assembly = myResult.CompiledAssembly()
        Dim myCls As Object = myAsm.CreateInstance("MyCalculator", True)
        'выводим результат
        Return myCls.Calc().ToString
    End Function
End Class

Выйти из спящего режима можно пошевелив мышью.

Public Class Form1
    <Runtime.InteropServices.DllImport("user32.dll", SetLastError:=True, CharSet:=Runtime.InteropServices.CharSet.Auto)> _
    Private Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal Msg As UInteger, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
    End Function
    Private Const MONITOR_ON = -1&
    Private Const MONITOR_LOWPOWER = 1&
    Private Const MONITOR_OFF = 2&
    Private Const SC_MONITORPOWER = &HF170 '&
    Private Const WM_SYSCOMMAND = &H112
    'Отключение
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        SendMessage(Me.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, MONITOR_OFF)
    End Sub
    'Включение
    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
        SendMessage(Me.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, MONITOR_ON)
    End Sub
End Class

На форму кидаем:

• Button
• ListBox
• WebBrowser

В WebBrowser пишите любой сайт, я взял https://ya.ru/

Ну и сам код:

Dim H As HtmlElementCollection = WebBrowser1.Document.Body.GetElementsByTagName("a")
For Each Url As HtmlElement In H
ListBox1.Items.Add(Url.GetAttribute("href"))
Next

Также можно получить, как ссылку так и текст к ней.

ListBox1.Items.Add(Url.GetAttribute("href") & "|" & Url.InnerHtml)

Загрузить проект

Простите, что давно ничего не писал.

Возможно для саморазвития я приведу практически два одинаковых примера перемещения формы.

Первый вариант с помощью API функций SendMessage и ReleaseCapture:

Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
                (ByVal hWnd As Integer, ByVal wMsg As Integer, _
                 ByVal wParam As Integer, ByVal lParam As Integer) As Integer
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown
    ReleaseCapture()
    SendMessage(Me.Handle, WM_NCLBUTTONDOWN, HTCAPTION, 0)
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
    Me.FormBorderStyle = FormBorderStyle.None
End Sub

Слишком много кода, не правда ли?

Второй вариант, с помощью структуры Message, посылаем сообщение Windows:

Private Const WM_NCHITTEST As Integer = &H84
Private Const HTCAPTION = 2
Protected Overrides Sub WndProc(ByRef m As Message)
    If (m.Msg = WM_NCHITTEST) Then
        m.Result = IntPtr.op_Explicit(HTCAPTION)
    Else
        MyBase.WndProc(m)
    End If
End Sub

Дополнительно:

Функция SendMessage и функция ReleaseCapture.

Красивый эффект "горящего" текста на форме:

Imports System.Drawing.Drawing2D
Public Class Form1
    Private Sub Form1_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint
        Me.BackColor = Color.Black
        'создаем лист для рисования 58х43
        Dim bm As New Bitmap(CInt(Me.ClientSize.Width / 5), CInt(Me.ClientSize.Height / 5))
        'создаем траекторию
        Dim pth As New GraphicsPath
        'добавим строку в заданном стиле
        pth.AddString("VB.NET", New FontFamily("Tahoma"), CInt(FontStyle.Bold), 48, New Point(70, 60), StringFormat.GenericTypographic)
        'создаем поверхность для рисования
        Dim g As Graphics = Graphics.FromImage(bm)
        Dim mx As Matrix
        mx = New Matrix(1.0F / 5, 0, 0, _
                        1.0F / 5, -(1.0F / 5), _
                        -(1.0F / 5))
        'выберем режим сглаживания для поверхности
        g.SmoothingMode = SmoothingMode.AntiAlias
        'преобразуем объект Graphics
        g.Transform = mx
        'создадим перо
        Dim p As New Pen(Color.Tomato, 3)
        'рисуем вокруг созданного пути
        g.DrawPath(p, pth)
        'и заполняем для лудшего эфекта
        g.FillPath(Brushes.Yellow, pth)
        'освобождаем ресурсы
        g.Dispose()
        'установим режим сглаживания для контура (действие на форму)
        e.Graphics.SmoothingMode = SmoothingMode.AntiAlias
        'e.Graphics.InterpolationMode = InterpolationMode.HighQualityBicubic
        'и расширяем картинку для создания размытости краев
        e.Graphics.DrawImage(bm, ClientRectangle, 0, 0, bm.Width, bm.Height, GraphicsUnit.Pixel)
        'перерисовываем оригинальный текст
        e.Graphics.FillPath(Brushes.Black, pth)
        'освобождаем ресурсы
        pth.Dispose()
    End Sub
End Class

Источник