Is there a method to perform 3D axis system rotation in draw widget by Mouse operator

mark jack

unread,

Apr 5, 2025, 8:12:34 AMApr 5

to dislin-users

Dear developer:

I want to know is there a simple method to rotate system in draw widget (created by wgdraw) by mouse button and move? I mean rotating 3D axis system directly via mouse control in draw region, not through separate slider widgets (such as wgscl).

Thanks!

Sincerely Mark.

Haydar AKDAĞ

unread,

Apr 5, 2025, 12:52:00 PMApr 5

to dislin...@googlegroups.com

I sharing my code to give you an idea , Exported from Notepad++

    do while (running)

        
        if (PeekMessage(msg, NULL, 0, 0, PM_REMOVE) .NEQV. .FALSE.) then
           !write(*,*) "Received message:", msg%message  ! Gelen mesajları yazdır
            
          
            
            tk = TranslateMessage(msg)
            tk = DispatchMessage(msg)

            ! WM_MOUSEMOVE kontrolü
            if (msg%message == WM_MOUSEMOVE) then
                xPos = msg%pt%x
                yPos = msg%pt%y

                ! Pencere içindeyse
                if (xPos >= winRect%left .and. xPos <= winRect%right .and. &
                    yPos >= winRect%top  .and. yPos <= winRect%bottom) then

                    ! İlk konumu kaydet
                    if (lastX < 0.0_8 .or. lastY < 0.0_8) then
                        lastX = real(xPos, kind=8)
                        lastY = real(yPos, kind=8)
                    end if

                    ! Fark hesapla
                    dx = real(xPos, kind=8) - lastX
                    dy = real(yPos, kind=8) - lastY

                    if (abs(dx) > 0.1_8 .or. abs(dy) > 0.1_8) then
                        xrot1 = xrot1 + dx * 0.5_8  
                        xrot2 = xrot2 + dy * 0.5_8  
                    end if

                    lastX = real(xPos, kind=8)
                    lastY = real(yPos, kind=8)
                end if
            end if

            ! WM_MOUSEWHEEL kontrolü
            if (msg%message == WM_MOUSEWHEEL) then
                wheelDelta = iand(ishft(msg%wParam, -16), Z'FFFF')
                if (wheelDelta > 32767) then
                    wheelDelta = wheelDelta - 65536
                end if

                ! Zoom işlemi
                factor = 0.5
                zoom = zoom + factor * (real(wheelDelta, kind=8) / 12.0)
                if (zoom <= 5.0D0) then
                    zoom = 5.0D0
                end if
            end if
            
              if (msg%message == WM_QUIT) then
                running = .FALSE.
                exit
              end if
        else
          exit
        end if
   end do

    
end subroutine mysub

subroutine myzoom(idm, ival)
    use var
    use dislin
    use ifwin
    implicit none
 integer(HANDLE) :: hWnd, hDC
    integer :: idm, ival,ikey
    real*8 :: factor
  integer(BOOL) :: iret
   ! integer(DWORD)  :: iret

    ! Aktif pencereyi al
    hWnd = GetForegroundWindow()

    ! Zoom faktörü
    factor = 0.05D0

    ! Fare tekerleği dönüşüne göre zoom güncellemesi
    if (ival == 1) then
        zoom = zoom + factor
    else if (ival == -1) then
        zoom = zoom - factor
    end if
    zoom=zoom 
    ! Zoom sınırlarını kontrol et
   ! if (zoom < 5.0D0) zoom = 5.0D0
   ! if (zoom > 20.0D0) zoom = 20.0D0

    ! **Grafiği güncelle**
   ! call setxid(id_draw, "widget")  ! Çizim widget'ını tekrar aktif yap
    !call disfin()                   ! **Ekranı güncellemek için gerekli**
   !call doevnt()                   ! **Olayları işleyerek anında tepki ver**
   
 
    
end subroutine myzoom

--------------------------------------------------------------------------

hhayda...@gmail.com

mark jack <liuyu...@gmail.com>, 5 Nis 2025 Cmt, 15:12 tarihinde şunu yazdı:

--
You received this message because you are subscribed to the Google Groups "dislin-users" group.
To unsubscribe from this group and stop receiving emails from it, send an email to dislin-users...@googlegroups.com.
To view this discussion visit https://groups.google.com/d/msgid/dislin-users/ae7b8fb0-0524-4a97-bde9-950acf4ab01cn%40googlegroups.com.

mark jack

unread,

Apr 11, 2025, 8:40:01 AMApr 11

to dislin-users

Thank you very much! Based on your advice, I successfully implemented this feature on Windows.

Reply all

Reply to author

Forward