Silverfrost Forums

Welcome to our forums

How to make it working in /64 ?

5 Jul 2020 10:27 #25904

This program from Eddie which makes any window gradually disappear works with standard 32 bit FTN95 but needs something with LOC in /64 case. How to make it working in 64 bits FTN95?

use clrwin
integer, external :: SetWindowOpacity
integer (7) ihw1, iop

i = winio@('%sv%ww&')
I = winio@('%ca[Finished] %ff %ff&')
I = winio@('%cn Task finished OK %ff&')
I = winio@('%cn   %ff&')
i = winio@('%hw%lw', ihw1, ilw1)

do i=0,155,2;  call temporary_yield@; 
  iOp=255*exp(-(i**2/255.**2));ii=SetWindowOpacity(ihw1,iop);
  call sleep1@(0.03); 
enddo

ilw1 = 0; call WINDOW_UPDATE@(ilw1)

END


!------------------------------------------------------------------

  integer function SetWindowOpacity(hWnd, alpha) 

!     Set opacity level for a window (call after window creation) - 
!     automatically sets appropriate extended style and sets opacity  
!     from 0 (transparent) to 255 (no transparency). 

   use mswin 
   integer, parameter:: WS_EX_LAYERED = Z'00080000' 
   integer, parameter:: LWA_COLORKEY  = Z'00000001' 
   integer, parameter:: LWA_ALPHA     = Z'00000002' 
   STDCALL SetLayeredWindowAttributes 'SetLayeredWindowAttributes' &
   &         (VAL, VAL, VAL, VAL) : LOGICAL*4 
   integer (7), intent(in)     :: hWnd 
   integer (KIND=7), intent(in):: alpha 
   integer:: attrib, i 
   logical aaaaaa


! Get current window attributes to ensure WS_EX_LAYERED extended style is set 
   attrib = GetWindowLong(hWnd, GWL_EXSTYLE) 
   if (IAND(attrib,WS_EX_LAYERED) /= WS_EX_LAYERED) then 
     i = SetWindowLong(hWnd, GWL_EXSTYLE, IOR(attrib,WS_EX_LAYERED)) 
   end if 
! Set layered window alpha value 
   aaaaaa = SetLayeredWindowAttributes &
   &           (hWnd, 0, CORE1(LOC(alpha)), LWA_ALPHA) 

   SetWindowOpacity = 1
   end function SetWindowOpacity
6 Jul 2020 8:40 #25911

CORE1(LOC(alpha)) ought to compile and I will log this as a bug that needs fixing.

For the moment you can use:

addr = LOC(alpha) aaaaaa = SetLayeredWindowAttributes(hWnd, 0, CORE1(addr), LWA_ALPHA)

where addr is INTEGER(7).

Strictly, attrib should also be INTEGER(7) and you should use the 64 bit alternative functions GetWindowLongPtr and SetWindowLongPtr. I will make a note to add these API functions to mswin etc.[/code]

6 Jul 2020 9:19 #25912

Dan,

it is the loc routine as you suspected. For technical reasons concerning my compile environment I changed your code sample a little bit to use compile option /fixed_format . The problem is the declaration of function loc in the 64 bit case.

Here is the new code:

      use clrwin
      integer, external :: SetWindowOpacity
      integer (7) ihw1, iop
      
      i = winio@('%sv%ww&')
      I = winio@('%ca[Finished] %ff %ff&')
      I = winio@('%cn Task finished OK %ff&')
      I = winio@('%cn   %ff&')
      i = winio@('%hw%lw', ihw1, ilw1)
      
      do i=0,155,2;  call temporary_yield@;
        iOp=255*exp(-(i**2/255.**2));ii=SetWindowOpacity(ihw1,iop);
        call sleep1@(0.03);
      enddo
      
      ilw1 = 0; call WINDOW_UPDATE@(ilw1)
      
      END
      
      
      !------------------------------------------------------------------
      
        integer function SetWindowOpacity(hWnd, alpha)
      
      !     Set opacity level for a window (call after window creation) -
      !     automatically sets appropriate extended style and sets opacity 
      !     from 0 (transparent) to 255 (no transparency).
      
         use mswin
         integer, parameter:: WS_EX_LAYERED = Z'00080000'
         integer, parameter:: LWA_COLORKEY  = Z'00000001'
         integer, parameter:: LWA_ALPHA     = Z'00000002'
         STDCALL SetLayeredWindowAttributes 'SetLayeredWindowAttributes'
     *         (VAL, VAL, VAL, VAL) : LOGICAL*4
         integer (7), intent(in)     :: hWnd
         integer (KIND=7), intent(in):: alpha
         integer:: attrib, i
         logical aaaaaa
         integer(7) L  !+ code change for 64 bit
         INTRINSIC LOC !+ code change for 64 bit
         L=LOC(alpha)  !+ code change for 64 bit
      
      ! Get current window attributes to ensure WS_EX_LAYERED extended style is set
         attrib = GetWindowLong(hWnd, GWL_EXSTYLE)
         if (IAND(attrib,WS_EX_LAYERED) /= WS_EX_LAYERED) then
         i = SetWindowLong(hWnd, GWL_EXSTYLE, IOR(attrib,WS_EX_LAYERED))
         end if
      ! Set layered window alpha value
         aaaaaa = SetLayeredWindowAttributes
     *           (hWnd, 0, CORE1(L), LWA_ALPHA) !+ code change for 64 bit
C     *           (hWnd, 0, CORE1(LOC(alpha)), LWA_ALPHA)
      
         SetWindowOpacity = 1
         end function SetWindowOpacity	

which I compiled using command

ftn95 dan_sample.for /debug /link /fixed_format /64

. The 64 bit executable works in the same way as the 32 bit one. If compiling your original code then the lines

0049)          aaaaaa = SetLayeredWindowAttributes
0050) C     *           (hWnd, 0, CORE1(L), LWA_ALPHA)
0051)      *           (hWnd, 0, CORE1(LOC(alpha)), LWA_ALPHA)
*** In 64-bit mode, the argument to the CORE functions must be of type
    INTEGER(KIND=4)
    1 ERROR, 3 WARNINGS  [<SETWINDOWOPACITY> FTN95 v8.62.1]
*** Compilation failed

are displayed and the compilation fails.

Regards Dietmar

6 Jul 2020 12:42 #25915

This false error report has been removed for the next release of FTN95.

6 Jul 2020 8:50 #25919

Thanks everyone for quick fixes and workarounds of this fading away feature. By the way this feature is not just cool, it is very useful when you have many pop up reminding windows. Just adjust the font size/color for reliable visibility during the time it flashes

6 Jul 2020 9:11 #25920

It is nice to be given the credit for something, but it was another poster who produced SetWindowOpacity. I used it originally to make the startup splash screen gradually fade away. It can be terminated prematurely if the user wants to get on with using the main program. I'm glad that people have it working in 64 bit. E

7 Jul 2020 9:11 #25921

John-Silver,

I think I have used the following link

https://www.silverfrost.com/ftn95-help/asm/other_machine_level_facilities.aspx

Regards Dietmar

Please login to reply.