|
forums.silverfrost.com Welcome to the Silverfrost forums
|
View previous topic :: View next topic |
Author |
Message |
DanRRight
Joined: 10 Mar 2008 Posts: 2834 Location: South Pole, Antarctica
|
Posted: Sun Jul 05, 2020 11:27 pm Post subject: How to make it working in /64 ? |
|
|
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 |
|
|
John-Silver
Joined: 30 Jul 2013 Posts: 1520 Location: Aerospace Valley
|
Posted: Mon Jul 06, 2020 3:03 am Post subject: |
|
|
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 ... " |
|
Back to top |
|
|
PaulLaidler Site Admin
Joined: 21 Feb 2005 Posts: 7942 Location: Salford, UK
|
Posted: Mon Jul 06, 2020 9:40 am Post subject: |
|
|
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 |
|
|
DietmarSiepmann
Joined: 03 Jun 2013 Posts: 279
|
Posted: Mon Jul 06, 2020 10:19 am Post subject: |
|
|
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 |
|
|
PaulLaidler Site Admin
Joined: 21 Feb 2005 Posts: 7942 Location: Salford, UK
|
Posted: Mon Jul 06, 2020 1:42 pm Post subject: |
|
|
This false error report has been removed for the next release of FTN95. |
|
Back to top |
|
|
DanRRight
Joined: 10 Mar 2008 Posts: 2834 Location: South Pole, Antarctica
|
Posted: Mon Jul 06, 2020 9:50 pm Post subject: |
|
|
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 |
|
|
LitusSaxonicum
Joined: 23 Aug 2005 Posts: 2391 Location: Yateley, Hants, UK
|
Posted: Mon Jul 06, 2020 10:11 pm Post subject: |
|
|
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 |
|
|
John-Silver
Joined: 30 Jul 2013 Posts: 1520 Location: Aerospace Valley
|
Posted: Tue Jul 07, 2020 12:18 am Post subject: |
|
|
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 ... " |
|
Back to top |
|
|
DietmarSiepmann
Joined: 03 Jun 2013 Posts: 279
|
|
Back to top |
|
|
John-Silver
Joined: 30 Jul 2013 Posts: 1520 Location: Aerospace Valley
|
Posted: Thu Jul 09, 2020 11:37 am Post subject: |
|
|
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 ... " |
|
Back to top |
|
|
|
|
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
|