forums.silverfrost.com Forum Index forums.silverfrost.com
Welcome to the Silverfrost forums
 
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

How to make it working in /64 ?

 
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> 64-bit
View previous topic :: View next topic  
Author Message
DanRRight



Joined: 10 Mar 2008
Posts: 2813
Location: South Pole, Antarctica

PostPosted: Sun Jul 05, 2020 11:27 pm    Post subject: How to make it working in /64 ? Reply with quote

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?

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


! 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
Back to top
View user's profile Send private message
John-Silver



Joined: 30 Jul 2013
Posts: 1520
Location: Aerospace Valley

PostPosted: Mon Jul 06, 2020 3:03 am    Post subject: Reply with quote

by 'gradually disappear' do you mean a 'fading out' effect on window close Dan ?
or that it 'disappears' from view under inactivity but can be 'brought back' with mouse-over or something else ?
_________________
''Computers (HAL and MARVIN excepted) are incredibly rigid. They question nothing. Especially input data.Human beings are incredibly trusting of computers and don't check input data. Together cocking up even the simplest calculation ... Smile "
Back to top
View user's profile Send private message
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 7916
Location: Salford, UK

PostPosted: Mon Jul 06, 2020 9:40 am    Post subject: Reply with quote

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]
Back to top
View user's profile Send private message AIM Address
DietmarSiepmann



Joined: 03 Jun 2013
Posts: 279

PostPosted: Mon Jul 06, 2020 10:19 am    Post subject: Reply with quote

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:
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
Code:

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
Code:

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
Back to top
View user's profile Send private message
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 7916
Location: Salford, UK

PostPosted: Mon Jul 06, 2020 1:42 pm    Post subject: Reply with quote

This false error report has been removed for the next release of FTN95.
Back to top
View user's profile Send private message AIM Address
DanRRight



Joined: 10 Mar 2008
Posts: 2813
Location: South Pole, Antarctica

PostPosted: Mon Jul 06, 2020 9:50 pm    Post subject: Reply with quote

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
Back to top
View user's profile Send private message
LitusSaxonicum



Joined: 23 Aug 2005
Posts: 2388
Location: Yateley, Hants, UK

PostPosted: Mon Jul 06, 2020 10:11 pm    Post subject: Reply with quote

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
Back to top
View user's profile Send private message
John-Silver



Joined: 30 Jul 2013
Posts: 1520
Location: Aerospace Valley

PostPosted: Tue Jul 07, 2020 12:18 am    Post subject: Reply with quote

where is the documentation for the ftn95 extension intrinsics listed here - there are no direcct links

https://silverfrost.com/ftn95-help/optim/intrinsic_functions.aspx
_________________
''Computers (HAL and MARVIN excepted) are incredibly rigid. They question nothing. Especially input data.Human beings are incredibly trusting of computers and don't check input data. Together cocking up even the simplest calculation ... Smile "
Back to top
View user's profile Send private message
DietmarSiepmann



Joined: 03 Jun 2013
Posts: 279

PostPosted: Tue Jul 07, 2020 10:11 am    Post subject: Reply with quote

John-Silver,

I think I have used the following link

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

Regards
Dietmar
Back to top
View user's profile Send private message
John-Silver



Joined: 30 Jul 2013
Posts: 1520
Location: Aerospace Valley

PostPosted: Thu Jul 09, 2020 11:37 am    Post subject: Reply with quote

Thanks Dietmar.
_________________
''Computers (HAL and MARVIN excepted) are incredibly rigid. They question nothing. Especially input data.Human beings are incredibly trusting of computers and don't check input data. Together cocking up even the simplest calculation ... Smile "
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> 64-bit All times are GMT + 1 Hour
Page 1 of 1

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Powered by phpBB © 2001, 2005 phpBB Group