Delphi控件源码

开发平台：
Delphi

MMIde.pas：源码内容
							unit MMIDE;
{$I COMPILER.INC}
interface
uses
{$IFDEF WIN32}
  Windows,
{$ELSE}
  WinProcs,
  WinTypes,
{$ENDIF}
{$IFDEF DELPHI6}
  DesignIntf,
  DesignEditors,
{$ELSE}
  DsgnIntf,
{$ENDIF}
  SysUtils,
  Classes,
  Graphics,
  Forms,
  Messages,
  MMDesign,
  MMUtils;
type
    {-- TMMDesignerEditor -----------------------------------------------------}
    TMMDesignerEditor = class(TComponentEditor)
    public
       procedure Edit; override;
       function  GetVerbCount: integer; override;
       function  GetVerb(Index: integer): string; override;
       procedure ExecuteVerb(Index: integer); override;
    end;
procedure RegisterProperty(PropType: TPropType; const PropGroup: string; ClassFrom: TClass;
                           const PropName: string; ClassTo: TClass;
                           CheckProc: TConnectCheck);
procedure RegisterPropertyException(PropType: TPropType; const PropGroup: string; ClassFrom: TClass;
                                    const PropName: string; ClassTo: TClass;
                                    CheckProc: TConnectCheck);
implementation
{== Service routines ====================================================}
{------------------------------------------------------------------------}
procedure RegisterProperty(PropType: TPropType; const PropGroup: string; ClassFrom: TClass;
                           const PropName: string; ClassTo: TClass;
                           CheckProc: TConnectCheck);
begin
   PropList.Add(TPropRec.Create(PropType,PropGroup,ClassFrom,PropName,ClassTo,CheckProc));
end;
{------------------------------------------------------------------------}
procedure RegisterPropertyException(PropType: TPropType; const PropGroup: string; ClassFrom: TClass;
                                    const PropName: string; ClassTo: TClass;
                                    CheckProc: TConnectCheck);
begin
   ExcPropList.Add(TPropRec.Create(PropType,PropGroup,ClassFrom,PropName,ClassTo,CheckProc));
end;
{------------------------------------------------------------------------}
function FindDesignerForWindow(Wnd: HWND): TMMDesigner;
var
    i : Integer;
begin
   { It is no sense to have multiple different designers for one window }
   if (ControlList <> nil) and (ControlList.Count > 0) then
   for i := 0 to ControlList.Count-1 do
   begin
      with TMMDesigner(ControlList.Items[i]) do
      if Active and ((ParentForm.Handle = Wnd) or
         IsChild(ParentForm.Handle, Wnd)) then
      begin
         Result := TMMDesigner(ControlList.Items[i]);
         Exit;
      end;
   end;
   Result := nil;
end;
{------------------------------------------------------------------------}
procedure RedrawTrack(Show: Boolean);
begin
   if (DragDesigner <> nil) and (TrackVisible <> Show) then
   {$IFDEF BUILD_ACTIVEX}
   begin
      DrawRubberLine(DragDesigner.ParentForm,
                     Rect(DragOrigin.X,DragOrigin.Y,
                          DragPoint.X,DragPoint.Y));
   end;
   {$ELSE}
   with DragDesigner.ParentForm,DragDesigner.ParentForm.Canvas do
   begin
      Pen.Color := clWhite;
      Pen.Mode := pmXor;
      if Adjusting then
      begin
         Pen.Width := 2;
         MoveTo(0,DragPoint.Y);
         LineTo(Width,DragPoint.Y);
         Pen.Width := 1;
      end
      else
      begin
         MoveTo(DragOrigin.X,DragOrigin.Y);
         LineTo(DragPoint.X,DragPoint.Y);
      end;
      Pen.Mode := pmCopy;
   end;
   {$ENDIF}
   TrackVisible := Show;
end;
{------------------------------------------------------------------------}
function GetMsgProc(Code: Integer; WParam: Word; LParam: Longint): LongInt;
export;{$IFDEF WIN32}stdcall;{$ENDIF}
var
   Msg: ^TMsg;
   Pt: TPoint;
   Rect: TRect;
   WndDesigner: TMMDesigner;
   Target: TComponent;
   TargetType: TPropType;
   {$IFDEF DELPHI4}
   Unknown: IUnknown;
   {$ENDIF}
   {$IFDEF DELPHI6}
   RealDesigner: IDesigner;
   {$ENDIF}
