AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Sprachen und Entwicklungsumgebungen Sonstige Fragen zu Delphi Delphi Bildschirmlupe - Bereich unter Formular ermitteln
Thema durchsuchen
Ansicht
Themen-Optionen

Bildschirmlupe - Bereich unter Formular ermitteln

Ein Thema von Fussball-Robby · begonnen am 29. Dez 2008 · letzter Beitrag vom 17. Jul 2009
Antwort Antwort
Seite 7 von 10   « Erste     567 89     Letzte »    
EWeiss
(Gast)

n/a Beiträge
 
#61

Re: Bildschirmlupe - Bereich unter Formular ermitteln

  Alt 2. Jan 2009, 09:36
Zitat von turboPASCAL:
Sie funktioniert, teilweise. Nach ein paar Scekunden schiesst sich das Programm ohne eine Fehlermeldung.
Den Desktophintergrund wird mit dem Prg. nicht angezeigt.

Wie arbeitet denn das Teil ?
Bei mir wird alles angezeigt incl. Desktop auf XP/SP2.
Hmm glaube aber du hast Vista.

Arbeiten tut es mit Standard API's

CreateRoundRectRgn
DeleteObject
GetCursorPos
GetModuleHandle
GetProcAddress
GetWindowDC
ReleaseDC
SetWindowPos
SetWindowRgn
StretchBlt

und einen Timer.. 50ms geht aber auch in realzeit also 1ms
mit 0% CPU auslastung.

Hab das Teil mal als Plugin (VB) für meinen Mediaplayer geschrieben.
Der Source !! VB

Hab keine lust das jetzt zu übersetzen dürfte aber nicht schwer sein da es nu um API
und Koordinaten geht.

Delphi-Quellcode:
Option Explicit

#Const Rounded = True 'False = wird als Rechteck angezeigt
Private Const Magnify As Long = 5
'Magnify Faktor
Private Const ViewSize As Long = 40 'Größe des Areals zu Magnify (in pixel)

Private Const ViewSize2 As Long = ViewSize \ 2
Private Const DestSize As Long = ViewSize * Magnify
Private Const DestCenter As Long = DestSize \ 2
Private Const CrossCenter As Long = DestCenter + Magnify \ 2 + (Magnify And 1)

Private Const Border As Long = 1
Private ScrXMax As Long
Private ScrYMax As Long

Private Type tPoint
x As Long
y As Long
End Type

Private CursorPos As tPoint
Private PrevPos As tPoint
Private Cnt As Long
Private xPos As Long
Private yPos As Long

Private Const hWndDesktop As Long = 0
Private hDCDesktop As Long
Private hRgn As Long
Private Const HWND_TOPMOST As Long = -1
Private Const SWP_NOSIZE As Long = 1
Private Const SWP_NOMOVE As Long = 2

Private Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As tPoint) As Long
Private Declare Function GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
Private Declare Function SetWindowPos Lib "user32.dll" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hDstDC As Long, ByVal xDst As Long, ByVal yDst As Long, ByVal nDstWidth As Long, ByVal nDtsHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long

Private Sub Form_Load()

If App.PrevInstance Then
Beep 333, 100
Beep 222, 222
Unload Me
Else
SetWindowPos hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
hDCDesktop = GetWindowDC(hWndDesktop)
Width = ScaleX(DestSize + Border + Border, vbPixels, vbTwips)
Height = Width
Show
tmrRefresh_Timer

#If Rounded Then
'------------------------------------------------------------------
        xPos = ScaleWidth
        hRgn = CreateRoundRectRgn(2, 2, xPos, xPos, xPos, xPos)
        SetWindowRgn hwnd, hRgn, True
#End If '---------------------------------------------------------------------------

With Screen
ScrXMax = ScaleX(.Width, vbTwips, vbPixels) - ViewSize
ScrYMax = ScaleY(.Height, vbTwips, vbPixels) - ViewSize
End With
App.TaskVisible = False

End If

End Sub

Private Sub Form_Unload(Cancel As Integer)

