Je suis de retour !

Je ne l'en souvenais plus, mais en y regardant de plus près, le programme PanEdi (chez moi) est 100 % Panoramic, sans fonctions de DLL. Cependant, je dispose de divers objets et fonctions qui peuvent sélectionner (tracer un cadre avec poignées) un objet, le déplacer et/ou le redimensionner. On peut même sélectionner plusieurs objets et les déplacer en groupe.

Voici les extraits de code concernés (post 1 sur 2):

Code:: // définition de l'objet ObjectMover - dérive de TForm
type
  TObjectMover = class(TForm)
   // déclaration des procédures internes de gestion de la souris
   class procedure ControlMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
   class procedure ControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
   class procedure ControlMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

  private
   // variables internes pour les propriétés
   FMoving: Boolean; // flag "déplacement en cours"
   fDragOrigin: TPoint; // coordonnées du coin en haut à gauche de l'objet contenant ObjectMover
   FDownX, FDownY: integer; // coordonnées du MouseDown sur ObjectMover
   FWinWidth, FWinHeight: integer; // dimensions de l'objet contenant ObjectMover
   FUserEventData: Integer; // adresse d'un tableau de 4 entiers à remplir sur MoseDown et MouseUp
   FNormalBMP: TBitMap; // image état normal
   FActiveBMP: TBitMap; // image état actif
   FMoveHostParent: HWND; // déplacer le parent de l'hôte au lieu de l'hôte - ici son handle
   FNonWindowObject: TObject; // pour ALPHA et PICTURE (TLabel et TImage) à déplacer
   fDesignerHost: TControl; // objet Panoramic hébergeant le Designer
   fDesignerHostHandle: HWND; // handle de l'objet hébergeant de Designer
   fDesignerMove: boolean; // flag "déplacer le Designer aussi"
   fFakeParentWindow: HWND; // remplacement de Parentwindow
   fParentWindowOffset: TPoint; // adresse du coin en haut à gauche de ParentWindow en coordonnées écran
   fDelta: integer; // décalage dû au Designer position intérieure (défaut: 0)
   fDesigner: TControlHandler; // objet Designer associé
   // procédures appelées par les propriétées et méthodes
   procedure SetNormalBMPFromClipboard();
   procedure SetActiveBMPFromClipboard();
   procedure SetNormalImageFromIcon(index: integer);
   procedure SetActiveImageFromIcon(index: integer);
   procedure SetNormalImageFromFile(bmpfile: integer);
   procedure SetActiveImageFromFile(bmpfile: integer);
   procedure SetDesignerHost(aValue: TControl);
// protected
  public
   constructor CreateNew(AOwner: TComponent; ADestination: HWND; ALocation, ADimension: TPoint; NonWindow: TObject); //override;
   destructor Destroy; override;
  published
   // propriétés et méthodes
   property NormalBMP: TBitMap read FNormalBMP;
   property ActiveBMP: TBitMap read FActiveBMP;
   property UserEventData: Integer read FUserEventData write FUserEventData;
   property DesignerHost: TControl read fDesignerHost write SetDesignerHost;
   property DesignerHostHandle: HWND read fDesignerHostHandle write fDesignerHostHandle;
   property DesignerMove: Boolean read fDesignerMove write fDesignerMove;
   property FakeParentwindow: HWND read fFakeParentWindow write fFakeParentWindow;
   property ParentWindowOffset: TPoint read fParentWindowOffset write fParentWindowOffset;
   property Delta: integer read fDelta write fDelta;
   property Designer: TControlHandler read fDesigner write fDesigner;
   property OnMouseDown;
   property OnMouseMove;
   property OnMouseUp;
  end;

  Type TDummy = class
// pour Designer
   class procedure DesignerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
   class procedure DesignerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
   class procedure DesignerMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

  function CreateObjectMover(hdest: HWND; act,lft,tp,w,h: integer):integer; stdcall; forward;
  function CreateSpecialObjectMover(hdest: HWND; obj: TObject; lft,tp,w,h: integer):integer; stdcall; forward;
  function ObjectMoverTarget(OM: TObjectMover; Target: HWND):integer; stdcall; forward;
  function SetObjectMoverImage(OM: TObjectMover; NormalTyp, NormalImg, ActiveTyp, ActiveImg: integer):integer; stdcall; forward;
  function DeleteObjectMover(OM: TObjectMover):integer; stdcall; forward;

Implementation

// mémoriser le Designer hébergeant l'ObjectMover
procedure TObjectMover.SetDesignerHost(aValue: TControl);
begin
  if not assigned(aValue) then exit;
  fDesignerHost := aValue;
end;

// procédure privée pour l'évènement MouseDown - accrocher et activer ObjectMover
class procedure TObjectMover.ControlMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  ind, i, w, h: integer;
  r: TRect;
  s: string;
  pos: TPoint;
begin
  with (Sender as TObjectMover) do begin
   w := Width; // prendre les dimensions de ObjectMover
   h := Height;
   FMoving := true; // marquer "en mouvement" (actif)
   FDownX := X; // mémoriser les coordonnées du clic d'accroche dans ObjectMover
   FDownY := Y;
   Canvas.StretchDraw(Rect(0,0,w,h),ActiveBMP); // dessiner l'image de l'état actif

   GetWindowRect((Sender as TObjectMover).fFakeParentWindow,r); // prendre les coordonnées de l'objet hébergeant ObjectMover

   pos := r.TopLeft; // extraire le coin en haut à gauche
   fDragOrigin.X := pos.X; // mémoriser le point de départ du déplacement de l'objet hébergeur
   fDragOrigin.Y := pos.Y;
   FWinWidth := r.Right - r.Left; // calculer les dimensions de ObjectMover
   FWinHeight := r.Bottom - r.Top;

   if UserEventData<>0 then begin // l'adresse d'un tableau de 4 mots a été indiquée ?
   pinteger(UserEventData)^ := fDragOrigin.X; // indice 0: abscisse du hébergeur
   pinteger(UserEventData+4)^ := fDragOrigin.Y; // indice 1: ordonnée du hébergeur
   pinteger(UserEventData+8)^ := ID_MouseDown; // indice 2: signaler action "down" pour "ObjectMover"
   pinteger(UserEventData+12)^ := integer(Sender); // ObjectMover lui-même
   SendMessage(MainFormHandle,USER_EVENT_Message,ID_MouseDown,integer(Sender)); // créer le USER_EVENT dans Panoramic
   // *** les deux lignes suivantes sont juste pour les tests
{ s := 'objet '+inttohex(integer(Sender),8)+' '+inttohex(ID_MouseDown,8);
   SendMessage(MainFormHandle,WM_SETTEXT,0,integer(pchar(s))); }
   end;
  end;
end;

// procédure privée pour l'évènement MouseMove - déplacer l'hébergeur si ObjectMover est actif
class procedure TObjectMover.ControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  l, t, lp, tp, d, deltaX, deltaY: integer;
  s: string;
  pi: pinteger;
  pos: TPoint;
