Сложность у меня вызвали масштабирование и скролинг
Cyr писал(а):И ещё надо, чтобы можно было вывести информацию по объекте при щелчке по нему.
Dim Масштаб
Private Sub Form1_Load(sender As Object, e As System.EventArgs) Handles Me.Load
Масштаб = 1
PictureBox1.Refresh()
End Sub
Private Sub Form1_Paint(sender As Object, e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
Dim blackPen As New Pen(Color.FromArgb(255, 0, 0, 0), 5)
Dim x, y, номер, i As UShort
Dim размер As Byte
'Готовим переменную GraphicsFun для графических вызовов
Dim GraphicsFun As System.Drawing.Graphics
GraphicsFun = Me.PictureBox1.CreateGraphics
Dim ЦветРамки As New Pen(Color.Black)
'Для создания заполненного прямоугольника используем кисть цвета
Dim ЦветФона As New SolidBrush(Color.CornflowerBlue)
Dim ЦветШрифта As New SolidBrush(Color.Black)
Dim drawFont As New Font("Microsoft Sans Serif", 8)
GraphicsFun.Clear(Color.White)
'Массштабирование
GraphicsFun.ScaleTransform(Масштаб, Масштаб)
размер = 25
For ряд = 0 To 6
For i = 0 To 89
x = i * размер
If x < 800 Then ' меньше размера окна
y = ряд * 3 * размер
номер = ряд * 90 * 2 + i
GraphicsFun.DrawRectangle(ЦветРамки, x, y, размер, размер)
GraphicsFun.FillRectangle(ЦветФона, x + 1, y + 1, размер - 1, размер - 1)
GraphicsFun.DrawString(номер, drawFont, ЦветШрифта, x, y)
GraphicsFun.DrawRectangle(ЦветРамки, x, y + размер, размер, размер)
GraphicsFun.FillRectangle(ЦветФона, x + 1, y + размер + 1, размер - 1, размер - 1)
End If
Next
Next
End Sub
Private Sub Больше_Click(sender As System.Object, e As System.EventArgs) Handles Больше.Click
If Масштаб < 2 Then
Масштаб = Масштаб * 2
End If
End Sub
Private Sub Меньше_Click(sender As System.Object, e As System.EventArgs) Handles Меньше.Click
If Масштаб > 0.5 Then
Масштаб = Масштаб / 2
End If
End Sub
Cyr писал(а):Как избавится от мигания?
Cyr писал(а): GraphicsFun = Me.PictureBox1.CreateGraphics
Cyr писал(а): GraphicsFun.Clear(Color.White)
Во-первых, делать так в хендлере paint неправильно и плохо:Cyr писал(а):
GraphicsFun = Me.PictureBox1.CreateGraphics
Во-вторых, мигание вполне естественно приCyr писал(а):
GraphicsFun.Clear(Color.White)
Cyr писал(а):А где это делать? в Form1_Load ? Но тогда изображение исчезает сразу после первой прорисовки.
А если не стирать старое изображение, то новое изображение накладывается поверх.
А по ссылкам почитать?
Dim myLabel As Label
Private Sub Forml_Load(ByVal sender As System.Object, ByVal e As _
System.EventArgs) Handles MyBase.Load
Dim TextLine As String
Dim x, y As UInteger
FileOpen(1, "c:\палаткиVB.txt", OpenMode.Input, OpenAccess.Read, , )
Do While Not EOF(1)
' Read line into variable.
TextLine = LineInput(1)
' Display result in a message box.
x = TextLine.Split(",").GetValue(0)
y = TextLine.Split(",").GetValue(1)
newlabel_create(x, y, "150", 0)
Loop
FileClose(1)
End Sub
Public Sub newlabel_create(x, y, Text, tip)
Dim newlabel As New System.Windows.Forms.Label()
' Задать свойства newLabel
With newlabel
.Visible = True
If tip = 0 Then
.Size = New Size(25, 25)
.BackColor = Color.CornflowerBlue
.Font = New Font("Microsoft Sans Serif", 6.75)
Else
.Size = New Size(13, 13)
.BackColor = Color.Peru
.Font = New Font("Microsoft Sans Serif", 3.75)
End If
.BorderStyle = BorderStyle.FixedSingle
.Name = Text
.Text = Text
.TextAlign = ContentAlignment.MiddleCenter
.Location = New Size(x, y)
End With
Me.Controls.Add(newlabel)
AddHandler newlabel.Click, AddressOf Me.newlabel_Click
End Sub
Cyr писал(а):Сложновато...
Cyr писал(а):А можно ли как-нибудь быстро выводить и перерисовывать 1300 объектов label ?
Cyr писал(а):вернее у меня сейчас вот так:
Ты на VB.NET пишешь, а не на VB6. Работай с файлами по-человечески.
И со строками. Зачем выполнять одни и те же операции несколько раз?
Cyr писал(а):Я делаю как проще (как умею).
Cyr писал(а):А как же иначе прочитать координаты из файла и нарисовать label?
Cyr писал(а):Может можно как-то отключить перерисовку окна при выводе каждого label а в конце включить отображение "одним махом"?
SetStyle(ControlStyles.UserPaint, True)
SetStyle(ControlStyles.AllPaintingInWmPaint, True)
SetStyle(ControlStyles.DoubleBuffer, True)
Shurrik писал(а):В твоем случае, если карта не изменяется, можно все построить в памяти один раз, а выводить только часть рисунка.
Shurrik писал(а):Для предотвращения мерцания при перерисовке изображения используют двойную буферизацию.
Cyr писал(а):И ещё такая проблемка, надо как-то отделить кнопки управления от остального экрана. Когда водишь курсором над кнопками, происходит перерисовка всей формы. А т.к. объектов много, картинка тухнет и перерисовывается несколько раз медленно.
Cyr писал(а):Это типовая задача, неужели нет готового работающего и отлаженного со всех сторон примера, учитывающего все тонкости творения Microsoft?
Qwertiy писал(а):Ничего непонятно. Нафига вообще перерисовывать карту на MouseMove?
Qwertiy писал(а):И не типовая она. Как уже писали, для графических задач существует DirectX.
Qwertiy писал(а):Чем не устраивает мой пример с движущимися кругами?
Cyr писал(а):В том то и дело, что такой процедуры в программе нет. Карта перерисовывается через paint, который вызывается самой Windows автоматически для обновления формы. При движении курсора мы ведь им заслоняем кнопки.
Cyr писал(а):Как это не типовая? Во всех учебниках есть примеры использования класса Graphics, и везде пишут, что его методы (команды) надо вставлять в paint.
Cyr писал(а):попробуйте его сделать для вывода 1300 квадратиков с текстом и фоном.
Cyr писал(а):Почему же MS не позаботилась о нормальной отрисовке?
Dim rects As Rectangle() 'массив квадратов
Private Sub Form1_Load(sender As Object, e As System.EventArgs) Handles Me.Load
Dim path As String = "c:\палаткиVB.txt"
'файл из строк вида: x,y,номер
Dim readText() As String = IO.File.ReadAllLines(path)
Dim s As String
For Each s In readText
'заполнить массив квадратов
'заполнить массив номеров
Next
End Sub
Private Sub Form1_Paint(sender As Object, e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
Dim blackPen As New Pen(Color.Black)
'вывести массив квадратов
e.Graphics.DrawRectangles(blackPen, rects)
Dim Фон As New SolidBrush(Color.Blue)
'вывести массив заштрихованных квадратов
e.Graphics.FillRectangles(Фон, rects)
Dim Текст As New Pen(Color.Black)
'вывести надписи номеров
e.Graphics.DrawString()
End Sub
Cyr писал(а):Как заполнить массив квадратов и номеров?
Class MapItem
Public X As Integer, Y As Integer
Public Text As String
Public Sub New()
End Sub
Public Sub New(ByVal X As Integer, ByVal Y As Integer)
With Me
.X = X
.Y = Y
.Text = Text
End With
End Sub
End Class
Private Marks As New List(Of MapItem)
For Each Line As String In File.ReadAllLines(Path)
Dim Temp As String = Line.Split(","c)
Marks.Add(New MapItem(Integer.Parse(Temp(0)), Integer.Parse(Temp(1)), Temp(2)))
Next Line
И что рисовать надо было сразу в paint от начала и до конца, а не как я - по одному.что не надо вызывать CreateGraphics в Paint. Надо использовать e.Graphics вместо этого.
Qwertiy писал(а):Да квадраты рисовать вообще замечательно, не то что круги.
Cyr писал(а):Надо было стразу сказать,
FireFenix писал(а):И как ни странно, круги, которые мерцают и немного плющит
Qwertiy писал(а):Я как раз поэтому и сказал, не то что круги. Если увеличивать bounding box не на пару пикселей, как в моём коде, а на пару десятков, то шевеление границ круга пропадает.
FireFenix писал(а):Мой вариант на WPF, впрочем как почти и должно быть...
Mouse Click (не на синих квадратах) + Move -> перемещение всех квадратов
Mouse Click (на квадрате) -> MsgBox с именем квадрата
Mouse Scroll -> масштаб
Cyr писал(а):FireFenix, посмотрел. Реализация классная. Но единственно, что мне не понравилось - это то, что толщина границ объектов при изменении масштаба тоже изменяется. И большинство линий получаются размытыми почти при любом масштабе, кроме крупных. Как будто схема один раз рисуется на канве, а потом масштабируется уже не как векторный рисунок, а как растровая картинка.
FireFenix писал(а):возьми убери масштабирование границ
Cyr писал(а):И большинство линий получаются размытыми почти при любом масштабе, кроме крупных.
Cyr писал(а): потом масштабируется уже не как векторный рисунок, а как растровая картинка.
Cyr писал(а):пробовал убирать толщину, не помогло
Cyr писал(а):Как это сделать?
Сейчас этот форум просматривают: SemrushBot и гости: 15