rem Picture Spyglass ........... Rev 4.0
      rem A J Tooth // July 2005
      rem Modified 20th August for multiple screen sizes
      
      *FLOAT 64
      himem=lomem + 10000000
      
      rem Setup
      proc_setup
      
      rem Choose a picture
      proc_pichoose
      
      rem Go to full screen
      proc_fullscreen
      
      rem Display the picture initially
      proc_gendisp(FulName$,0,0,xscreen%,yscreen%)
      *REFRESH OFF
      a$=""
      
      |md%=2.5 : rem Default is 1/2.5 gamma correction
      
      repeat
        rem Check whether the mouse wheel is rotated
        mouse mx%,my%,but&
        !Xmid%=int(mx%/2) : !Ymid%=int(my%/2)
        w&=asc(inkey$(0))
        case w& of
            rem Zoom IN
          when 140: |md%+=0.1 : if |md%>6.0 then |md%=6.0
            rem Zoom OUT
          when 141: |md%-=0.1 : if |md%<0.2 then |md%=0.2
          otherwise
            rem Do nothing
        endcase
        
        rem Expand / contract circular area around the mouse position
        call rotate%
        
        rem Display BMP
        sys "SetStretchBltMode", @memhdc%, 3
        command$="MDISPLAY "+str$~pfmir%+" 0,0,"+str$(2*xscreen%)+","+str$(2*yscreen%)
        oscli command$
        *REFRESH
      until (but&=1 or but&=4)
      *REFRESH ON
      
      vdu 5
      *FONT Georgia Italic,12,B
      proc_back(100,1250,1000,200,150,150,150)
      move 200,1400 : gcol 6: print;"Left-click to choose another picture."
      move 200,1350 : print;"Right-click to QUIT."
      vdu 4
      
      repeat
        mouse x,y,b&
        sys "Sleep", 10
      until (b&=1 or b&=4)
      
      if b&=4 then run else quit
      
      quit
      end
      rem End of Program ==========================================
      rem =========================================================
      
      rem Set up use of Full Screen
      def proc_fullscreen
      sys "GetSystemMetrics", 0 to xscreen%
      sys "GetSystemMetrics", 1 to yscreen%
      sys "SetWindowLong",@hwnd%,-16,&16000000
      sys "SetWindowPos",@hwnd%,-1,0,0,xscreen%,yscreen%,0
      vdu 23,22,xscreen%;yscreen%;8,16,16,1 : rem Set fullscreen mode
      mouse off : off : rem Turns off the Mouse Pointer and the Cursor
      endproc
      rem =========================================================
      
      rem Choose a picture
      def proc_pichoose
      local g%,rn%,n$,Flg&,pic$,fullname$,command$,m&
      
      dim pq% 75, ff% 18, fm% 255
      !pq%=76
      pq%!4=@hwnd%
      pq%!12=ff%
      pq%!28=fm%
      pq%!32=256
      pq%!52=6
      
      BPic$=@dir$ + "BPic.jpg"
      rem Display a background picture
      proc_gendisp(BPic$,10,10,xscreen%-20,yscreen%-70)
      
      rem Displays my icon
      proc_AJTicon(10,650)
      
      *FONT Blackadder ITC,24,B
      vdu 5
      colour 8,160,90,20
      gcol 8 : move 350,500 : print;"SPYGLASS"
      
      *FONT Georgia Italic,12,B
      proc_back(100,1250,1000,200,150,150,150)
      move 200,1400 : gcol 6: print;"Choose to view either a jpeg or bitmap image."
      move 200,1350 : print;"Press -j- (or left-click) or -b- (or right-click)."
      
      proc_back(100,600,1000,200,150,150,150)
      move 200,750 : gcol 2: print;"Roll the mouse-wheel to zoom in or out."
      move 200,700 : print;"Click either mouse button to exit."
      vdu 4
      repeat
        mouse a,b,m&
        p$=inkey$(1)
        if m&=4 then p$="j"
        if m&=1 then p$="b"
      until (p$="j" or p$="b")
      
      case p$ of
        when "b":
          $ff% ="BMP files"+chr$0+"*.bmp"+chr$0+chr$0
        when "j":
          $ff% ="JPG files"+chr$0+"*.jpg"+chr$0+chr$0
      endcase
      
      sys "GetOpenFileName", pq% to result%
      if result%<>0 then fullname$ = fn_nulterm$(fm%)
      
      rn%=len(fullname$)
      g%=0 : pic$=""
      repeat
        n$=mid$(fullname$,rn%-g%,1)
        if n$<>"\" then pic$=n$+pic$ : g%+=1
      until n$="\"
      
      PreW$=left$(fullname$,rn%-g%)
      rem Change the current Directory
      command$="CD "+chr$(34)+PreW$+chr$(34)
      oscli command$
      Name$=pic$ : FulName$=PreW$+Name$
      endproc
      rem---------------------------------------------------------------------
      
      rem Converts a Windows null-terminated string to BB4W format
      def fn_nulterm$(Pnt%)
      local A$
      while ?Pnt% <> 0
        A$+=chr$(?Pnt%)
        Pnt%+=1
      endwhile
      =A$
      rem ====================================================================
      
      rem Display a Picture
      def proc_gendisp(picture$,xpos%,ypos%,xsize%,ysize%)
      
      sys "LoadLibrary", "OLEAUT32.DLL"
      sys "GetModuleHandle", "OLEAUT32.DLL" to oleaut32%
      sys "GetProcAddress", oleaut32%, "OleLoadPicturePath" to olpp%
      if olpp%=0 error 0, "Could not get address of OleLoadPicturePath"
      
      dim iid% 15, gpp% 3, hmw% 3, hmh% 3, picture% 513
      sys "MultiByteToWideChar", 0, 0, picture$, len(picture$), picture%, 256 to lon%
      picture%!(2*lon%) = 0
      
      iid%!0  = &7BF80980
      iid%!4  = &101ABF32
      iid%!8  = &AA00BB8B
      iid%!12 = &AB0C3000
      
      sys olpp%, picture%, 0, 0, 0, iid%, gpp%
      if !gpp% = 0 error 0, "OleLoadPicturePath failed"
      
      sys !(!!gpp%+24), !gpp%, hmw% : rem. IPicture::get_Width
      sys !(!!gpp%+28), !gpp%, hmh% : rem. IPicture::get_Height
      sys !(!!gpp%+32), !gpp%, @memhdc%, xpos%, ypos%, xsize%, ysize%, 0, !hmh%, !hmw%, -!hmh%, 0 to res%
      if res% error 0, "IPicture::Render failed"
      
      sys !(!!gpp%+8), !gpp% : rem. IPicture::Release
      sys "InvalidateRect", @hwnd%, 0, 0
      sys "UpdateWindow", @hwnd%
      
      *SCREENSAVE "temp.bmp"
      
      command$=" LOAD "+chr$(34) + "temp.bmp"+chr$(34)+" "+str$~pf%
      oscli command$
      
      endproc
      rem ====================================================================
      
      rem Setup
      def proc_setup
      sys "GetSystemMetrics", 0 to xscreen%
      sys "GetSystemMetrics", 1 to yscreen%
      sys "SetWindowLong",@hwnd%,-16,&16CF0000
      sys "SetWindowPos",@hwnd%,0,0,0,1024,767,0
      mouse on
      colour 132,0,0,50 : colour 4,0,0,50 : colour 128 : cls : colour 3
      mode 22 : off
      rem Change the Windows Title
      title$ = "SPYGLASS"
      sys "SetWindowText", @hwnd%, title$
      
      dim lgth% 3, rgb% 3
      dim Xlim% 3, Ylim% 3, Xmid% 3, Ymid% 3
      
      !lgth%=3*xscreen%*yscreen% + 54
      dim pf% !lgth%, pfmir% !lgth%
      
      rem BMP header for pfmir% array
      proc_bmpheader
      
      !Xlim%=xscreen%-1 : !Ylim%=yscreen%-1 : !Xmid%=100 : !Ymid%=384
      
      dim rotate% 2000
      
      dim dist% 7, csalp% 7, snalp% 7, theta% 7, rdist% 7
      dim csthe% 7, snthe% 7, xn% 3, yn% 3, x% 3, y% 3, f100% 7
      dim f1000% 7, flim% 7, md% 7, rd% 7, ftmp% 7, r% 3, th% 3
      dim Flg% 0
      
      |f1000%=1000.0 : |flim%=5.0 : |rd%=100.0
      |f100%=200.0
      
      colour 3
      rem Dual-pass assembly, in case of labels
      for pass&=0 to 2 step 2
        proc_rotate(pass&)
      next pass&
      
      endproc
      rem =======================================================================
      
      rem Prints the backdrop for the screen message
      def proc_back(Xs%,Ys%,Ws%,Hs%,Rr&,Gg&,Bb&)
      local h&,Rf&,Gf&,Bf&
      
      for h&=0 to 30
        Rf&=Rr&*h&/30 : Gf&=Gg&*h&/30 : Bf&=Bb&*h&/30
        colour 9,Rf&,Rf&,Rf& : gcol 9
        rectangle fill Xs%+h&,Ys%+h&,Ws%-2*h&,Hs%-2*h&
      next h&
      endproc
      rem ========================================================================
      
      rem Standard 1024x768 Header setup
      def proc_bmpheader
      
      P% = pfmir%
      [OPT 0
      DB "BM"          ; Signature
      DD !lgth%        ; Total file bytes
      DD 0             ; Set t0 zero
      DD 54            ; Header bytes
      DD 40            ; Offset t0 Data
      DD xscreen%      ; Image Width
      DD yscreen%      ; Image Height
      DW 1             ; Bit planes
      DW 24            ; Colour depth in bits
      DD 0             ; Compression type=0=none
      DD !lgth%-54     ; Image size net 0f header
      DD 0             ; Set t0 zero
      DD 0             ; Set t0 zero
      DD 0             ; Set t0 zero
      DD 0             ; Set t0 zero
      ]
      endproc
      rem =======================================================================
      
      rem Rotate and Display Routine
      def proc_rotate(opt%)
      P%=rotate%
      [opt opt%
      
      mov esi,pf%
      mov edi,pfmir%
      mov eax,[lgth%]
      sub eax,54
      shr eax,2
      mov ecx,eax
      cld
      rep movsd
      
      finit
      
      mov edx,0
      mov [r%],edx                ;Initialise r-loop counter
      
      .rloop
      fld qword [rd%]
      fld qword [f100%]
      fdivp st1,st0
      fild dword [r%]
      fmulp st1,st0
      fst qword [dist%]           ;Radius
      
      fld qword [md%]
      fdivp st1,st0
      fstp qword [rdist%]
      
      mov edx,0
      mov [th%],edx               ;Initialise th-loop counter
      
      .thloop
      fldpi
      fld st0
      faddp st1,st0
      fld qword [f1000%]
      fdivp st1,st0
      fild dword [th%]
      fmulp st1,st0
      fst qword [theta%]          ;Angle
      
      fld st0
      fcos
      fld qword [dist%]
      fmulp st1,st0
      fild dword [Xmid%]
      faddp st1,st0
      fistp dword [xn%]
      
      fsin
      fld qword [dist%]
      fmulp st1,st0
      fild dword [Ymid%]
      faddp st1,st0
      fistp dword [yn%]
      
      fld qword [theta%]
      fld st0
      fcos
      fld qword [rdist%]
      fmulp st1,st0
      fild dword [Xmid%]
      faddp st1,st0
      fistp dword [x%]
      
      fsin
      fld qword [rdist%]
      fmulp st1,st0
      fild dword [Ymid%]
      faddp st1,st0
      fistp dword [y%]
      
      mov ebx,[x%]                ;Check that point is within bmp limits
      cmp ebx,0
      jl near miss
      cmp ebx,[Xlim%]
      jg near miss
      mov eax,[y%]
      cmp eax,0
      jl near miss
      cmp eax,[Ylim%]
      jg near miss                ;Check that point is within screen limits
      
      mov eax,[Xlim%]                ;Source bmp-reference
      add eax,[Xlim%]
      add eax,[Xlim%]
      add eax,3
      imul eax,[y%]
      add eax,[x%]
      add eax,[x%]
      add eax,[x%]
      add eax,54                  ;Destination bmp-reference
      
      mov ecx,pf%[eax]
      mov [rgb%],ecx
      
      mov ebx,[xn%]                ;Check that point is within bmp limits
      cmp ebx,0
      jl near miss
      cmp ebx,[Xlim%]
      jg near miss
      mov eax,[yn%]
      cmp eax,0
      jl near miss
      cmp eax,[Ylim%]
      jg near miss                ;Check that point is within screen limits
      
      mov eax,[Xlim%]               ;Destination bmp-reference
      add eax,[Xlim%
      add eax,[Xlim%
      add eax,3
      imul eax,[yn%]
      add eax,[xn%]
      add eax,[xn%]
      add eax,[xn%]
      add eax,54                  ;Destination bmp-reference
      
      mov cl,[rgb%]               ;Transfer rgb v@alue
      mov pfmir%[eax],cl
      mov cl,[rgb%+1]
      mov pfmir%[eax+1],cl
      mov cl,[rgb%+2]
      mov pfmir%[eax+2],cl        ;Transfer rgb v@alue
      
      .miss
      mov edx,[th%]               ;th loop control
      add edx,1
      mov [th%],edx
      cmp edx,1000
      jle near thloop
      
      mov edx,[r%]                ;r loop control
      add edx,1
      mov [r%],edx
      cmp edx,200
      jle near rloop
      
      ret
      ]
      endproc
      rem ======================================================================
      
      rem Displays my Icon in .exe version
      def proc_AJTicon(i%,j%)
      sys "GetModuleHandle", 0 to hm%
      sys "LoadImage", hm%, "BBCWin", 1, 32, 32, 0 to hicon%
      w% = 32
      h% = 32
      sys "DrawIconEx", @memhdc%, i%, j%, hicon%, w%, h%, 0, 0, 3
      sys "InvalidateRect", @hwnd%, 0, 0
      endproc
      rem ===============================================================