Текст в PictureBox как в Corel

[Timoxa]

Необходимо выводить текст в PictureBox. Как реализоавть знаю.
Но затем его необходимо перещать и редактировать. Например так как сделано в Corel.

[Blame!]

А как ты его выводишь (рисуешь или label исп.)?

[Blame!]

Для перемещения label'a по форме

Код: Выделить всё


Option Explicit
Private tr As Boolean
Private X1 As Integer
Private Y1 As Integer

Private Sub Label1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  tr = True
  X1 = X
  Y1 = Y
End Sub

Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If tr = True Then
    Me.Label1.Left = (Me.Label1.Left + X) - X1
    Me.Label1.Top = (Me.Label1.Top + Y) - Y1
  End If
End Sub

Private Sub Label1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  tr = False
End Sub


Для редактирования подставляешь за место label текстовое поле

[BV]

2 Timoxa

CorelDraw - не растровый, а векторный редактор. Там создается слой с набором свойств и выводится он по своим функциям а не так как ты знаешь. Для тебя будет проще оставить эту затею

[Timoxa]

Конечно с Label я думал как вариант, но надо еще масштабировать и поварачивать, а вот поваричивать его проблематично.

[tyomitch]

Лейбл, который легко поворачивать: http://vbrussian.com/Controls.asp?ID=100

[Konst_One]

Может будет кому полезным:

[Timoxa]

Неужели нет больше вариантов ?

[nekeda]

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

[Timoxa]

Спасибо, что сделал вывод....

[Matew]

Timoxa
Поворачивай на здоровье

Код: Выделить всё

        NOption Explicit
Private Declare Function SelectObject _
        Lib "gdi32.dll" (ByVal hdc As Long, _
                         ByVal hObject As Long) As Long
Private Declare Function DeleteObject _
        Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function CreateFont _
        Lib "gdi32" _
        Alias "CreateFontA" (ByVal H As Long, _
                             ByVal w As Long, _
                             ByVal E As Long, _
                             ByVal O As Long, _
                             ByVal w As Long, _
                             ByVal i As Long, _
                             ByVal U As Long, _
                             ByVal S As Long, _
                             ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) As Long
Private Const ANSI_CHARSET As Long = 0

Private Const FF_DONTCARE As Long = 0

Private Const CLIP_LH_ANGLES As Long = &H10

Private Const CLIP_DEFAULT_PRECIS As Long = 0

Private Const OUT_TT_ONLY_PRECIS As Long = 7

Private Const PROOF_QUALITY As Long = 2

Private Const TRUETYPE_FONTTYPE As Long = &H4

Private Const p_WIDTH As Long = 24

Private Const p_HEIGHT As Long = 48
Private Declare Function TextOut _
        Lib "gdi32.dll" _
        Alias "TextOutA" (ByVal hdc As Long, _
                          ByVal X As Long, _
                          ByVal Y As Long, _
                          ByVal lpString As String, _
                          ByVal nCount As Long) As Long
Private Sub Paint(Grad As Long)
Dim NewFont As Long, OldFont As Long
NewFont = CreateFont(p_HEIGHT, p_WIDTH, Grad, 0, FF_DONTCARE, 0, 0, 0, ANSI_CHARSET, OUT_TT_ONLY_PRECIS, CLIP_LH_ANGLES Or CLIP_DEFAULT_PRECIS, PROOF_QUALITY, TRUETYPE_FONTTYPE, "Courier New")
OldFont = SelectObject(pbDoc.hdc, NewFont)

TextOut pbDoc.hdc, 200, 200, "Tvoy text", Len("Tvoy text")

NewFont = SelectObject(pbDoc.hdc, OldFont)
DeleteObject NewFont
pbDoc.Cls

End Sub

Private Sub Form_Paint()
Dim i As Long
Do
For i = 0 To 3600 Step 10
    Paint (i)
    DoEvents
Next i
Loop
End Sub


[tyomitch]

Matew, такой код и лежит по приведённой мной ссылке -- только в виде реюзабельного юзерконтрола.