begin
  d := (Sender as TObjectMover).Delta; // zéro par défaut. Peut être chargée avec HandleWidth si Designer intérieur !
  with (Sender as TObjectMover) do begin
   if fmoving then begin // ObjectMover est actif ?
   deltaX := X - FDownX; // calculer les décalages horizontaux
   deltaY := Y - FDownY; // et verticaux
   l := DeltaX + fDragOrigin.X; // calculer la nouvelle position de l'hébergeur
   t := DeltaY + fDragOrigin.Y;
   fDragOrigin.X := l; // mémoriser la nouvelle position
   fDragOrigin.Y := t;
   pos := TObjectMover(Sender).ParentWindowOffset; // récupérer l'offset du coin en haut à gauche

   if FNonWindowObject=nil then begin // objet normal ? (fenêtré)
   if FMoveHostParent<>0 then begin // déplacer le parent du hébergeur ?
   MoveWindow(FMoveHostParent,l-pos.X,t-pos.Y,FWinWidth,FWinHeight,true) // déplacer le parent de l'hébergeur
   end else begin // déplacer l'hébergeur
   MoveWindow((Sender as TObjectMover).fFakeParentWindow,l-pos.X,t-pos.Y,FWinWidth,FWinHeight,true); // déplacer l'hébergeur
   end;
   if fDesignerHost<>nil then begin // on est attaché au Designer ?
   pos := (Sender as TObjectMover).ParentWindowOffset; // récupérer les offsets
   // déplacer le Designer
   MoveWindow(fDesignerHostHandle,l-pos.X,t-pos.Y,(Sender as TObjectMover).FWinWidth-2*d,(Sender as TObjectMover).FWinHeight-2*d,true);
   end;
   end else begin // objet non fenêtré (ALPHA ou PICTURE)
   TObjectMover(Sender).Left := l+pos.X+d; // déplacer l'ObjectMover
   TObjectMover(Sender).Top := t+pos.Y+d;
   SetObjectPosition(FNonWindowObject,(Sender as TObjectMover).fFakeParentWindow,l,t); // déplacer l'objet ciblé
   if TObjectMover(Sender).DesignerMove then begin // faut_il déplacer le Designer aussi ?
   SetWindowPos(TControlHandler(TObjectMover(Sender).Designer).Handle,0,l-HandleWidth+d,t-HandleWidth+d,0,0,SWP_NOSIZE or SWP_NOZORDER);
   InvalidateRect (TControlHandler(TObjectMover(Sender).Designer).ParentWindow, 0, TRUE);
   UpdateWindow (TControlHandler(TObjectMover(Sender).Designer).ParentWindow);
   end;
   end;
   end;
  end;
end;

// procédure privée pour l'évènement MouseUp - décrocher ObjectMover et désactiver
class procedure TObjectMover.ControlMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  ind, stk, i, w, h: integer;
  s: string;
begin
  with (Sender as TObjectMover) do begin
   FMoving := false; // désactiver
   FDownX := X; // mémoriser la position de MouseUp
   FDownY := Y;
   w := Width; // prendre les dimensions de ObjectMover
   h := Height;
   Canvas.StretchDraw(Rect(0,0,w,h),NormalBMP); // dessiner l'image de l'état normal
   if UserEventData<>0 then begin // l'adresse d'un tableau de 4 mots a été indiquée ?
   pinteger(UserEventData)^ := fDragOrigin.X; // indice 0: abscisse du hébergeur
   pinteger(UserEventData+4)^ := fDragOrigin.Y; // indice 1: ordonnée du hébergeur
   pinteger(UserEventData+8)^ := ID_MouseUp; // indice 2: signaler action "up" pour "ObjectMover"
   pinteger(UserEventData+12)^ := integer(Sender); // ObjectMover lui-même
   SendMessage(MainFormHandle,USER_EVENT_Message,ID_MouseUp,integer(Sender)); // créer le USER_EVENT dans Panoramic
   // *** les deux lignes suivantes sont juste pour les tests
{ s := 'objet '+inttohex(integer(Sender),8)+' '+inttohex(ID_MouseUp,8);
   SendMessage(MainFormHandle,WM_SETTEXT,0,integer(pchar(s))); }
   end;
  end;
end;

// constructeur privé de ObjectMover
constructor TObjectMover.CreateNew(AOwner: TComponent; ADestination: HWND; ALocation, ADimension: TPoint; NonWindow: TObject);
var
  rr: TRect;
begin
  inherited CreateNew(AOwner); // créer une form normalement
  FMoveHostParent := 0; // comportement normal
  FNonWindowObject := NonWindow; // objet non-Windows associé
  BorderStyle := bsNone; // pas de bords
  SetBounds(0,0,ADimension.X,ADimension.Y); // dimensions imposées
  Top := ALocation.Y; // position imposée
  Left := ALocation.X;
  color := clSilver; // couleur imposée
  fDesignerHost := nil; // défaut: pas hébergé par un objet Designer
  fDesignerHostHandle := 0; // et donc pas de handle
  fDesignerMove := false; // défaut: ne pas déplacer le Designer
  fFakeParentwindow := ADestination; // à la place de Parentwindow
  fParentWindowOffset := point(0,0); // offzet du coin en haut à gauche de l'objet contenant l'objet à déplacer, par rapport à l'écran entier
  Windows.ClientToScreen(GetAncestor(FakeParentwindow,GA_PARENT),fParentWindowOffset); // et déduire l'offset par rapoort à l'écran
  fDelta := 0; // défaut: pas de décalage
  fDesigner := nil;
  BringToFront;
  Paint;
  SetWindowPos(Handle,HWND_TOPMOST,0,0,0,0,SWP_NOMOVE or SWP_NOSIZE);
end;

// suppression privée de ObjectMover
destructor TObjectMover.Destroy;
begin
  if assigned(fDesigner) then fDesigner := nil;
  inherited Destroy; // supprimer la TForm, en réalité
end;

// charger l'image de l'état normal du presse-papier
procedure TObjectMover.SetNormalBMPFromClipboard();
begin
  FNormalBMP.Assign(Clipboard);
  Canvas.StretchDraw(Rect(0,0,width,height),FNormalBMP);
  Paint;
end;

// charger l'image de l'état actif du presse-papier
procedure TObjectMover.SetActiveBMPFromClipboard();
begin
  FActiveBMP.Assign(Clipboard);
end;

// charger l'image de l'état normal à partir d'une icône de KGF.dll
procedure TObjectMover.SetNormalImageFromIcon(index: integer);
begin
  FNormalBMP.Assign(GetInternalIcon(index));
  Canvas.StretchDraw(Rect(0,0,width,height),FNormalBMP);
  Paint;
end;

// charger l'image de l'état actif à partir d'une icône de KGF.dll
procedure TObjectMover.SetActiveImageFromIcon(index: integer);
begin
  FActiveBMP.Assign(GetInternalIcon(index));
end;

class procedure TDummy.DesignerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  single: boolean;
begin
  TControlHandler(Sender).SetActualPosition(X,Y);

  TcontrolHandler(Sender).Drag := True;
  single := True;

  if single then TcontrolHandler(Sender).ControlPoint := TcontrolHandler(Sender).GetControlPoint(TcontrolHandler(Sender).ActualPosition)
   else TcontrolHandler(Sender).ControlPoint := pcOther;
  case TcontrolHandler(Sender).ControlPoint of
   pcTopLeft : TcontrolHandler(Sender).Cursor := crSizeNWSE;
   pcTopRight : TcontrolHandler(Sender).Cursor := crSizeNESW;
   pcBottomLeft : TcontrolHandler(Sender).Cursor := crSizeNESW;
   pcBottomRight : TcontrolHandler(Sender).Cursor := crSizeNWSE;
   pcOther : TcontrolHandler(Sender).Cursor := crDrag;
  end;
  (Sender as TControlHandler).BringToFront;
end;

class procedure TDummy.DesignerMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  i: integer;
begin
  if TcontrolHandler(Sender).DesignerSelectionIndex>=0 then begin
   for i:=DesignerSelection.Count-1 downto 0 do begin
   if Assigned(DesignerSelection[i]) then begin
   if i<>(Sender as TControlHandler).DesignerSelectionIndex then begin
   TcontrolHandler(DesignerSelection[i]).Cursor := crDefault;
   TcontrolHandler(DesignerSelection[i]).SetRegion;
   TcontrolHandler(DesignerSelection[i]).Drag := False;
   RedrawWindow((DesignerSelection[i] as TControlHandler).Handle, 0, 0, RDW_INVALIDATE or RDW_UPDATENOW);
   end;
   end;
   end;
  end;
  TcontrolHandler(Sender).Cursor := crDefault;
  TcontrolHandler(Sender).SetRegion;
  TcontrolHandler(Sender).Drag := False;
  RedrawWindow((Sender as TControlHandler).Handle, 0, 0, RDW_INVALIDATE or RDW_UPDATENOW);
end;

class procedure TDummy.DesignerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  i, ind, dx, dy, dleft, dtop, temp, ltemp, ttemp: integer;
  a, b: integer;
  pi: pinteger;
  hdc: THandle;
  s: string;
  doleft, dotop: boolean;
begin
  with TControlHandler(Sender) do begin
   if (X=ActualPosition.X) and (Y=ActualPosition.Y) then exit;
   if not Drag then Exit;
   Drag := false;

   dx := X - ActualPosition.X;
   dy := Y - ActualPosition.Y;
   dleft := dx;
   dtop := dy;
   doleft := false;
   dotop := false;
  end;

// s := inttostr(MagneticGridSize)+' '+inttostr(dx)+','+inttostr(dy)+' '+inttostr(x)+','+inttostr(y)+' '+inttostr(PosAct.X)+','+inttostr(PosAct.Y);
// SendMessage(GetForegroundWindow,WM_SETTEXT,0,integer(pchar(s)));

  with (Sender as TControlHandler) do begin
   case ControlPoint of

   pcTopLeft : begin
   if MagneticGridSize<=1 then begin
   dleft := dx;
   dtop := dy;
   Left := Left + dleft;
   Top := Top + dtop;
   Width := width - dleft;
   Height := Height - dtop;
   SetActualPosition(X-dleft,Y-dtop);
   doleft := true;
   dotop := true;
   end else begin
   if (Left+dleft)=Round((Left+dleft)/MagneticGridSize)*MagneticGridSize then begin
   left := Left + dleft;
   Width := Width - dleft;
   SetActualPosition(X-dleft,ActualPosition.Y);
   doleft := true;
   end;
   if (Top+dtop)=Round((Top+dtop)/MagneticGridSize)*MagneticGridSize then begin
   Top := Top + dtop;
   Height := Height - dtop;
   SetActualPosition(ActualPosition.X,Y-dtop);
   dotop := true;
   end;
   end;
   end;

   pcTopRight : begin
   dleft := 0;
   if MagneticGridSize<=1 then begin
   dtop := dy;
   Width := Width + dx;
   Top := Top + dtop;
   Height := Height - dtop;
   SetActualPosition(X,Y-dtop);
   doleft := true;
   dotop := true;
   end else begin
   if (Left+Width+dleft)=Round((Left+Width+dleft)/MagneticGridSize)*MagneticGridSize then begin
   Width := Width + dleft;
   SetActualPosition(X-dleft,ActualPosition.Y);
   doleft := true;
   end;
   if (Top+dtop)=Round((Top+dtop)/MagneticGridSize)*MagneticGridSize then begin
   Top := Top + dtop;
   Height := Height - dtop;
   SetActualPosition(ActualPosition.X,Y-dtop);
   dotop := true;
   end;
   end;
   end;

   pcBottomLeft : begin
   dtop := 0;
   if MagneticGridSize<=1 then begin
   Left := Left + dleft;
   Width := Width - dleft;
   Height := Height + dy;
   SetActualPosition(X-dleft,Y);
   doleft := true;
   dotop := true;
   end else begin
   if (Left+dleft)=Round((Left+dleft)/MagneticGridSize)*MagneticGridSize then begin
   left := Left + dleft;
   Width := Width - dleft;
   SetActualPosition(X-dleft,ActualPosition.Y);
   doleft := true;
   end;
   if (Top+Height+dtop)=Round((Top+Height+dtop)/MagneticGridSize)*MagneticGridSize then begin
   Height := Height + dtop;
   SetActualPosition(ActualPosition.X,Y);
   dotop := true;
   end;
   end;
   end;

   pcBottomRight : begin
   dleft := 0;
   dtop := 0;
   if MagneticGridSize<=1 then begin
   Height := Height + dy;
   Width := Width + dx;
   SetActualPosition(X,Y);
   doleft := true;
   dotop := true;
   end else begin
   if (Left+Width+dleft)=Round((Left+Width+dleft)/MagneticGridSize)*MagneticGridSize then begin
   Width := Width + dleft;
   SetActualPosition(X,ActualPosition.Y);
   doleft := true;
   end;
   if (Top+Height+dtop)=Round((Top+Height+dtop)/MagneticGridSize)*MagneticGridSize then begin
   Height := Height + dtop;
   SetActualPosition(ActualPosition.X,Y-dtop);
   dotop := true;
   end;
   end;
   end;

   pcOther : begin
   if MagneticGridSize<=1 then begin
   Left := Left + dleft;
   Top := Top + dtop;
   SetActualPosition(X-dleft,Y-dtop);
   doleft := true;
   dotop := true;
   end else begin
   if (Left+dleft)=Round((Left+dleft)/MagneticGridSize)*MagneticGridSize then begin
   left := Left + dleft;
   SetActualPosition(X-dleft,ActualPosition.Y);
   doleft := true;
   end;
   if (Top+dtop)=Round((Top+dtop)/MagneticGridSize)*MagneticGridSize then begin
   Top := Top + dtop;
   SetActualPosition(actualPosition.X,Y-dtop);
   dotop := true;
   end;
   end;

   end;
   end;
  end;

  if assigned((Sender as TControlHandler).ObjectMover) then begin
   if doleft then TForm((Sender as TControlHandler).ObjectMover).Left := TForm((Sender as TControlHandler).ObjectMover).Left + dleft;
   if dotop then TForm((Sender as TControlHandler).ObjectMover).Top := TForm((Sender as TControlHandler).ObjectMover).Top + dtop;
   TForm((Sender as TControlHandler).ObjectMover).BringToFront;
  end;

  with (Sender as TControlHandler) do begin
   if (Sender as TControlHandler).ExternalBorder then begin
   s := inttostr(tag)+','+inttostr(left+HandleWidth)+','+inttostr(top+HandleWidth)+','+inttostr(width-2*HandleWidth)+','+inttostr(height-2*HandleWidth);
   SendMessage(EventReceiver,WM_SETTEXT,0,integer(pchar(s)));
   end else begin
   s := inttostr(tag)+','+inttostr(left)+','+inttostr(top)+','+inttostr(width)+','+inttostr(height);
   SendMessage(EventReceiver,WM_SETTEXT,0,integer(pchar(s)));
   end;

// répéter le paragraphe suivant pour tous les objets de DesignerCHlist si cette liste est référencée dans l'objet

   SetRegion;
   if assigned((Sender as TControlHandler).ObjectMover) then TForm((Sender as TControlHandler).ObjectMover).BringtoFront;
   Drag := true;

   ind := GetWindowTextLength(EventReceiver);
   SendMessage(EventReceiver, EM_SETSEL, ind, ind);
   s := ' ';
   SendMessage (EventReceiver, EM_REPLACESEL, 0, Integer(@s[1]));
   TControlHandler(Sender).BringToFront;
  end;

  with (Sender as TControlHandler) do begin
  if DesignerSelectionIndex<>-1 then begin

   for i:=DesignerSelection.Count-1 downto 0 do begin
   if i<>(Sender as TControlHandler).DesignerSelectionIndex then begin

   if Assigned(DesignerSelection[i]) then begin
   with TControlHandler(DesignerSelection[i]) do begin
   if MagneticGridSize<=1 then begin
   dleft := dx;
   dtop := dy;
   Left := Left + dleft;
   Top := Top + dtop;
