• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Userformulieren + scherm eigenschappen en fullscreen

Status
Niet open voor verdere reacties.

Jarodxxx

Gebruiker
Lid geworden
26 nov 2006
Berichten
243
Ik gebruik sinds een tijdje onderstaande code om userformulieren fullscreen weer te laten geven, met de juiste verhouding van de gegevens (met hulp van dit forum!)

Werkt prachtig, alleen kan ik nu het formulier nog verplaatsen. Dit leidt er in praktijk mogelijk toe, dat mijn formulieren 'zoekraken':eek: :shocked: .

Hoe kan ik zorgen dat dit niet gebeurd? In windows programma's kun je ze 'fullscreen' zetten, zodat je ze niet kunt verplaatsen, maar ook aanpassen zodat dit wel kan + zichtbaar op de taakbalk en minimaliseren naar de taakbalk. De openstaande formulieren kun je dan via je taakbalk wel weer terug vinden.


Code:
Dim big(10, 1) As Integer


'SCHERMINSTELLINGEN'

Private Sub UserForm_Initialize()
  
Dim SchermMaten     As New cScreenRes   ' Verwijzing naar klassemodule
    Dim iControls       As Integer          ' Aantal besturingselementen
    
    On Error Resume Next
    
    ' Schermresolutie wordt weergegeven in pixels
    ' Moet vermenigvuldigd worden met 3/4 om de juiste maten te krijgen
    Me.Width = SchermMaten.SchermBreedte * 3 / 4
    Me.Height = SchermMaten.SchermHooghte * 3 / 4
     
    ' Besturingselementen worden allen aangepast aan de nieuwe schermresolutie.
    ' Vermits ze oorspronkelijk gemaakt zijn met een schermhoogte van 600 (800 x 600)
    ' wordt dit getal in de berekening opgenomen.
    With Me
        For iControls = 0 To .Controls.Count - 1
            With .Controls(iControls)
                .Top = .Top * SchermMaten.SchermHooghte / 840
                .Height = .Height * SchermMaten.SchermHooghte / 840
                .Left = .Left * SchermMaten.SchermBreedte / 1060
                .Width = .Width * SchermMaten.SchermBreedte / 1060
                .Font.Size = Int(.Font.Size * SchermMaten.SchermHooghte / 840)
            End With
        Next
    End With

En de Klasse module

Code:
Option Explicit

' 32-bit API declaration
 Private Declare Function GetSystemMetrics32 Lib "user32" _
    Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long

' 16-bit API declaration
 Private Declare Function GetSystemMetrics16 Lib "user" _
    Alias "GetSystemMetrics" (ByVal nIndex As Integer) As Integer

Const SM_CXSCREEN = 0
Const SM_CYSCREEN = 1

Property Get SchermBreedte()
Dim vidWidth As Integer
    If Left(Application.Version, 1) = 5 Then
'       16-bit Excel
        vidWidth = GetSystemMetrics16(SM_CXSCREEN)
    Else
'       32-bit Excel
        vidWidth = GetSystemMetrics32(SM_CXSCREEN)
    End If
    SchermBreedte = vidWidth
End Property

Property Get SchermHooghte()
    Dim vidHeight As Integer
    If Left(Application.Version, 1) = 5 Then
'       16-bit Excel
        vidHeight = GetSystemMetrics16(SM_CYSCREEN)
    Else
'       32-bit Excel
        vidHeight = GetSystemMetrics32(SM_CYSCREEN)
    End If
    SchermHooghte = vidHeight
End Property


Groeten,

Jarod

ps: long time no see btw, 'k heb weinig tijd gehad voor m'n personal projectje helaas!
 

Bijlagen

Laatst bewerkt:
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan