PB Snipper Problem mit Windows 8.1

[Velindos]

Hallo Leute,
habe mal einen Snippertest am Windows 8.1 ausprobiert. Läuft nicht mehr, weil Maus und Bildausschnitt nicht zusammen passen! Hab die Sache mit PB 5.23 und 5.30 x64 getest, kein unterschied!

Mache es momentan so das ich das Bild Resize von 2160,1440 auf 1440,960.

Code: Alles auswählen

; Snipping TEST am Microsoft SURFACE 3 Pro
; Desktopauflösung 2160 x 1440
; 
; Bildausschneiden am Desktop
; Dient zum Ausschneiden von Bilder am Desktop
; Mittels ESC kann abgebrochen werden



AnzahlDesktop.i = ExamineDesktops() ; Gibt die Anzahl der Desktops zurück
Debug "AnzahlDesktop= " + AnzahlDesktop
Debug DesktopWidth(0)
Debug DesktopHeight(0)

;DesktopMouseY()
InitMouse()


Enumeration
  #FrameMain; Für MainWindows
  #ParentWindow; für SnipperParentWindows
  #ChildWindow ; für SnipperChildWindows
EndEnumeration

;{-Image Plugin
UsePNGImageDecoder(); Encoder
UsePNGImageEncoder(); Decoder
                    ;}

Enumeration
  #TastenDruckEscape
  #BildAusschneiden
  #BildVomDesktop
  #FensterKlick
  #XI_ChildButton
  #XI_SnipperEinAus
  #XI_Image
  #XI_StartP
  #XI_EndeP
  #XI_VirtStartP
  #XI_VirtStartP2
  #XI_VirtEndeP
  #XI_SchnittP
  #Snipperaktiv
EndEnumeration

Enumeration
  #imgCapture
  #DesktopImage
  #myImage
  #myImage2
  #Testbild
  #myKleinDisplay
  #ProcedureImage
EndEnumeration
Global MeinWindows
Global Showline
Global yy
Global ww
Global frc.RECT
Global X1
Global Y1
Global IX
Global IY
Global MX
Global MY
Global SnipperAktivted
Global myKleinDisplay
Global myGrossDisplay
Global LeseBild_Breite
Global LeseBild_Hoehe
Global LeseBild_Tiefe
Global ImageGadget_Format.i
Global ImageGadget_Position_X.i
Global ImageGadget_Position_Y.i
Global LeseBild_Verhaeltinis.f
Global LeseBild_Verhaeltinis_Hoehe.i
Global ImageGadget_Position_Y.i
Global ImageGadget_LadeBildHoehe.i
Global ImageGadget_NeuePosition_Y.i
Global ImageGadget_Position_X.i
Global Fensterklick=false
Global ScreenCaptureAddress



