Un bug avec USER_EVENT ?

{
  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.
  Par défaut, il contient un dessin représentant une cible simplifiée, 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
}
unit KGF_unit_ObjectMover;

interface
  uses
    Windows, Messages, Forms, Classes, Clipbrd, ImgList, SysUtils, Graphics, Controls, Dialogs,
    KGF_unit_data, KGF_unit_internal_procedures;

type
  TObjectMover = class(TForm)

    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
    FMoving: Boolean;
    fDragOrigin: TPoint;
    FDownX, FDownY: integer;
    FWinWidth, FWinHeight: integer;
    FUserEventData: Integer;
//  protected
  public
    constructor CreateNew(AOwner: TComponent; ADestination: HWND; ALocation, ADimension: TPoint); //override;
    destructor Destroy; override;
  published
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;

implementation

// 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;
  Windows.GetClientRect(hdest,r);
  if w=0 then w0 := 16 else w0 := w;
  if h=0 then h0 := 16 else h0 := h;
  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;
  FM := TObjectMover.CreateNew(nil,hdest,point(l,t),point(w0,h0));
  FM.FUserEventData := 0;
  FM.Show;
  FM.Canvas.FillRect(Rect(2,2,w0-3,h0-3));
  FM.Canvas.Ellipse(3,3,w0-3,h0-3);
  FM.Canvas.MoveTo(3,trunc(h0/2));
  FM.Canvas.LineTo(trunc(w0-3),trunc(h0/2));
  FM.Canvas.MoveTo(trunc(w0/2),3);
  FM.Canvas.LineTo(trunc(w0/2),h0-3);
  FM.OnMouseDown := TObjectMover.ControlMouseDown;
  FM.onMouseMove := TObjectMover.ControlMouseMove;
  FM.OnMouseUp := TObjectMover.ControlMouseUp;
  result := integer(FM);
end;

function DeleteObjectMover(OM: TObjectMover):integer; stdcall; export;
begin
  result := 0;
  if not assigned(OM) then exit;
  OM.Free;
end;

function GetInternalIcon(i: integer):TBitMap;
var
  imglist: TImageList;
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;

function SetObjectMoverImage(OM: TObjectMover; typ, img: integer):integer; stdcall; export;
var
  bm: TBitMap;
  s: string;
  w, h: integer;
begin
   result := -1;
   try
     if not assigned(OM) then exit;
     w := OM.Width - 1;
     h := OM.Height - 1;
     case typ of
       0: begin             // presse-papier
            bm := TBitMap.Create;
            bm.Assign(Clipboard);
            OM.Canvas.StretchDraw(Rect(0,0,w,h),bm);
            bm.Free
          end;
       1: begin             // icône interne
            bm := TBitMap.Create;
            bm := GetInternalIcon(img);
            OM.Canvas.StretchDraw(Rect(0,0,w,h),bm);
            bm.Free
          end;
       2: begin             // fichier image externe
            if img=0 then exit;
            s := pstring(img)^;
            if s='' then exit;
            if not FileExists(s) then exit;
            bm := TBitMap.Create;
            bm.LoadFromFile(s);
            OM.Canvas.StretchDraw(Rect(0,0,w,h),bm);
            bm.Free
          end;
     else exit;
     end;
     result := 0;
   except
   end;
end;

function SetObjectMoverUserEvent(OM: TObjectMover; ptr: integer):integer; stdcall; export;
begin
  result := -1;
  try
    if not assigned(OM) then exit;
    OM.FUserEventData := ptr;
    result := 0;
  except
  end;
end;

constructor TObjectMover.CreateNew(AOwner: TComponent; ADestination: HWND; ALocation, ADimension: TPoint);
begin
  inherited CreateNew(AOwner);
  BorderStyle := bsNone;
  SetBounds(0,0,ADimension.X,ADimension.Y);
  Top := ALocation.Y;
  Left := ALocation.X;
  color := clSilver;
  Canvas.Pen.Width := 1;
  Canvas.Pen.Color := clBlack;
  Canvas.Brush.Color := clSilver;
  Paint;
  ParentWindow := ADestination;
end;

destructor TObjectMover.Destroy;
begin
  inherited Destroy;
end;


class procedure TObjectMover.ControlMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  ind, i: integer;
  r: TRect;
  s: string;
begin
  with (Sender as TObjectMover) do begin
    FMoving := true;
    FDownX := X;
    FDownY := Y;
    GetWindowRect((Sender as TObjectMover).ParentWindow,r);
    fDragOrigin.X := r.Left;
    fDragOrigin.Y := r.Top;
    FWinWidth := r.Right - r.Left + 1;
    FWinHeight := r.Bottom - r.Top + 1;
    if FUserEventData<>0 then begin
      pinteger(FUserEventData)^ := fDragOrigin.X;
      pinteger(FUserEventData+4)^ := fDragOrigin.Y;
      pinteger(FUserEventData+8)^ := $10001;
      pinteger(FUserEventData+12)^ := integer(Sender);
      SendMessage(MainFormHandle,WM_USER+3000,$10001,integer(Sender));
      // *** les deux lignes suivantes sont juste pour les tests
      s := 'objet '+inttohex(integer(Sender),8)+'  $10001  '+inttohex(fDragOrigin.X+(fDragOrigin.Y shl 16),8);
      SendMessage(MainFormHandle,WM_SETTEXT,0,integer(pchar(s)));
    end;
  end;
end;

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
//      s := inttostr(x)+','+inttostr(y);
//      SendMessage((Sender as TObjectMover).ParentWindow,WM_SETTEXT,0,integer(pchar(s)));
      l := X - FDownX + fDragOrigin.X;
      t := Y - FDownY + fDragOrigin.Y;
      fDragOrigin.X := l;
      fDragOrigin.Y := t;
      MoveWindow((Sender as TObjectMover).ParentWindow,l,t,FWinWidth,FWinHeight,true);
    end;
  end;
end;

class procedure TObjectMover.ControlMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  ind, stk, i: integer;
  s: string;
begin
  with (Sender as TObjectMover) do begin
    FMoving := false;
    if FUserEventData<>0 then begin
      pinteger(FUserEventData)^ := fDragOrigin.X;
      pinteger(FUserEventData+4)^ := fDragOrigin.Y;
      pinteger(FUserEventData+8)^ := $20001;
      pinteger(FUserEventData+12)^ := integer(Sender);
      SendMessage(MainFormHandle,WM_USER+3000,$20001,integer(Sender));
      // *** les deux lignes suivantes sont juste pour les tests
      s := 'objet '+inttohex(integer(Sender),8)+'  $20001  '+inttohex(fDragOrigin.X+(fDragOrigin.Y shl 16),8);
      SendMessage(MainFormHandle,WM_SETTEXT,0,integer(pchar(s)));
    end;
  end;
end;




exports
  CreateObjectMover, DeleteObjectMover, SetObjectMoverImage, SetObjectMoverUserEvent
  ;

end.

' demo_ObjectMover.bas

label clic1, clic21, user
dim res% : ' valeur retour des fonctions de la DLL
dim OM1%, OM20% : ' objets ObjectMover
dim type% : ' valeur passant de façon cyclique de 0 à 4 pour déterminer l'emplacement de OM1%
dim EventData%(3) : ' tableau de 4 valeurs rempli par les objets OM1% et OM20% lors d'un USER_EVENT

dll_on "KGF_test.dll"

' Valable pour tout ce qui a un handle et peut recevoir un clic:
form 1 : top 1,60 : left 1,200 : on_click 1,clic1
' edit 1 : top 1,100 : left 1,200 : on_click 1,clic1
' spin 1 : top 1,100 : left 1,200 : on_click 1,clic1
' container 1 : top 1,100 : left 1,200 : on_click 1,clic1
' panel 1 : top 1,100 : left 1,200 : on_click 1,clic1
' ...

button 2 : caption 2,"Créer" : on_click 2,clic1
picture 3 : top 3,40 : left 3,10 : width 3,30 : height 3,30 : color 3,0,255,255
picture 31 : top 31,40 : left 31,40 : width 31,30 : height 31,30 : color 31,255,255,0