begin
   Result := 0;
   try
      Msg := Pointer(LParam);
      if (Msg^.message = WM_PAINT) and not MMDesign.Dragging then
      begin
         WndDesigner := FindDesignerForWindow(Msg^.HWND);
         if (WndDesigner <> nil) and WndDesigner.Visible then
         begin
            if Adjusting and not PaintOK then RedrawTrack(False);
            PaintOk := True;
         end;
      end;
      if (Msg^.message = WM_RBUTTONDOWN) and not MMDesign.Dragging and not Deconnect then
      begin
         if Adjusting then
         begin
            Msg^.HWND := 0;
         end
         else
         begin
            WndDesigner := FindDesignerForWindow(Msg^.HWND);
            if (WndDesigner <> nil) and WndDesigner.Visible then
            with WndDesigner, ParentForm do
            begin
               DragSource := nil;
               DragDest := nil;
               Pt := SmallPointToPoint(TSmallPoint(Msg^.Lparam));
               Target := FindTarget(ParentForm, Msg^.HWND, Pt, TargetType, Rect);
               if Target <> nil then
               begin
                  if TargetType = ptOutput then
                     Deconnect := RemoveOutput(Target)
                  else
                     Deconnect := RemoveInput(Target);
                  Msg^.HWND   := 0;
                  if Deconnect then
                  begin
                     PaintOK := True;
                     DrawPaintBox;
                     BeepSound(MB_ICONHAND);
                     if (Designer <> nil) then
                         Designer.Modified;
                  end;
               end;
            end;
         end;
      end;
      if (Msg^.message = WM_RBUTTONUP) then
      begin
         if Deconnect and not MMDesign.Dragging or Adjusting then
         begin
            Msg^.HWND := 0;
            Deconnect := False;
         end;
      end;
      if (Msg^.message = WM_LBUTTONDOWN) and not MMDesign.Dragging then
      begin
         if Adjusting then
         with DragDesigner do
         begin
            DoneDragging;
            BeepSound(MB_OK);
            Pt := SmallPointToPoint(TSmallPoint(Msg^.Lparam));
            MapWindowPoints(Msg^.HWND,ParentForm.Handle,pt,1);
            RunTimeHeight := pt.Y;
            DragDesigner := nil;
            ClipCursor(nil);
            Msg^.HWND := 0;
         end
         else
         begin
            WndDesigner := FindDesignerForWindow(Msg^.HWND);
            if (WndDesigner <> nil) and WndDesigner.Visible then
            with WndDesigner,ParentForm do
            begin
               DragSource:= nil;
               DragDest := nil;
               Pt := SmallPointToPoint(TSmallPoint(Msg^.Lparam));
               Target := FindTarget(ParentForm, Msg^.HWND, Pt, TargetType, Rect);
               if Target <> nil then
               begin
                  Msg^.HWND := 0;
                  DragDesigner    := WndDesigner;
                  DragInput       := TargetType = ptInput;
                  DragSource      := Target;
                  OffsetRect(Rect, Griff div 2, Griff div 2);
                  DragOrigin      := Rect.TopLeft;
                  DragPoint       := DragOrigin;
                  Rect            := ParentForm.ClientRect;
                  MapWindowPoints(ParentForm.Handle,0,Rect,2);
                  ClipCursor(@Rect);
                  {$IFDEF WIN32}
                  {$IFDEF DELPHI6}
                  if (Designer.QueryInterface(IDesigner,RealDesigner) = S_OK) then
                  begin
                     RealDesigner.SelectComponent(nil);
                  {$ELSE}
                  {$IFDEF DELPHI4}
                  if Designer.QueryInterface(IFormDesigner, Unknown) = S_OK then
                  begin
                     IFormDesigner(Designer).SelectComponent(nil);
                  {$ELSE}
                  if (Designer is TFormDesigner) then
                  begin
                     TFormDesigner(Designer).SelectComponent(nil);
                  {$ENDIF}
                  {$ENDIF}
                  {$ELSE}
                  begin
                     {CompLib.GetActiveForm.SetSelection(FParentForm.Name);}
                  {$ENDIF}
                      PaintOK := True;
                      DrawPaintBox;
                      BeepSound(MB_OK);
                  end;
                  MMDesign.Dragging := True;
               end;
            end;
         end;
      end;
      if (Msg^.message = WM_LBUTTONUP) and MMDesign.Dragging then
      begin
         DoneDragging;
         if (DragSource <> nil) then
         begin
            if (DragDest <> nil) and (DragSource <> DragDest) then
            begin
                if DragInput then
                   DragDesigner.Connect(DragDest,DragSource)
                else
                   DragDesigner.Connect(DragSource,DragDest);
                PaintOK := True;
                DragDesigner.DrawPaintBox;
                DragDesigner.BeepSound(MB_OK);
                if (DragDesigner.ParentForm.Designer <> nil) then
                   DragDesigner.ParentForm.Designer.Modified;
            end
            else
                DragDesigner.BeepSound(MB_ICONHAND);
         end;
         Msg^.HWND := 0;
      end;
      if (Msg^.message = WM_MOUSEMOVE) then
      begin
         if Adjusting then
         with DragDesigner.ParentForm do
         begin
            if not PaintOK then
            begin
               RedrawTrack(False);
               Pt := SmallPointToPoint(TSmallPoint(Msg^.Lparam));
               MapWindowPoints(Msg^.HWND,Handle,Pt,1);
               DragPoint := Pt;
               RedrawTrack(True);
            end;
            Msg^.HWND := 0;
         end
         else if MMDesign.Dragging then
         with DragDesigner.ParentForm do
         begin
            Pt := SmallPointToPoint(TSmallPoint(Msg^.Lparam));
            MapWindowPoints(Msg^.HWND,Handle,Pt,1);
            if (DragDest = nil) or not PtInRect(DragRect, Pt) then
            begin
               DragDest := nil;
               RedrawTrack(False);
               MapWindowPoints(Handle,Msg^.HWND,Pt,1);
               Target := DragDesigner.FindTarget(DragDesigner.ParentForm, Msg^.HWND, Pt, TargetType, Rect);
               DragPoint := Pt;
               RedrawTrack(True);
               if Target <> nil then
               begin
                  if (DragInput and (TargetType = ptOutput) and DragDesigner.CanConnect(Target,DragSource)) or
                     (not DragInput and (TargetType = ptInput) and DragDesigner.CanConnect(DragSource,Target)) then
                  begin
                     DragDesigner.BeepSound(MB_OK);
                     DragDest := Target;
                     DragRect := Rect;
                     InflateRect(DragRect, Griff, Griff);
                     OffsetRect(Rect, Griff div 2, Griff div 2);
                     RedrawTrack(False);
                     DragPoint := Rect.TopLeft;
                     RedrawTrack(True);
                     DragDesigner.BeepSound(MB_OK);
                  end;
               end;
               Canvas.Pen.Mode := pmCopy;
            end;
            Msg^.HWND := 0;
         end;
      end;
      if (Result = 0) then
         Result := CallNextHookEx(GetMsgHook, Code, WParam, LParam);
   except
      Application.HandleException(nil);
   end;