Procedure Snipper_Display_Klein(ProcedureImage)
  ;Protected #ProcedureImage
  ;Format vom Sony 1366 x 768 x 16
  ;Fehler beim Ausschneiden = 1382 x 784
  myKleinDisplay = CopyImage(ProcedureImage, #myKleinDisplay); Bild kopieren ?????? Wenn Bild kopiert funktioniert die Sache auch!
                                                             ;Werte des Bild
  LeseBild_Breite = ImageWidth(ProcedureImage)               ;#imgCapture
                                                             ;Debug LeseBild_Breite
  LeseBild_Hoehe = ImageHeight(ProcedureImage) 
  ;Debug LeseBild_Hoehe
  LeseBild_Tiefe = ImageDepth(#imgCapture)
  ;Debug LeseBild_Tiefe
  ; format de Bildes
  If LeseBild_Breite > LeseBild_Hoehe: 
    LeseBild_Format = 1;            =>Horizontales Bild
  ElseIf LeseBild_Breite < LeseBild_Hoehe:   
    LeseBild_Format = 2 ; => Vertikales Bild
  Else :   
    LeseBild_Format = 0 : 
  EndIf  ;                                                    => Quadratisches Bild : 
         ;Debug "LeseBild_Format= "+Str(LeseBild_Format)
  SetGadgetText(#XI_VirtStartP,Str(LeseBild_Breite))
  SetGadgetText(#XI_VirtEndeP,Str(LeseBild_Hoehe))
  
  ; Position des Bildes
  ImageGadget_Format = 230
  ImageGadget_Position_X = 10
  ImageGadget_Position_Y = 10
  ;==========================================================================================================
  If LeseBild_Format = 1 ; Horizontales Bild   
                         ; Image Umrechnen
                         ;myKleinDisplay = CatchImage(#myKleinDisplay, *ImageMemory, MemSize)
    LeseBild_Verhaeltinis = LeseBild_Hoehe / LeseBild_Breite;Debug LeseBild_Verhaeltinis
    LeseBild_Verhaeltinis_Hoehe = ImageGadget_Format* LeseBild_Verhaeltinis;Debug LeseBild_Verhaeltinis_Hoehe
    ResizeImage (#myKleinDisplay, ImageGadget_Format, LeseBild_Verhaeltinis_Hoehe);Resize Bild
                                                                                  ;>>> Image kopieren
                                                                                  ;>>> Image in Memomry
    SetGadgetState(#XI_Image,ImageID(#myKleinDisplay))
    ; Wieter gehts zum Gadget
    ImageGadget_LadeBildHoehe = (ImageGadget_Format - LeseBild_Verhaeltinis_Hoehe)/2; ImageGadget positionieren
                                                                                    ;Debug "ImageGadget_LadeBildHoehe = "+Str(ImageGadget_LadeBildHoehe)
    ImageGadget_NeuePosition_Y = ImageGadget_Position_Y + ImageGadget_LadeBildHoehe
    ;Debug ImageGadget_NeuePosition_Y
    ResizeGadget(#XI_Image, ImageGadget_Position_X, ImageGadget_NeuePosition_Y, ImageGadget_Format, LeseBild_Verhaeltinis_Hoehe)
    ;==========================================================================================================
  ElseIf LeseBild_Format = 2 ; Vertikales Bild
    LeseBild_Verhaeltinis = LeseBild_Breite / LeseBild_Hoehe
    ;Debug LeseBild_Verhaeltinis
    LeseBild_Verhaeltinis_Breite = ImageGadget_Format* LeseBild_Verhaeltinis
    ;Debug LeseBild_Verhaeltinis_Breite
    ResizeImage (#myKleinDisplay, LeseBild_Verhaeltinis_Breite, ImageGadget_Format)
    SetGadgetState(#XI_Image,ImageID(#myKleinDisplay))
    ; ImageGadget positionieren
    ImageGadget_LadeBildBreite = (ImageGadget_Format - LeseBild_Verhaeltinis_Breite)/2
    ImageGadget_NeuePosition_X = ImageGadget_Position_X + ImageGadget_LadeBildBreite
    ResizeGadget(#XI_Image,ImageGadget_NeuePosition_X , ImageGadget_Position_Y, LeseBild_Verhaeltinis_Breite, ImageGadget_Format)
    ;==========================================================================================================
  ElseIf LeseBild_Format = 0  ;Quadratisches Bild
    SetGadgetState(#XI_Image,myKleinDisplay)
    ResizeGadget(#XI_Image, ImageGadget_Position_X, ImageGadget_Position_Y, ImageGadget_Format, ImageGadget_Format)
    ;==========================================================================================================
  EndIf; End of Bildformat
EndProcedure

Procedure Snipper_Desktop()
  GetWindowRect_(GetDesktopWindow_(), @r.rect)
  Width= DesktopWidth(0);-735
  Height = DesktopHeight(0);-520
  Debug Width
  Debug Height
  CreateImage(#imgCapture, Width, Height)
  DC = StartDrawing(ImageOutput(#imgCapture))
  BitBlt_(DC, 0, 0, Width, Height, GetWindowDC_(GetDesktopWindow_()), 0, 0, #SRCCOPY)
  StopDrawing()
  ResizeImage(#imgCapture,1440,960) ;- Hier der Eintrag
  SetClipboardImage(#imgCapture)
EndProcedure

Procedure.l CaptureScreen(Left.l, Top.l, Width.l, Height.l)
  dm.DEVMODE
  BMPHandle.l
  srcDC = CreateDC_("DISPLAY", "", "", dm)
  trgDC = CreateCompatibleDC_(srcDC)
  BMPHandle = CreateCompatibleBitmap_(srcDC, Width, Height)
  SelectObject_( trgDC, BMPHandle)
  BitBlt_( trgDC, 0, 0, Width, Height, srcDC, Left, Top, #SRCCOPY)
  DeleteDC_( trgDC)
  ReleaseDC_( BMPHandle, srcDC)
  ProcedureReturn BMPHandle
EndProcedure
Procedure CopyActiveWindow()
  Protected Handle.i = GetForegroundWindow_()
  Protected hDC.i    = GetWindowDC_(Handle)
  Protected pID.i, pDrawID.i, RECT.RECT
  
  GetWindowRect_(Handle, @RECT.RECT)
  With RECT
    \right  - \left
    \bottom - \top
    pID = CreateImage(#imgCapture, \right, \bottom)
    pDrawID = StartDrawing(ImageOutput(#imgCapture))
    If pDrawID
      BitBlt_(pDrawID, 0, 0, \right, \bottom, hDC, 0, 0, #SRCCOPY)
      StopDrawing()
      SetClipboardImage(#imgCapture)
    EndIf
  EndWith
  ReleaseDC_(Handle, hDC)
  SetClipboardImage(#imgCapture)
EndProcedure
Procedure Snipper_Transparency(win,level)
  If level>=0 And level<=100
    SetWindowLong_(WindowID(win),#GWL_EXSTYLE,GetWindowLong_(WindowID(win),#GWL_EXSTYLE)|$00080000) ; #WS_EX_LAYERED = $00080000
    SetLayeredWindowAttributes_(WindowID(win),0,255*level/100,2)
  EndIf
EndProcedure

Procedure Snipper_WorkCallback2(WindowID, Message, wParam, lParam) 
  Protected MyCallBackResult2
  Snipper_WorkCallbackResult2 = #PB_ProcessPureBasicEvents
  Select Message
      
    Case #WM_LBUTTONDOWN	; #WM_LBUTTONDOWN => Linker Mausbuttun gedrückt			                                  
      ShowLine = #True
      Debug "#WM_LBUTTONDOWN"
      
    Case #WM_LBUTTONDBLCLK				                                  
  EndSelect
  
  ProcedureReturn Snipper_WorkCallbackResult2
EndProcedure

Procedure Snipper_WorkCallback(WindowID, Message, wParam, lParam) 
  Protected MyCallBackResult
  Snipper_WorkCallbackResult = #PB_ProcessPureBasicEvents
  Select Message
      
    Case #WM_LBUTTONDOWN				                                  
      ShowLine = #True
      IX = DesktopMouseX() : IY = DesktopMouseY() 
      X1 = DesktopMouseX()
      Y1 = DesktopMouseY()
      Debug  DesktopMouseX()
      Debug  DesktopMouseY()
      Debug "#WM_LBUTTONDOWN"
    Case #WM_LBUTTONUP					                                  
      ShowLine = #False
      ; - Snipper Maus Up (Losgelassen)
      ; Mauswert in X/Y(2)
      X2 = DesktopMouseX()
      Y2 = DesktopMouseY()
      SetGadgetText(#XI_StartP, "Start Maus-Klick-Position:                    X1= "+Str(X1)+", Y1= "+Str(Y1))
      SetGadgetText(#XI_EndeP,  "Stop Maus-Klick-Position:                    X1= "+Str(X2)+", Y1= "+Str(Y2))
      ; Festlegen des Ausschnitts
      ;Bildausschnitt RECHTS UNTEN
      If X2>X1 And Y2>Y1
        BX1=X1
        BY1=Y1
        BX2=X2
        BY2=Y2
        Delay(20)
      EndIf
      ;Bildausschnitt RECHTS OBEN
      If X2>X1 And Y2<Y1 
        BX1=X1
        BY1=Y2
        BX2=X2
        BY2=Y1
        Delay(20)
      EndIf
      ;Bildausschnitt LINKS UNTEN
      If X2<X1 And Y2>Y1 
        BX1=X2
        BY1=Y1
        BX2=X1
        BY2=Y2
        Delay(20)
      EndIf
      ;Bildausschnitt LINKS OBEN
      If X2<X1 And Y2<Y1 
        BX1=X2
        BY1=Y2
        BX2=X1
        BY2=Y1
        Delay(20)
      EndIf
      SetGadgetText(#XI_VirtStartP, "VirtualStart Maus-Klick-Position:          X1= "+Str(BX1)+", Y1= "+Str(BY1))
      SetGadgetText(#XI_VirtEndeP, "VirtualStop Maus-Klick-Position:          X2= "+Str(BX2)+", Y2= "+Str(BY2))
      ; Berechnen des Bildauschnittes
      Speicherbild_Breite = BX2-BX1   
      Speicherbild_Hoehe = BY2-BY1
      SetGadgetText(#XI_VirtStartP2, "Bildausschnitt STARTPunkt               BX1="+Str(BX1)+", BY1= "+Str(BY1))
      SetGadgetText(#XI_SchnittP, "Desktop Bildausschnitt                 Width="+Str(Speicherbild_Breite)+", Height= "+Str(Speicherbild_Hoehe))
      
      GrabImage(#imgCapture,#myImage2, BX1, BY1, Speicherbild_Breite, Speicherbild_Hoehe)
      SetClipboardImage(#myImage2)
      Snipper_Display_Klein(#myImage2)
      CloseWindow(#ChildWindow); SnipperWindows schliessen
      CloseWindow(#ParentWindow); SnipperWindows schliessen
      SetWindowState(#FrameMain, #PB_Window_Normal)
      HideWindow(#FrameMain, #False ); Windows wieder einschalten
      SetActiveWindow(#FrameMain)    ; Windows wieder als Aktiv
      StickyWindow(#FrameMain,0)     ; Windows ganz nach vorne
      SetWindowCallback(@Snipper_WorkCallback2()); Zweiten Callback bereitstellen
      Debug "#WM_LBUTTONUP"                      
      
    Case #WM_MOUSEMOVE				                                        
      If ShowLine
        Debug "#WM_MOUSEMOVE"    
        If EventwParam() = #MK_LBUTTON
          ; - Snipper Maus Move (in Bewegung)
          ;MX=0:MY=0
          MX = DesktopMouseX() : MY = DesktopMouseY()
          Bildauschnitt=A
          hdc = GetDC_(WindowID(#ChildWindow))
          DrawFocusRect_(hdc,frc.RECT)
          
          If ((IX < MX) And (IY > MY))
            SetRect_(frc,IX,MY, MX,IY)
          ElseIf ((IX > MX) And (IY > MY))
            SetRect_(frc,MX, MY, IX,IY)
          ElseIf ((IX > MX) And (IY < MY))
            SetRect_(frc,MX,IY, IX, MY)
          Else
            SetRect_(frc,IX,IY,MX,MY)         
          EndIf
          
          DrawFocusRect_(hdc,frc)
          ;ClearRect_(frc,IX,IY,MX,MY)
          ReleaseDC_(WindowID(#ChildWindow),hdc)   
        EndIf
      EndIf
  EndSelect
  ProcedureReturn Snipper_WorkCallbackResult
EndProcedure

Procedure Snipper_Window()
  ExamineDesktops(); Ermittelt Informationen Desktops für folgende Befehle Desktopheight()
  OpenWindow(#ParentWindow,0,0,DesktopWidth(0),DesktopHeight(0),"Snipping Test",#PB_Window_Invisible)
  ;Unser Fenster mit dem wir auf den Desktop malen wollen
  OpenWindow(#ChildWindow,0,0,DesktopWidth(0),DesktopHeight(0),"Snipping Test",#PB_Window_BorderLess|#PB_Window_Invisible,GetDesktopWindow_())
  ;Window auf Layered Child Window umschalten
  SetWindowLong_(WindowID(#ChildWindow),#GWL_HWNDPARENT,WindowID(#ParentWindow))
  ;Snap Windows vom Desktop
  Snipper_Desktop(); Bild vom Desktop
  ;Window auf Transparent Layered Window umschalten
  Snipper_Transparency(#ChildWindow,40)
  ;Fenster fixieren
  ;SetWindowPos_(WindowID(#ChildWindow),#HWND_BOTTOM,0,0,0,0,#SWP_NOMOVE|#SWP_NOREPOSITION|#SWP_NOSIZE)
  ;Window anzeigen
  HideWindow(#ChildWindow,#False)
  ; Windows in den Vordergrund
  StickyWindow(#ChildWindow,0)
  ;SetActiveWindow(#ParentWindow)
  ; Fokus auf das Windows setzen
  SetActiveWindow(#ChildWindow)
  ; ESC Taste freischalten ?
  ;AddKeyboardShortcut(#ChildWindow, #PB_Shortcut_Escape, #TastenDruckEscape) ; Escape einschalten
  ; Snipper Callback einschalten
  SetWindowCallback(@Snipper_WorkCallback(),#ChildWindow);Snipper_WorkCallback einschalten
  SetRect_(frc,0,0,0,0)         
EndProcedure

MeinWindows=OpenWindow(#FrameMain,683, 0,667, 350,"Velindos Snipping Test",#PB_Window_SystemMenu|#PB_Window_SizeGadget);  |#PB_Window_BorderLess  

TextGadget(#XI_SnipperEinAus,150,250,150,25,Str(SnipperEinAus))
ButtonGadget(#BildAusschneiden,150,270,150,25,"Bild ausschneiden")
ButtonGadget(#BildVomDesktop,320,270,150,25,"Bild vom Desktop")

ButtonGadget(#FensterKlick,490,270,150,25,"Bild vom Fenster")

TextGadget(#XI_StartP, 250, 6, 290, 20, "Start")
TextGadget(#XI_EndeP, 250, 26, 290, 20, "Ende")
TextGadget(#XI_VirtStartP, 250, 66, 290, 20, "VirtualStart")
TextGadget(#XI_VirtEndeP, 250, 86, 290, 20, "VirtualEnde")

TextGadget(#XI_VirtStartP2, 250, 126, 290, 20, "VirtualStart")
TextGadget(#XI_SchnittP, 250, 146, 290, 20, "Bildausschnitt")

AddKeyboardShortcut(#FrameMain, #PB_Shortcut_Escape, #TastenDruckEscape) ; Escape einschalten

SetWindowCallback(@Snipper_WorkCallback2(),#FrameMain)
SetActiveWindow(#FrameMain)

CreateImage(#Testbild,230,230)
ImageGadget(#XI_Image,10,10,230,230,ImageID(#Testbild));,#PB_Image_Raised|#PB_Image_Border<============================================   BILD
DesktopMouseX()
;-REPEAT
Repeat
  EventID=WaitWindowEvent()
  Select EventID
    Case #PB_Event_CloseWindow:End
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #BildAusschneiden
          SetGadgetText(#XI_SnipperEinAus,"1")
          HideWindow(#FrameMain, #True ); Window ausblenden
          SetWindowState(#FrameMain, #PB_Window_Minimize)
          Snipper_Window(); Aufruf des Snipper Fenster
        Case #BildVomDesktop
          Snipper_Desktop()
          Snipper_Display_Klein(#imgCapture)
        Case #FensterKlick
          ;Hier beginnt die Abfrage für den Fensterklick
          ;If Fensterklick = #True
          Debug "Fensterklick ausgelöst"
          SetWindowState(#FrameMain, #PB_Window_Minimize)
          Delay(3000)
          CopyActiveWindow()
          Snipper_Display_Klein(#imgCapture)      
          SetWindowState(#FrameMain, #PB_Window_Normal  )
          StickyWindow(#FrameMain,0); Windows ganz nach vorne
      EndSelect
    Case #PB_Event_Menu
      Select EventMenu()                          ;PopUp und Einträge für Kategorie und ESC
        Case #TastenDruckEscape:End               ;Escape Taste gedrückt, soll Snipper Quittieren
      EndSelect
  EndSelect
Until event = #PB_Event_CloseWindow 

Hat mal jemand eine Idee?

Gruss ... Velindos

[Velindos]

Hallo Leute,
mein Problem in kurzer Form.

Wenn ich

Code: Alles auswählen

Delay(3000)
ExamineDesktops()
Debug DesktopWidth(0)
Debug DesktopHeight(0)

Debug DesktopMouseX()
Debug DesktopMouseY()

Nachdem ich den Cursor im rechten/unteren Ecke Positioniert habe, bekomme ich die folgende Werte geliefert:
2160
1440
1439
959

Ist das ein Bug im Purebasic?

Gruss ... Velindos

[Kiffi]

1920
1200
1919
1199

... was bei mir (Windows 7) korrekt wäre. Weiß nicht, wie das bei Windows 8.1 aussieht.

Grüße ... Peter

[matbal]

Das hängt mit der Bildschirm-DPI-Einstellung zusammen. Microsoft gibt sich alle Mühe, daß alte Programme auch auf superhochauflösenden Bildschirmen bedienbar bleiben. Nicht angepaßte (alte) Programme werden dann vom Betriebssystem entsprechend des eingestellten DPI-Wertes skaliert.

In jeder neuen Windows-Version kamen neue Funktionen hinzu: Writing DPI-Aware Desktop and Win32 Applications

[Velindos]

Hallo, Danke für deinen Tip. Für das Auslesen der DPI habe ich folgendes in mein Programm eingebaut:

Code: Alles auswählen

; DPI auslesen vom Release
MessageRequester("","DPI: "+Str(GetDeviceCaps_(GetDC_(GetDesktopWindow_()),88)),0)

1) Nun wenn ich die Sache im PB starte zeigt er 144 Dpi an.
2) Nach dem Compilieren zeigt er 96 Dpi an!

Besteht die Möglichkeit im Purebasic dieses zu beeinflussen, bzw. die Desktopauflösung per PB umzuschalten!

Gruss Velindos ...

[matbal]

Ich habe diese im englischen Forum gepostete Include für mich angepaßt: DPI Aware Application

ScaleDPI.pbi

Code: Alles auswählen

EnableExplicit

#PB_Compiler_Exe = #True 

Global _ScaleDPI_X_.f = 1.0
Global _ScaleDPI_Y_.f = 1.0

Prototype.i PT0()

#DefaultDPIX = 96.0 
#DefaultDPIY = 96.0

Macro ScaleDPIx(x)
   (x)*_ScaleDPI_X_
EndMacro
Macro ScaleDPIy(y)
   (y)*_ScaleDPI_Y_  
EndMacro

Procedure InitScaleDPI() 
   Protected dpiaware.l = #False
   Protected hDC.i
   Protected lpx.i 
   Protected lpy.i
   Protected dll.i
   Protected SetProcessDPIAware.pt0
   Protected IsProcessDPIAware.pt0
   Protected ncm.NONCLIENTMETRICS
   Protected font.i
   Protected name$, points.i, styles.i, charset.i
   
   
   CompilerIf #PB_Compiler_Exe 
      dll = OpenLibrary(#PB_Any,"user32.dll")
      If dll
         ; ab Window Vista
         IsProcessDPIAware = GetFunction(dll, "IsProcessDPIAware")
         SetProcessDPIAware = GetFunction(dll, "SetProcessDPIAware")
         
         If IsProcessDPIAware And SetProcessDPIAware
            
            dpiaware = IsProcessDPIAware()
            
            If Not dpiaware 
               SetProcessDPIAware()
            EndIf
            
         EndIf
         CloseLibrary(dll)
      EndIf
   CompilerEndIf
   
   
   
   ; Skalierungsfaktor bestimmen
   hDC = GetDC_(#Null)
   If hDC
      lpx = GetDeviceCaps_(hDC,#LOGPIXELSX)  ; DPI-Wert x
      lpy = GetDeviceCaps_(hDC,#LOGPIXELSY)  ; DPI-Wert y
      ReleaseDC_(#Null,hDC)
   EndIf
   
   If lpx > 0
      _ScaleDPI_X_ = lpx / #DefaultDPIX   ; Skalierungsfaktor x
   EndIf
   If lpy > 0
      _ScaleDPI_Y_ = lpy / #DefaultDPIY   ; Skalierungsfaktor y
   EndIf
   
   ; DialogFont
   ncm\cbSize = SizeOf(NONCLIENTMETRICS)
   If SystemParametersInfo_(#SPI_GETNONCLIENTMETRICS,SizeOf(NONCLIENTMETRICS),ncm,#Null)
      name$ = PeekS(@ncm\lfMessageFont\lfFaceName)
      
      charset = ncm\lfMessageFont\lfCharSet
      
      points = -MulDiv_(ncm\lfMessageFont\lfHeight, 72, lpy)
      
      If ncm\lfMessageFont\lfWeight = 700 : styles|#PB_Font_Bold     : EndIf
      If ncm\lfMessageFont\lfItalic > 0   : styles|#PB_Font_Italic   : EndIf
      
      ; Dialogfont als Standardfont setzen
      font = LoadFont(#PB_Any,name$,points,#PB_Font_HighQuality|styles)
      If font
         SetGadgetFont(#PB_Default,FontID(font))
      EndIf
   EndIf
   
EndProcedure


Procedure __EnumChild__(hwnd, Parent)
   Protected Buffer.s = Space(256)
   Protected RC.RECT
   Protected p1.POINT
   Protected p2.POINT
   
   GetClassName_(hwnd, @Buffer,256)  
   ;Debug Buffer
   If Buffer 
      ; Screen-Koordinaten des Gadgets  
      GetWindowRect_(hWnd, RC)      
      
      ; In Client-Koordinaten umwandeln
      p1\x = rc\left
      p1\y = rc\top
      ScreenToClient_(GetParent_(hwnd), p1)   
      p2\x = rc\right
      p2\y = rc\bottom
      ScreenToClient_(GetParent_(hwnd), p2)   
      
      ;Debug Str(p1\x) + " , " + Str(p1\y) + " - " + Str(p2\x - p1\x) + " , " + Str(p2\y - p1\y)
      
      ; Skalieren
      SetWindowPos_(hwnd, 0, ScaleDPIx(p1\x), ScaleDPIy(p1\y), ScaleDPIx(p2\x - p1\x), ScaleDPIy(p2\y - p1\y), #SWP_NOZORDER)
      
      ProcedureReturn 1
   EndIf
EndProcedure
Procedure WindowScaleDpi(Window)
   ; Skaliert alle Gadgets eines Windows
   
   EnumChildWindows_(WindowID(window), @__EnumChild__(), WindowID(window))
   
EndProcedure

Procedure GadgetScaleDpi(Gadget, LastGadget = 0)
   ; Skaliert ein oder mehrere Gadgets
   Protected.i i, x, y, w, h
   If LastGadget = 0
      LastGadget = Gadget
   EndIf
   
   For i = Gadget To LastGadget
      If IsGadget(i)
         x = GadgetX(i) * _ScaleDPI_X_
         y = GadgetY(i) * _ScaleDPI_Y_
         w = GadgetWidth(i) * _ScaleDPI_X_
         h = GadgetHeight(i) * _ScaleDPI_Y_
         ResizeGadget(i, x, y, w, h)
      EndIf
   Next i
   
EndProcedure

Wenn man InitScaleDPI aufruft, muß man sich auch um die korrekte Skalierung der GUI-Elemente selber kümmern.

Die Include bestimmt die Skalierungsfaktoren und stellt ein paar Macros bereit. Zusätzlich habe ich noch ein paar Prozeduren hinzugefügt, um den Aufwand weiter zu reduzieren.
Nebenbei ändere ich auch den DefaultFont.

Mit den zusätzlichen Prozeduren läßt sich die Include auch mit dem FormDesigner von PB recht kompfortabel verwenden.

Beispiel

FormMain:

Code: Alles auswählen

;
; This code is automatically generated by the FormDesigner.
; Manual modification is possible to adjust existing commands, but anything else will be dropped when the code is compiled.
; Event procedures needs to be put in another source file.
;

Enumeration FormWindow
  #FormMain
EndEnumeration

Enumeration FormGadget
  #FormMain_Button_1
  #FormMain_Button_2
  #FormMain_Text_Info
EndEnumeration


Procedure OpenFormMain(x = 0, y = 0, width = 305, height = 80)
  OpenWindow(#FormMain, x, y, width, height, "Test", #PB_Window_SystemMenu | #PB_Window_Invisible | #PB_Window_ScreenCentered)
  ButtonGadget(#FormMain_Button_1, 10, 5, 110, 25, "Hier bitte drücken")
  ButtonGadget(#FormMain_Button_2, 10, 35, 140, 25, "Oder auch hier drücken")
  TextGadget(#FormMain_Text_Info, 155, 5, 145, 20, "Mausposition")
EndProcedure

main.pb:

Code: Alles auswählen

EnableExplicit
XIncludeFile "ScaleDPI.pbi"
InitScaleDPI()

XIncludeFile "FormMain.pbf"

Procedure Timer_Proc()
   Static x,y
   
   If DesktopMouseX() <> x Or DesktopMouseY() <> y
      x = DesktopMouseX()
      y = DesktopMouseY()
      
      SetGadgetText(#FormMain_Text_Info, "Mauspos: " + x + "," + y)
   EndIf
EndProcedure

Procedure FormMain_Open()
   OpenFormMain(0, 0, ScaleDPIx(305), ScaleDPIy(80)) ; Window skalieren
   
   WindowScaleDpi(#FormMain)  ; Gadgets skalieren
   HideWindow(#FormMain, 0)   ; jetzt erst Window zeigen
   
   AddWindowTimer(#FormMain, 1, 20)
   BindEvent(#PB_Event_Timer, @Timer_Proc(), #FormMain, 1)
EndProcedure

FormMain_Open()

Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow

[Velindos]

Hallo Leute,
besten Dank für die Tips, komme jedoch bei dem Fensterklick nicht zurecht mit dem Vorschlag.

Code: Alles auswählen

Enumeration
  #imgCapture
EndEnumeration
Procedure CopyActiveWindow()
  
  Delay(3000) ; Jetzt auf Fenster drücken
  
  Protected Handle.i = GetForegroundWindow_()
  Protected hDC.i    = GetWindowDC_(Handle)
  Protected pID.i, pDrawID.i, RECT.RECT
  
  GetWindowRect_(Handle, @RECT.RECT)
  With RECT
    \right  - \left
    \bottom - \top
    pID = CreateImage(#imgCapture, \right, \bottom)
    pDrawID = StartDrawing(ImageOutput(#imgCapture))
    If pDrawID
      BitBlt_(pDrawID, 0, 0, \right, \bottom, hDC, 0, 0, #SRCCOPY)
      StopDrawing()
      SetClipboardImage(#imgCapture)
    EndIf
  EndWith
  ReleaseDC_(Handle, hDC)
  SetClipboardImage(#imgCapture)
EndProcedure

CopyActiveWindow() ; Aus Zwischenablage auslesen(zB.Paint)

Hier schneidet er nicht richtig, bzw. GetForegroundWindow liefert nicht den richtigen Ausschnitt zurück. Entweder schneidet es zu klein aus, oder versetzt den Ausschnitt.

Jemand eine Idee!

Gruss ... Velindos

[matbal]

Hier schneidet er nicht richtig, bzw. GetForegroundWindow liefert nicht den richtigen Ausschnitt zurück. Entweder schneidet es zu klein aus, oder versetzt den Ausschnitt.
Jemand eine Idee!

Bei 96 dpi (100%) und 120 dpi (125%) funktioniert es noch richtig. Probleme habe ich unter Windows 8.1 erst bei 144 dpi (150%).

Wenn ich meine ScaleDPI-Include einbinde, funktionieren mit deinem Code immerhin alle Programme, die DPI-Aware unterstützen.
Die Fenster von Programmen ohne DPI-Aware Unterstützung werden ungezoomt (in 96 dpi) kopiert. Der Screenshot ist also viel kleiner als das Fenster. Diese Programme erkennt man schon daran, daß alle GUI-Elemente verschwommen sind, weil sie von Windows gezoomt werden. (Der Fensterrahmen vom Screenshot ist hier verstümmelt)


Eine Lösung wäre, daß du einen Screenshot vom Desktop erstellst und daraus dann das Fenster ausschneidest. Ich habe mir mal aus deinen geposteten Codes so etwas zusammengebaut.

Code: Alles auswählen

EnableExplicit

IncludeFile "ScaleDPI.pbi"
InitScaleDPI()

Enumeration
   #imgCapture
   #imgWindow
EndEnumeration


Procedure CopyActiveWindow()
   
   Delay(3000) ; Jetzt auf Fenster drücken
   
   Protected Handle.i 
   Protected hDC.i    
   Protected RECT.RECT
   
   ; Screenshot vom gesamten Desktop
   ExamineDesktops()
   CreateImage(#imgCapture, DesktopWidth(0), DesktopHeight(0))
   hDC = StartDrawing(ImageOutput(#imgCapture))
   If hDC
      BitBlt_(hDC, 0, 0, DesktopWidth(0), DesktopHeight(0), GetWindowDC_(GetDesktopWindow_()), 0, 0, #SRCCOPY)
      StopDrawing()
      
      
      ; Bereich des Fensters ermitteln
      Handle = GetForegroundWindow_()
      hDC = GetWindowDC_(Handle)
      GetWindowRect_(Handle, @RECT.RECT)
      
      ; Fensterbereich kopieren
      With RECT
         If CreateImage(#imgWindow, \right-\left, \bottom-\top)
            GrabImage(#imgCapture, #imgWindow, \left, \top, \right-\left, \bottom-\top)
            SetClipboardImage(#imgWindow)   
         EndIf
      EndWith
      
      CloseHandle_(hDC) ; ?
      FreeImage(#imgCapture)
   EndIf

EndProcedure


CopyActiveWindow() ; Aus Zwischenablage auslesen(zB.Paint)

[Velindos]

Hallo,
besten Dank für eure Hilfe. Nun wollte aber die DPI Lösung im Surface nicht einbauen, weil das Programm zu Umfangreich! Daher habe ich mich umgesehen und folgendes gefunden:
http://www.forums.purebasic.com/english ... =5&t=58757
Besten Dank an die Kollegen! Wie die Sache genau funktioniert ist mir zu hoch aber es funzt nach der folgenden Assemblierung:

Code: Alles auswählen

Enumeration ; GetWindowRectEx()
 #DWMWA_NCRENDERING_ENABLED = 1
 #DWMWA_NCRENDERING_POLICY
 #DWMWA_TRANSITIONS_FORCEDISABLED
 #DWMWA_ALLOW_NCPAINT
 #DWMWA_CAPTION_BUTTON_BOUNDS
 #DWMWA_NONCLIENT_RTL_LAYOUT
 #DWMWA_FORCE_ICONIC_REPRESENTATION
 #DWMWA_FLIP3D_POLICY
 #DWMWA_EXTENDED_FRAME_BOUNDS
 #DWMWA_HAS_ICONIC_BITMAP
 #DWMWA_DISALLOW_PEEK
 #DWMWA_EXCLUDED_FROM_PEEK
 #DWMWA_LAST
EndEnumeration

Global   WindowSize.RECT

Procedure.l CaptureScreen(Left.l, Top.l, Width.l, Height.l)
   Protected dm.DEVMODE, BMPHandle.l, srcDC, trgDC
   dm.DEVMODE
   BMPHandle.l
   srcDC = CreateDC_("DISPLAY", "", "", dm)
   trgDC = CreateCompatibleDC_(srcDC)
   BMPHandle = CreateCompatibleBitmap_(srcDC, Width, Height)
   SelectObject_( trgDC, BMPHandle)
   BitBlt_( trgDC, 0, 0, Width, Height, srcDC, Left, Top, #SRCCOPY)
   DeleteDC_( trgDC)
   ReleaseDC_( BMPHandle, srcDC)
   ProcedureReturn BMPHandle
EndProcedure

Procedure.i IsAeroActive()
 Protected *DwmIsCompositionEnabled
 Protected iRetVal, hDll, iBool

 If OSVersion() >= #PB_OS_Windows_Vista
    hDll = OpenLibrary(#PB_Any, "dwmapi.dll")
    If hDll
        *DwmIsCompositionEnabled = GetFunction(hDll, "DwmIsCompositionEnabled")

        If *DwmIsCompositionEnabled
            If CallFunctionFast(*DwmIsCompositionEnabled, @iBool) = #S_OK
                iRetVal = iBool ; #True / #False
            EndIf       
        EndIf
        CloseLibrary(hDll)
    EndIf
 EndIf

 ProcedureReturn iRetVal
EndProcedure

Procedure GetWindowRectEx (hWnd, *tRECT.RECT)
 Protected hDll, iDwmUsed
 Protected *DwmGetWindowAttribute
 Protected tRECT.RECT

 If OSVersion() >= #PB_OS_Windows_Vista
    If IsAeroActive()
        hDll = OpenLibrary(#PB_Any, "dwmapi.dll")
        If hDll
            *DwmGetWindowAttribute = GetFunction(hDll, "DwmGetWindowAttribute")
            If *DwmGetWindowAttribute                 
                If CallFunctionFast(*DwmGetWindowAttribute, hWnd,  #DWMWA_EXTENDED_FRAME_BOUNDS, *tRECT, SizeOf(RECT)) = #S_OK
                    iDwmUsed = 1               
                EndIf           
            EndIf           
            CloseLibrary(hDLL)
        EndIf
    EndIf
 EndIf
 If iDwmUsed = 0 ; fallback
    GetWindowRect_(hWnd, *tRECT)
 EndIf
EndProcedure

Procedure CaptureForGroundWindow()
Protected WinHndl
WinHndl=GetWindowRectEx (GetForegroundWindow_(),@WindowSize.RECT);rect.RECT
    ScreenCaptureAddress = CaptureScreen(WindowSize\Left, WindowSize\Top, WindowSize\Right - WindowSize\Left, WindowSize\Bottom - WindowSize\Top)
    CreateImage(0, WindowSize\Right - WindowSize\Left, WindowSize\Bottom - WindowSize\Top)
    StartDrawing(ImageOutput(00))
    DrawImage(ScreenCaptureAddress, 0, 0)
    StopDrawing()
    SetClipboardImage(0)
  EndProcedure
OpenWindow(0,0,0,800,600,"Title",#PB_Window_TitleBar|#PB_Window_ScreenCentered)

Delay(3000)

CaptureForGroundWindow()

Debug WindowSize\left
Debug WindowSize\top
Debug WindowSize\right  - WindowSize\left
Debug WindowSize\bottom - WindowSize\top

Gruss ... Velindos