leider liefert GetDeviceCaps fragwürdige, ungenaue Ergebnisse. Habe folgende Werte gemessen:
Die Idee der ganauen Ausgabe auf jede Bildschirmgröße finde ich toll.
leider habe ich kein Beispiel zur richtigen Verwendung von Shcore.dll GetDpiForMonitor in PureBasic gefunden.
Code: Alles auswählen
; Warum: Male mm_Gitter 170.0 x 100.0 mm - Die Bildschirmgrößen in mm müssen wahrscheinlich geändert werden mit Massband oder Specs.
; Erstellt mit PureBasic 5.51 (x64) auf Wacom Cintiq Companion 2 2560x1440xR8G8B8A8@59 Windows 8.1 64 bit
; Nach einem Neustart gab das Programm den halben dpiX und dpiY Wert aus 111 statt 221.
; Aktuell werden in der IDE die richtigen dpiX, dpiY Werte ausgeben aber nicht in der EXE und
; der InputRequester ist in der IDE zu klein und in der EXE in Ordnung und
; Warum ist in der EXE plötzlich der Monitor Rect, Workarea Rect 0,0,1280,720 bei einem 2560x1440?
; offen Umgang mit mehreren Bildschirmen
; Testen, anpassen unter Linuxe-
; Testen, anpassen unter MacOS.
; Einmaliges eingeben bei Installation, Umgebungsänderung, Einstellungsänderung und Speicherung mit Preference, INI und, oder Registry.
; Procedure.f Pixel_X_zu_Millimeter(Pixel.w)
; Procedure.f Pixel_Y_zu_Millimeter(Pixel.w)
; erl. GetMonitorInfo_(hMonitor,@mi) ; ? Gibt es doch schon seit Windows NT, wieso #Bs_Win81Plus
; erl. die Gitterausgabe ist in der IDE in Ordnung aber in der EXE 200% gezoomt bzw. schlecht.
EnableExplicit
Define BildschirmBreite_mm.f=294.0
Define BildschirmHoehe_mm.f =166.0
Declare Male_mm_Gitter(PixelX.w,PixelY.w, Gitter_x_mm.f, Gitter_y_mm.f ,BildschirmBreite_mm.f,BildschirmHoehe_mm.f,Array Farben.d(1))
Declare.w Millimeter_zu_Pixel_X(mm.f)
Declare.w Millimeter_zu_Pixel_Y(mm.f)
#Bs_Win81Plus=#True
Global dpiX.l=0, dpiY.l=0 , unten.l=0, rechts.l=0
CompilerIf #PB_Compiler_OS=#PB_OS_Windows
CompilerIf #Bs_Win81Plus
Prototype protoGetDpiForMonitor(hmonitor, dpiType.l, *dpiX.Long, *dpiY.Long) ; Warum sind dpiX und dpiY nicht float?
Global GetDpiForMonitor.protoGetDpiForMonitor
If OSVersion()>=#PB_OS_Windows_8_1
Define libShcore = OpenLibrary(#PB_Any, "Shcore.dll")
If libShcore
GetDpiForMonitor = GetFunction(libShcore,"GetDpiForMonitor") ; Win8.1+
EndIf
EndIf
CompilerEndIf
Declare MonitorEnumProc(hMonitor, hdcMonitor, *lprcMonitor.RECT, dwData.l)
EnumDisplayMonitors_(0,0,@MonitorEnumProc(),0)
CompilerEndIf
InitSprite()
ExamineDesktops()
InitKeyboard()
Dim GitterFarben.d(5)
GitterFarben(0)=RGB($00,$00,$00) ; Hintergrund
GitterFarben(1)=RGB($18,$28,$00) ; Farbe 1 mm
GitterFarben(2)=RGB($1C,$38,$00) ; Farbe 5 mm
GitterFarben(3)=RGB($24,$48,$00) ; Farbe 10 mm
GitterFarben(4)=RGB($2C,$58,$00) ; Farbe 50 mm
If dpiX>0 : BildschirmBreite_mm= 25.4/dpiX * DesktopWidth(0) :EndIf
If dpiY>0 : BildschirmHoehe_mm = 25.4/dpiY * DesktopHeight(0):EndIf
Define DesktopWidth_Pixel =DesktopWidth(0)
Define DesktopHeight_Pixel=DesktopHeight(0)
If rechts>0 : Define FaktorX.f=DesktopWidth(0)/rechts: Else : FaktorX=1.0 :EndIf
If unten >0 : Define FaktorY.f=DesktopHeight(0)/unten: Else : FaktorY=1.0 :EndIf
CompilerIf #Bs_Win81Plus
BildschirmBreite_mm=ValF(InputRequester("dpiX:"+Str(dpiX)+" "+Str(rechts),
"Breite des Bildschirms in mm:",
StrF(BildschirmBreite_mm/FaktorX,1)))*FaktorX
BildschirmHoehe_mm =ValF(InputRequester("dpiY:"+Str(dpiY)+" "+Str(unten) ,
"Höhe des Bildschirms in mm:" ,
StrF(BildschirmHoehe_mm/FaktorY,1)))*FaktorY
CompilerElse
BildschirmBreite_mm=ValF(InputRequester("dpiX:"+Str(dpiX)+" "+Str(rechts),
"Breite des Bildschirms in mm:",
StrF(BildschirmBreite_mm,1)))*FaktorX
BildschirmHoehe_mm =ValF(InputRequester("dpiY:"+Str(dpiY)+" "+Str(unten) ,
"Höhe des Bildschirms in mm:" ,
StrF(BildschirmHoehe_mm,1)))*FaktorY
CompilerEndIf
Male_mm_Gitter(DesktopWidth(0), ; Breite des Bildschirms in Pixel
DesktopHeight(0), ; Höhe des Blldschirms in Pixel
170.0, ; Gitter Brreite in mm
100.0, ; Gitter Höhe in mm
BildschirmBreite_mm, ; Breite des Bildschirms in mm
BildschirmHoehe_mm, ; Höhe des Blldschirms in mm
GitterFarben()) ; Farben des Gitters
Repeat : Define Event = WaitWindowEvent() : Until Event = #PB_Event_CloseWindow ; Hauptschleife Alt-F4 Taste beendet Programm
End
CompilerIf #PB_Compiler_OS=#PB_OS_Windows
Structure MONITORINFOEX_ Align #PB_Structure_AlignC : cbSize.l : rcMonitor.RECT : rcWork.RECT : dwFlags.l : szDevice.c[#CCHDEVICENAME] :EndStructure
Procedure MonitorEnumProc(hMonitor, hdcMonitor, *lprcMonitor.RECT, dwData.l)
Shared dpiX, dpiY, rechts, unten
Protected mi.MONITORINFOEX_
mi\cbSize = SizeOf( MONITORINFOEX_ )
GetMonitorInfo_(hMonitor,@mi)
rechts = mi\rcMonitor\right - mi\rcMonitor\left
unten = mi\rcMonitor\bottom - mi\rcMonitor\top
CompilerIf #Bs_Win81Plus
#MDT_RAW_DPI = 2
If OSVersion()>=#PB_OS_Windows_8_1
If GetDpiForMonitor
GetDpiForMonitor(hmonitor, #MDT_RAW_DPI, @dpiX, @dpiY)
EndIf
EndIf
CompilerEndIf
ProcedureReturn #True
EndProcedure
CompilerEndIf
Procedure.w Millimeter_zu_Pixel_X(mm.f)
Shared Bildschirmbreite_mm, DesktopWidth_Pixel
ProcedureReturn mm*DesktopWidth_Pixel/Bildschirmbreite_mm
EndProcedure
Procedure.w Millimeter_zu_Pixel_Y(mm.f)
Shared Bildschirmhoehe_mm, DesktopHeight_Pixel
ProcedureReturn mm*DesktopHeight_Pixel/Bildschirmhoehe_mm
EndProcedure
Procedure Male_mm_Gitter(PixelX.w,PixelY.w, Gitter_x_mm.f, Gitter_y_mm.f ,BildschirmBreite_mm.f,BildschirmHoehe_mm.f,Array Farben.d(1))
Define Bildnr.l =CreateImage(#PB_Any, PixelX, PixelY,32,Farben(0))
Define xoffset.f=PixelX/BildschirmBreite_mm
Define yoffset.f=PixelY/BildschirmHoehe_mm
Define x.f
Define y.f
StartDrawing(ImageOutput(Bildnr))
x=1.0 : While x<=Gitter_x_mm : LineXY(Int(x*xoffset),0,Int(x*xoffset),Gitter_y_mm*yoffset,Farben(1)): x+5.0 : Wend ; 1mm
x=2.0 : While x<=Gitter_x_mm : LineXY(Int(x*xoffset),0,Int(x*xoffset),Gitter_y_mm*yoffset,Farben(1)): x+5.0 : Wend
x=3.0 : While x<=Gitter_x_mm : LineXY(Int(x*xoffset),0,Int(x*xoffset),Gitter_y_mm*yoffset,Farben(1)): x+5.0 : Wend
x=4.0 : While x<=Gitter_x_mm : LineXY(Int(x*xoffset),0,Int(x*xoffset),Gitter_y_mm*yoffset,Farben(1)): x+5.0 : Wend
y=1.0 : While y<=Gitter_y_mm : LineXY(0,Int(y*yoffset),Gitter_x_mm*xoffset,Int(y*yoffset),Farben(1)): y+5.0 : Wend
y=2.0 : While y<=Gitter_y_mm : LineXY(0,Int(y*yoffset),Gitter_x_mm*xoffset,Int(y*yoffset),Farben(1)): y+5.0 : Wend
y=3.0 : While y<=Gitter_y_mm : LineXY(0,Int(y*yoffset),Gitter_x_mm*xoffset,Int(y*yoffset),Farben(1)): y+5.0 : Wend
y=4.0 : While y<=Gitter_y_mm : LineXY(0,Int(y*yoffset),Gitter_x_mm*xoffset,Int(y*yoffset),Farben(1)): y+5.0 : Wend
x=5.0 : While x<=Gitter_x_mm : LineXY(Int(x*xoffset),0,Int(x*xoffset),Gitter_y_mm*yoffset,Farben(2)): x+10.0 : Wend ; 5 mm
y=5.0 : While y<=Gitter_y_mm : LineXY(0,Int(y*yoffset),Gitter_x_mm*xoffset,Int(y*yoffset),Farben(2)): y+10.0 : Wend
x=0.0 : While x<=Gitter_x_mm : LineXY(Int(x*xoffset),0,Int(x*xoffset),Gitter_y_mm*yoffset,Farben(3)): x+10.0 : Wend ; 10 mm
y=0.0 : While y<=Gitter_y_mm : LineXY(0,Int(y*yoffset),Gitter_x_mm*xoffset,Int(y*yoffset),Farben(3)): y+10.0 : Wend
x=0.0 : While x<=Gitter_x_mm : LineXY(Int(x*xoffset),0,Int(x*xoffset),Gitter_y_mm*yoffset,Farben(4)): x+50.0 : Wend ; 50 mm
y=0.0 : While y<=Gitter_y_mm : LineXY(0,Int(y*yoffset),Gitter_x_mm*xoffset,Int(y*yoffset),Farben(4)): y+50.0 : Wend
StopDrawing()
Define Fenster=OpenWindow(#PB_Any, 0, 0, PixelX, PixelY, "mm Gitter", #PB_Window_BorderLess)
Define Gadget=CanvasGadget(#PB_Any, Millimeter_zu_Pixel_X( 10.0), Millimeter_zu_Pixel_Y( 10.0),
Millimeter_zu_Pixel_X(170.0), Millimeter_zu_Pixel_Y(100.0))
StartDrawing(CanvasOutput(Gadget))
DrawImage(ImageID(Bildnr),0,0,PixelX,PixelY)
StopDrawing()
EndProcedure