// Width := width - dleft;
// Height := Height - dtop;
   SetActualPosition(X-dleft,Y-dtop);
   doleft := true;
   dotop := true;
   end else begin
   if (Left+dleft)=Round((Left+dleft)/MagneticGridSize)*MagneticGridSize then begin
   left := Left + dleft;
   Width := Width - dleft;
   SetActualPosition(X-dleft,ActualPosition.Y);
   doleft := true;
   end;
   if (Top+dtop)=Round((Top+dtop)/MagneticGridSize)*MagneticGridSize then begin
   Top := Top + dtop;
   Height := Height - dtop;
   SetActualPosition(ActualPosition.X,Y-dtop);
   dotop := true;
   end;
   end;

   if assigned(ObjectMover) then begin
   if doleft then TForm(ObjectMover).Left := TForm(ObjectMover).Left + dleft;
   if dotop then TForm(ObjectMover).Top := TForm(ObjectMover).Top + dtop;
   TForm(ObjectMover).BringToFront;
   end;

   if ExternalBorder then begin
   s := inttostr(tag)+','+inttostr(left+HandleWidth)+','+inttostr(top+HandleWidth)+','+inttostr(width-2*HandleWidth)+','+inttostr(height-2*HandleWidth);
   SendMessage(EventReceiver,WM_SETTEXT,0,integer(pchar(s)));
   end else begin
   s := inttostr(tag)+','+inttostr(left)+','+inttostr(top)+','+inttostr(width)+','+inttostr(height);
   SendMessage(EventReceiver,WM_SETTEXT,0,integer(pchar(s)));
   end;

   SetRegion;
   if assigned(ObjectMover) then TForm(ObjectMover).BringtoFront;
   Drag := true;

   ind := GetWindowTextLength(EventReceiver);
   SendMessage(EventReceiver, EM_SETSEL, ind, ind);
   s := ' ';
   SendMessage (EventReceiver, EM_REPLACESEL, 0, Integer(@s[1]));
   BringToFront;

   end;
   end;

   end;
   end;
  end;
  end;

end;

La suite dans le post suivant...

...suite (post 2 sur 2):

Code:: {
########################################################################################################
########################################################################################################
####################### fonctions Designer ########################################################
########################################################################################################
########################################################################################################
}
// ²fonctions_Designer²

{$define AvecObjectMover}
// créer un Designer pour un objet Panoramic individuel
function CreateDesigner(obj: integer; hnd, event: HWND; ctrl: TControl; opt: integer):integer; stdcall; export;
var
DS: TControlHandler;
OM: TObjectMover;
pi: pinteger;
begin
result := 0;
try
if not assigned(DesignerSelection) then begin
DesignerSelection := TObjectList.Create(False); // juste en prévision - pas utilisée ici !
DesignerSelectObjectsFromAnyParent := false;
end;
DS := TControlHandler.CreateNew;
DS.OnMouseMove := TDummy.DesignerMouseMove;
DS.OnMouseUp := TDummy.DesignerMouseUp;
DS.OnMouseDown := TDummy.DesignerMouseDown;
if DS.MagneticGridSize<1 then DS.MagneticGridSize := 1; // sécuriser la taille de la grille magnétique
if ctrl.ClassName='TForm' then begin // l'objet à déplacer est une FORM ?
DS.ParentWindow := GetDesktopWindow();
DS.BringToFront;
end else begin // l'objet à déplacer est un objet fenêtré
DS.ParentWindow := hnd;
DS.BringToFront;
end;
DS.EventReceiver := event; // adresse pour écrire les données
DS.Tag := obj; // mémoriser le numéro d'objet Panoramic
DS.SetExternalBorder((opt<>0)); // et configurer le Designer
DS.SetControl(ctrl); // attacher l'objet au Designer

{$ifdef AvecObjectMover}
ObjectMoverDelta := 0;
if DS.ExternalBorder then begin // bordure à l'extérieur ?
OM := TObjectMover(CreateSpecialObjectMover(DS.ParentWindow,ctrl,0,0,16,16))
end else begin // bprdire à l'intérieur
ObjectMoverDelta := HandleWidth;
OM := TObjectMover(CreateSpecialObjectMover(DS.ParentWindow,ctrl,HandleWidth,HandleWidth,16,16));
end;
OM.Designer := DS;
OM.FNonWindowObject := ctrl; // mémoriser l'objet non fenêtré
OM.DesignerMove := true; // flag "déplacer le Designer"

DS.ObjectMover := TObject(OM); // attacher l'ObjectMover au Designer
ObjectMoverDelta := 0;
{$endif}

DS.SetRegion; // redessiner le Designer (probablement obsolète...)
{$ifdef AvecObjectMover}
SetObjectMoverImage(OM,2,362,2,364); // imposer deux icônes standard
OM.Canvas.StretchDraw(Rect(0,0,16,16),OM.FNormalBMP); // et dessiner celle de l'état normal
{$endif}

result := integer(DS);
except
end;
end;
exports CreateDesigner;

function DeleteDesigner(DS: TControlHandler):integer; stdcall; export;
var
i: integer;
begin
result := integer(DS);
try
if not assigned(DS) then exit;
if DS.ClassName<>'TControlHandler' then exit;
if DS.DesignerSelectionIndex>=0 then begin // membre d'une sélection ?
{$ifdef AvecObjectMover}
DeleteObjectMover(TObjectMover(TControlHandler(DesignerSelection[DS.DesignerSelectionIndex]).ObjectMover));
{$endif}
DS.Free;
DesignerSelection[DS.DesignerSelectionIndex] := nil;
if DS.DesignerSelectionIndex=(DesignerSelection.Count-1) then DesignerSelection.Delete(i);
result := 0;
exit;
end;
{$ifdef AvecObjectMover}
DeleteObjectMover(TObjectMover(DS.ObjectMover));
DS.ObjectMover := nil;
{$endif}
DS.free;
result := 0;
except
end;
end;
exports DeleteDesigner;

// créer un Designer pour un objet Panoramic inclus dans la sélection multiple
function CreateSelectedDesigner(obj: integer; hnd, event: HWND; ctrl: TControl; opt: integer):integer; stdcall; export;
var
DS: TControlHandler;
OM: TObjectMover;
pi: pinteger;
i: integer;
begin
result := 0;
try
if not assigned(DesignerSelection) then begin
DesignerSelection := TObjectList.Create(False); // juste en prévision - pas utilisée ici !
DesignerSelectObjectsFromAnyParent := false;
end;
if not DesignerSelectObjectsFromAnyParent then begin
if DesignerSelection.Count>0 then begin
for i:=0 to DesignerSelection.Count-1 do begin
if assigned(DesignerSelection[i]) then begin
if TControlHandler(DesignerSelection[i]).Control.Parent<>ctrl.Parent then exit
else break;
end;
end;
end;
end;
DS := TControlHandler.CreateNew;
DS.OnMouseMove := TDummy.DesignerMouseMove;
DS.OnMouseUp := TDummy.DesignerMouseUp;
DS.OnMouseDown := TDummy.DesignerMouseDown;
if DS.MagneticGridSize<1 then DS.MagneticGridSize := 1; // sécuriser la taille de la grille magnétique
if ctrl.ClassName='TForm' then begin // l'objet à déplacer est une FORM ?
DS.ParentWindow := GetDesktopWindow();
DS.BringToFront;
end else begin // l'objet à déplacer est un objet fenêtré
DS.ParentWindow := hnd;
DS.BringToFront;
end;
DS.EventReceiver := event; // adresse pour écrire les données
DS.Tag := obj; // mémoriser le numéro d'objet Panoramic
DS.SetExternalBorder((opt<>0)); // et configurer le Designer
DS.SetControl(ctrl); // attacher l'objet au Designer

{$ifdef AvecObjectMover}
ObjectMoverDelta := 0;
if DS.ExternalBorder then begin // bordure à l'extérieur ?
OM := TObjectMover(CreateSpecialObjectMover(DS.ParentWindow,ctrl,0,0,16,16))
end else begin // bprdire à l'intérieur
ObjectMoverDelta := HandleWidth;
OM := TObjectMover(CreateSpecialObjectMover(DS.ParentWindow,ctrl,HandleWidth,HandleWidth,16,16));
end;
OM.Designer := DS;
OM.FNonWindowObject := ctrl; // mémoriser l'objet non fenêtré
OM.DesignerMove := true; // flag "déplacer le Designer"

