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.
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;
...
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionconstructor 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;
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;
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.
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.
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;
>>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...
... { TResizeableMemo } procedure TCustomSizeableMemo.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); with Params do Style := Style or WS_SIZEBOX; end; end.
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;
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.
InflateRect(Br, -5, -5);tu constateras un petit bug qui pourrait bien se révéler très utile ...
@+ Cirec
{ 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;
apparuesi 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.