L'éditeur a été remanié

{
  Cette unité crée l'objet ObjectMover. Il peut être injecté dans n'importe quel objet fenêtré. Il réagit alors
  comme une barre de titre d'un ojtt FORM permettant de déplacer l'objet qui l'héberge, en le tirant par la souris.
  Par défaut, sa taille est de 16x16 pixels, mais elle est paramétrable.

  Cet objet a deux états distincts: normal et actif. L'état est actif si l'objet est accroché par la souris pour effectuer un
  déplacement  et redevient normal en relâchant l'objet. L'image par défaut de l'état noirmal est un carré rouge, et celle
  de l'état actif est un carr" jaune, mais on peut lui charger une icône interne à KGF.dll ou une bitmap externe, ou encore
  une mage du presse-papier. L'icône interne 362 est bien adaptée à cet usage. L'image sera automatiquement ajustée aux
  dimensions réelles de l'ObjectMover, mais attention aux déformations !

  On peut dimensionner cet objet de sorte à obtenir une barre le long d'un des 4 côtés de l'objet hébergeant, créant ainsi
  un semblant de barre de titre ou d'outils, réagissante aux manipulation par la souris. On peut bien entendu placer des objets
  visuels par-dessus.

  Lors d'un début et d'une fin de déplacement, un USER_EVENT est déclenché.
  Ceci est fait par l'envoi d'un message WM_USER+3000 à la form 0, avec les informations suivantes:
    LParam:  LowWord(LParam)  = 1 signifie ObjectMoverEvent
            HighWord(LParam) = 1 signifie Start moving
            HighWord(LParam) = 2 signifie Stop moving
    Wparam:  LowWord(WParam)  = x contient l'abscisse
            HighWord(WParam) = y contient l'ordonnée

  ATTENTION ! A cause d'une inversion de USER_EVENT_LPARAM et USER_EVENT_WPARAM dans Panoramic, il faudra inverser
              ces valeurs dans ma présente unité lorsque ce bug sera corrigé !             
}
unit KGF_unit_ObjectMover;

interface
  uses
    Windows, Messages, Forms, Classes, Clipbrd, ImgList, SysUtils, Graphics, Controls, Dialogs,
    KGF_unit_data      // unité contenant la variable globale MainFormHandle: HWND;  <= handle de la form 0
    ;

// 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
    // 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);
//  protected
  public
    constructor CreateNew(AOwner: TComponent; ADestination: HWND; ALocation, ADimension: TPoint); //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 OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;

const
  USER_EVENT_Message              = WM_USER + 3000;
  UserEventOrigin_ObjectMover      = $00000001;
  UserEventAction_ObjectMover_Down = $00010000;
  UserEventAction_ObjectMover_Up  = $00020000;
  ID_MouseDown                    = UserEventOrigin_ObjectMover or UserEventAction_ObjectMover_Down;  // $00010001
  ID_MouseUp                      = UserEventOrigin_ObjectMover or UserEventAction_ObjectMover_Up;    // $00020001

implementation

// 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
  FM: TObjectMover;
  r: TRect;
  t, l, w0, h0: integer;
begin
  result := 0;                          // initialement: objet non créé
  Windows.GetClientRect(hdest,r);        // dimensions de l'objet recevant ObjectMover
  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éfinir top et left en fonction du code action
  case act of
    0: begin            // (x,y)
        t := tp;
        l := lft;
      end;
    1: begin            // top left
        t := 0;
        l := 0;
      end;
    2: begin            // top right
        t := 0;
        l := r.Right-w0;
      end;
    3: begin            // bottom right
        t := r.Bottom-h0;
        l := r.Right-w0;
      end;
    4: begin            // bottom left
        t := r.Bottom-h0;
        l := 0;
      end;
  end;
  // création effective de l'objet
  FM := TObjectMover.CreateNew(nil,hdest,point(l,t),point(w0,h0));
  with FM 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;
    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(FM);                                  // et retourner l'objet ObjectMover en cas de réussite
end;

// 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.FNormalBMP.Free;                  // supprimer les images d'abord, par sécurité
  OM.FActiveBMP.Free;
  OM.Free;                            // et supprimer ObjectMover
end;

// routine interne de service, pour récupérer la bitmap associée à une icône interne à KGF.dll
function GetInternalIcon(i: integer):TBitMap;
var
  imglist: TImageList;

  procedure ExtractResToFile(ResType, ResName, ResNewName : String);
  var
    Res : TResourceStream;
  begin
    Res := TResourceStream.Create(Hinstance, Resname, Pchar(ResType));
    Res.SavetoFile(ResNewName);
    Res.Free;
  end;

begin
  ExtractResToFile('DATAFILE','TOOLBAR_ICONS','.\KGF_temp.ilb');  // récupérer le fichier ilb
  imglist := TImageList.Create(nil);      // créer une imagelist temporaire
  imglist.DrawingStyle := dsTransparent;
  imglist.BkColor := clBtnFace;
  imglist.Height := 16;
  imglist.Width := 16;
  result := TBitMap.Create;
  result.Width := 16;
  result.Height := 16;
  ReadComponentResFile('.\KGF_temp.ilb', imglist) ;  // charger le fichier ilb dans cette liste
  if (i<1) or (i>imglist.Count) then begin
    imglist.Free;
    deletefile('.\KGF_temp.ilb');
    exit;
  end;
  imglist.GetBitmap(i-1,result);
  imglist.Free;
  deletefile('.\KGF_temp.ilb');
end;

// 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();
            OM.Canvas.StretchDraw(Rect(0,0,w,h),OM.NormalBMP);
          end;
      2: begin            // icône interne
            OM.SetNormalImageFromIcon(NormalImg);
            OM.Canvas.StretchDraw(Rect(0,0,w,h),OM.NormalBMP);
          end;
      3: begin            // fichier image externe
            if NormalImg<>0 then begin
              OM.SetNormalImageFromFile(NormalImg);
              OM.Canvas.StretchDraw(Rect(0,0,w,h),OM.NormalBMP);
            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;

// 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;

// constructeur privé de ObjectMover
constructor TObjectMover.CreateNew(AOwner: TComponent; ADestination: HWND; ALocation, ADimension: TPoint);
begin
  inherited CreateNew(AOwner);                    // créer une form normalement
  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
  Paint;
  ParentWindow := ADestination;                  // injecter O bjectMover dans l'objet ciblé
//SendMessage(MainFormHandle,WM_USER+3000,$234,$345);
end;

// suppression privée de ObjectMover
destructor TObjectMover.Destroy;
begin
  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);
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));
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;

// charger l'image de l'état normal à partir d'un fichier BMP
procedure TObjectMover.SetNormalImageFromFile(bmpfile: integer);
var
  s: string;
begin
  if bmpfile<>0 then begin
    s := pstring(bmpfile)^;
    if s='' then exit;
    if not FileExists(s) then exit;
    FNormalBMP.LoadFromFile(s);
  end;
end;

// charger l'image de l'état actif à partir d'un fichier BMP
procedure TObjectMover.SetActiveImageFromFile(bmpfile: integer);
var
  s: string;
begin
  if bmpfile<>0 then begin
    s := pstring(bmpfile)^;
    if s='' then exit;
    if not FileExists(s) then exit;
    FActiveBMP.LoadFromFile(s);
  end;
end;


// procédure privé 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;
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;
    GetWindowRect((Sender as TObjectMover).ParentWindow,r);  // prendre les coordonnées de l'objet hébergeant ObjectMover
    Canvas.StretchDraw(Rect(0,0,w,h),ActiveBMP);              // dessiner l'image de l'état actif
    fDragOrigin.X := r.Left;                                  // mémoriser le point de départ du déplacement de l'objet hébergeur
    fDragOrigin.Y := r.Top;
    FWinWidth := r.Right - r.Left + 1;                        // calculer les dimensions de ObjectMover
    FWinHeight := r.Bottom - r.Top + 1;
    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: integer;
  s: string;
  r: TRect;
begin
  with (Sender as TObjectMover) do begin
    if fmoving then begin                            // ObjectMover est actif ?
      l := X - FDownX + fDragOrigin.X;                // calculer la nouvelle position de l'hébergeur
      t := Y - FDownY + fDragOrigin.Y;
      fDragOrigin.X := l;                            // mémoriser la nouvelle position
      fDragOrigin.Y := t;
      MoveWindow((Sender as TObjectMover).ParentWindow,l,t,FWinWidth,FWinHeight,true);  // déplacer l'hébergeur
    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;




exports
  CreateObjectMover, DeleteObjectMover, SetObjectMoverImage, SetObjectMoverUserEvent
  ;

end.