Composant TSizeableMemo [Résolu]

Messages postés
1293
Date d'inscription
mardi 28 octobre 2003
Statut
Contributeur
Dernière intervention
3 juillet 2015
- 14 avril 2014 à 15:06 - Dernière réponse :
Messages postés
1293
Date d'inscription
mardi 28 octobre 2003
Statut
Contributeur
Dernière intervention
3 juillet 2015
- 7 mai 2014 à 16:35
Bonjour,

J'ai fait une petite source pour avoir un memo redimensionnable en runtime :

unit USizeableMemo;

{
Composant Memo resizeable
}

interface

         uses System.Classes, Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.Controls, Vcl.Graphics, Vcl.Forms;

         Type
             TSizeableMemo = Class(Vcl.StdCtrls.TMemo)
             img_resize: TImage;
             Private
                    MemoW, MemoH,         // Dimensions originales du memo avant redimensionnement
                    X1, Y1    : Integer;  // Premier point de la souris au début du drag
                    fDragging : Boolean;  // = True tant que le bouton de la souris est enfoncé sur l'image
                    procedure img_resizeMouseDown(Sender: TObject; Button: TMouseButton;
                              Shift: TShiftState; X, Y: Integer);
                    procedure img_resizeMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
                    procedure img_resizeMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
                    procedure imgReplace;
             Public
                   constructor Create(AOwner: TComponent); override;
                   destructor Destroy; override;
             published
                   property OnResize;
             end;



procedure Register;

implementation

{$R TSizeableMemo.RES}

{Enregistrement du composant}
procedure Register;
begin
     RegisterComponents('Exemples', [TSizeableMemo]);
end;

{ TResizeableMemo }

constructor TSizeableMemo.Create(AOwner: TComponent);
begin
     inherited;
     // Image en coin du composant pour le resize
     img_resize  := TImage.Create(Self);
     with img_resize do begin
          Autosize    := True;
          Cursor      := crSizeNWSE;
          Anchors     := [akRight, akBottom];
          OnMouseDown := img_resizeMouseDown;
          OnMouseMove := img_resizeMouseMove;
          OnMouseUp   := img_resizeMouseUp;
          Picture.Bitmap.LoadFromResourceName(hInstance, 'Resize');
          Transparent := True;
     end;
     InsertComponent(img_resize);
     imgReplace;
end;

// Libération du composant
destructor TSizeableMemo.Destroy;
begin
     img_resize.Free;
     inherited;
end;

// Replace l'image à la bonne place dans le memo
procedure TSizeableMemo.imgReplace;
begin
     img_resize.Top  := Height - img_resize.Height;
     img_resize.Left := Width  - img_resize.Width;
end;

// Premier point
procedure TSizeableMemo.img_resizeMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
     fDragging := True;
     X1    := Mouse.CursorPos.X;
     Y1    := Mouse.CursorPos.Y;
     MemoH := Height;
     MemoW := Width;
     Application.ProcessMessages;
end;

// Redimensionnement
procedure TSizeableMemo.img_resizeMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
     if fDragging then begin
        Height := MemoH + (Mouse.CursorPos.Y - Y1);
        Width  := MemoW + (Mouse.CursorPos.X - X1);
        imgReplace;
        Repaint;
        Application.ProcessMessages;
     end;
end;

// Fin redimmensionnement
procedure TSizeableMemo.img_resizeMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
     fDragging := False;
end;

end.



J'ai un petit souci :
Quand je dessine ma form, pas de problème, je pose le composant et je peux le dimensionner à la taille que je veux. Mais si je lui donne une taille supérieure à celle par défaut, quand j'exécute mon application, la petite image qui est en bas à droite du memo en design se positionne sur les dimensions par défaut du memo. Et si je mets un point d'arrêt sur le creator de mon composant, effectivement les valeurs height et width sont sur les valeurs par défaut du composant TMemo... Il doit me manquer quelque chose, mais je n'arrive pas à voir quoi...
Afficher la suite 

Votre réponse

25 réponses

Messages postés
260
Date d'inscription
lundi 27 octobre 2003
Dernière intervention
4 mars 2016
- 16 avril 2014 à 09:56
0
Merci
Salut,
en regardant le code à première vu...
dans le Create je dirais inherited Create(Aowner) et img_resize.Parent := Self, ensuite InsertComponent inutile je pense, le ImgReplace dans le MouseMove inutile du fait du Anchors [Right,Bottom], les ProcessMessages, le Repaint je pense aussi inutile.
Ensuite sur le fait qu'il se positionne pas c'est un peu normal à première vu...à la fin du Create tu n'as pas la nouvelle valeur de Height et Width et tu as replacé ton image...
Ensuite en ajoutant et virant ceci normalement je pense que le ImgReplace dans le Create devrait recaler l'image et ensuite le Anchors faire le taf pour le mettre dans l'angle.
@+
Commenter la réponse de cs_yanb
Messages postés
1293
Date d'inscription
mardi 28 octobre 2003
Statut
Contributeur
Dernière intervention
3 juillet 2015
- 17 avril 2014 à 16:23
0
Merci
Merci yanb, je n'ai pas eu le temps de me pencher sur ça, je suis passé sur autre chose, mais j'essaie de m'en occuper rapidement et te tiens au courant
Commenter la réponse de sp40
Messages postés
273
Date d'inscription
samedi 13 juin 2009
Dernière intervention
18 avril 2015
- 24 avril 2014 à 19:13
0
Merci
Salut,
au risque de dire une con.... mais pourquoi ne pas poser 2 tSplitter pour redimentionner ton memo ? C'est fait pour çà non ?
Bon courage.
solilog


--
Messages postés
1293
Date d'inscription
mardi 28 octobre 2003
Statut
Contributeur
Dernière intervention
3 juillet 2015
- 25 avril 2014 à 09:16
Mouais... c'est juste une question d'esthétique... ;)
Commenter la réponse de solilog
Messages postés
1293
Date d'inscription
mardi 28 octobre 2003
Statut
Contributeur
Dernière intervention
3 juillet 2015
- 28 avril 2014 à 10:48
0
Merci
Bon, version 2 :

unit USizeableMemo;

{
Composant Memo resizeable
}

interface

         uses System.Classes, Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.Controls, Vcl.Graphics, Vcl.Forms;

         Type
             TSizeableMemo = Class(Vcl.StdCtrls.TMemo)
             img_resize: TImage;
             Private
                    MemoW, MemoH,         // Dimensions originales du memo avant redimensionnement
                    X1, Y1    : Integer;  // Premier point de la souris au début du drag
                    fDragging : Boolean;  // = True tant que le bouton de la souris est enfoncé sur l'image
                    procedure img_resizeMouseDown(Sender: TObject; Button: TMouseButton;
                              Shift: TShiftState; X, Y: Integer);
                    procedure img_resizeMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
                    procedure img_resizeMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
                    procedure imgReplace;
             Public
                   constructor Create(AOwner: TComponent); override;
                   destructor Destroy; override;
             published
                   property OnResize;
             end;

implementation

{$R TSizeableMemo.RES}

{Enregistrement du composant}
procedure Register;
begin
     RegisterComponents('Exemples', [TSizeableMemo]);
end;

{ TResizeableMemo }

constructor TSizeableMemo.Create(AOwner: TComponent);
begin
     inherited Create(Aowner);
     // Image en coin du composant pour le resize
     img_resize  := TImage.Create(Self);
     with img_resize do begin
          Parent      := Self;
          Autosize    := True;
          Cursor      := crSizeNWSE;
          Anchors     := [akRight, akBottom];
          OnMouseDown := img_resizeMouseDown;
          OnMouseMove := img_resizeMouseMove;
          OnMouseUp   := img_resizeMouseUp;
          Picture.Bitmap.LoadFromResourceName(hInstance, 'Resize');
          Transparent := True;
     end;
     imgReplace;
end;

// Libération du composant
destructor TSizeableMemo.Destroy;
begin
     img_resize.Free;
     inherited;
end;

// Replace l'image à la bonne place dans le memo
procedure TSizeableMemo.imgReplace;
begin
     img_resize.Top  := Height - img_resize.Height;
     img_resize.Left := Width  - img_resize.Width;
end;

// Premier point
procedure TSizeableMemo.img_resizeMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
     fDragging := True;
     X1    := Mouse.CursorPos.X;
     Y1    := Mouse.CursorPos.Y;
     MemoH := Height;
     MemoW := Width;
     Application.ProcessMessages;
end;

// Redimensionnement
procedure TSizeableMemo.img_resizeMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
     if fDragging then begin
        Height := MemoH + (Mouse.CursorPos.Y - Y1);
        Width  := MemoW + (Mouse.CursorPos.X - X1);
        imgReplace;
     end;
