Forum Coders' city Strona Główna Coders' city
Nasza pasja to programowanie!
 

 PomocPomoc   SzukajSzukaj   UżytkownicyUżytkownicy   GrupyGrupy  RejestracjaRejestracja 
Archiwum starego forum + teoria    RSS & Panel/SideBar
 ProfilProfil   Zaloguj się, by sprawdzić wiadomościZaloguj się, by sprawdzić wiadomości   ZalogujZaloguj 

Potrzebuję szybkiej odpowiedzi na moje pytanie... Zasady

[WinAPI] Zmiana współrzędnych linii w VBA



 
Odpowiedz do tematu    Forum Coders' city Strona Główna -> Biblioteki
Zobacz poprzedni temat :: Zobacz następny temat  
Autor Wiadomość
paacc



Dołączył: 09 Lis 2013
Posty: 3

PostWysłany: Sob Lis 09, 2013 5:07 pm  OP    Temat postu: [WinAPI] Zmiana współrzędnych linii w VBA Odpowiedz z cytatem Pisownia

Witam,

Korzystam z Windowsowskiego API, rysuje linie od punktu w który w który się przenosze (MoveToEx), w moim przypadku wpołrzędne x=300,y=300. Z tego punktu rysuje linie (lineTo) do wspłórzędnych myszy X i Y.
Moje pytanie jest takie , jak zmienic dlugość tej lini poprzez zdarzenie (MouseMove), ale żeby nie rysowac nowej linii. Chce miec poprostu jedna linie a nie pare tak jak teraz. Wrzucam tez screeny.

Kod:

Kod:

Option Explicit
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, lpPoint As POINTAPI) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Type POINTAPI
        X As Long
        Y As Long
End Type
Dim hwnd As Long
Dim hdc As Long
Dim pt As POINTAPI

Private Sub UserForm_Initialize()
  hwnd = FindWindow(vbNullString, UserForm1.Caption)
  hdc = GetDC(hwnd)
End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    If Button = 1 Then
         hdc = GetDC(hwnd)
         Call MoveToEx(hdc, 300, 300, pt)
         linia = LineTo(hdc, X, Y)
    End If

End Sub



Próbowałem odwoływać sie do obiektu poprzez SelectObject ale nie dziala.
Pozdrawiam.



linia.jpg
 Opis:
screen

Pobierz
 Nazwa pliku:  linia.jpg
 Wielkość pliku:  181.17 KB
 Pobierano:  177 raz(y)

Powrót do góry
Zobacz profil autora Wyślij prywatną wiadomość
samolot



Dołączył: 26 Sty 2006
Posty: 8094
Skąd: Toruń

PostWysłany: Sob Lis 09, 2013 9:36 pm      Temat postu: Odpowiedz z cytatem Pisownia

Zobacz , czego z ponizszego spisu nie masz:
1. Na poziomie modułu deklarujesz zmienną Rysuj typu Boolean i ustawiasz jej wstępnie wartość False
2. W procedurze zdarzenia MouseDown formy - zapamietujesz wspołrzedne kursora myszy i ustawiasz w tym zdarzeniu flagę Rysuj = True
3. W procedurze zdarzenie MouseMovie formy czyścisz formę i jeśli flaga Rysuj = True to rysujesz linię od zapamietamego punku do bieżacej pozycji kursora muszy.
4. W zdarzeniu MouseUp formy ustawiasz flagę Rysuj = False

Wg mnie nie masz tego, co podkreśliłem na czerwono.

_________________
Nie zadawaj bezcelowych pytań / Windows 8.1 / Windows 10 / VB2008 / VB 2010 / VB 2012 / Pisz poprawnie
Powrót do góry
Zobacz profil autora Wyślij prywatną wiadomość Wyślij email
paacc



Dołączył: 09 Lis 2013
Posty: 3

PostWysłany: Nie Lis 10, 2013 12:11 am  OP    Temat postu: Odpowiedz z cytatem Pisownia

Wydaje mi się że dodałem wszystko o czym napisałeś, oprócz czyszczenia formy, nie wiem jak to zrobic. Teraz mój kod wyglada tak:
Kod:

Private Sub UserForm_Initialize()
  
  hwnd = FindWindow(vbNullString, UserForm1.Caption)
  hdc = GetDC(hwnd)
  punkt.X = 0
  punkt.Y = 0

rysuj = False
  
End Sub

Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    punkt.X = X
    punkt.Y = Y
    rysuj = True
    
End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    If rysuj Then
        Call LineTo(hdc, punkt.X, punkt.Y)
    End If
  
End Sub

Private Sub UserForm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    rysuj = False
End Sub




Rysuje teraz polilinie. Wg mnie brakuje czegos co niszczyłoby poprzednia linię i rysowalo zamast jej nową.
Powrót do góry
Zobacz profil autora Wyślij prywatną wiadomość
samolot



Dołączył: 26 Sty 2006
Posty: 8094
Skąd: Toruń

PostWysłany: Nie Lis 10, 2013 1:37 pm      Temat postu: Odpowiedz z cytatem Pisownia

Musisz zrealizować jakoś punkt trzeci: wyczyścić poprzedni rysunek.

Wypróbuj dwa sposoby:
1. Rysowanie poprzedniej linii w kolorze tła.
Na początku zdarzenia MouseMovie narysuj poprzednią linię w kolorze tła formy.
Narysuj nową linię
Na końcu procedury MouseMovie zapamiętaj współrzędne nowej rysowanej linii.

2. No początku procedury MouseMovie czyść całą formę. Na przykład jeśli rysujesz na białym tle, to nadajesz formie taki BackColor:
Kod:
Me.BackColor = RGB(255, 255, 255)

Następnie rysuj nowa linię

_________________
Nie zadawaj bezcelowych pytań / Windows 8.1 / Windows 10 / VB2008 / VB 2010 / VB 2012 / Pisz poprawnie
Powrót do góry
Zobacz profil autora Wyślij prywatną wiadomość Wyślij email
paacc



Dołączył: 09 Lis 2013
Posty: 3

PostWysłany: Pon Lis 11, 2013 6:44 pm  OP    Temat postu: Odpowiedz z cytatem Pisownia

Dzieki za odpowiedz obydwa pomysły są dobre, mogą sie jeszcze przydać :) Ale w zdarzeniu MouseMove dodalem me.repaint i jest tak jak chciałem :)
Pozdrawiam i dzieki
Powrót do góry
Zobacz profil autora Wyślij prywatną wiadomość
Wyświetl posty z ostatnich:   
Odpowiedz do tematu    Forum Coders' city Strona Główna -> Biblioteki Wszystkie czasy w strefie CET (Europa)

Strona 1 z 1

 
Skocz do:  
Możesz pisać nowe tematy
Możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Możesz dodawać załączniki na tym forum
Możesz pobierać pliki z tego forum




Debug: strone wygenerowano w 0.08163 sekund, zapytan = 13
contact

| Darmowe programy i porady Jelcyna | Tansze zakupy w Helionie | MS Office Blog |