end;
{------------------------------------------------------------------------}
procedure AddDesigner(Designer: TMMDesigner);
begin
   inc(CreateCount);
   if (CreateCount = 1) then
   begin
      ControlList := TList.Create;
      { install Windows-Message-Hook }
      {$IFDEF WIN32}
      GetMsgHook    := SetWindowsHookEx(WH_GETMESSAGE, @GetMsgProc, 0, GetCurrentThreadID);
      {$ELSE}
      GetMsgHook    := SetWindowsHookEx(WH_GETMESSAGE, GetMsgProc, GetInstanceModule(HInstance), GetCurrentTask);
      {$ENDIF}
      { load Bitmap for Caption Button }
      DesignBitmap := LoadBitmap(HInstance,'BTN_DESIGNER');
      GetBitmapSize(DesignBitmap, BitmapWidth, BitmapHeight);
   end;
   ControlList.Add(Designer);
end;
{------------------------------------------------------------------------}
procedure RemoveDesigner(Designer: TMMDesigner);
begin
   ControlList.Remove(Designer);
   ControlList.Pack;
   dec(CreateCount);
   if (CreateCount = 0) then
   begin
      if GetMsgHook <> 0 then UnhookWindowsHookEx(GetMsgHook);
      ControlList.Free;
      ControlList := nil;
      DeleteObject(DesignBitmap);
      DesignBitmap := 0;
   end;
end;
{== TMMDesignerEditor =========================================================}
function TMMDesignerEditor.GetVerbCount: integer;
begin
   GetVerbCount := 1;
end;
{-- TMMDesignerEditor ---------------------------------------------------------}
function TMMDesignerEditor.GetVerb(Index: integer): string;
begin
   GetVerb := '&Update Connections';
end;
{-- TMMDesignerEditor ---------------------------------------------------------}
procedure TMMDesignerEditor.ExecuteVerb(Index: integer);
begin
   if (Component is TMMDesigner) then
      (Component as TMMDesigner).Update := True;
end;
{-- TMMDesignerEditor ---------------------------------------------------------}
procedure TMMDesignerEditor.Edit;
begin
   if (Component is TMMDesigner) then
   begin
      if (Component as TMMDesigner).Active then
         (Component as TMMDesigner).Active := False
      else
         (Component as TMMDesigner).Active := True;
   end;
   if (Designer <> nil) then Designer.Modified;
end;
initialization
   // we need to avoid references from the designtime to the runtime code, so if
   // we are in designmode we supply the functions needed to do the trick....
   // cant believe what a shit the Borland guys did in Delphi 6....
   _FindDesignerForWindow := FindDesignerForWindow;
   _AddDesigner           := AddDesigner;
   _RemoveDesigner        := RemoveDesigner;
   _RedrawTrack           := RedrawTrack;
finalization
end.

						