DS.ObjectMover := TObject(OM); // attacher l'ObjectMover au Designer
ObjectMoverDelta := 0;
{$endif}

DS.SetRegion; // redessiner le Designer (probablement obsolète...)
{$ifdef AvecObjectMover}
SetObjectMoverImage(OM,2,362,2,364); // imposer deux icônes standard
OM.Canvas.StretchDraw(Rect(0,0,16,16),OM.FNormalBMP); // et dessiner celle de l'état normal
{$endif}

result := integer(DS); // retourner le Designer
if DesignerSelection.Count>0 then begin // est-ce qu'on a déjà des designers ?
for i:=0 to DesignerSelection.Count-1 do begin // alors parcourir la liste
if not assigned(DesignerSelection[i]) then begin // est-ce un slot libre ?
DesignerSelection[i] := DS; // alors utiliser ce slot pour mémoriser le designer
DS.DesignerSelectionIndex := i; // et son indice
exit;
end;
end;
end;
DesignerSelection.Add(DS); // ajouter le Designer à la sélection
DS.DesignerSelectionIndex := DesignerSelection.Count-1; // et mémoriser son indice
except
end;
end;
exports CreateSelectedDesigner;

function CreateDesignerSelection(act: integer):integer; stdcall; export;
var
i: integer;
begin
result := -1;
try
if not assigned(DesignerSelection) then begin
DesignerSelection := TObjectList.Create(False);
DesignerSelectObjectsFromAnyParent := false;
end;
if act<>0 then begin // faut-il annuler une sélection existante ?
if DesignerSelection.Count>0 then begin // est-ce qu'il y a une sélection en cours ?
for i:= DesignerSelection.Count-1 downto 0 do begin // boucle sur les objets sélectionnés
if Assigned(DesignerSelection[i]) then begin
if assigned(DesignerSelection[i]) then DeleteDesigner(TControlHandler(DesignerSelection[i])); // supprimer un Designer individuel
DesignerSelection.Delete(i); // et enlever de la liste
end;
end;
end;
end;
result := DesignerSelection.Count;
except
end;
end;
exports CreateDesignerSelection;

// gérer les fonctions étendues du designer
// act: 0 = retourner le designer de l'objet dans la sélection mutiple (0=pas de sélection multiple)
// 1 = retourner l'indice du designer de l'objet dans la sélection multiple (-1=pas de sélection multiple)
// 2 = retourner le code Panoramic de construction pour les objets en multi-sélection (opt%=handle(memo%))
// 3 = retourner la liste des objets sélectionnés dans un memo
// 4 = autoriser ou non la sélection multiple d'objets de parents différents
// 5 = définir la taille de la grille magnétique ( <1 ==> 1)
// 6 = aligner tous les objets sélectionnés sur le premier objet sélectionné (multi-sélection)
// par=1: à gauche par=2: en haut par=3: à droite par=4: en bas
// 7 = ajuster la position du ObjectMover associé
// 8 = ../..
function DesignerFunction(act, obj: integer; hnd, event: HWND; ctrl: TControl; opt: integer):integer; stdcall; export;
var
i, x, y, xch, ych, wch, hch, delta1, delta2, ind: integer;
s, s1, sno: string;
present: boolean;
multi: boolean;
OM: TObjectMover;
pos: TPoint;
DS: TControlHandler;
sleft, stop, swidth, sheight: string;

procedure GetControlCoordinates(ctrl: TControl; var sleft,stop: string);
var
pi: pinteger;
v: integer;
begin
sleft := inttostr(Left(ctrl));
stop := inttostr(Top(ctrl));
end;

procedure GetControlDimensions(ctrl: TControl; var swidth,sheight: string);
var
pi: pinteger;
v: integer;
begin
swidth := inttostr(Width(ctrl));
sheight := inttostr(Height(ctrl));
{ pi := pinteger(integer(ctrl)+oWidth); // pointer sur WIDTH
swidth := inttostr(pi^);
inc(pi);
sheight := inttostr(pi^); }
end;