end;

// Fin redimmensionnement
procedure TSizeableMemo.img_resizeMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
     fDragging := False;
end;


end.



C'est toujours pareil... En mettant un point d'arrêt sur le imgReplace, au démarrage de l'appli de test (et donc sur le "create" du composant), les dimensions du memo sont celles par défaut d'un composant TMemo (89x185) alors qu'en design, j'ai mis mon composant à 281x313... Pourtant il s'affiche ensuite avec les bonnes dimensions. C'est étonnant...



Et au premier redimensionnement, l'icône de redimensionnement vient bien se caler dans le coin en bas à droite.


@yanb :
Je suis obligé de laisser le imgReplace dans le img_resizeMouseMove, parce que les anchors ne repositionnent pas du tout l'image en runtime (mais par contre elles la replace bien en design...) c'est peut être une piste ?

Messages postés
1293
Date d'inscription
mardi 28 octobre 2003
Statut
Contributeur
Dernière intervention
3 juillet 2015
- 28 avril 2014 à 11:52
oups... Manque le "procedure Register;" avant "implementation"...
Messages postés
260
Date d'inscription
lundi 27 octobre 2003
Dernière intervention
4 mars 2016
- 29 avril 2014 à 17:22
Salut,
si si tu peux virer ce que j'ai dit ProcessMessages, Repaint, imgReplace,..., pour le runtime je dirais en ajoutant le parent dans le Create ( à tester )...pi j'utiliserai bien Loaded du TMemo à la place, et puis aussi csDesigning pour ne charger l'image quand design mais ça c'est un avis perso...un exemple est plus parlant pour le Create et Loaded
public
procedure Loaded; override;
...
constructor TSizeableMemo.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Parent := AOwner as TWinControl;
end;
...
procedure TSizeableMemo.Loaded;
begin
inherited Loaded;
img_resize := TImage.Create(Self);
with img_resize do
begin
Parent := Self;
Autosize := True;
Cursor := crSizeNWSE;
Anchors := [akRight, akBottom];
OnMouseDown := img_resizeMouseDown;
OnMouseMove := img_resizeMouseMove;
OnMouseUp := img_resizeMouseUp;
Picture.Bitmap.LoadFromResourceName(hInstance, 'Resize');
Transparent := True;
end;
imgReplace;
Modified := False;
end;
...
@+
Commenter la réponse de sp40
Messages postés
423
Date d'inscription
samedi 17 mai 2003
Dernière intervention
4 août 2018
- 1 mai 2014 à 18:43
0
Merci
Salut,

Vite fait comme ça, je viens de vérifier qu'en précisant la position de img_resize au moment de la création (onCreate) du Memo comme ceci :

constructor TSizeableMemo.Create(AOwner: TComponent);
begin
     inherited;
     // Image en coin du composant pour le resize
     img_resize  := TImage.Create(Self);
     with img_resize do begin
          Parent := Self;
          Autosize    := True;
          Cursor      := crSizeNWSE;
          Anchors     := [akRight, akBottom];
          OnMouseDown := img_resizeMouseDown;
          OnMouseMove := img_resizeMouseMove;
          OnMouseUp   := img_resizeMouseUp;
          Picture.Bitmap.LoadFromResourceName(hInstance, 'Resize');
          Transparent := True;
          Left := Self.Width - Width;    // <- ici...
          Top := Self.Height - Height;   // <- et là !
     end;
     imgReplace;
end;


ça marche nickel.
Je compile sous D4-D7 (avec quelques retouches dans les uses).
Si ça peut faire avancer le schmilblick...
Messages postés
423
Date d'inscription
samedi 17 mai 2003
Dernière intervention
4 août 2018
- 1 mai 2014 à 19:05
Non, désolé...

Je viens d'y revenir, en se contentant d'appeler imgReplace, ça fonctionne quand même, ce qui paraît logique finalement.

Concrètement donc, ceci marche quelle que soit la dimension du RSizeableMemo créé dynamiquement :

constructor TSizeableMemo.Create(AOwner: TComponent);
begin
     inherited;
     img_resize  := TImage.Create(Self);
     with img_resize do begin
          Parent := Self;
          Autosize    := True;
          Cursor      := crSizeNWSE;
          Anchors     := [akRight, akBottom];
          OnMouseDown := img_resizeMouseDown;
          OnMouseMove := img_resizeMouseMove;
          OnMouseUp   := img_resizeMouseUp;
          Picture.Bitmap.LoadFromResourceName(hInstance, 'Resize');
          Transparent := True;
     end;
     imgReplace;
