Form change de place avec changement de resolution [Résolu]
cocowz
- Messages postés
- 89
- Date d'inscription
- lundi 28 novembre 2005
- Dernière intervention
- 25 février 2007
- Messages postés
- 4229
- Date d'inscription
- vendredi 23 juillet 2004
- Dernière intervention
- 3 août 2018
A voir également:
- Pascal form
- Delphi form - Meilleures réponses
- Controls sur une form : changer leurs positions via une fonction, à un emplaceme ✓ - Forum - Visual Basic 6
- Visual Basic / VB.NET : Changer la resolution de windows - CodeS SourceS - Guide
- Changer la resolution affichage windows (+ couleur + frequence) - Codes sources - Visual Basic / VB.NET (Système)
- Visual Basic / VB.NET : Changer la résolution de l'écran - CodeS SourceS - Guide
- Changer la résolution d'écran - Codes sources - Delphi / Pascal (API)
20/22 réponses
Meilleure réponse
- Messages postés
- 3982
- Date d'inscription
- mardi 8 mars 2005
- Dernière intervention
- 7 novembre 2014
Perso je suis pas sûr de comprendre "ne change pas de place".
Vala le code ci dessus avec les déclarations qui vont bien. (Ne pas oublier d'affecter le OnCreate dans les évènements).
Il s'arrange pour que la form reste dans le coin inférieur gauche, tout en restant entièrement visible.
==================================
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
procedure AdaptPos(Sender: TObject);
procedure WMDisplayChange(var Message: TMessage); message WM_DisplayChange;
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.AdaptPos(Sender: TObject);
begin
Left := Screen.Monitors[0].Width - Width;
Top := Screen.Monitors[0].Height - Height;
end;
procedure TForm1.WMDisplayChange(var Message: TMessage);
begin
inherited;
AdaptPos(Self);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
AdaptPos(Sender);
end;
end.
Vala le code ci dessus avec les déclarations qui vont bien. (Ne pas oublier d'affecter le OnCreate dans les évènements).
Il s'arrange pour que la form reste dans le coin inférieur gauche, tout en restant entièrement visible.
==================================
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
procedure AdaptPos(Sender: TObject);
procedure WMDisplayChange(var Message: TMessage); message WM_DisplayChange;
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.AdaptPos(Sender: TObject);
begin
Left := Screen.Monitors[0].Width - Width;
Top := Screen.Monitors[0].Height - Height;
end;
procedure TForm1.WMDisplayChange(var Message: TMessage);
begin
inherited;
AdaptPos(Self);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
AdaptPos(Sender);
end;
end.
Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire
120 internautes nous ont dit merci ce mois-ci
- Messages postés
- 4229
- Date d'inscription
- vendredi 23 juillet 2004
- Dernière intervention
- 3 août 2018
Rt15, j'étais en contacte par MP avec Cocowz ... il devait m'envoyer son adresse EMail pour renvoyé la source complète
mais il ne la toujours pas fait.
par contre ta méthode est presque la bonne ... je dis presque parce que sur un système à deux écrans selon sur le quel est placé la forme elle risque de disparaitre avec ton code !
je poste donc le code ici et si toute fois tu n'y arrives pas tu me donnes ton Mail pour t'envoyé le source complet :
type
TForm1 = class (TForm)
procedure FormCreate(Sender: TObject);
private
{ Déclarations privées }
procedure WMDisplayChange(var Message:TMessage); message WM_DISPLAYCHANGE;
Procedure ReplaceWindow;
public
{ Déclarations publiques }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
ReplaceWindow;
end;
procedure TForm1.ReplaceWindow;
begin
With Screen.Monitors[Monitor.MonitorNum] Do Begin
Self.Left : = Left + (Width - Self.Width);
Self.Top := Top + (Height - Self.Height);
End ;
end;
procedure TForm1.WMDisplayChange(var Message: TMessage);
begin
Inherited;
ReplaceWindow;
end;
end.
@+
Cirec
<hr size ="2" />
mais il ne la toujours pas fait.
par contre ta méthode est presque la bonne ... je dis presque parce que sur un système à deux écrans selon sur le quel est placé la forme elle risque de disparaitre avec ton code !
je poste donc le code ici et si toute fois tu n'y arrives pas tu me donnes ton Mail pour t'envoyé le source complet :
type
TForm1 = class (TForm)
procedure FormCreate(Sender: TObject);
private
{ Déclarations privées }
procedure WMDisplayChange(var Message:TMessage); message WM_DISPLAYCHANGE;
Procedure ReplaceWindow;
public
{ Déclarations publiques }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
ReplaceWindow;
end;
procedure TForm1.ReplaceWindow;
begin
With Screen.Monitors[Monitor.MonitorNum] Do Begin
Self.Left : = Left + (Width - Self.Width);
Self.Top := Top + (Height - Self.Height);
End ;
end;
procedure TForm1.WMDisplayChange(var Message: TMessage);
begin
Inherited;
ReplaceWindow;
end;
end.
@+
Cirec
<hr size ="2" />
Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire
120 internautes nous ont dit merci ce mois-ci
- Messages postés
- 4229
- Date d'inscription
- vendredi 23 juillet 2004
- Dernière intervention
- 3 août 2018
remplace le par Screen.DesktopHeight et Screen.DesktopWidth
Mais si le programme est executé sur un système à deux écrans ça peut poser problème
dans ce cas on utilise :
Screen.Monitors[0].Width
et
Screen.Monitors[0].Height
Screen.MonitorCount détermine le nombre de moniteurs présents dans le système
@+
Cirec
Mais si le programme est executé sur un système à deux écrans ça peut poser problème
dans ce cas on utilise :
Screen.Monitors[0].Width
et
Screen.Monitors[0].Height
Screen.MonitorCount détermine le nombre de moniteurs présents dans le système
@+
Cirec
- Messages postés
- 4229
- Date d'inscription
- vendredi 23 juillet 2004
- Dernière intervention
- 3 août 2018
pour intercepter le message : WM_DISPLAYCHANGE
il faut proceder comme ceci
type
TForm1 = class (TForm)
.....
private
procedure WMDisplayChange(var Message:TMessage); message WM_DISPLAYCHANGE;
.....
end;
........
procedure TForm1.WMDisplayChange(var Message: TMessage);
begin
inherited;
// ici tu fais appel à ta procedure qui ajuste la position de la fenêtre
end;
@+
Cirec
<hr size ="2" />
il faut proceder comme ceci
type
TForm1 = class (TForm)
.....
private
procedure WMDisplayChange(var Message:TMessage); message WM_DISPLAYCHANGE;
.....
end;
........
procedure TForm1.WMDisplayChange(var Message: TMessage);
begin
inherited;
// ici tu fais appel à ta procedure qui ajuste la position de la fenêtre
end;
@+
Cirec
<hr size ="2" />
- Messages postés
- 3982
- Date d'inscription
- mardi 8 mars 2005
- Dernière intervention
- 7 novembre 2014
Salut,
Je connaissais pas le mot clé Message... C'est vraiment honteusement pratique le Delphi.
Merci.
Pour ce qui est de la procédure... Bin c'est celle qui replace la Form,
autant factoriser. (Bon ça se dicute car on va se bouffer un appel pour
deux ligne...)
Quelque chose comme ça ?
procedure TForm1.FormCreate(Sender: TObject);
begin
AdaptPos(Sender);
end;
procedure TForm1.AdaptPos(Sender: TObject);
begin
Left :=
Screen.Monitors[0].Width
- Width;
Top :=
Screen.Monitors[0].Height
- Height;
end;
procedure TForm1.WMDisplayChange(var Message: TMessage);
begin
inherited;
AdaptPos(Self);
end;
Avec les déclarations qui vont bien.
Je connaissais pas le mot clé Message... C'est vraiment honteusement pratique le Delphi.
Merci.
Pour ce qui est de la procédure... Bin c'est celle qui replace la Form,
autant factoriser. (Bon ça se dicute car on va se bouffer un appel pour
deux ligne...)
Quelque chose comme ça ?
procedure TForm1.FormCreate(Sender: TObject);
begin
AdaptPos(Sender);
end;
procedure TForm1.AdaptPos(Sender: TObject);
begin
Left :=
Screen.Monitors[0].Width
- Width;
Top :=
Screen.Monitors[0].Height
- Height;
end;
procedure TForm1.WMDisplayChange(var Message: TMessage);
begin
inherited;
AdaptPos(Self);
end;
Avec les déclarations qui vont bien.
- Messages postés
- 4229
- Date d'inscription
- vendredi 23 juillet 2004
- Dernière intervention
- 3 août 2018
Le projet à un peut évolué à la demande de Cocows (par MP)
et donc je me dis ... peut être que ça interresse encore d'autres personnes
{
Démonstration de repositionnement automatique
de la forme principale.
Auteur Cirec pour Cocows sur [www.Delphifr.com]
Propose un ancrage de la fenêtre dans l'un des quatre coins
de l'écran au choix
Fonctionne également sur un système à deux écrans :
La forme se replace automatiquement dans le "nouveau moniteur"
Quand Ancrer la fenêtre est coché la forme permet un déplacement
pour un changement d'écran mais si le déplacement s'effectu à
l'intérieur du même moniteur elle se replacera automatiquement
dans le coin préalablement sélectionné
}
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
Tfrm_Main = class (TForm)
GroupBox1: TGroupBox;
rbt_BottomRight: TRadioButton;
rbt_BottomLeft: TRadioButton;
rbt_TopRight: TRadioButton;
rbt_TopLeft: TRadioButton;
ckb_Anker: TCheckBox;
//procedure FormCreate(Sender: TObject);
procedure ckb_AnkerClick(Sender: TObject);
Procedure ReplaceWindow(Sender: TObject);
private
{ Déclarations privées }
procedure WMDisplayChange(var Message:TMessage); message WM_DISPLAYCHANGE;
Procedure OnFormMoved(Var Msg: TWMSysCommand); Message WM_SysCommand;
public
{ Déclarations publiques }
end;
var
frm_Main: Tfrm_Main;
implementation
{$R *.dfm}
{ Vu la nouvelle déclaration de ReplaceWindow (ajout de (Sender: TObject) )
l'appel se fait maintenant directement dans l'inspecteur d'objets
procedure Tfrm_Main.FormCreate(Sender: TObject);
begin
// Self représentant frm_Main sont Tag étant à zéro
// la fenêtre est initialisée en bas à gauche
ReplaceWindow (Self);
end;}
procedure Tfrm_Main.ReplaceWindow(Sender: TObject);
{ tous les composants ont une propriété nommée Tag
Comme elle n'est pas utilisée on va s'en servir pour stocker la position de la Forme
Les Tags des 4 TRadioButton sont déclarés comme suit
0 : = Bottom Right
1 := Bottom Left
2 := Top Right
3 := Top Left
et les évenements OnClick sont redirigés vers ReplaceWindow dans l'inspecteur d'objets}
begin
{ on mémorise la position dans le Tag de la Forme (pour les appels avec Self)
Sender est donc soit frm_Main ou un des TRadioButton}
Tag : = (Sender as TComponent).Tag;
With Screen.Monitors[Monitor.MonitorNum] Do Begin
Case Tag of {et on change la position}
0 : Begin // Bottom Right
Self.Left : = Left + (Width - Self.Width);
Self.Top := Top + (Height - Self.Height);
End ;
1 : Begin // Bottom Left
Self.Left : = Left;
Self.Top := Top + (Height - Self.Height);
End ;
2 : Begin // Top Right
Self.Left : = Left + (Width - Self.Width);
Self.Top := Top;
End ;
3 : Begin // Top Left
Self.Left : = Left;
Self.Top := Top;
End ;
End;
End;
end;
{ ici je ne passe pas l'inspecteur d'objet parce qu'il faudait dans ce cas aussi
mémoriser la position dans cbk_Anker.Tag alors qu'il l'est déjà dans fmr_Main.Tag}
procedure Tfrm_Main.ckb_AnkerClick(Sender: TObject);
begin
ReplaceWindow(Self);
end;
{ réagit aux changements de résolutions}
procedure Tfrm_Main.WMDisplayChange(var Message: TMessage);
begin
{ Appel de la méthode héritée}
Inherited;
{ et replacement de la fenêtre}
ReplaceWindow(Self);
end;
{ réagit après déplacement de la forme}
procedure Tfrm_Main.OnFormMoved(var Msg: TWMSysCommand);
begin
{ Appel de la méthode héritée}
Inherited;
{ Si ancrer la fenêtre est coché ... }
If ckb_Anker.Checked Then ReplaceWindow(Self);
end;
end.
//***********************************************************
Le DFM
//***********************************************************
object frm_Main: Tfrm_Main
Left = 0
Top = 0
Caption = 'D'#233'mo :Ancrer une fen'#234'tre '
ClientHeight = 184
ClientWidth = 301
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poDesigned
OnCreate = ReplaceWindow
PixelsPerInch = 96
TextHeight = 13
object GroupBox1: TGroupBox
Left = 2
Top = 0
Width = 297
Height = 153
Caption = 'Window Position'
TabOrder = 0
object rbt_BottomRight: TRadioButton
Left = 163
Top = 73
Width = 85
Height = 17
Caption = 'Bas Droite'
Checked = True
TabOrder = 0
TabStop = True
OnClick = ReplaceWindow
end
object rbt_BottomLeft: TRadioButton
Tag = 1
Left = 16
Top = 73
Width = 85
Height = 17
Caption = 'Bas Gauche'
TabOrder = 1
OnClick = ReplaceWindow
end
object rbt_TopRight: TRadioButton
Tag = 2
Left = 163
Top = 24
Width = 85
Height = 17
Caption = 'Haut Droite'
TabOrder = 2
OnClick = ReplaceWindow
end
object rbt_TopLeft: TRadioButton
Tag = 3
Left = 16
Top = 24
Width = 85
Height = 17
Caption = 'Haut Gauche'
TabOrder = 3
OnClick = ReplaceWindow
end
end
object ckb_Anker: TCheckBox
Left = 163
Top = 159
Width = 118
Height = 17
Caption = 'Ancrer la fen'#234'tre'
TabOrder = 1
OnClick = ckb_AnkerClick
end
end
@+
Cirec
et donc je me dis ... peut être que ça interresse encore d'autres personnes
{
Démonstration de repositionnement automatique
de la forme principale.
Auteur Cirec pour Cocows sur [www.Delphifr.com]
Propose un ancrage de la fenêtre dans l'un des quatre coins
de l'écran au choix
Fonctionne également sur un système à deux écrans :
La forme se replace automatiquement dans le "nouveau moniteur"
Quand Ancrer la fenêtre est coché la forme permet un déplacement
pour un changement d'écran mais si le déplacement s'effectu à
l'intérieur du même moniteur elle se replacera automatiquement
dans le coin préalablement sélectionné
}
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
Tfrm_Main = class (TForm)
GroupBox1: TGroupBox;
rbt_BottomRight: TRadioButton;
rbt_BottomLeft: TRadioButton;
rbt_TopRight: TRadioButton;
rbt_TopLeft: TRadioButton;
ckb_Anker: TCheckBox;
//procedure FormCreate(Sender: TObject);
procedure ckb_AnkerClick(Sender: TObject);
Procedure ReplaceWindow(Sender: TObject);
private
{ Déclarations privées }
procedure WMDisplayChange(var Message:TMessage); message WM_DISPLAYCHANGE;
Procedure OnFormMoved(Var Msg: TWMSysCommand); Message WM_SysCommand;
public
{ Déclarations publiques }
end;
var
frm_Main: Tfrm_Main;
implementation
{$R *.dfm}
{ Vu la nouvelle déclaration de ReplaceWindow (ajout de (Sender: TObject) )
l'appel se fait maintenant directement dans l'inspecteur d'objets
procedure Tfrm_Main.FormCreate(Sender: TObject);
begin
// Self représentant frm_Main sont Tag étant à zéro
// la fenêtre est initialisée en bas à gauche
ReplaceWindow (Self);
end;}
procedure Tfrm_Main.ReplaceWindow(Sender: TObject);
{ tous les composants ont une propriété nommée Tag
Comme elle n'est pas utilisée on va s'en servir pour stocker la position de la Forme
Les Tags des 4 TRadioButton sont déclarés comme suit
0 : = Bottom Right
1 := Bottom Left
2 := Top Right
3 := Top Left
et les évenements OnClick sont redirigés vers ReplaceWindow dans l'inspecteur d'objets}
begin
{ on mémorise la position dans le Tag de la Forme (pour les appels avec Self)
Sender est donc soit frm_Main ou un des TRadioButton}
Tag : = (Sender as TComponent).Tag;
With Screen.Monitors[Monitor.MonitorNum] Do Begin
Case Tag of {et on change la position}
0 : Begin // Bottom Right
Self.Left : = Left + (Width - Self.Width);
Self.Top := Top + (Height - Self.Height);
End ;
1 : Begin // Bottom Left
Self.Left : = Left;
Self.Top := Top + (Height - Self.Height);
End ;
2 : Begin // Top Right
Self.Left : = Left + (Width - Self.Width);
Self.Top := Top;
End ;
3 : Begin // Top Left
Self.Left : = Left;
Self.Top := Top;
End ;
End;
End;
end;
{ ici je ne passe pas l'inspecteur d'objet parce qu'il faudait dans ce cas aussi
mémoriser la position dans cbk_Anker.Tag alors qu'il l'est déjà dans fmr_Main.Tag}
procedure Tfrm_Main.ckb_AnkerClick(Sender: TObject);
begin
ReplaceWindow(Self);
end;
{ réagit aux changements de résolutions}
procedure Tfrm_Main.WMDisplayChange(var Message: TMessage);
begin
{ Appel de la méthode héritée}
Inherited;
{ et replacement de la fenêtre}
ReplaceWindow(Self);
end;
{ réagit après déplacement de la forme}
procedure Tfrm_Main.OnFormMoved(var Msg: TWMSysCommand);
begin
{ Appel de la méthode héritée}
Inherited;
{ Si ancrer la fenêtre est coché ... }
If ckb_Anker.Checked Then ReplaceWindow(Self);
end;
end.
//***********************************************************
Le DFM
//***********************************************************
object frm_Main: Tfrm_Main
Left = 0
Top = 0
Caption = 'D'#233'mo :Ancrer une fen'#234'tre '
ClientHeight = 184
ClientWidth = 301
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poDesigned
OnCreate = ReplaceWindow
PixelsPerInch = 96
TextHeight = 13
object GroupBox1: TGroupBox
Left = 2
Top = 0
Width = 297
Height = 153
Caption = 'Window Position'
TabOrder = 0
object rbt_BottomRight: TRadioButton
Left = 163
Top = 73
Width = 85
Height = 17
Caption = 'Bas Droite'
Checked = True
TabOrder = 0
TabStop = True
OnClick = ReplaceWindow
end
object rbt_BottomLeft: TRadioButton
Tag = 1
Left = 16
Top = 73
Width = 85
Height = 17
Caption = 'Bas Gauche'
TabOrder = 1
OnClick = ReplaceWindow
end
object rbt_TopRight: TRadioButton
Tag = 2
Left = 163
Top = 24
Width = 85
Height = 17
Caption = 'Haut Droite'
TabOrder = 2
OnClick = ReplaceWindow
end
object rbt_TopLeft: TRadioButton
Tag = 3
Left = 16
Top = 24
Width = 85
Height = 17
Caption = 'Haut Gauche'
TabOrder = 3
OnClick = ReplaceWindow
end
end
object ckb_Anker: TCheckBox
Left = 163
Top = 159
Width = 118
Height = 17
Caption = 'Ancrer la fen'#234'tre'
TabOrder = 1
OnClick = ckb_AnkerClick
end
end
@+
Cirec
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.