Draw Eyes II

Category: Games

Date: 02-16-2022

'Compilable Example:  (Jose Includes)
#Compile Exe
#Dim All
%Unicode=1
#Include "Win32API.inc"

Global hDlg, hBMP, hBMPDC, hDC As Dword, r As Single
Enum Equates Singular
   IDC_Graphic = 500
   IDC_Timer
End Enum

Function PBMain() As Long
   Dialog New Pixels, 0, "gbEyes",300,300,200,200, %WS_Popup, %WS_Ex_Layered To hDlg
   Dialog Set Color hDlg, %Black, %White
   'create the graphic control on which the eye is drawn (fills the dialog)
   Control Add Graphic, hDlg, %IDC_Graphic, "", 0,0,200,200
   Graphic Attach hDlg, %IDC_Graphic
   Graphic Color %Black, %White
   Graphic Clear
   Dialog Show Modal hDlg Call DlgProc
End Function

CallBack Function DlgProc() As Long
   Select Case Cb.Msg
      Case %WM_InitDialog
         SetLayeredWindowAttributes(hDlg, %White, 255, %LWA_ALPHA Or %LWA_Colorkey)
         SetTimer(hDlg, %IDC_Timer, 100, ByVal %NULL)
      Case %WM_ContextMenu
         Dialog End hDlg
      Case %WM_LButtonDown
         If Cb.WParam = %MK_LBUTTON Then SendMessage hDlg, %WM_NCLButtonDown, %HTCaption, ByVal %Null  ' force drag
      Case %WM_Timer
         DrawEyes
   End Select
End Function

Sub DrawEyes
   Local pt As Point, r,s,xc,yc,x,y,ddx, ddy,sx,sy,h As Long, A As Single
   GetCursorPos pt
   'draw eyes, no pupils
   s = 60 : r = 25 : xc = 50 : yc = 50   's=separation r=radius
   Graphic Width 1
   Graphic Clear
   Graphic Ellipse (xc-r,yc-r)-(xc+r,yc+r), RGB(1,1,1), %rgb_Wheat
   Graphic Ellipse (xc-r+s,yc-r)-(xc+r+s,yc+r), RGB(1,1,1), %rgb_Wheat

   Dialog Get Loc hDlg To x,y
   x = x + xc + r       : y = y + yc + r       'x,y is center of left eye
   sx = pt.x - x        : sy = pt.y - y        'center to cursor
   h = Sqr(sx*sx + sy*sy)                      'hypotenuse - center of eye to cursor
   ddy = (sy/h) * (r/2) : ddx = (sx/h) * (r/2) 'delta x,y to move to reach r/2

   'draw pupils
   Graphic Ellipse (xc+ddx-r/3,yc+ddy-r/3)-(xc+ddx+r/3,yc+ddy+r/3), %Black, %Black
   Graphic Ellipse (xc+ddx-r/3+s,yc+ddy-r/3)-(xc+ddx+r/3+s,yc+ddy+r/3), %Black, %Black

   'draw lids
   If Pt.y < yc Then Exit Sub
   a = Max(1-(pt.y-yc)/500, 0.1)
   Graphic Arc (xc-r,yc-a*r)-(xc+r,yc+a*r), 0, 3.14, RGB(1,1,1)
   Graphic Arc (xc-r+s,yc-a*r)-(xc+r+s,yc+a*r), 0, 3.14, RGB(1,1,1)
   Graphic Paint Border (xc,yc-r+2), %rgb_Peru, RGB(1,1,1)
   Graphic Paint Border (xc+s,yc-r+2), %rgb_Peru, RGB(1,1,1)

   'other face parts
   Graphic Width 5
   Graphic Ellipse (xc+s/2-5,yc+s/2-5)-(xc+s/2+5,yc+s/2+5), %Black, %Black  'nose
   Graphic Arc (xc-0.6*r,yc-r/2)-(xc+s+0.6*r,yc+2.5*r), 3.14+.5, 6.28-.5, %Black      'mouth
End Sub

'gbs_01458
'Date: 10-17-2014

created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm