Discussion :

[The Freestyler Fou]

Comment afficher une form dont les dimensions ne dépendent pas de la résolution sous VB 6.0 ?

J'ai découvert que VB 6.0 n'accépte pas le code que donne la FAQ en ce qui concerne la redimention des fenêtres en fonction de la résolution.J'ai donc écrit un nouveau code un peu plus long et je l'ai expliquer :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Dim hSysMenu As Long
Dim RatioX As Single
Dim RatioY As Single
Dim ResolutionX As Long
Dim ResolutionY As Long
Const ResolutionRefX As Long = 800
Const ResolutionRefY As Long = 600
 
Private Const SC_CLOSE = &HF060&
Private Const MF_BYCOMMAND = &H0&
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long

Je définie les variables etc ... au début je préfére !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Private Sub Form_Load()
 
hSysMenu = GetSystemMenu(Me.hwnd, False)
RemoveMenu hSysMenu, SC_CLOSE, MF_BYCOMMAND

Petite équation trés simple pour avoir la résolution on divise la taille de l'écran par le nombre de pixel !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
ResolutionX = Screen.Width / Screen.TwipsPerPixelX
ResolutionY = Screen.Height / Screen.TwipsPerPixelY

Ici pour avoir le coefficient de proportionalité entre la taille de l'écran et la taille de la fenêtre dans le programme, on divise la résolution d'écran par la résolution de départ de la fenêtre.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
RatioX = ResolutionX / ResolutionRefX
RatioY = ResolutionY / ResolutionRefY

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
ResizeForResolution RatioX, RatioY
 
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Private Sub ResizeForResolution(ByVal RatioX As Single, ByVal RatioY As Single)

Pour savoir le coefficient de proportionalité entre les polices :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

RatioPolices = (RatioX + RatioY) / 2.25

Redimention de la fenêtre :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Me.Width = Me.Width * RatioX
Me.Height = Me.Height * RatioY

Redimention de tout les objets, ATTENTION 1 par 1 !! Celon la méthode Suivante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If TypeOf ctl Is L'ObjetQueVousVoulezRedimentionner Then

Pour dire qu'il bouge :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ctl Move

Redéfini la position de l'objet sur l'axe droite gauche :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ctl Left * RatioX

Redéfini la position de l'objet sur l'axe haut bas :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ctl.Top * RatioY

Redimention la largeur de l'objet :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ctl.Width * RatioX

Redimentionne la hauteur de l'objet :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ctl.Height * RatioY

Il faut ensuite que vous réfléchissiez pour savoir ci toute ces option sont nécessaire car par exemple pour une image il ne vaut mieu pas redimentioner la hauteur les la largeur !!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
For Each ctl In Me.Controls
If TypeOf ctl Is CommandButton Then
ctl.Move ctl.Left * RatioX, ctl.Top * RatioY, ctl.Width * RatioX, ctl.Height * RatioY
Else
If TypeOf ctl Is Label Then
ctl.Move ctl.Left * RatioX, ctl.Top * RatioY, ctl.Width * RatioX, ctl.Height * RatioY
Else
If TypeOf ctl Is FileListBox Then
ctl.Move ctl.Left * RatioX, ctl.Top * RatioY, ctl.Width * RatioX, ctl.Height * RatioY
Else
If TypeOf ctl Is FolderTreeview Then
ctl.Move ctl.Left * RatioX, ctl.Top * RatioY, ctl.Width * RatioX, ctl.Height * RatioY
Else
If TypeOf ctl Is Image Then
ctl.Move ctl.Left * RatioX, ctl.Top * RatioY
End If
End If
End If
End If
End If

Ici on redéfini les polices des objets que vous voulez ! If suffit comme au dessus de mettre :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If TypeOf ctl Is L'ObjetDontVousVoulezRedimentionerLaPolice Then ctl.FontSize = ctl.FontSize * RatioPolices

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
If TypeOf ctl Is Label Then ctl.FontSize = ctl.FontSize * RatioPolices
If TypeOf ctl Is CommandButton Then ctl.FontSize = ctl.FontSize * RatioPolices
If TypeOf ctl Is FileListBox Then ctl.FontSize = ctl.FontSize * RatioPolices
Next
 