If hDCDesktop Then
ReleaseDC hWndDesktop, hDCDesktop
End If
If hRgn Then
DeleteObject hRgn
End If

End Sub

Private Sub tmrRefresh_Timer()

GetCursorPos CursorPos
With CursorPos
If .x <> PrevPos.x Or .y <> PrevPos.y Or Cnt = 0 Then
PrevPos = CursorPos
If .x = 0 And .y = 0 Then
Unload Me
Else
xPos = ScaleX(.x + ViewSize2, vbPixels, vbTwips)
yPos = ScaleY(.y + ViewSize2, vbPixels, vbTwips)
If xPos + Width > Screen.Width Then
xPos = Screen.Width - Width
End If
If yPos + Height > Screen.Height Then
yPos = Screen.Height - Height
End If
If xPos = Screen.Width - Width And yPos = Screen.Height - Height Then
xPos = ScaleX(.x - ViewSize2, vbPixels, vbTwips) - Width
yPos = ScaleY(.y - ViewSize2, vbPixels, vbTwips) - Height
End If
Move xPos, yPos
xPos = .x - ViewSize2
yPos = .y - ViewSize2
Cls
StretchBlt hDC, Border, Border, DestSize, DestSize, hDCDesktop, xPos, yPos, ViewSize, ViewSize, vbSrcCopy
Line (CrossCenter, CrossCenter - 7)-(CrossCenter, CrossCenter + 8), vbRed
Line (CrossCenter - 7, CrossCenter)-(CrossCenter + 8, CrossCenter), vbRed

#If Rounded Then
'------------------------------------------------------------------
                DrawWidth = 2
                DrawMode = vbCopyPen
                Circle (DestCenter - 1, DestCenter - 1), DestCenter - 2, vbBlack
                DrawWidth = 1
                DrawMode = vbMergePenNot
#End If '---------------------------------------------------------------------------

End If
End If
Cnt = (Cnt + 1) Mod 16
End With

End Sub
Bei Magnify 1 und Viewsize 80 wird alles unterhalb der Form angezeigt im Oroginal Maßstab.
vbPixels := 15
mit Cls wird der Hintergrund gelöscht und dann mit StretchBlt neu gezeichnet.

Das andere ist selbsterklärend.

gruss Emil
  Mit Zitat antworten Zitat
Benutzerbild von turboPASCAL
turboPASCAL

Registriert seit: 8. Mai 2005
Ort: Sondershausen
4.274 Beiträge
 
Delphi 6 Personal
 
#62

Re: Bildschirmlupe - Bereich unter Formular ermitteln

  Alt 2. Jan 2009, 10:53
Zitat:
Hmm glaube aber du hast Vista.
Ja, warum hab ich hdas denn nicht hingeschrieben. Man wird wohl vergesslich.

Zitat:
Hab keine lust das jetzt zu übersetzen
Nö, warum auch. Man(n) kanns ja lesen.
Matti
Meine Software-Projekte - Homepage - Grüße vom Rüsselmops -Mops Mopser
  Mit Zitat antworten Zitat
EWeiss
(Gast)

n/a Beiträge
 
#63

Re: Bildschirmlupe - Bereich unter Formular ermitteln

  Alt 2. Jan 2009, 11:02
Zitat:
Man wird wohl vergesslich.
Du sagst es
Mein Gehirn arbeitet nicht mehr so richtig..
Hab wohl Alsheimer.

gruss Emil
  Mit Zitat antworten Zitat
Benutzerbild von Garfield
Garfield

Registriert seit: 9. Jul 2004
Ort: Aken (Anhalt-Bitterfeld)
1.335 Beiträge
 
Delphi XE5 Professional
 
#64

Re: Bildschirmlupe - Bereich unter Formular ermitteln

  Alt 2. Jan 2009, 11:17
Hallo, ein gesundes neues ...

Leider vergrößert die Lupe das, was unter der Maus und nicht unterm "Lupenglas" ist.
Gruss Garfield
Ubuntu 22.04: Laz2.2.2/FPC3.2.2 - VirtBox6.1+W10: D7PE, DXE5Prof
  Mit Zitat antworten Zitat