begin
result := -1;
try
if not assigned(DesignerSelection) then begin
DesignerSelection := TObjectList.Create(false);
DesignerSelectObjectsFromAnyParent := false;
end;
case act of
0: begin
result := 0;
if DesignerSelection.Count=0 then exit;
for i:=0 to DesignerSelection.Count-1 do begin
if assigned(DesignerSelection[i]) then begin
if TControlHandler(DesignerSelection[i]).Control=ctrl then begin
result := integer(DesignerSelection[i]);
exit;
end;
end;
end;
exit;
end;
1: begin
if DesignerSelection.Count=0 then exit;
for i:=0 to DesignerSelection.Count-1 do begin
if assigned(DesignerSelection[i]) then begin
if TControlHandler(DesignerSelection[i]).Control=ctrl then begin
result := i;
exit;
end;
end;
end;
exit;
end;
2: begin
s := '';
SendMessage(opt,WM_SETTEXT,0,LPARAM(integer(@s[1])));
if DesignerSelection.Count=0 then exit;
for i:=0 to DesignerSelection.Count-1 do begin
DS := TControlHandler(DesignerSelection[i]);
s1 := DS.Control.ClassName;
sno := inttostr(DS.Tag);
GetControlCoordinates(DS.Control,sleft,stop);
if s1='TLabel' then begin
s := s + 'alpha '+sno + ' : left '+sno+','+sleft+' : top '+sno+','+stop + #13#10;
end;
if s1='TImage' then begin
GetControlDimensions(DS.Control,swidth,sheight);
s := s + 'picture '+sno + ' : left '+sno+','+sleft+' : top '+sno+','+stop +
' : width '+sno+','+swidth+' : height '+sno+','+sheight + #13#10;
end;
if s1='TButton' then begin
GetControlDimensions(DS.Control,swidth,sheight);
s := s + 'button '+sno + ' : left '+sno+','+sleft+' : top '+sno+','+stop +
' : width '+sno+','+swidth+' : height '+sno+','+sheight + #13#10;
end;
if s1='TCheckBox' then begin
GetControlDimensions(DS.Control,swidth,sheight);
s := s + 'check '+sno + ' : left '+sno+','+sleft+' : top '+sno+','+stop +
' : width '+sno+','+swidth+' : height '+sno+','+sheight + #13#10;
end;
if s1='TRadioButton' then begin
GetControlDimensions(DS.Control,swidth,sheight);
s := s + 'option '+sno + ' : left '+sno+','+sleft+' : top '+sno+','+stop +
' : width '+sno+','+swidth+' : height '+sno+','+sheight + #13#10;
end;
if s1='TComboBox' then begin
GetControlDimensions(DS.Control,swidth,sheight);
s := s + 'combo '+sno + ' : left '+sno+','+sleft+' : top '+sno+','+stop +
' : width '+sno+','+swidth+' : height '+sno+','+sheight + #13#10;
end;
if s1='TGroupBox' then begin
GetControlDimensions(DS.Control,swidth,sheight);
s := s + 'container '+sno + ' : left '+sno+','+sleft+' : top '+sno+','+stop +
' : width '+sno+','+swidth+' : height '+sno+','+sheight + #13#10;
end;
if s1='TRadioGroup' then begin
GetControlDimensions(DS.Control,swidth,sheight);
s := s + 'container_option '+sno + ' : left '+sno+','+sleft+' : top '+sno+','+stop +
' : width '+sno+','+swidth+' : height '+sno+','+sheight + #13#10;
end;
if s1='TPageControl' then begin
GetControlDimensions(DS.Control,swidth,sheight);
s := s + 'container_tab '+sno + ' : left '+sno+','+sleft+' : top '+sno+','+stop +
' : width '+sno+','+swidth+' : height '+sno+','+sheight + #13#10;
end;
if s1='TEdit' then begin
GetControlDimensions(DS.Control,swidth,sheight);
s := s + 'edit '+sno + ' : left '+sno+','+sleft+' : top '+sno+','+stop +
' : width '+sno+','+swidth+' : height '+sno+','+sheight + #13#10;
end;
if s1='Form' then begin
GetControlDimensions(DS.Control,swidth,sheight);
s := s + 'form '+sno + ' : left '+sno+','+sleft+' : top '+sno+','+stop +
' : width '+sno+','+swidth+' : height '+sno+','+sheight + #13#10;
end;
if s1='TStringGrid' then begin
GetControlDimensions(DS.Control,swidth,sheight);
s := s + 'grid '+sno + ' : left '+sno+','+sleft+' : top '+sno+','+stop +
' : width '+sno+','+swidth+' : height '+sno+','+sheight + #13#10;
end;
if s1='TPaintPanel' then begin
GetControlDimensions(DS.Control,swidth,sheight);
s := s + 'hviewer '+sno + ' : left '+sno+','+sleft+' : top '+sno+','+stop +
' : width '+sno+','+swidth+' : height '+sno+','+sheight + #13#10;
end;
if s1='TListBox' then begin
GetControlDimensions(DS.Control,swidth,sheight);
s := s + 'list '+sno + ' : left '+sno+','+sleft+' : top '+sno+','+stop +
' : width '+sno+','+swidth+' : height '+sno+','+sheight + #13#10;
end;
if s1='TMemo' then begin
GetControlDimensions(DS.Control,swidth,sheight);
s := s + 'memo '+sno + ' : left '+sno+','+sleft+' : top '+sno+','+stop +
' : width '+sno+','+swidth+' : height '+sno+','+sheight + #13#10;
end;
if s1='TAnimate' then begin
GetControlDimensions(DS.Control,swidth,sheight);
s := s + 'movie '+sno + ' : left '+sno+','+sleft+' : top '+sno+','+stop +
' : width '+sno+','+swidth+' : height '+sno+','+sheight + #13#10;
end;
if s1='TPanel' then begin
GetControlDimensions(DS.Control,swidth,sheight);
s := s + 'panel '+sno + ' : left '+sno+','+sleft+' : top '+sno+','+stop +
' : width '+sno+','+swidth+' : height '+sno+','+sheight + #13#10;
end;
if s1='TProgressBar' then begin
GetControlDimensions(DS.Control,swidth,sheight);
s := s + 'progress_bar '+sno + ' : left '+sno+','+sleft+' : top '+sno+','+stop +
' : width '+sno+','+swidth+' : height '+sno+','+sheight + #13#10;
end;
if s1='TSpriteBox' then begin
GetControlDimensions(DS.Control,swidth,sheight);
s := s + 'scene2d '+sno + ' : left '+sno+','+sleft+' : top '+sno+','+stop +
' : width '+sno+','+swidth+' : height '+sno+','+sheight + #13#10;
end;
if s1='TGLSceneViewer' then begin
GetControlDimensions(DS.Control,swidth,sheight);
s := s + 'scene3d '+sno + ' : left '+sno+','+sleft+' : top '+sno+','+stop +
' : width '+sno+','+swidth+' : height '+sno+','+sheight + #13#10;
end;
if s1='TScrollBar' then begin
GetControlDimensions(DS.Control,swidth,sheight);
s := s + 'scroll_bar '+sno + ' : left '+sno+','+sleft+' : top '+sno+','+stop +
' : width '+sno+','+swidth+' : height '+sno+','+sheight + #13#10;
end;
if s1='TSprinEdit' then begin
GetControlDimensions(DS.Control,swidth,sheight);
s := s + 'spin '+sno + ' : left '+sno+','+sleft+' : top '+sno+','+stop +
' : width '+sno+','+swidth+' : height '+sno+','+sheight + #13#10;
end;
if s1='TTabsheet' then begin
GetControlDimensions(DS.Control,swidth,sheight);
s := s + 'tab '+sno + ' : left '+sno+','+sleft+' : top '+sno+','+stop +
' : width '+sno+','+swidth+' : height '+sno+','+sheight + #13#10;
end;
if s1='TTRackBar' then begin
GetControlDimensions(DS.Control,swidth,sheight);
s := s + 'track_bar '+sno + ' : left '+sno+','+sleft+' : top '+sno+','+stop +
' : width '+sno+','+swidth+' : height '+sno+','+sheight + #13#10;
end;
end;
SendMessage(opt,WM_SETTEXT,0,LPARAM(integer(@s[1])));
end;
3: begin
SendMessage(hnd, LB_RESETCONTENT,0, 0);
if DesignerSelection.Count>0 then begin
for i:=0 to DesignerSelection.Count-1 do begin
if assigned(DesignerSelection[i]) then s := inttostr(integer(TControlHandler(DesignerSelection[i]).Control))
else s := '../..';
SendMessage(hnd, LB_ADDSTRING,0, integer(pchar(s)));
end;
end;
SendMessage(hnd,WM_SETTEXT,0,integer(pchar(s)));
end;
4: begin
DesignerSelectObjectsFromAnyParent := (opt<>0);
end;
5: begin
if opt<1 then TControlHandler(obj).MagneticGridSize := 1
else TControlHandler(obj).MagneticGridSize := opt;
end;
6: begin
if (opt<1) or (opt>7) then exit;
if DesignerSelection.Count>1 then begin
xch := TControlHandler(DesignerSelection[0]).Left;
ych := TControlHandler(DesignerSelection[0]).Top;
wch := TControlHandler(DesignerSelection[0]).Width;
hch := TControlHandler(DesignerSelection[0]).Height;
if TControlHandler(DesignerSelection[0]).ExternalBorder then begin
x := xch + HandleWidth;
y := ych + HandleWidth;
delta1 := HandleWidth;
delta2 := 2*HandleWidth;
end else begin
xch := x;
ych := y;
delta1 := 0;
delta2 := 0;
end;
s := '';
for i:=1 to DesignerSelection.Count-1 do begin
if assigned(DesignerSelection[i]) then begin
case opt of
1: begin // aligner à gauche
TControlHandler(DesignerSelection[i]).Left := xch;
with TControlHandler(DesignerSelection[i]) do
s := s + inttostr(tag)+','+inttostr(x)+','+inttostr(top+delta1)+','+inttostr(width-delta2)+','+inttostr(height-delta2)+#13#10;
end;
2: begin // aligner en haut
TControlHandler(DesignerSelection[i]).Top := ych;
with TControlHandler(DesignerSelection[i]) do
s := s + inttostr(tag)+','+inttostr(left)+','+inttostr(y)+','+inttostr(width-delta2)+','+inttostr(height-delta2)+#13#10;
end;
3: begin // aligner droite
TControlHandler(DesignerSelection[i]).Left := xch+TControlHandler(DesignerSelection[0]).Width-TControlHandler(DesignerSelection[i]).Width;
with TControlHandler(DesignerSelection[i]) do
s := s + inttostr(tag)+','+inttostr(x+TControlHandler(DesignerSelection[0]).Control.Width-TControlHandler(DesignerSelection[i]).Control.Width)+','+inttostr(top+delta1)+','+inttostr(width-delta2)+','+inttostr(height-delta2)+#13#10;
end;
4: begin // aligner en bas
TControlHandler(DesignerSelection[i]).Top := ych+TControlHandler(DesignerSelection[0]).Height-TControlHandler(DesignerSelection[i]).Height;
with TControlHandler(DesignerSelection[i]) do
s := s + inttostr(tag)+','+inttostr(left+delta1)+','+inttostr(top+TControlHandler(DesignerSelection[0]).Height-TControlHandler(DesignerSelection[i]).Height)+','+inttostr(width-delta2)+','+inttostr(height-delta2)+#13#10;
end;
5: begin // aligner en largeur
TControlHandler(DesignerSelection[i]).Width := wch;
TControlHandler(DesignerSelection[i]).SetRegion;
with TControlHandler(DesignerSelection[i]) do
s := s + inttostr(tag)+','+inttostr(left+delta1)+','+inttostr(top+delta1)+','+inttostr(wch-delta2)+','+inttostr(height-delta2)+#13#10;
end;
6: begin // aligner en hauteur
TControlHandler(DesignerSelection[i]).Height := hch;
TControlHandler(DesignerSelection[i]).SetRegion;
with TControlHandler(DesignerSelection[i]) do
s := s + inttostr(tag)+','+inttostr(left+delta1)+','+inttostr(top+delta1)+','+inttostr(width-delta2)+','+inttostr(hch-delta2)+#13#10;
end;
7: begin // aligner en largeur et hauteur
TControlHandler(DesignerSelection[i]).Width := wch;
TControlHandler(DesignerSelection[i]).Height := hch;
TControlHandler(DesignerSelection[i]).SetRegion;
with TControlHandler(DesignerSelection[i]) do begin
s := s + inttostr(tag)+','+inttostr(left+delta1)+','+inttostr(top+delta1)+','+inttostr(wch-delta2)+','+inttostr(height-delta2)+#13#10;
s := s + inttostr(tag)+','+inttostr(left+delta1)+','+inttostr(top+delta1)+','+inttostr(width-delta2)+','+inttostr(hch-delta2)+#13#10;
end;
end;
end;
end;
end;
if length(s)>0 then begin
with TControlHandler(DesignerSelection[0]) do begin
SendMessage(EventReceiver,WM_SETTEXT,0,integer(pchar(s)));
ind := GetWindowTextLength(EventReceiver);
SendMessage(EventReceiver, EM_SETSEL, ind, ind);
s := ' ';
SendMessage (EventReceiver, EM_REPLACESEL, 0, Integer(@s[1]));
// générer aussi un ON_USER_EVENT !
end;
end;
end;
end;
7: begin
// showmessage(inttostr(obj)+'='+ctrl.ClassName+' indice='+inttostr(opt));
if assigned(TControlHandler(DesignerSelection[opt-1]).ObjectMover) then begin
OM := TObjectMover(TControlHandler(DesignerSelection[opt-1]).ObjectMover);
pos := OM.ParentWindowOffset;
OM.Left := TControlHandler(DesignerSelection[opt-1]).Left + HandleWidth + pos.X;
OM.Top := TControlHandler(DesignerSelection[opt-1]).Top + HandleWidth + pos.Y;
end;
end;
8: begin
// à faire !
end;
end;
result := 0;
except
end;
end;
exports DesignerFunction;