end;


Je ne sais plus si ça peut faire avancer quoi que ce soit puisque sauf erreur je ne fais que reprendre ton code...
Je peux juste affirmer que ça fonctionne sous D4-D7...
Commenter la réponse de korgis
Messages postés
4229
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
3 août 2018
- 3 mai 2014 à 22:06
0
Merci
Salut à tous ;)

ça fait un moment que je vous suis dans l'ombre et là j'en peux plus :p
il faut que je vous aide un peu ...


j'ai modifié le code pour qu'il compile sous ma version de delphi et j'ai supprimé tout ce qu'il me semblait inutile et ajouté ce qu'il manquait.

Au passage on ne dérive jamais directement d'un composant de la palette mais de son ancêtre "Custom" prévu à cet effet. (voir l'exemple)

unit USizeableMemo;

{
Composant Memo resizeable
}

interface

uses Classes, ExtCtrls, StdCtrls, Controls, Graphics, Forms, Messages;

type
TCustomSizeableMemo = Class(StdCtrls.TCustomMemo)
img_resize: TImage;
Private
MemoW, MemoH, // Dimensions originales du memo avant redimensionnement
X1, Y1 : Integer; // Premier point de la souris au début du drag
fDragging : Boolean; // = True tant que le bouton de la souris est enfoncé sur l'image
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure img_resizeMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure img_resizeMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure img_resizeMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure imgReplace;
Public
constructor Create(AOwner: TComponent); override;
published
property OnResize;
end;

TSizeableMemo = Class(TCustomSizeableMemo)
published
property Align;
property Alignment;
property Anchors;
property BevelEdges;
property BevelInner;
property BevelKind default bkNone;
property BevelOuter;
property BiDiMode;
property BorderStyle;
property CharCase;
property Color;
property Constraints;
property Ctl3D;
property DoubleBuffered;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property HideSelection;
property ImeMode;
property ImeName;
property Lines;
property MaxLength;
property OEMConvert;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentDoubleBuffered;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly;
property ScrollBars;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property WantReturns;
property WantTabs;
property WordWrap;
property OnChange;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseActivate;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnStartDock;
property OnStartDrag;
End;


procedure Register;

implementation

{$R TSizeableMemo.RES}

{Enregistrement du composant}
procedure Register;
begin
RegisterComponents('Exemples', [TSizeableMemo]);
end;




{ TResizeableMemo }

constructor TCustomSizeableMemo.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
// Image en coin du composant pour le resize
img_resize := TImage.Create(Self);
with img_resize do begin
Autosize := True;
Parent := Self;
Cursor := crSizeNWSE;
OnMouseDown := img_resizeMouseDown;
OnMouseMove := img_resizeMouseMove;
OnMouseUp := img_resizeMouseUp;
Picture.Bitmap.LoadFromResourceName(hInstance, 'Resize');
Transparent := True;
end;
Height := 89;
Width := 185;
end;


// Replace l'image à la bonne place dans le memo
procedure TCustomSizeableMemo.imgReplace;
begin
img_resize.Top := Height - img_resize.Height;
img_resize.Left := Width - img_resize.Width;
end;

// Premier point
procedure TCustomSizeableMemo.img_resizeMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
fDragging := True;
X1 := Mouse.CursorPos.X;
Y1 := Mouse.CursorPos.Y;
MemoH := Height;
MemoW := Width;
end;

// Redimensionnement
procedure TCustomSizeableMemo.img_resizeMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if fDragging then begin
Height := MemoH + (Mouse.CursorPos.Y - Y1);
Width := MemoW + (Mouse.CursorPos.X - X1);
end;
end;

// Fin redimmensionnement
procedure TCustomSizeableMemo.img_resizeMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
fDragging := False;
end;




procedure TCustomSizeableMemo.WMSize(var Message: TWMSize);
begin
inherited;
ImgReplace;
end;

end.


Voilà, j'ai pas installé le composant mais ça devrait résoudre le problème ;)
Commenter la réponse de Cirec
Messages postés
4229
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
3 août 2018
- 4 mai 2014 à 16:09
0
Merci
re,

je viens de remarquer que ça ne fonctionne plus si les scrollbars sont actives !!!