End Sub

Voila c'était long mais c'est enfin fini !!!
Le code est donc en résumer celui-ci pour ceux qui voudrai faire un petit copier coller :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
Dim hSysMenu As Long
Dim RatioX As Single
Dim RatioY As Single
Dim ResolutionX As Long
Dim ResolutionY As Long
Const ResolutionRefX As Long = 800
Const ResolutionRefY As Long = 600
 
Private Const SC_CLOSE = &HF060&
Private Const MF_BYCOMMAND = &H0&
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
 
Private Sub Form_Load()
 
hSysMenu = GetSystemMenu(Me.hwnd, False)
RemoveMenu hSysMenu, SC_CLOSE, MF_BYCOMMAND
 
ResolutionX = Screen.Width / Screen.TwipsPerPixelX
ResolutionY = Screen.Height / Screen.TwipsPerPixelY
 
RatioX = ResolutionX / ResolutionRefX
RatioY = ResolutionY / ResolutionRefY
 
ResizeForResolution RatioX, RatioY
 
End Sub
 
Private Sub ResizeForResolution(ByVal RatioX As Single, ByVal RatioY As Single)
 
RatioPolices = (RatioX + RatioY) / 2.25
 
Me.Width = Me.Width * RatioX
Me.Height = Me.Height * RatioY
 
For Each ctl In Me.Controls
If TypeOf ctl Is CommandButton Then
ctl.Move ctl.Left * RatioX, ctl.Top * RatioY, ctl.Width * RatioX, ctl.Height * RatioY
Else
If TypeOf ctl Is Label Then
ctl.Move ctl.Left * RatioX, ctl.Top * RatioY, ctl.Width * RatioX, ctl.Height * RatioY
Else
If TypeOf ctl Is FileListBox Then
ctl.Move ctl.Left * RatioX, ctl.Top * RatioY, ctl.Width * RatioX, ctl.Height * RatioY
Else
If TypeOf ctl Is FolderTreeview Then
ctl.Move ctl.Left * RatioX, ctl.Top * RatioY, ctl.Width * RatioX, ctl.Height * RatioY
Else
If TypeOf ctl Is Image Then
ctl.Move ctl.Left * RatioX, ctl.Top * RatioY
End If
End If
End If
End If
End If
If TypeOf ctl Is Label Then ctl.FontSize = ctl.FontSize * RatioPolices
If TypeOf ctl Is CommandButton Then ctl.FontSize = ctl.FontSize * RatioPolices
If TypeOf ctl Is FileListBox Then ctl.FontSize = ctl.FontSize * RatioPolices
Next
 
End Sub

[AASI]

J'ai utilisé le code de 'The Freestyler Fou' qui fonctionne très bien (merci à toi) et j'apporte ce complément pour ceux et celles qui utilise des grid.

J'ai testé sur 'SSDBGRID' , 'SSDBCOMBO' (Data Widgets) , et sur 'DataGrid'.

ajouté..

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim cnt As Integer

et..

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
If TypeOf ctl Is SSDBGrid Or TypeOf ctl Is SSDBCombo Or TypeOf ctl Is DataGrid Then
      ctl.Move ctl.Left * RatioX, ctl.Top * RatioY, ctl.Width * RatioX, ctl.Height * RatioY
      ctl.Font.Size = ctl.Font.Size * RatioPolices
      ctl.HeadFont.Size = ctl.HeadFont.Size * RatioPolices
      ctl.RowHeight = ctl.RowHeight * RatioY
      For cnt = 0 To (ctl.Columns.Count - 1)
          ctl.Columns(cnt).Width = ctl.Columns(cnt).Width * RatioX
      Next cnt
End If