{
########################################################################################################
########################################################################################################
####################### fonctions ObjectMover #####################################################
########################################################################################################
########################################################################################################
}
// ²fonctions_ObjectMover²

// création de l'objet ObjectMover
// act: 0=(tp,lft) 1=top left 2=top right 3=bottom right 4=bottom left
function CreateObjectMover(hdest: HWND; act,lft,tp,w,h: integer):integer; stdcall; export;
var
OM: TObjectMover;
r: TRect;
t, l, w0, h0, d: integer;
begin
result := 0; // initialement: objet non créé
d := 0;
Windows.GetClientRect(hdest,r); // dimensions de l'objet recevant ObjectMover
ClientToScreen(hdest,r.TopLeft);
ClientToScreen(hdest,r.BottomRight);

if w=0 then w0 := 16 else w0 := w; // largeur imposée ou 16 pixels si non spécifiée
if h=0 then h0 := 16 else h0 := h; // hauteur imposée ou 16 pixels si non spécifiée
d := ObjectMoverDelta; // zéro par défaut. Peut être chargée avec HandleWidth si Designer intérieur !
// définir top et left en fonction du code action
case act of
0: begin // (x,y)
t := tp+d + r.Top;
l := lft+d + r.Left;
end;
1: begin // top left
t := 0+d + r.Top;
l := 0+d + r.Left;
end;
2: begin // top right
t := 0+d + r.Top;
l := r.Right-w0-d + r.Left;
end;
3: begin // bottom right
t := r.Bottom-h0-d + r.Top;
l := r.Right-w0-d + r.Left;
end;
4: begin // bottom left
t := r.Bottom-h0-d + r.Top;
l := 0+d + r.Left;
end;
end;
// création effective de l'objet
OM := TObjectMover.CreateNew(nil,hdest,point(l,t),point(w0,h0),nil);
with OM do begin
show;
// créer l'image par défaut de l'état normal - un carré rouge
FNormalBMP := TBitMap.Create;
With FNormalBMP do begin
width := 16;
height := 16;
Canvas.Brush.Color := clRed;
Canvas.FillRect(Rect(0,0,16,16));
end;
// créer l'image par défaut de l'état activé - un carré jaune
FActiveBMP := TBitMap.Create;
With FActiveBMP do begin
width := 16;
height := 16;
Canvas.Brush.Color := clYellow;
Canvas.FillRect(Rect(0,0,16,16));
end;
if integer(SetWindowPos(Handle,HWND_TOPMOST,0,0,0,0,SWP_NOSIZE or SWP_NOMOVE or SWP_SHOWWINDOW))=0 then
showmessage(SysErrorMessage(GetLastError));
Canvas.StretchDraw(Rect(0,0,w,h),NormalBMP); // dessiner l'image de l'état normal
UserEventData := 0; // initialement, pas de lien vers le tableau de 4 mots
paint;
OnMouseDown := TObjectMover.ControlMouseDown; // imposer les routines évènement de gestion de la souris
onMouseMove := TObjectMover.ControlMouseMove;
OnMouseUp := TObjectMover.ControlMouseUp;
end;
result := integer(OM); // et retourner l'objet ObjectMover en cas de réussite
end;
exports CreateObjectMover;

function ObjectMoverTarget(OM: TObjectMover; Target: HWND):integer; stdcall; export;
begin
result := -1;
try
OM.FMoveHostParent := Target;
result := 0;
except
end;
end;
exports ObjectMoverTarget;

// mémoriser l'adresse de début d'un tableau de 4 entiers, pour retourner des informations sur MouseDown et MouseUp
function SetObjectMoverUserEvent(OM: TObjectMover; ptr: integer):integer; stdcall; export;
begin
result := -1;
try
if not assigned(OM) then exit; // ObjectMover non créé ?
OM.UserEventData := ptr;
result := 0;
except
end;
end;
exports SetObjectMoverUserEvent;

// création de l'objet ObjectMover
// act: 0=(tp,lft) 1=top left 2=top right 3=bottom right 4=bottom left
function CreateSpecialObjectMover(hdest: HWND; obj: TObject; lft,tp,w,h: integer):integer; stdcall; export;
var
OM: TObjectMover;
t, l, w0, h0, d: integer;
pi: pinteger;
pos: TPoint;
rct, rr: TRect;
begin
result := 0; // initialement: objet non créé
d := 0;
// if (obj.ClassName<>'TLabel') and (obj.ClassName<>'TImage') then exit; // pas un objet non fenêtré ?
d := ObjectMoverDelta; // zéro par défaut. Peut être chargée avec HandleWidth si Designer intérieur !
if w=0 then w0 := 16 else w0 := w; // largeur imposée ou 16 pixels si non spécifiée
if h=0 then h0 := 16 else h0 := h; // hauteur imposée ou 16 pixels si non spécifiée
GetWindowRect(hdest,rct); // prendre le rectangle du hébergeur
pos := Point(0,0);
Windows.ClientToScreen(hdest,pos);

