Помогите с MoveToEx

[XairOn]

Вобщем проблема, моя состоит в том, что пытаюсь написать что-то вроде Paint'a и вот понять не могу как рисовать, вернее

рисовать могу, но рисуется почему-то всё из нулевой точки, вобщем вот код, посмотрите где моя ошибка:

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

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, lpPoint As Any) As Long

Dim xy As POINTAPI

   Private Sub Command1_Click()
   Timer1.Enabled = True
   End Sub

   Private Sub Timer1_Timer()
   GetCursorPos xy
   LineTo GetWindowDC(GetDesktopWindow), xy.X, xy.Y
   'MoveToEx GetWindowDC(GetDesktopWindow), xy.X, xy.Y, ByVal 0& - вот тут я и не знаю толком что к чему
   End Sub


И ещё вопросик: а как толщину линий регулировать? Ну к примеру 5 пикселей, что бы была, как сделать?[/code]

[xolod]

Вот код, думаю разберешься что к чему:

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

Option Explicit

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, lpPoint As Any) As Long

Private Sub Form_Load()
  ScaleMode = vbPixels
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If (Button = vbLeftButton) Then
    MoveToEx hdc, ScaleWidth \ 2, ScaleHeight \ 2, ByVal 0&
    LineTo hdc, X, Y
  End If
End Sub


[XairOn]

Нет, так не катит, может я вопрос не так задал, вобщем мне нужно, что бы за мышкой оставался след в виде линии, и не только в окне формы, а вообще в любом окне, тот код который я выложил в первом сообщении работает, но все линии рисуются из нулевой позиции, короче функция MoveToEx работает у меня неправильно, она должна перемещать точку рисования... но она этого не делает, я там что-то напортачил. Кстати в том примере который ты выложил тот же косяк, все линии рисуются из центра формы - солнышко какое-то получается, а должно быть как, например, в Paint'е карандашиком рисуешь, и за ним остается линия.

[GSerg]

А ты думаешь, ты один там рисуешь?

Сохраняй у себя в проге последнюю точку и ставь её через movetoex перед lineto.

[XairOn]

Сохраняй у себя в проге последнюю точку и ставь её через movetoex перед lineto

Так я пробовал, но у меня не получается - эффект тот же. Может подскажешь, как правильно надо делать?

[xolod]

Что значит "эффект тот же... солнышко какое-то получается"?!
Естественно, я же указал рисовать из центра формы!

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

  MoveToEx hdc, ScaleWidth \ 2, ScaleHeight \ 2, ByVal 0&
  LineTo hdc, X, Y


Вот тебе пример, как рисовать кисточкой на форме, там используются медленные встроенные функции (pset, line) но главное есть алгоритм. Что-то больше лень было писать, надеюсь, ты поймешь и адаптируешь для себя

[XairOn]

Спасибо конечно большое, но мой вопрос видать ты так и не понял, на форме рисовать и я могу, а мне нужно рисовать исключительно api функциями - LineTo и MoveToEx (ты первое сообщение внимательно читал, зачем там по-твоему GetWindowDC(GetDesktopWindow) - что бы рисовать на рабочей области, а не на форме), так вот эта MoveToEx у меня не работает, точка рисования всегда остается в нуле, а мне надо её переносить и из неё рисовать новую линию, иначе получается, что у меня все линии идут из левого верхнего угла экрана.

[GSerg]

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

Option Explicit

Private Declare Function LineTo Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function MoveToEx Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As Any) As Long
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hdc As Long) As Long

Private Type POINT
  x As Long
  y As Long
End Type

Private p As POINT

Private Sub AppendLine(ByVal x As Long, ByVal y As Long)
  Dim h As Long
 
  h = GetDC(0)
  MoveToEx h, p.x, p.y, ByVal 0&
  LineTo h, x, y
  p.x = x
  p.y = y
  ReleaseDC 0, h
End Sub

Private Sub Form_Click()
  AppendLine 100, 100
  AppendLine 300, 200
  AppendLine 600, 400
End Sub

[XairOn]

GSerg спасибо тебе большое за код, я его немного поправил и теперь всё работает как надо, только вот один... вернее два вопроса осталось: как только вызываю функцию первая линия все равно рисуется из нуля, потом всё нормально - как это исправить, и второй вопрос: можно ли толщину линий регулировать???

[GSerg]

Чтобы начиналась не из нуля, перед вызовом append установи p.
Чтобы регулировать толщину - перед lineto вставить prevpen=selectobject(h,createpen(ps_solid, толщина, цвет)), а перед releasedc - deleteobject selectobject(h, prevpen).

[XairOn]

Ну теперь всё, окончательное спасибо. Всё работает!