voici une solution très élégante et surtout très très simple ... si simple que je n'y ai même pas pensé de suite :D

unit USizeableMemo;

{
Composant Memo resizeable
}

interface

uses Windows, Classes, ExtCtrls, StdCtrls, Controls, Graphics, Forms, Messages;

type
TCustomSizeableMemo = Class(StdCtrls.TCustomMemo)
protected
procedure CreateParams(var Params: TCreateParams); override;
end;

TSizeableMemo = Class(TCustomSizeableMemo)
published
property Align;
property Alignment;
property Anchors;
property BevelEdges;
property BevelInner;
property BevelKind default bkNone;
property BevelOuter;
property BiDiMode;
property BorderStyle;
property CharCase;
property Color;
property Constraints;
property Ctl3D;
property DoubleBuffered;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property HideSelection;
property ImeMode;
property ImeName;
property Lines;
property MaxLength;
property OEMConvert;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentDoubleBuffered;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly;
property ScrollBars;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property WantReturns;
property WantTabs;
property WordWrap;
property OnChange;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseActivate;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnStartDock;
property OnStartDrag;
End;


procedure Register;

implementation

{Enregistrement du composant}
procedure Register;
begin
RegisterComponents('Exemples', [TSizeableMemo]);
end;




{ TResizeableMemo }


procedure TCustomSizeableMemo.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
Style := Style or WS_SIZEBOX or WS_HSCROLL or WS_VSCROLL;
end;
end.


du coup on peut le redimensionner de tous les cotés

ps: si le cadre dérange il suffit de mettre la propriété Ctl3D du Mémo à False
Commenter la réponse de Cirec
Messages postés
1293
Date d'inscription
mardi 28 octobre 2003
Statut
Contributeur
Dernière intervention
3 juillet 2015
- Modifié par simonpelloquin le 5/05/2014 à 10:46
0
Merci
Salut Cirec, Korgis, yanb et Solilog, et merci beaucoup pour votre participation !

"Au passage on ne dérive jamais directement d'un composant de la palette mais de son ancêtre "Custom" prévu à cet effet. (voir l'exemple)" -> Bien noté.

Concernant ta nouvelle proposition (le "TResizeableMemo") Cirec, c'est sûr que c'est plus propre et plus simple... Par contre, je trouve l'esthétique du composant un peu... pas top :) les scrollsbars, ça fait un peu moche...

Je pense cependant que je vais partir sur ça, parce qu'en plus j'ai un autre problème avec ma tentative et ça commence à me prendre bien la tête...

Juste pour compléter un peu le sujet, et résumer les infos que j'ai reçu de Yanb et du support Embarcadero... Avec le code ci dessous, ça fonctionne bien.
Korgis, je ne sais pas comment tu as pu le faire fonctionner avec le même code...

constructor TSizeableMemo.Create(AOwner: TComponent);
begin
     fCreating := True;
     inherited Create(Aowner);
     // Affectation d'un parent par défaut
     Parent     := AOwner as TWinControl;  
     // Image en bas à droite du composant pour le redimensionnement
     img_resize := TImage.Create(Self);
     with img_resize do begin
          Parent      := Self as TWinControl;
          Autosize    := True;
          Cursor      := crSizeNWSE;
          OnMouseDown := img_resizeMouseDown;
          OnMouseMove := img_resizeMouseMove;
          OnMouseUp   := img_resizeMouseUp;
          Picture.Bitmap.LoadFromResourceName(hInstance, 'Resize');
          Transparent := True;
     end;
     // On ne repositionne l'image qu'en designTime, ou en runtime mais uniquement sur une création dynamique
     if (csDesigning in ComponentState)
        or (Assigned(Owner) and not (csReading in Owner.ComponentState))
        then imgReplace;
     fCreating := False;
end;

// Repositionnement de l'image
procedure TSizeableMemo.imgReplace;
begin
     // Prise en compte de la zone "effective" du contrôle
     img_resize.Top  := ClientHeight - img_resize.Height;
     img_resize.Left := ClientWidth  - img_resize.Width;
end;
 
// Si le composant est chargé repositionnement de l'image avec les dimensions du memo
// enregistrées dans le DFM
procedure TSizeableMemo.Loaded;
begin
     inherited;
     if not (csDesigning in ComponentState) then begin
        HandleNeeded;
        if HandleAllocated
           then imgReplace;
     end;
end;