// définir top et left: toujour en haut à gauche de l'objet non-Windows
pi := pinteger(integer(obj)+oLeft); // pointer sur la valeur de LEFT
l := pi^ + d; // récupérer la valeur de LEFT
inc(pi); // pointer sur la valeur de TOP
t := pi^ + d; // récupérer la valeur de TOP
// création effective de l'objet

OM := TObjectMover.CreateNew(nil,hdest,point(l+pos.X,t+pos.Y),point(16,16),obj); // créer l'ObjectMover
OM.Delta := ObjectMoverDelta;
OM.ParentWindowOffset := pos;

with OM do begin
show; // afficher
// créer l'image par défaut de l'état normal - un carré rouge
FNormalBMP := TBitMap.Create;
With FNormalBMP do begin
width := 16;
height := 16;
Canvas.Brush.Color := clRed;
Canvas.FillRect(Rect(0,0,16,16));
end;
// créer l'image par défaut de l'état activé - un carré jaune
FActiveBMP := TBitMap.Create;
With FActiveBMP do begin
width := 16;
height := 16;
Canvas.Brush.Color := clYellow;
Canvas.FillRect(Rect(0,0,16,16));
end;
Show;
Canvas.StretchDraw(Rect(0,0,w,h),NormalBMP); // dessiner l'image de l'état normal
UserEventData := 0; // initialement, pas de lien vers le tableau de 4 mots
BringToFront; // mettre l'ObjectMover en avant
paint; // et dessiner
OnMouseDown := TObjectMover.ControlMouseDown; // imposer les routines évènement de gestion de la souris
onMouseMove := TObjectMover.ControlMouseMove;
OnMouseUp := TObjectMover.ControlMouseUp;
end;

result := integer(OM); // et retourner l'objet ObjectMover en cas de réussite
end;
exports CreateSpecialObjectMover;

// charger les deux images possibles (état normal et actif)
function SetObjectMoverImage(OM: TObjectMover; NormalTyp, NormalImg, ActiveTyp, ActiveImg: integer):integer; stdcall; export;
var
w, h: integer;
begin
result := -1; // supposer échec
try
if not assigned(OM) then exit; // ObjectMover non créé ?
w := OM.Width - 1; // récupérer ses dimensions
h := OM.Height - 1;
// charger l'image de l'état normal (laisser inchangé si zéro !), et dessiner de suite
case NormalTyp of
1: begin // presse-papier
OM.SetNormalBMPFromClipboard();
end;
2: begin // icône interne
OM.SetNormalImageFromIcon(NormalImg);
end;
3: begin // fichier image externe
if NormalImg<>0 then begin
OM.SetNormalImageFromFile(NormalImg);
end;
end;
else exit;
end;
// charger l'image de l'état actif (laisser inchangé si zéro !), ne pas dessiner
case ActiveTyp of
1: begin // presse-papier
OM.SetActiveBMPFromClipboard();
end;
2: begin // icône interne
OM.SetActiveImageFromIcon(ActiveImg);
end;
3: begin // fichier image externe
if ActiveImg<>0 then begin
OM.SetActiveImageFromFile(ActiveImg);
end;
end;
else exit;
end;
result := 0; // résultat ok
except
end;
end;
exports SetObjectMoverImage;

// supprimer un objet ObjectMover
function DeleteObjectMover(OM: TObjectMover):integer; stdcall; export;
begin
result := 0;
if not assigned(OM) then exit; // cet objet n'exise pas ? abandon !

OM.DesignerHost := nil;
OM.fNonWindowObject := nil;

// supprimer les images d'abord, par sécurité
OM.FNormalBMP.Dormant;
OM.FNormalBMP.FreeImage;
OM.FNormalBMP.ReleaseHandle;
OM.FActiveBMP.Dormant;
OM.FActiveBMP.FreeImage;
OM.FActiveBMP.ReleaseHandle;

OM.Close;
OM.Destroy;
end;
exports DeleteObjectMover;

J'ai pris par un rapide survol ce qui me semblait correspondre. Si une fonction manque, dis-le moi et je posterai les modules oubliés.

Bonjour à tous !

Absent quelques jours et de retour du mariage de ma fille à Toulouse, j’ai la joie de découvrir les messages de Klaus ! cheers

Je suis très content de pouvoir te lire à nouveau de te savoir en bonne santé ! cheers

Pour en revenir à ce que disait jean_debord concernant PanEdi, il faut savoir que GPP est toujours en téléchargement sur le lien suivant :

http://gpp.panoramic.free.fr/Files/Other/setup_GPP_alpha_0-69-5.exe

Ou bien sur My Drive
Identifiant : panoramic@minibug
Mot de passe : panoramic123

Si cela intéresse quelqu'un, le programme est complet mais pas très stable et trop compliqué à déboguer. D’où son arrêt.
Par contre il peut être utile pour décortiquer l'usage de la DLL de Klaus. En particulier par la sélection des objets.

Donc jean_debord si cela t'intéresse n'hésites pas a regarder, tester et même prendre des idées... Wink

Oui j'avais regardé le code de GPP mais il était effectivement trop complexe par rapport aux possibilités de FBPano donc je m'étais plutôt tourné vers PanEdi qui est plus facile à adapter.

Mais c'est vrai que le redimensionnement et le déplacement des objets sont limités dans PanEdi et qu'il faudrait ajouter un système de "drag and drop" avec des poignées de redimensionnement. Théoriquement, c'est faisable avec FLTK (pour le "drag and drop", voir l'exemple ex85 de FBPano)

Je n'ai pas encore pris de décision à ce sujet. Pour l'instant je me limite à faire de petits programmes pour générer automatiquement les instructions relatives aux objets FLTK, sachant que la syntaxe va évoluer dans FBCroco par rapport à FBPano.

Je vous tiendrai au courant de mes progrès dans le forum consacré au "Crocodile Basic".

Citation :: ...il faudrait ajouter un système de "drag and drop" avec des poignées de redimensionnement.

C'est justement ce que font mon objet Designer. Tu trouveras la documentation ici:
https://klauspanoramic.000webhostapp.com/ObjetDesigner.html#Designer_fr

C'est exactement ce que tu cherches, et j'avais posté le code (que j'espère complet) il y a quelues jours. Un cadre avec pignées autour de n'importe quel objet visuel de Panoramic, déplaçable et dimensionnable à l'aide de poignées.

Cet objet est essentiellement une TForm Windows évidée d'un rectangle dans son centre via les APIs de régions Windows, dans laquelle je déssine le cadre et les poignées et qui intercepte les évèments souris pour réaliser le drag-and-drop.

Sujet: Re: Je suis de retour ! Sam 31 Oct 2020 - 10:27

Je suis de retour, à nouveau !

Oui, ces derniers temps, j'ai eu de longues périodes d'absence, pour des raisons diverses. Cela pourra encore se produire dans les prochains temps.

Depuis cet été, j'ai eu de gros problèmes aux yeux, et j'ai décidé de me faire soigner en priorité. Ca va mieux, malgré une perte presque totale d'un oeuil, mais le problème est stabilisé et le traitement continue. J'ai donc recommencé à programmer, et je viens de publier une nouvelle version de KGF.dll avec une petite fonction de service qui m'a rendu de fiers services.

Je travaille en parallèle sur un autre projet; hors Panoramic mais en Delphi pur. Ca avance bien, et j'en parlerai prochainement.

Sujet: Re: Je suis de retour ! Sam 31 Oct 2020 - 10:31

Bonjour Klaus !

Très heureux de te retrouver parmi nous.

Je te souhaite un bon rétablissement et bon retour sur Panoramic ! Wink

Sujet: Re: Je suis de retour ! Sam 31 Oct 2020 - 19:11

Bonjour Klaus !

Je suis très content de te voir de retour et pouvoir te lire à nouveau.

Courage à toi et bonne continuation !

» Je suis de retour
» Je suis de retour.
» Le suis je ou pas ?
» Où j'en suis ...
» Colisions 2d