Sujet Précédent Sujet Suivant

Composant TSizeableMemo

Résolu
sp40 Messages postés 1276 Date d'inscription mardi 28 octobre 2003 Statut Contributeur Dernière intervention 3 juillet 2015 - 14 avril 2014 à 15:06
sp40 Messages postés 1276 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...

13 réponses

Réponse 1 / 13
cs_yanb Messages postés 271 Date d'inscription lundi 27 octobre 2003 Statut Membre Dernière intervention 7 juillet 2022 14
16 avril 2014 à 09:56
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.
@+
0
Réponse 2 / 13
sp40 Messages postés 1276 Date d'inscription mardi 28 octobre 2003 Statut Contributeur Dernière intervention 3 juillet 2015 15
17 avril 2014 à 16:23
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
0
Réponse 3 / 13
solilog Messages postés 273 Date d'inscription samedi 13 juin 2009 Statut Membre Dernière intervention 18 avril 2015 10
24 avril 2014 à 19:13
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


--
0
sp40 Messages postés 1276 Date d'inscription mardi 28 octobre 2003 Statut Contributeur Dernière intervention 3 juillet 2015 15
25 avril 2014 à 09:16
Mouais... c'est juste une question d'esthétique... ;)
0
Réponse 4 / 13
sp40 Messages postés 1276 Date d'inscription mardi 28 octobre 2003 Statut Contributeur Dernière intervention 3 juillet 2015 15
28 avril 2014 à 10:48
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 ?

0
sp40 Messages postés 1276 Date d'inscription mardi 28 octobre 2003 Statut Contributeur Dernière intervention 3 juillet 2015 15
28 avril 2014 à 11:52
oups... Manque le "procedure Register;" avant "implementation"...
0
cs_yanb Messages postés 271 Date d'inscription lundi 27 octobre 2003 Statut Membre Dernière intervention 7 juillet 2022 14
Modifié par cs_yanb le 29/04/2014 à 17:25
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;
...
@+
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 13
korgis Messages postés 420 Date d'inscription samedi 17 mai 2003 Statut Membre Dernière intervention 6 mai 2019 17
1 mai 2014 à 18:43
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...
0
korgis Messages postés 420 Date d'inscription samedi 17 mai 2003 Statut Membre Dernière intervention 6 mai 2019 17
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...
0
Réponse 6 / 13
Cirec Messages postés 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
3 mai 2014 à 22:06
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 ;)
0
Réponse 7 / 13
Cirec Messages postés 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
4 mai 2014 à 16:09
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
0
Réponse 8 / 13
sp40 Messages postés 1276 Date d'inscription mardi 28 octobre 2003 Statut Contributeur Dernière intervention 3 juillet 2015 15
Modifié par simonpelloquin le 5/05/2014 à 10:46
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
0
sp40 Messages postés 1276 Date d'inscription mardi 28 octobre 2003 Statut Contributeur Dernière intervention 3 juillet 2015 15
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é... :(
0
Réponse 9 / 13
Cirec Messages postés 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
5 mai 2014 à 17:03
>>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.
0
sp40 Messages postés 1276 Date d'inscription mardi 28 octobre 2003 Statut Contributeur Dernière intervention 3 juillet 2015 15
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"...
0
Cirec Messages postés 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
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 ?
0
sp40 Messages postés 1276 Date d'inscription mardi 28 octobre 2003 Statut Contributeur Dernière intervention 3 juillet 2015 15
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...
0
Cirec Messages postés 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
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 ?
0
sp40 Messages postés 1276 Date d'inscription mardi 28 octobre 2003 Statut Contributeur Dernière intervention 3 juillet 2015 15
6 mai 2014 à 11:39
Avec XE2. Sous 2009, tu ne reproduis pas la violation d'accès en allant sur les scrolls bars ?
0
Réponse 10 / 13
Cirec Messages postés 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
Modifié par Cirec le 6/05/2014 à 15:01
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
0
sp40 Messages postés 1276 Date d'inscription mardi 28 octobre 2003 Statut Contributeur Dernière intervention 3 juillet 2015 15
Modifié par simonpelloquin le 6/05/2014 à 16:57
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 !
0
Réponse 11 / 13
Cirec Messages postés 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
6 mai 2014 à 18:22
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 ... ;)
0
Réponse 12 / 13
sp40 Messages postés 1276 Date d'inscription mardi 28 octobre 2003 Statut Contributeur Dernière intervention 3 juillet 2015 15
7 mai 2014 à 09:20
T'abuses ! Je voulais m'en occuper... :-)

Enfin, c'est nickel, pile poil !!! Je mettrai à jour la source prochainement !
0
Réponse 13 / 13
Cirec Messages postés 3833 Date d'inscription vendredi 23 juillet 2004 Statut Modérateur Dernière intervention 18 septembre 2022 50
7 mai 2014 à 16:29
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
0
sp40 Messages postés 1276 Date d'inscription mardi 28 octobre 2003 Statut Contributeur Dernière intervention 3 juillet 2015 15
7 mai 2014 à 16:35
Ah non !!! Pas d'abstention, hein ! :-)
Merci encore en tous cas ! Et en espérant te recroiser rapidement ;-)
0

Discussions similaires

800A01AD - Un composant activex ne peut pas créer un objet
VBScript37 -
wassim.azzouzi -

9 réponses
Diagramme de Gantt
umale -
umale -

5 réponses
Le composant Active X ne peut créer l'objet
JSilvere -
malo777 -

9 réponses
Un composant ActiveX ne peut créer un objet GetObject
cs_stagiaire -
charlycbu -

7 réponses
utilisation du composant true DB GRID 6
riadh100 -
cboulas -

5 réponses
Rejoignez-nous