// Pour gestion du changement du ClientRect (bordures...) et de la taille
procedure TSizeableMemo.Resize;
begin
     inherited;
     if not fCreating
        then imgReplace;
end;



Voilà, par contre, nouveau hic :
Sur une app de test, je créée dynamiquement le contrôle, que je libère sur le onMouseLeave. Une fois le contrôle créé, si j'approche la souris de l'image pour redimensionner, la souris quitte le memo (du SizeableMemo) pour entrer sur l'imgResize et l'événement onmouseleave est déclenché... Du coup, violation d'accès car imgResize n'a pas de parent...
C'est normal que le mouseLeave ne soit attaché qu'au memo ?


Simon
Messages postés
1293
Date d'inscription
mardi 28 octobre 2003
Statut
Contributeur
Dernière intervention
3 juillet 2015
- 5 mai 2014 à 10:51
Damned !!! Cirec, j'ai le même problème avec ton composant : Dès que j'arrive sur les scrollsbars du memo ou le triangle de redimensionnement, l'événement onMouseLeave est déclenché... :(
Commenter la réponse de sp40
Messages postés
4229
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
3 août 2018
- 5 mai 2014 à 17:03
0
Merci
>>Concernant ta nouvelle proposition (le "TResizeableMemo") Cirec, c'est sûr que c'est plus propre et plus simple... Par contre, je trouve l'esthétique du composant un peu... pas top :) les scrollsbars, ça fait un peu moche...

J'ai forcé l'affichage des ScrollBars pour qu'on se rende compte que ça fonctionne ;)

mais tu peux les supprimer en retirant les deux constantes:

 ...
{ TResizeableMemo }


procedure TCustomSizeableMemo.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
    Style := Style or WS_SIZEBOX;
end;
end.


pour l'événement onMouseLeave j'ai pas bien compris ton problème.
Messages postés
1293
Date d'inscription
mardi 28 octobre 2003
Statut
Contributeur
Dernière intervention
3 juillet 2015
- 5 mai 2014 à 17:24
Eh bien en fait, je créé le composant dynamiquement :
procedure TMyForm.MemoFree(Sender : TObject);
begin
   TResizeableMemo(Sender).Free;
end;

Procedure TMyForm.ButtonClick(Sender : TObject);
begin
   With TResizeableMemo.Create(Self) do begin
      Parent := Self;
      OnMouseLeave := MemoFree;
   end;
end;


Le problème (et ça le fait aussi avec ton composant), c'est que quand tu arrives dans cette zone où le curseur change d'état pour passer en flèche d'étirement (ou quand tu arrives sur mon "imgResize" pour mon composant), tu déclenches l'événement MouseLeave... Or, le composant étant libéré, tu ne peux plus changer l'état du curseur et ça déclenche la violation. Mais bon, c'est pas grave, je vais "jouer" avec la propriété "visible"...
Messages postés
4229
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
3 août 2018
- 5 mai 2014 à 17:44
ok ... compris.

je dois me sauver là mais je testerai dès mon retour.

en attendant quel est l'intérêt de détruire le composant sur son OnMouseLeave ?
Messages postés
1293
Date d'inscription
mardi 28 octobre 2003
Statut
Contributeur
Dernière intervention
3 juillet 2015
- 5 mai 2014 à 18:06
Hé bien, c'est pour afficher la totalité d'un champ blob en cliquant dessus dans une dbgrid. Et me disant qu'une fois que j'en ai plus besoin, je peux supprimer le composant, je voulais le détruire quand la souris quitte le composant... Mais bon...
Messages postés
4229
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
3 août 2018
- 5 mai 2014 à 22:01
bon ben ...

j'ai testé avec ceci et ça fonctionne parfaitement ... et ce avec la dernière version du compo que j'ai donné plus haut et sous Delphi 2009 !!!

tu codes avec quelle version de Delphi ?
Messages postés
1293
Date d'inscription
mardi 28 octobre 2003
Statut
Contributeur
Dernière intervention
3 juillet 2015
- 6 mai 2014 à 11:39
Avec XE2. Sous 2009, tu ne reproduis pas la violation d'accès en allant sur les scrolls bars ?
Commenter la réponse de Cirec
Messages postés
4229
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
3 août 2018
- Modifié par Cirec le 6/05/2014 à 15:01
0
Merci
re,

ben non pas avec cette version du compo.

par contre j'ai réessayé avec cette version et là effectivement j'ai un message d'insulte me disant que le composant n'a pas de parent !!!

et en fait ce que tu prends pour un bug est en fait une réaction tout à fait normale. Du moment que la souris passe du TMemo au TImage un WM_MOUSELEAVE est envoyé par le TMemo. Même si en réalité le curseur se trouve encore sur le TMemo il survole un autre composant ... et inversement quand on passe du TImage au TMemo le TImage envoi un WM_MOUSELEAVE qui est renvoyé à son tour à son parent ... le TMemo.

il faut donc intercepter le MouseLeave message ...

voici comment:
unit UResizeableMemo;

{
Composant Memo resizeable
}

interface

uses Windows, Classes, ExtCtrls, StdCtrls, Controls, Graphics, Forms, Messages;

type
  TCustomResizeableMemo = Class(StdCtrls.TCustomMemo)
    img_resize: TImage;
  Private
    MemoW, MemoH,         // Dimensions originales du memo avant redimensionnement
    X1, Y1    : Integer;  // Premier point de la souris au début du drag
    fDragging : Boolean;  // = True tant que le bouton de la souris est enfoncé sur l'image
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure img_resizeMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure img_resizeMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure img_resizeMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure imgReplace;
  protected
    procedure CMMouseleave(var Message: TMessage); message CM_MOUSELEAVE;
  Public
    constructor Create(AOwner: TComponent); override;
  end;

  TResizeableMemo = Class(TCustomResizeableMemo)
  published
    property Align;
    property Alignment;
    property Anchors;
    property BevelEdges;
    property BevelInner;
    property BevelKind default bkNone;
    property BevelOuter;
    property BiDiMode;
    property BorderStyle;
    property CharCase;
    property Color;
    property Constraints;
    property Ctl3D;
    property DoubleBuffered;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property HideSelection;
    property ImeMode;
    property ImeName;
    property Lines;
    property MaxLength;
    property OEMConvert;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentDoubleBuffered;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ScrollBars;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property WantReturns;
    property WantTabs;
    property WordWrap;
    property OnChange;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseActivate;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDock;
    property OnStartDrag;
  End;


procedure Register;

implementation

{$R TSizeableMemo.RES}

{Enregistrement du composant}
procedure Register;
begin
  RegisterComponents('Exemples', [TResizeableMemo]);
end;




{ TResizeableMemo }
{ Interception du message WM_MOUSELEAVE}
procedure TCustomResizeableMemo.CMMouseleave(var Message: TMessage);
var
  Pt: TPoint;
  Br: TRect;
begin
  // si c'est bien un message du TMemo on le traite ...
  if Message.LParam = 0 then
  begin
    Pt := ScreenToClient(Mouse.CursorPos);
    Br := BoundsRect;
    // on réduit la zone de controle
    // pour assurer le bon fonctionnement
    InflateRect(Br, -5, -5);
    // pour un controle et un déclenchement dans toutes les directions
//    if not PtInRect(Br, Pt) then
    // ou un controle et déclenchement sur la droite et en bas
    if (Pt.X > Br.Right) or (Pt.Y > Br.Bottom) then
      // on propage le message ce qui déclenchera le OnMouseLeave
      inherited;
  end;
  // sinon on l'empeche de se propager et on évite la violation d'accès ;)
end;

constructor TCustomResizeableMemo.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  // Image en coin du composant pour le resize
  img_resize  := TImage.Create(Self);
  with img_resize do begin
    Autosize := True;
    Parent   := Self;
    Cursor   := crSizeNWSE;
    OnMouseDown := img_resizeMouseDown;
    OnMouseMove := img_resizeMouseMove;
    OnMouseUp   := img_resizeMouseUp;
    Picture.Bitmap.LoadFromResourceName(hInstance, 'Resize');
    Transparent := True;
  end;
  Height := 89;
  Width  := 185;
end;

// Replace l'image à la bonne place dans le memo
procedure TCustomResizeableMemo.imgReplace;
begin
  img_resize.Top  := Height - img_resize.Height;
  img_resize.Left := Width  - img_resize.Width;
end;

// Premier point
procedure TCustomResizeableMemo.img_resizeMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  fDragging := True;
  X1    := Mouse.CursorPos.X;
  Y1    := Mouse.CursorPos.Y;
  MemoH := Height;
  MemoW := Width;
end;

// Redimensionnement
procedure TCustomResizeableMemo.img_resizeMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if fDragging then begin
    Height := MemoH + (Mouse.CursorPos.Y - Y1);
    Width  := MemoW + (Mouse.CursorPos.X - X1);
  end;
end;

// Fin redimensionnement
procedure TCustomResizeableMemo.img_resizeMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  fDragging := False;
end;

procedure TCustomResizeableMemo.WMSize(var Message: TWMSize);
begin
  inherited;
  ImgReplace;
end;

end.


chez moi ça fonctionne très bien ;)

ps: si tu mets cette ligne en commentaire :
    InflateRect(Br, -5, -5);
tu constateras un petit bug qui pourrait bien se révéler très utile ...
si la souris quitte lentement le TMemo par la droite, ou le bas, l'évènement ne se déclenche pas ... il faut quitter plus rapidement (ou vers le haut ou la gauche si activé) à tester
    
@+ Cirec
Messages postés
1293
Date d'inscription
mardi 28 octobre 2003
Statut
Contributeur
Dernière intervention
3 juillet 2015
- 6 mai 2014 à 16:54
Arrrgh, je me doutais bien qu'il fallait faire un truc comme ça... mais je n'ai pas eu le courage et le temps de chercher un peu. Y a pas à dire, t'es un as ! :)
Bon, dans le même esprit, il me reste à gérer le mouseLeave sur l'ImgResize quand la souris quitte le composant pour déclencher le mouseLeave du composant... Mais je vais m'en occuper, j'ai pigé le truc (enfin, j'espère...) Je mettrai à jour ma source pourrie et tout ira mieux !
En tous cas, merci beaucoup !
Commenter la réponse de Cirec
Messages postés
4229
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
3 août 2018
- 6 mai 2014 à 18:22
0
Merci
de rien,

pour ton dernier "problème" voici la solution:
{ TResizeableMemo }
{ Interception du message WM_MOUSELEAVE}
procedure TCustomResizeableMemo.CMMouseleave(var Message: TMessage);
var
  Pt: TPoint;
  Br: TRect;
begin
  Pt := ScreenToClient(Mouse.CursorPos);
  Br := BoundsRect;
  // on réduit la zone de controle
  // pour assurer le bon fonctionnement
  InflateRect(Br, -5, -5);
  // si c'est bien un message du TMemo on le traite ...
  if Message.LParam = 0 then
  begin
    // pour un controle et un déclanchement dans toutes les directions
//    if not PtInRect(Br, Pt) then
    // ou un controle et déclanchement sur la droite et en bas
    if (Pt.X > Br.Right) or (Pt.Y > Br.Bottom) then
      // on propage le message ce qui déclanchera le OnMouseLeave
      inherited;
  end
  else  // le message provient du TImage
  begin
    // on controle sur la droite et en bas
    if (Pt.X > Br.Right) or (Pt.Y > Br.Bottom) then
      // cette fois on déclanche l'évenement OnMouseLeave
      if Assigned(OnMouseLeave) then
        OnMouseLeave(Self);
  end;
  // sinon on l'empeche de se propager et on évite la violation d'accès ;)
end;


dis moi juste si tout fonctionne comme tu le souhaites ... ;)
Commenter la réponse de Cirec
Messages postés
1293
Date d'inscription
mardi 28 octobre 2003
Statut
Contributeur
Dernière intervention
3 juillet 2015
- 7 mai 2014 à 09:20
0
Merci
T'abuses ! Je voulais m'en occuper... :-)

Enfin, c'est nickel, pile poil !!! Je mettrai à jour la source prochainement !
Commenter la réponse de sp40
Messages postés
4229
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
3 août 2018
- 7 mai 2014 à 16:29
0
Merci
Désolé ... :-D

je n'ai pas pu résister !!! mouahahahaha

en fait la solution m'est
apparue
si simple et facile à mettre en oeuvre et n'étant pas certain que mes explications étaient suffisamment claires et complètes pour en arriver au même résultat avec très peu de code, j'ai tout simplement livré la solution.

Mais je peux aussi m'abstenir la prochaine fois ... hein ^^ :p
Messages postés
1293
Date d'inscription
mardi 28 octobre 2003
Statut
Contributeur
Dernière intervention
3 juillet 2015
- 7 mai 2014 à 16:35
Ah non !!! Pas d'abstention, hein ! :-)
Merci encore en tous cas ! Et en espérant te recroiser rapidement ;-)
Commenter la réponse de 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.