WinWorkstation.st
changeset 8871 62717b04953b
parent 8866 486bee55512e
child 8872 7d7024512b49
equal deleted inserted replaced
8870:d0a74d18b207 8871:62717b04953b
    20 		eventTrace eventBuffer lastClipboardSequenceNumber
    20 		eventTrace eventBuffer lastClipboardSequenceNumber
    21 		lastNativeFileDialogOutputStream'
    21 		lastNativeFileDialogOutputStream'
    22 	classVariableNames:'BeepDuration NativeDialogs NativeFileDialogs NativeWidgets
    22 	classVariableNames:'BeepDuration NativeDialogs NativeFileDialogs NativeWidgets
    23 		NativeWidgetClassTable StandardColorValues IgnoreSysColorChanges
    23 		NativeWidgetClassTable StandardColorValues IgnoreSysColorChanges
    24 		IgnoreFontChanges SystemColorValues CanEndSession
    24 		IgnoreFontChanges SystemColorValues CanEndSession
    25 		VerboseNativeDialogs'
    25 		VerboseNativeDialogs CurrentDisplayResolutionFromTool
       
    26 		VirtualDisplayResolutionFromTool'
    26 	poolDictionaries:''
    27 	poolDictionaries:''
    27 	category:'Interface-Graphics'
    28 	category:'Interface-Graphics'
    28 !
    29 !
    29 
    30 
    30 Object subclass:#AlphaBlendParameters
    31 Object subclass:#AlphaBlendParameters
  6570     RETURN (nil);
  6571     RETURN (nil);
  6571 #endif
  6572 #endif
  6572 %}
  6573 %}
  6573 ! !
  6574 ! !
  6574 
  6575 
  6575 !WinWorkstation class methodsFor:'queries'!
  6576 !WinWorkstation class methodsFor:'private'!
  6576 
  6577 
  6577 currentDisplayResolution
  6578 commonDisplayResolutionBinaryFromPackageSubPath:packageSubPath
  6578     "this is the current resolution of the display,
  6579     binaryBaseNameWithoutSuffix:binaryBaseNameWithoutSuffix
  6579      without any effect of scaling
  6580 
       
  6581     "
       
  6582         Screen 
       
  6583             commonDisplayResolutionBinaryFromPackageSubPath:'currentDisplayResolution'
       
  6584             binaryBaseNameWithoutSuffix:'cdr'
       
  6585     "
       
  6586 
       
  6587     |packageId directory|
       
  6588 
       
  6589     packageId := 'stx:support/win32/', packageSubPath, '/bin'.
       
  6590     directory := Smalltalk packageDirectoryForPackageId:packageId.
       
  6591     directory isNil ifTrue:[
       
  6592         'package "', packageId, '" is missing"' errorPrintCR.
       
  6593         ^ nil
       
  6594     ].
       
  6595 
       
  6596     ^ directory / (binaryBaseNameWithoutSuffix, '.exe')
       
  6597 
       
  6598     "Created: / 19-11-2019 / 11:58:44 / Stefan Reise"
       
  6599 !
       
  6600 
       
  6601 currentDisplayResolutionBinary
       
  6602     "
       
  6603         Screen currentDisplayResolutionBinary        
       
  6604     "
       
  6605 
       
  6606     ^ self 
       
  6607         commonDisplayResolutionBinaryFromPackageSubPath:'currentDisplayResolution'
       
  6608         binaryBaseNameWithoutSuffix:'cdr'
       
  6609 
       
  6610     "Created: / 15-11-2019 / 09:32:22 / Stefan Reise"
       
  6611     "Modified (comment): / 19-11-2019 / 11:59:34 / Stefan Reise"
       
  6612 !
       
  6613 
       
  6614 displayResolutionFromTool:aFilenameOrNil
       
  6615     "
       
  6616         self displayResolutionFromTool:self currentDisplayResolutionBinary         
       
  6617         self displayResolutionFromTool:self virtualDisplayResolutionBinary     
       
  6618     "
       
  6619 
       
  6620     |output pointValues|
       
  6621 
       
  6622     aFilenameOrNil isNil ifTrue:[
       
  6623         ^ nil 
       
  6624     ].                            
       
  6625     aFilenameOrNil exists ifFalse:[
       
  6626         'tool binary "', aFilenameOrNil nameString, '" is missing"' errorPrintCR.
       
  6627         ^ nil
       
  6628     ].
       
  6629 
       
  6630     output := '' writeStream.   
       
  6631 
       
  6632     OperatingSystem
       
  6633         executeCommand:aFilenameOrNil pathName
       
  6634         outputTo:output 
       
  6635         errorTo:output.
       
  6636 
       
  6637     pointValues := output contents subStrings:$x.
       
  6638 
       
  6639     ^ pointValues first asInteger@pointValues second asInteger
       
  6640 
       
  6641     "Created: / 15-11-2019 / 09:37:01 / Stefan Reise"
       
  6642     "Modified: / 19-11-2019 / 12:03:00 / Stefan Reise"
       
  6643 !
       
  6644 
       
  6645 virtualDisplayResolution
       
  6646     "ATTENTION: can return nil if the package or the tool is missing:
       
  6647      stx:support/win32/virtualDisplayResolution/bin/vdr.exe  
       
  6648 
       
  6649      this is the resolution of a virtual display,
       
  6650      this resolution is effected by the scaling
  6580 
  6651 
  6581      for e.g.
  6652      for e.g.
  6582         real current display resolution -> 1080p
  6653         real current display resolution -> 1080p
  6583         scaling 150%
  6654         scaling 150%
  6584         virtual display resolution -> 720p
  6655         virtual display resolution -> 720p
  6585 
  6656 
  6586         real current display resolution -> 1080p
  6657         real current display resolution -> 1080p
  6587         scaling 100%
  6658         scaling 100%
  6588         virtual display resolution -> 1080p"         
  6659         virtual display resolution -> 1080p"
  6589 
  6660 
  6590     "
  6661     "
  6591         self currentDisplayResolution
  6662         VirtualDisplayResolutionFromTool := nil.
       
  6663         self virtualDisplayResolution
  6592     "    
  6664     "    
  6593 
  6665 
  6594     ^ self displayResolutionFromTool:self currentDisplayResolutionBinary
  6666     |tmp|
  6595 
  6667 
  6596     "Created: / 15-11-2019 / 09:37:53 / Stefan Reise"
  6668     VirtualDisplayResolutionFromTool isNil ifTrue:[
  6597 !
  6669         tmp := self displayResolutionFromTool:self virtualDisplayResolutionBinary.
  6598 
  6670         tmp isNil ifTrue:[
  6599 currentDisplayResolutionBinary
  6671             "use 0 to indicate nil,
  6600     "
  6672              avoid recalling of #displayResolutionFromTool:"
  6601         Screen currentDisplayResolutionBinary 
  6673             VirtualDisplayResolutionFromTool := 0.
  6602     "
  6674         ] ifFalse:[
  6603 
  6675             VirtualDisplayResolutionFromTool := tmp.
  6604     |packageId directory|
  6676         ].
  6605 
  6677     ].
  6606     packageId := 'stx:support/win32/currentDisplayResolution/bin'.
  6678 
  6607     directory := Smalltalk packageDirectoryForPackageId:packageId.
  6679     VirtualDisplayResolutionFromTool == 0 ifTrue:[
  6608     directory isNil ifTrue:[
       
  6609         ^ nil
  6680         ^ nil
  6610     ].
  6681     ].
  6611 
  6682 
  6612     ^ directory / 'cdr.exe'
  6683     ^ VirtualDisplayResolutionFromTool
  6613 
  6684 
  6614     "Created: / 15-11-2019 / 09:32:22 / Stefan Reise"
  6685     "Created: / 15-11-2019 / 09:37:48 / Stefan Reise"
  6615 !
  6686     "Modified (format): / 19-11-2019 / 12:17:02 / Stefan Reise"
  6616 
  6687 !
  6617 displayResolutionFromTool:aFilename
  6688 
       
  6689 virtualDisplayResolutionBinary
       
  6690     "      
       
  6691         Screen virtualDisplayResolutionBinary   
  6618     "
  6692     "
  6619         self displayResolutionFromTool:self currentDisplayResolutionBinary    
  6693 
  6620         self displayResolutionFromTool:self virtualDisplayResolutionBinary     
  6694     ^ self 
       
  6695         commonDisplayResolutionBinaryFromPackageSubPath:'virtualDisplayResolution'
       
  6696         binaryBaseNameWithoutSuffix:'vdr'
       
  6697 
       
  6698     "Created: / 15-11-2019 / 09:32:51 / Stefan Reise"
       
  6699     "Modified (comment): / 19-11-2019 / 11:59:52 / Stefan Reise"
       
  6700 ! !
       
  6701 
       
  6702 !WinWorkstation class methodsFor:'queries'!
       
  6703 
       
  6704 currentDisplayResolution
       
  6705     "ATTENTION: can return nil if the package or the tool is missing:
       
  6706      stx:support/win32/currentDisplayResolution/bin/cdr.exe
       
  6707 
       
  6708      this is the current resolution of the display,
       
  6709      without any effect of scaling
       
  6710 
       
  6711      for e.g.
       
  6712         real current display resolution -> 1080p
       
  6713         scaling 150%
       
  6714         virtual display resolution -> 720p
       
  6715 
       
  6716         real current display resolution -> 1080p
       
  6717         scaling 100%
       
  6718         virtual display resolution -> 1080p"         
       
  6719 
  6621     "
  6720     "
  6622 
  6721         CurrentDisplayResolutionFromTool := nil. 
  6623     |output pointValues|
  6722         self currentDisplayResolution            
  6624 
  6723     "    
  6625     output := '' writeStream.
  6724 
  6626 
  6725     |tmp|
  6627     aFilename exists ifFalse:[
  6726 
  6628         'tool binary "', aFilename nameString, '" is missing"' errorPrintCR.
  6727     CurrentDisplayResolutionFromTool isNil ifTrue:[
       
  6728         tmp := self displayResolutionFromTool:self currentDisplayResolutionBinary.
       
  6729         tmp isNil ifTrue:[
       
  6730             "use 0 to indicate nil,
       
  6731              avoid recalling of #displayResolutionFromTool:"
       
  6732             CurrentDisplayResolutionFromTool := 0.
       
  6733         ] ifFalse:[
       
  6734             CurrentDisplayResolutionFromTool := tmp.
       
  6735         ].
       
  6736     ].
       
  6737 
       
  6738     CurrentDisplayResolutionFromTool == 0 ifTrue:[
  6629         ^ nil
  6739         ^ nil
  6630     ].
  6740     ].
  6631 
  6741 
  6632     OperatingSystem
  6742     ^ CurrentDisplayResolutionFromTool
  6633         executeCommand:aFilename pathName
  6743 
  6634         outputTo:output 
  6744     "Created: / 15-11-2019 / 09:37:53 / Stefan Reise"
  6635         errorTo:output.
  6745     "Modified (comment): / 19-11-2019 / 12:17:27 / Stefan Reise"
  6636 
       
  6637     pointValues := output contents subStrings:$x.
       
  6638 
       
  6639     ^ pointValues first asInteger@pointValues second asInteger
       
  6640 
       
  6641     "Created: / 15-11-2019 / 09:37:01 / Stefan Reise"
       
  6642 !
  6746 !
  6643 
  6747 
  6644 displayScaleFactor
  6748 displayScaleFactor
  6645     "this is the scale factor the user did enter within the windows settings,
  6749     "ATTENTION: returns the may wrong default 1@1 if the package or the tool is missing:
       
  6750      stx:support/win32/currrentDisplayResolution/bin/cdr.exe
       
  6751      stx:support/win32/virtualDisplayResolution/bin/vdr.exe
       
  6752 
       
  6753      this is the scale factor the user did enter within the windows settings,
  6646      for e.g. the user can choose between 100, 125, 150 etc.
  6754      for e.g. the user can choose between 100, 125, 150 etc.
  6647      here we return 1, 1.25 1.5"
  6755      here we return 1, 1.25 1.5"
  6648 
  6756 
  6649     "
  6757     "
  6650         self displayScaleFactor          
  6758         self displayScaleFactor          
  6665     ].
  6773     ].
  6666 
  6774 
  6667     ^ currentDisplayResolution / virtualDisplayResolution
  6775     ^ currentDisplayResolution / virtualDisplayResolution
  6668 
  6776 
  6669     "Created: / 15-11-2019 / 09:43:53 / Stefan Reise"
  6777     "Created: / 15-11-2019 / 09:43:53 / Stefan Reise"
       
  6778     "Modified (comment): / 19-11-2019 / 12:07:55 / Stefan Reise"
  6670 !
  6779 !
  6671 
  6780 
  6672 isWindowsPlatform
  6781 isWindowsPlatform
  6673     "return true, if this device is a windows screen"
  6782     "return true, if this device is a windows screen"
  6674 
  6783 
  6684 
  6793 
  6685     "Modified: 26.5.1996 / 15:32:46 / cg"
  6794     "Modified: 26.5.1996 / 15:32:46 / cg"
  6686 !
  6795 !
  6687 
  6796 
  6688 scaleFactorForRootDisplayCoordinates
  6797 scaleFactorForRootDisplayCoordinates
  6689     "this is the factor we need to adopt for the root display coordinates,
  6798     "ATTENTION: returns the may wrong default 1@1 (from super) if the package or the tool is missing:
       
  6799      stx:support/win32/currrentDisplayResolution/bin/cdr.exe
       
  6800 
       
  6801      this is the factor we need to adopt for the root display coordinates,
  6690      if windows did scale the application (when the app is not high DPI aware)"
  6802      if windows did scale the application (when the app is not high DPI aware)"
  6691 
  6803 
  6692     "
  6804     "
  6693         self scaleFactorForRootDisplayCoordinates 
  6805         self scaleFactorForRootDisplayCoordinates 
  6694     "
  6806     "
  6702     ].
  6814     ].
  6703 
  6815 
  6704     ^ currentDisplayResolution / Display extent
  6816     ^ currentDisplayResolution / Display extent
  6705 
  6817 
  6706     "Created: / 14-11-2019 / 13:36:59 / Stefan Reise"
  6818     "Created: / 14-11-2019 / 13:36:59 / Stefan Reise"
  6707     "Modified (comment): / 15-11-2019 / 10:47:30 / Stefan Reise"
  6819     "Modified (comment): / 19-11-2019 / 12:08:26 / Stefan Reise"
  6708 !
       
  6709 
       
  6710 virtualDisplayResolution
       
  6711     "this is the resolution of a virtual display,
       
  6712      this resolution is effected by the scaling
       
  6713 
       
  6714      for e.g.
       
  6715         real current display resolution -> 1080p
       
  6716         scaling 150%
       
  6717         virtual display resolution -> 720p
       
  6718 
       
  6719         real current display resolution -> 1080p
       
  6720         scaling 100%
       
  6721         virtual display resolution -> 1080p"
       
  6722 
       
  6723     "
       
  6724         self virtualDisplayResolution
       
  6725     "    
       
  6726 
       
  6727     ^ self displayResolutionFromTool:self virtualDisplayResolutionBinary
       
  6728 
       
  6729     "Created: / 15-11-2019 / 09:37:48 / Stefan Reise"
       
  6730 !
       
  6731 
       
  6732 virtualDisplayResolutionBinary
       
  6733     "      
       
  6734         Screen virtualDisplayResolutionBinary 
       
  6735     "
       
  6736 
       
  6737     |packageId directory|
       
  6738 
       
  6739     packageId := 'stx:support/win32/virtualDisplayResolution/bin'.
       
  6740     directory := Smalltalk packageDirectoryForPackageId:packageId.
       
  6741     directory isNil ifTrue:[
       
  6742         ^ nil
       
  6743     ].
       
  6744 
       
  6745     ^ directory / 'vdr.exe'
       
  6746 
       
  6747     "Created: / 15-11-2019 / 09:32:51 / Stefan Reise"
       
  6748 ! !
  6820 ! !
  6749 
  6821 
  6750 !WinWorkstation methodsFor:'accessing & queries'!
  6822 !WinWorkstation methodsFor:'accessing & queries'!
  6751 
  6823 
  6752 activateOnClick:aBoolean
  6824 activateOnClick:aBoolean