form 20 : border_hide 20 : top 20,300 : left 20,500
clipboard_copy 3
OM20% = dll_call6("CreateObjectMover",handle(20),1,0,0,width_client(20),22)
res% = dll_call5("SetObjectMoverImage",OM20%,0,0,0,0)
res% = dll_call2("SetObjectMoverUserEvent",OM20%,adr(EventData%))
button 21 : height 21,20 : top 21,1 : left 21,10 : caption 21,"Cliquez-moi" : on_click 21,clic21
parent 21,20

color 3,255,0,0
alpha 4 : top 4,90 : left 4,10 : caption 4,"Icône interne:"
spin 5 : top 5,110 : left 5,10 : width 5,50 : min 5,0 : max 5,362 : position 5,362    : ' numéro de l'icône "état normal" pour OM1% !

alpha 6 : top 6,150 : left 6,10 : caption 6,"Largeur:"
spin 7 : top 7,170 : left 7,10 : width 7,50 : min 7,0 : max 7,width_client(1) : position 7,0
alpha 8 : top 8,200 : left 8,10 : caption 8,"Hauteur:"
spin 9 : top 9,220 : left 9,10 : width 9,50 : min 9,0 : max 9,height_client(1) : position 9,0

alpha 10 : top 10,260 : left 10,10 : caption 10,"User event:"
edit 11 : top 11,280 : left 11,10 : width 11,600

on_user_event user
gosub clic1

end

clic1:
  if OM1%=0
    OM1% = dll_call6("CreateObjectMover",handle(1),type%,int(width_client(1)/2)-15,int(height_client(1)/2)-15,position(7),position(9))
    res% = dll_call2("SetObjectMoverUserEvent",OM1%,adr(EventData%))
    type% = type% + 1
    if type%=5 then type% = 0
    if object_type(1)=7 then to_foreground 1
    if position(5)=0
      clipboard_copy 3
      res% = dll_call5("SetObjectMoverImage",OM1%,1,0,0,0)
      clipboard_copy 31
      res% = dll_call5("SetObjectMoverImage",OM1%,0,0,1,0)
    else
      clipboard_copy 31
      res% = dll_call5("SetObjectMoverImage",OM1%,2,position(5),1,0)
    end_if
    caption 2,"Supprimer"
  else
    OM1% = dll_call1("DeleteObjectMover",OM1%)
    caption 2,"Créer"
    if object_type(1)=7 then to_foreground 1
  end_if
  return
  
clic21:
  message "Je sais - vous avez voulu essayer..."
  return
  
user:
  if OM1%<>0
    if user_event_WParam=OM1%
      text 11,"Objet="+hex$(OM1%)+": wparam="+hex$(user_event_wparam)+"  lparam="+hex$(user_event_lparam)+"        EventData: x="+str$(EventData%(0))+" y="+str$(EventData%(1)) + " lparam="+hex$(EventData%(2))+" objet="+hex$(EventData%(3))
      return
    end_if
  end_if
  if OM20%<>0
    if user_event_WParam=OM20%
      text 11,"Objet="+hex$(OM20%)+": wparam="+hex$(user_event_wparam)+"  lparam="+hex$(user_event_lparam)+"        EventData: x="+str$(EventData%(0))+" y="+str$(EventData%(1)) + " lparam="+hex$(EventData%(2))+" objet="+hex$(EventData%(3))
      return
    end_if
  end_if
'  text 11,"Oups..."
  text 11,"wparam="+hex$(user_event_wparam)+"  lparam="+hex$(user_event_lparam)+"        EventData: x="+str$(EventData%(0))+" y="+str$(EventData%(1)) + " lparam="+hex$(EventData%(2))+" objet="+hex$(EventData%(3))
  return

{
  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)+'  $10001  '+inttohex(fDragOrigin.X+(fDragOrigin.Y shl 16),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_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)+'  $20001  '+inttohex(fDragOrigin.X+(fDragOrigin.Y shl 16),8);
      SendMessage(MainFormHandle,WM_SETTEXT,0,integer(pchar(s)));
    end;
  end;
end;




exports
  CreateObjectMover, DeleteObjectMover, SetObjectMoverImage, SetObjectMoverUserEvent
  ;

end.