EWeiss
(Gast)

n/a Beiträge
 
#65

Re: Bildschirmlupe - Bereich unter Formular ermitteln

  Alt 2. Jan 2009, 16:46
Zitat von Garfield:
Hallo, ein gesundes neues ...

Leider vergrößert die Lupe das, was unter der Maus und nicht unterm "Lupenglas" ist.
Ist doch nur ne frage wie man die position der Maus zum mittelpunkt der Lupe berechnet.

gruss Emil
  Mit Zitat antworten Zitat
Benutzerbild von Sunlight7
Sunlight7

Registriert seit: 17. Sep 2006
Ort: Sonnensystem, Zentral
1.522 Beiträge
 
Delphi 5 Standard
 
#66

Re: Bildschirmlupe - Bereich unter Formular ermitteln

  Alt 2. Jan 2009, 17:01
Für später dazu(ge)kommende:
Das ist gefragt: http://www.delphipraxis.net/internal...=981525#981525
Windows: Ja - Microsoft: Nein -> www.ReactOS.org
  Mit Zitat antworten Zitat
Namenloser

Registriert seit: 7. Jun 2006
Ort: Karlsruhe
3.724 Beiträge
 
FreePascal / Lazarus
 
#67

Re: Bildschirmlupe - Bereich unter Formular ermitteln

  Alt 2. Jan 2009, 19:19
Zitat von turboPASCAL:
Sie funktioniert, teilweise. Nach ein paar Scekunden schiesst sich das Programm ohne eine Fehlermeldung.
Den Desktophintergrund wird mit dem Prg. nicht angezeigt.

Wie arbeitet denn das Teil ?
Bei mir stürzt das Programm nicht ab. Die Arbeitsweise ist doch einfach: Er zeigt einfach nicht den Teil an, der unter der Lupe ist

[Edit]Sorry, hab irgendwie nicht gesehn, dass danach noch eine Seite kam [/Edit]
  Mit Zitat antworten Zitat
EWeiss
(Gast)

n/a Beiträge
 
#68

Re: Bildschirmlupe - Bereich unter Formular ermitteln

  Alt 2. Jan 2009, 19:42
Zitat:
Er zeigt einfach nicht den Teil an, der unter der Lupe ist
Ist auch witzlos und nicht der sinn einer realen Lupe.
Schließlich möchte ich den Arbeitsbereich vergrößern auf dem ich zeige, das ist nun mal der
bereich auf dem die Maus zeigt.

Um den bereich unter meiner Form anzuzeigen braucht man keine Lupe da reicht
es wenn man die Form transparent macht.

Ich verweise einfach noch mal auf den Beitrag von Sunlight7
http://www.delphipraxis.net/internal...=982777#982777

gruss Emil
  Mit Zitat antworten Zitat
Benutzerbild von lbccaleb
lbccaleb

Registriert seit: 25. Mai 2006
Ort: Rostock / Bremen
2.037 Beiträge
 
Delphi 7 Enterprise
 
#69

Re: Bildschirmlupe - Bereich unter Formular ermitteln

  Alt 2. Jan 2009, 19:46
Also bei mir klappt das Ding wunderbar, auch unter Vista...
Martin
MFG Caleb
TheSmallOne (MediaPlayer)
Die Dinge werden berechenbar, wenn man die Natur einer Sache durchschaut hat (Blade)
  Mit Zitat antworten Zitat
Benutzerbild von Sunlight7
Sunlight7

Registriert seit: 17. Sep 2006
Ort: Sonnensystem, Zentral
1.522 Beiträge
 
Delphi 5 Standard
 
#70

Re: Bildschirmlupe - Bereich unter Formular ermitteln

  Alt 2. Jan 2009, 19:58
Könnte freundlicherweise wer einen Vista/Aero Bericht geben?

http://www.delphipraxis.net/download.php?id=36836 (Post #48)
Windows: Ja - Microsoft: Nein -> www.ReactOS.org
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 7 von 10   « Erste     567 89     Letzte »    


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 19:52 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz