Delphi控件源码

开发平台：
Delphi

mmdesign.pas：源码内容
							{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Fax.: +49 (0)351-8037944              =}
{=  Loewenstr.7a                = info@swiftsoft.de                     =}
{========================================================================}
{=  Actual versions on http://www.swiftsoft.de/mmtools.html             =}
{========================================================================}
{=  This code is for reference purposes only and may not be copied or   =}
{=  distributed in any format electronic or otherwise except one copy   =}
{=  for backup purposes.                                                =}
{=                                                                      =}
{=  No Delphi Component Kit or Component individually or in a collection=}
{=  subclassed or otherwise from the code in this unit, or associated   =}
{=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
{=  without express permission from SwiftSoft.                          =}
{=                                                                      =}
{=  For more licence informations please refer to the associated        =}
{=  HelpFile.                                                           =}
{========================================================================}
{=  $Date: 12.08.98 - 13:14:05 $                                        =}
{========================================================================}
unit MMDesign;
{$I COMPILER.INC}
{.$DEFINE _MMDEBUG}
interface
uses
{$IFDEF WIN32}
  Windows,
{$ELSE}
  WinProcs,
  WinTypes,
{$ENDIF}
  SysUtils,
  Messages,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  ExtCtrls,
  StdCtrls,
  MMObj,
  MMHook,
  MMPanel;
type
  TCompRect = record
       Left  : integer;
       Top   : integer;
       Height: integer;
       Width : integer;
       Ok    : Boolean;
  end;
  TPropType     = (ptInput,ptOutput);
  TConnectCheck = function(C1, C2: TComponent): Boolean;
  TConnect      = procedure(C1, C2: TComponent);
  {-- TMMDesigner --------------------------------------------------------}
  TMMDesigner = class(TMMWndProcComponent)
  private
    FAutoUpdate     : Boolean;
    FActive         : Boolean;
    FUpdate         : Boolean;
    FVisible        : Boolean;
    FSound          : Boolean;
    FColor          : TColor;
    FLineWidth      : integer;
    FMargin         : integer;
    FParentForm     : TForm;
    FParentComponent: TComponent;
    FTimer          : TTimer;
    FPaintOk        : Boolean;
    FRuntimeHeight  : integer;
    FShowButton     : Boolean;
    FButtonDown     : Boolean;
    FButtonPressed  : Boolean;
    FProhibited     : TStringList;
    FAllowed        : TList;
    FPortList       : TList;
    FConnList       : TList;
    FValidLists     : Boolean;
    FRebuilding     : Boolean;
    procedure SetActive(aValue: Boolean);
    procedure SetUpdate(aValue: Boolean);
    procedure SetLineWidth(aValue: integer);
    procedure SetMargin(aValue: integer);
    procedure SetColor(aValue: TColor);
    procedure SetShowButton(aValue: Boolean);
    procedure DesignerFormPos;
    function  ButtonRect: TRect;
    function  InButton(pt: TPoint): Boolean;
    procedure PaintButton(Down: Boolean);
    procedure RefreshCaption;
    procedure SetPen(Color: TColor; Width:integer; Style: TPenStyle);
    procedure TimerAction(Sender:TObject);
    procedure RefreshForm(ControlsOk, ComponentsOk: Boolean);
    procedure GetComponentPos(Comp: TComponent; var CompRect: TCompRect);
    procedure DrawConnection(CompRect1,CompRect2: TCompRect;ArrowOk: Boolean);
    procedure DrawPorts(Comp: TComponent; InPort,OutPort: Boolean);
    procedure InitDesigner;
  protected
    procedure ChangeDesigning(aValue: Boolean); override;
    procedure Loaded; override;
    procedure HookWndProc(var Message: TMessage); override;
    function  HasInput(C: TComponent): Boolean;
    function  HasOutput(C: TComponent): Boolean;
    function  FindConnectProp(C1,C2: TComponent): Integer;
    function  HasPotentialInput(C: TComponent): Boolean;
    function  HasPotentialOutput(C: TComponent): Boolean;
    function  CheckInput(C: TComponent; Pt: TPoint; var R: TRect): Boolean;
    function  CheckOutput(C: TComponent; Pt: TPoint; var R: TRect): Boolean;
    function  FindProp(Pt: TPropType; CFrom: TComponent; CTo: TComponent; StartFrom: Integer): Integer;
    function  HasException(CompFrom: TComponent; CompTo: TComponent;
                           Index: Integer): Boolean;
    function  FindRef(PropType: TPropType;C: TComponent;StartFrom: Integer): Integer;
    function  FindRefs(PropType:TPropType;R,C:TComponent;StartFrom:Integer):Integer;
    function  RemoveRef(C: TComponent; PropType: TPropType): Boolean;
    function  RemoveRefs(C: TComponent; PropType: TPropType): Boolean;
    procedure GetConnected(C: TComponent; List: TList);
    function  Allowed: TList;
    procedure RebuildLists;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override ;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    function  FindTarget(Form: TForm; Wnd: HWND; var Pt: TPoint; var TargetType: TPropType; var R: TRect): TComponent;
    function  RemoveInput(C: TComponent): Boolean;
    function  RemoveOutput(C: TComponent): Boolean;
    procedure DrawPaintBox;
    procedure BeepSound(aValue: Cardinal);
    function  CanConnect(C1,C2: TComponent): Boolean;
    procedure Connect(C1,C2: TComponent);
    property  ParentForm: TForm read FParentForm;
    property  ParentComponent: TComponent read FParentComponent;
    property  Visible: Boolean read FVisible;
  published
    property  Active: Boolean read FActive write SetActive default True;
    property  Color: TColor read FColor write SetColor default clRed;
    property  LineWidth: integer read FLineWidth write SetLineWidth default 1;
    property  Margin: integer read FMargin write SetMargin default 6;
    property  AutoUpdate: Boolean read FAutoUpdate write FAutoUpdate default True;
    property  Update: Boolean read FUpdate write SetUpdate;
    property  Sound: Boolean read FSound write FSound default True;
    property  ShowButton: Boolean read FShowButton write SetShowButton default False;
    property  RuntimeHeight: integer read FRuntimeHeight write FRuntimeHeight;
  end;
  {-- TMMDesignerForm ----------------------------------------------------}
  TMMDesignerForm = class(TForm)
    MMPanel1: TMMPanel;
    btnClose: TButton;
    ckbActive: TCheckBox;
    ckbAuto: TCheckBox;
    ckbSound: TCheckBox;
    btnHeight: TButton;
    GroupBox: TListBox;
    Label1: TLabel;
    btnAll: TButton;
    btnNone: TButton;
    Bevel1: TBevel;
    Bevel2: TBevel;
    procedure CheckBoxClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btnHeightClick(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure btnAllClick(Sender: TObject);
    procedure btnNoneClick(Sender: TObject);
  public
    Designer: TMMDesigner;
  end;
  {-- TPropRec ----------------------------------------------------------------}
  TPropRec = class(TObject)
    PropType    : TPropType;
    PropGroup   : string;
    ClassFrom   : TClass;
    PropName    : string;
    ClassTo     : TClass;
    CheckProc   : TConnectCheck;
    constructor Create(APropType: TPropType; const APropGroup: string;
                       AClassFrom: TClass;
                       const APropName: string; AClassTo: TClass;
                       ACheckProc: TConnectCheck);
  end;
var
   DesignerForm: TMMDesignerForm;
var
   _FindDesignerForWindow: function(Wnd: HWND): TMMDesigner = nil;
   _AddDesigner          : procedure(Designer: TMMDesigner) = nil;
   _RemoveDesigner       : procedure(Designer: TMMDesigner) = nil;
   _RedrawTrack          : procedure(Show: Boolean);
const
   Griff = 5;
   ComponentWidth  = 28;
   ComponentHeight = 28;
const
   ControlList : TList   = nil;
   CreateCount : integer = 0;
   GetMsgHook  : HHook   = 0;
   PaintCount  : integer = 0;
   PaintOk     : Boolean = False;
   Dragging    : Boolean = False;
   Deconnect   : Boolean = False;
   Adjusting   : Boolean = False;
   PropList     : TList  = nil;
   ExcPropList  : TList  = nil;
var
   DragDesigner: TMMDesigner;
   DragOrigin  : TPoint;
   DragPoint   : TPoint;
   DragRect    : TRect;
   DragInput   : Boolean;
   DragSource  : TComponent;
   DragDest    : TComponent;
   TrackVisible: Boolean;
   DesignBitmap: HBITMAP;
   BitmapWidth : integer;
   BitmapHeight: integer;
procedure DoneDragging;
{========================================================================}
implementation
{$R *.DFM}
uses
    Consts,
    TabNotBk,
    TypInfo,
    MMUtils
    {$IFDEF WIN32}
    ,ComCtrls
    {$ENDIF}
    {$IFDEF _MMDEBUG}
    ,MMDebug
    {$ENDIF};
{== TPropRec ============================================================}
constructor TPropRec.Create(APropType: TPropType; const APropGroup: string;
                            AClassFrom: TClass;
                            const APropName: string; AClassTo: TClass;
                            ACheckProc: TConnectCheck);
begin
   inherited Create;
   PropType    := APropType;
   PropGroup   := APropGroup;
   ClassFrom   := AClassFrom;
   PropName    := APropName;
   ClassTo     := AClassTo;
   CheckProc   := ACheckProc;
end;
{------------------------------------------------------------------------}
function IsCompiling: Boolean;
begin
   Result := FindWindow('TProgressForm',nil) <> 0;
end;
{------------------------------------------------------------------------}
function LeftGriff(C: TComponent): TRect;
begin
   if (C is TControl) then
   with (C as TControl) do
   begin
      Result.Left   := Left - Griff div 2;
      Result.Top    := (Top + Height div 2) - Griff div 2 - (Height+1) mod 2;
   end
   else
   begin
      Result.Left   := LoWord(C.DesignInfo) - Griff div 2;
      Result.Top    := HiWord(C.DesignInfo) + (ComponentWidth div 2) - 1 - Griff div 2;
   end;
   Result.Right  := Result.Left + Griff;
   Result.Bottom := Result.Top + Griff;
end;
{------------------------------------------------------------------------}
function RightGriff(C: TComponent): TRect;
begin
   Result          := LeftGriff(C);
   Result.Left     := Result.Left + ComponentWidth - 1;
   Result.Right    := Result.Left + Griff;
end;
{------------------------------------------------------------------------}
function DesignerVisible(Designer: TMMDesigner): Boolean;
var
   L,T: integer;
begin
   Result := False;
   if (Designer <> nil) then
   with Designer do
   begin
      L:= LoWord(DesignInfo);
      T:= HiWord(DesignInfo);
      Result := (L < FParentForm.ClientWidth) and
                (T < FParentForm.ClientHeight);
   end;
end;
{------------------------------------------------------------------------}
function ControlVisible(AControl: TControl): Boolean;
begin
   if AControl is TForm then
   begin
      Result := True;
      Exit;
   end;
   if (AControl is TWinControl)
   {$IFDEF WIN32}
      and not (AControl is TTabSheet)
   {$ENDIF}
      and not (AControl is TPage) then
      Result := IsWindowVisible((AControl as TWinControl).Handle)
   else
      Result := AControl.Visible;
   if (AControl.Parent <> nil) then
       Result := Result and ControlVisible(AControl.Parent);
end;
{------------------------------------------------------------------------}
procedure DoneDragging;
begin
   if (DragDesigner <> nil) then
   with DragDesigner do
   if MMDesign.Dragging or Adjusting then
   begin
      _RedrawTrack(False);
      ClipCursor(nil);
      MMDesign.Dragging := False;
      Adjusting:= False;
   end;
end;
{------------------------------------------------------------------------}
function CheckPropAvail(C: TComponent; i: Integer; NeedCheck: Boolean): Boolean;
begin
   if NeedCheck then
      Result := GetPropInfo(C.ClassInfo,TPropRec(PropList[i]).PropName) <> nil
   else
      Result := True;
end;
{------------------------------------------------------------------------}
function GetPropValue(C: TComponent; i: Integer): TComponent;
begin
   Result := TComponent(GetOrdProp(C,GetPropInfo(C.ClassInfo,TPropRec(PropList[i]).PropName)));
end;
{------------------------------------------------------------------------}
procedure SetPropValue(C: TComponent; i: Integer; Value: TComponent);
begin
   SetOrdProp(C,GetPropInfo(C.ClassInfo,TPropRec(PropList[i]).PropName),LongInt(Value));
end;
{== TMMDesigner =========================================================}
constructor TMMDesigner.Create(AOwner: TComponent);
var
   CompOwner: TComponent;
begin
   inherited Create(AOwner);
   {$IFDEF WIN32}
   if (Owner is TDataModule) then
   begin
      CompOwner := Owner.Owner;
   end
   else {$ENDIF} CompOwner := Owner;
{  TODO: DataModules currently not supported !!!        }
{  if (CompOwner <> nil) and (CompOwner is TForm) then  }
   if (Owner <> nil) and (Owner is TForm) then
   begin
      FParentForm := CompOwner as TForm;
      FParentComponent := Owner;
      {$IFDEF BUILD_ACTIVEX}
      ParentWindow := TWinControl(aOwner).Handle;
      {$ENDIF}
      if assigned(_FindDesignerForWindow) then
         if _FindDesignerForWindow(FParentForm.Handle) <> nil then
            raise Exception.Create('Only one Designer is allowed per Form');
      FActive := True;
      FAutoUpdate := True;
      FUpdate := False;
      FSound := True;
      FColor := clRed;
      FLineWidth := 1;
      FMargin := 6;
      RuntimeHeight := -1;
      FShowButton := False;
      FButtonDown := False;
      FButtonPressed:= False;
      InitDesigner;
   end
   else FormOk := False;
   ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
   if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
end;
{-- TMMDesigner ---------------------------------------------------------}
destructor TMMDesigner.Destroy;
begin
   if FormOK and (FTimer <> nil) then
   begin
      { Timer may be nil because of MessageDlg instead of raise }
      FTimer.OnTimer := nil;
      FTimer.Free;
      { unhook the parent Forms WndProc }
      UnHookOwner;
      if assigned(_RemoveDesigner) then
         _RemoveDesigner(Self);
      RefreshForm(True,False);
      {  RefreshCaption;}
      FAllowed.Free;
      FProhibited.Free;
      FPortList.Free;
      FConnList.Free;
   end;
   inherited Destroy;
end;
{-- TMMDesigner ---------------------------------------------------------}
procedure TMMDesigner.InitDesigner;
begin
   if (csDesigning in ComponentState) and (FTimer = nil) then
   begin
      { create Timer }
      try
         FTimer := TTimer.Create(self);
         FTimer.Interval := 1000;
         FTimer.OnTimer := TimerAction;
      except
         MessageDlg({$IFDEF DELPHI3}SNoTimers{$ELSE}LoadStr(SNoTimers){$ENDIF},mtError,[mbOk],0);
      end;
      FProhibited := TStringList.Create;
      FAllowed    := TList.Create;
      if assigned(_AddDesigner) then
         _AddDesigner(Self);
      { hook the parent forms WndProc }
      HookOwner;
      FVisible := DesignerVisible(Self);
      FPaintOk := True;
      DrawPaintBox;
      { Because when form is loaded nothing exist }
      FPaintOk := True;
   end;
end;
{-- TMMDesigner ---------------------------------------------------------}
procedure TMMDesigner.ChangeDesigning(aValue: Boolean);
begin
   inherited;
   InitDesigner;
end;
{-- TMMDesigner ---------------------------------------------------------}
procedure TMMDesigner.Loaded;
begin
   inherited Loaded;
   if not (csDesigning in ComponentState) and (FRuntimeHeight > 0) then
   begin
      FParentForm.ClientHeight := FRuntimeHeight;
   end;
end;
{-- TMMDesigner ---------------------------------------------------------}
procedure TMMDesigner.BeepSound(aValue: Cardinal);
begin
   if FSound then MessageBeep(aValue);
end;
{-- TMMDesigner ---------------------------------------------------------}
procedure TMMDesigner.SetPen(Color: TColor; Width: integer; Style: TPenStyle);
begin
   with FParentForm.Canvas do
   begin
      Pen.Color := Color;
      Pen.Width := Width;
      Pen.Style := Style;
   end;
end;
{-- TMMDesigner ---------------------------------------------------------}
procedure TMMDesigner.DesignerFormPos;
var
   pt: TPoint;
begin
   if (DesignerForm <> nil) and (FParentForm <> nil) then
   begin
      pt := FParentForm.ClientToScreen(Point(ButtonRect.Left,0));
      DesignerForm.Left := Max(1,pt.X-GetSystemMetrics(SM_CXFRAME)+(ButtonRect.Right-ButtonRect.Left)-DesignerForm.Width);
      DesignerForm.Top := pt.Y;
   end;
end;
{-- TMMDesigner ---------------------------------------------------------}
procedure TMMDesigner.RefreshCaption;
begin
   if (FParentForm <> nil) and (FParentForm.Handle <> 0) and
      not (csDestroying in FParentForm.ComponentState) then
      SetWindowPos(FParentForm.Handle,0,0,0,0,0,SWP_DRAWFRAME or SWP_NOSIZE or
                   SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE);
end;
{-- TMMDesigner ---------------------------------------------------------}
function TMMDEsigner.InButton(pt: TPoint): Boolean;
begin
   pt.X := pt.X + GetSystemMetrics(SM_CXFRAME);
   pt.Y := pt.Y + NonClientHeight - 3;
   {$IFDEF WIN32}
   if not NewStyleControls then
   {$ELSE}
   if not _Win9x_ and not _WinNT4_ then
   {$ENDIF}
      pt.Y := pt.Y -2;
   if (FParentForm.Menu <> nil) and (FParentForm.Menu.Items.Count > 0) then
      pt.Y := pt.Y + GetSystemMetrics(SM_CYMENU);
   MapWindowPoints(0,FParentForm.Handle,pt,1);
   Result := ptInRect(ButtonRect,pt);
end;
{-- TMMDesigner ---------------------------------------------------------}
function TMMDesigner.ButtonRect: TRect;
var
  ButtonWidth,
  ButtonHeight,
  FrameWidth,
  FrameHeight: Integer;
begin
   {$IFDEF WIN32}
   if NewStyleControls then
   {$ELSE}
   if _Win9x_ or _WinNT4_ then
   {$ENDIF}
   begin
      ButtonWidth := GetSystemMetrics(SM_CXSIZE)-2;
      ButtonHeight:= GetSystemMetrics(SM_CYSIZE)-4;
      FrameWidth  := GetSystemMetrics(SM_CXFRAME)+2;
      FrameHeight := GetSystemMetrics(SM_CYFRAME)+2;
      with FParentForm do
      Result := Rect(Width-FrameWidth-3*ButtonWidth-4-BitmapWidth-5,
                     FrameHeight,
                     Width-FrameWidth-3*ButtonWidth-4,
                     FrameHeight + ButtonHeight);
   end
   else
   begin
      ButtonWidth := GetSystemMetrics(SM_CXSIZE);
      ButtonHeight:= GetSystemMetrics(SM_CYSIZE);
      FrameWidth  := GetSystemMetrics(SM_CXFRAME)+2;
      FrameHeight := GetSystemMetrics(SM_CYFRAME);
      with FParentForm do
      Result := Rect(Width-FrameWidth-2*ButtonWidth-BitmapWidth-6,
                     FrameHeight,
                     Width-FrameWidth-2*ButtonWidth,
                     FrameHeight + ButtonHeight);
   end;
end;
{-- TMMDesigner ---------------------------------------------------------}
procedure TMMDesigner.PaintButton(Down: Boolean);
var
   R    : TRect;
   CV   : TCanvas;
begin
   R  := ButtonRect;
   CV := TCanvas.Create;
   CV.Handle := GetWindowDC(FParentForm.Handle);
   {$IFDEF WIN32}
   if NewStyleControls then
   {$ELSE}
   if _Win9x_ or _WinNT4_ then
   {$ENDIF}
   with CV do
   begin
      if Down then
      begin
         Frame3D(CV, R, clBlack, clBtnHighLight, 1);
         Frame3D(CV, R, clBtnShadow, clBtnFace, 1);
         Brush.Color := clBtnFace;
         FillRect(R);
         OffsetRect(R,1,1);
      end
      else
      begin
         Frame3D(CV, R, clBtnHighLight, clBlack, 1);
         Frame3D(CV, R, clBtnFace, clBtnShadow, 1);
         Brush.Color := clBtnFace;
         FillRect(R);
      end;
   end
   else
   with CV do
   begin
      Pen.Color := clBlack;
      MoveTo(R.Left-1,R.Top);
      LineTo(R.Left-1,R.Bottom);
      if Down then
      begin
         Frame3D(CV, R, clBtnShadow, clBtnFace, 1);
         Brush.Color := clBtnFace;
         FillRect(R);
         OffsetRect(R,2,2);
      end
      else
      begin
         Frame3D(CV, R, clBtnHighLight, clBtnShadow, 1);
         Frame3D(CV, R, clBtnFace, clBtnShadow, 1);
         Brush.Color := clBtnFace;
         FillRect(R);
      end;
   end;
   R.Top := R.Top+((R.Bottom-R.Top) - BitmapHeight) div 2;
   DrawTransparentBitmap(CV.Handle,DesignBitmap,R.Left+1,R.Top,GetTransparentColor(DesignBitmap));
   ReleaseDC(FParentForm.Handle, CV.Handle);
   CV.Free;
end;
{-- TMMDesigner ---------------------------------------------------------}
procedure TMMDesigner.HookWndProc(var Message: TMessage);
var
   CompRec: TCompRect;
   i,H    : integer;
   pt     : TPoint;
   Down   : Boolean;
begin
    with Message do
    begin
       case Msg of
         WM_ACTIVATEAPP,
         WM_ACTIVATE: if ((Msg = WM_ACTIVATEAPP) and Boolean(wParam)) or
                         ((Msg = WM_ACTIVATE) and (LoWord(wParam) = WA_INACTIVE)) then
         begin
            if MMDesign.Dragging or Adjusting then
             begin
               DoneDragging;
               BeepSound(MB_ICONHAND);
            end
            else PaintOK := True;
            if (DesignerForm <> nil) then
            begin
               SendMessage(FParentForm.Handle, WM_NCACTIVATE, 1, 0);
               Message.Result := 0;
            end;
         end;
         WM_SIZE:
         begin
            if FShowButton then RefreshCaption;
            if FVisible then
            begin
               if not DesignerVisible(Self) then
               begin
                  FVisible := False;
                  RefreshForm(True,True);
               end;
            end
            else if DesignerVisible(Self) then
            begin
               FVisible := True;
               PaintOK := True;
               DrawPaintBox;
            end;
         end;
         WM_NCPAINT,
         WM_NCACTIVATE: if FShowButton then
         begin
            inherited HookWndProc(Message);
            if not IsIconic(FParentForm.Handle) then PaintButton(False);
            exit;
         end;
         WM_NCHITTEST: if FButtonPressed then
         begin
            inherited HookWndProc(Message);
            Message.Result := Longint(HTCAPTION);
            exit;
         end;
         WM_NCLBUTTONDOWN,
         WM_NCLBUTTONDBLCLK,
         WM_NCRBUTTONDOWN,
         WM_NCRBUTTONDBLCLK:
         begin
            if FShowButton and (wParam in [HTCAPTION]) and InButton(SmallPointToPoint(TSmallPoint(lParam))) then
            begin
               Windows.SetFocus(FParentForm.Handle);
               FButtonPressed:= True;
               FButtonDown := True;
               PaintButton(True);
               exit;
            end;
         end;
         WM_NCMOUSEMOVE: if FButtonPressed then
         begin
            pt := SmallPointToPoint(TSmallPoint(lParam));
            Down := InButton(pt);
            if FButtonDown <> Down then
            begin
               FButtonDown := Down;
               PaintButton(FButtonDown);
            end;
            exit;
         end;
         WM_NCLBUTTONUP,
         WM_NCRBUTTONUP: if FButtonPressed then
         begin
            FButtonPressed := False;
            PaintButton(False);
            if (Msg = WM_NCLBUTTONUP) and FActive then
            begin
               if InButton(SmallPointToPoint(TSmallPoint(lParam))) then
               begin
                  if not FVisible or (FRuntimeHeight = FParentForm.ClientHeight) then
                  begin
                     H := FParentForm.ClientHeight;
                     for i := 0 to FParentForm.ComponentCount-1 do
                     begin
                        GetComponentPos(FParentForm.Components[i],CompRec);
                        H := Max(H,CompRec.Top+CompRec.Height+5);
                     end;
                     FParentForm.ClientHeight := H;
                  end
                  else
                  begin                                 { Top }
                     if (FRuntimeHeight = -1) then
                         H := HiWord(DesignInfo)-5
                     else
                         H := FRuntimeHeight;
                     FParentForm.ClientHeight := H;
                  end;
               end;
               exit;
            end;
            if InButton(SmallPointToPoint(TSmallPoint(lParam))) then
            begin
               DesignerForm := TMMDesignerForm.Create(nil);
               DesignerFormPos;
               DesignerForm.Designer := Self;
               DesignerForm.ShowModal;
               DesignerForm.Free;
               DesignerForm := nil;
            end;
            exit;
         end;
       end;
       inherited HookWndProc(Message);
    end;
end;
{-- TMMDesigner ---------------------------------------------------------}
procedure TMMDesigner.SetShowButton(aValue: Boolean);
begin
   if (aValue <> FShowButton) then
   begin
      FShowButton := aValue;
      { redraw the Forms caption }
      RefreshCaption;
   end;
end;
{-- TMMDesigner ---------------------------------------------------------}
procedure TMMDesigner.RefreshForm(ControlsOk, ComponentsOk: Boolean);
var
   Wnd: THandle;
   procedure RefreshControls(Parent: TWinControl);
   var
      i : Integer;
   begin
      with Parent do
      for i := 0 to ControlCount - 1 do
      begin
         if Controls[i] is TWinControl then
            SetWindowPos((Controls[i] as TWinControl).Handle,
                         0, 0, 0, 0, 0, SWP_FRAMECHANGED+SWP_NOZORDER+
                         SWP_NOMOVE+SWP_NOSIZE+SWP_NOACTIVATE);
         Controls[i].Refresh;
         if Controls[i] is TWinControl then
            RefreshControls(Controls[i] as TWinControl);
      end
   end;
begin
   if FormOK then
   with FParentForm do
   begin
      RefreshControls(FParentForm);
      if ComponentsOk then
      begin
         { Let's look for window's childs, if they are not controls,
           then they are components or their captions }
         Wnd := GetWindow(Handle,GW_CHILD);
         while Wnd <> 0 do
         begin
            if FindControl(Wnd) = nil then
               InvalidateRect(Wnd,nil,False);
            Wnd := GetWindow(Wnd,GW_HWNDNEXT);
         end;
      end;
      Refresh;
   end;
end;
{-- TMMDesigner ---------------------------------------------------------}
procedure TMMDesigner.GetComponentPos(Comp: TComponent; var CompRect: TCompRect);
var
   Pt: TPoint;
begin
   with CompRect do
   if Comp is TControl then
   begin
      Ok := True;
      Pt := ClientToClient(FParentForm,Comp as TControl,Point(0,0));
      Left := Pt.X;
      Top  := Pt.Y;
      Width := (Comp as TControl).Width;
      Height := (Comp as TControl).Height;
   end
   else if Comp <> nil then
   begin
      Ok := True;
      Left := LoWord(Comp.DesignInfo);
      Top := HiWord(Comp.DesignInfo);
      {$IFDEF WIN32}
      if (FParentComponent is TDataModule) then
      begin
         inc(Left,2);
         inc(Top,2);
      end;
      {$ENDIF}
      Width := ComponentWidth;
      Height := ComponentHeight;
   end
   else OK := False;
end;
{-- TMMDesigner ---------------------------------------------------------}
procedure TMMDesigner.DrawConnection(CompRect1, CompRect2: TCompRect;ArrowOk: Boolean);
var
   x1,y1,x2,y2: integer;
begin
   with FParentForm.Canvas do
   begin
      x1 := CompRect1.Left + CompRect1.Width;
      y1 := CompRect1.Top + CompRect1.Height div 2 - (CompRect1.Height+1) mod 2;
      x2 := CompRect2.Left;
      y2 := CompRect2.Top + CompRect2.Height div 2 - (CompRect2.Height+1) mod 2;
      if (CompRect1.Left + CompRect1.Width+2*FMargin > CompRect2.Left) and
         ((CompRect1.Top <> CompRect2.Top) or (CompRect1.Left > CompRect2.Left)) then
      begin
         if (CompRect1.Top > CompRect2.Top) then
         begin
            if (CompRect2.Top + CompRect2.Height + 2*FMargin > CompRect1.Top) then
            begin
               MoveTo(x1,y1);
               LineTo(Max(x1+FMargin,CompRect2.Left+CompRect2.Width+FMargin),y1);
               LineTo(Max(x1+FMargin,CompRect2.Left+CompRect2.Width+FMargin),CompRect2.Top-FMargin);
               LineTo(x2-FMargin,CompRect2.Top-FMargin);
               LineTo(x2-FMargin,y2);
               LineTo(x2,y2);
            end
            else
            begin
               MoveTo(x1,y1);
               LineTo(Max(x1+FMargin,CompRect2.Left+CompRect2.Width+FMargin),y1);
               LineTo(Max(x1+FMargin,CompRect2.Left+CompRect2.Width+FMargin),CompRect2.Top+CompRect2.Height+FMargin);
               LineTo(x2-FMargin,CompRect2.Top+CompRect2.Height+FMargin);
               LineTo(x2-FMargin,y2);
               LineTo(x2,y2);
            end;
         end
         else
         begin
            if (CompRect1.Top + CompRect1.Height+2*FMargin > CompRect2.Top) then
            begin
               MoveTo(x1,y1);
               LineTo(Max(x1+FMargin,CompRect2.Left+CompRect2.Width+FMargin),y1);
               LineTo(Max(x1+FMargin,CompRect2.Left+CompRect2.Width+FMargin),CompRect2.Top+CompRect2.Height+FMargin);
               LineTo(x2-FMargin,CompRect2.Top+CompRect2.Height+FMargin);
               LineTo(x2-FMargin,y2);
               LineTo(x2,y2);
            end
            else
            begin
               MoveTo(x1,y1);
               LineTo(Max(x1+FMargin,CompRect2.Left+CompRect2.Width+FMargin),y1);
               LineTo(Max(x1+FMargin,CompRect2.Left+CompRect2.Width+FMargin),CompRect2.Top-FMargin);
               LineTo(x2-FMargin,CompRect2.Top-FMargin);
               LineTo(x2-FMargin,y2);
               LineTo(x2,y2);
            end;
         end;
      end
      else
      begin
         MoveTo(x1,y1);
         LineTo(x2-FMargin,y1);
         LineTo(x2-FMargin,y2);
         LineTo(x2,y2);
      end;
      if ArrowOk then
      begin
         MoveTo(x2-2,y2-1); LineTo(x2-2,y2+2);
         MoveTo(x2-3,y2-2); LineTo(x2-3,y2+3);
      end;
   end;
end;
type
    TCustomControlWithCanvas = class(TCustomControl)
    public
       property Canvas;
    end;
{-- TMMDesigner ---------------------------------------------------------}
procedure TMMDesigner.DrawPorts(Comp: TComponent; InPort,OutPort: Boolean);
var
   R: TRect;
   x1,y1,x2,y2: integer;
   CompRect: TCompRect;
begin
   if (Comp is TControl) and not ControlVisible(Comp as TControl) then
      Exit;
   GetComponentPos(Comp, CompRect);
   with FParentForm.Canvas do
   begin
      Brush.Color := clNavy;
      y1 := CompRect.Top + (CompRect.Height div 2 - Griff div 2 - (CompRect.Height+1) mod 2);
      y2 := y1 + Griff;
      if InPort then
      begin
        x1 := CompRect.Left - Griff div 2;
        x2 := x1 + Griff;
        R := Rect(x1,y1,x2,y2);
        FillRect(R);
        {$IFDEF BUILD_ACTIVEX}
        if (Comp is TCustomControl) then
        with TCustomControlWithCanvas(Comp) do
        begin
           MapWindowPoints(FParentForm.Handle,Handle,R,2);
           Canvas.Brush.Color := clNavy;
           Canvas.FillRect(R);
        end;
        {$ENDIF}
      end;
      if OutPort then
      begin
        x1 := CompRect.Left + CompRect.Width + Griff div 2;
        x2 := x1 - Griff;
        R := Rect(x1,y1,x2,y2);
        FillRect(R);
        {$IFDEF BUILD_ACTIVEX}
        if (Comp is TCustomControl) then
        with TCustomControlWithCanvas(Comp) do
        begin
           MapWindowPoints(FParentForm.Handle,Handle,R,2);
           Canvas.Brush.Color := clNavy;
           Canvas.FillRect(R);
        end;
        {$ENDIF}
      end;
    end;
end;
{-- Port utils ----------------------------------------------------------}
type
   TInfoRec = packed record
    case Byte of
        0 : (InPort: WordBool; OutPort: WordBool);
        1 : (Long: LongInt);
   end;
{------------------------------------------------------------------------}
function GetPortInfo(Designer: TMMDesigner; i: Integer): TInfoRec;
begin
   if not Designer.FValidLists and not Designer.FRebuilding then
      Designer.RebuildLists;
   if Designer.FPortList = nil then
      Result.Long := 0
   else
      Result.Long := LongInt(Designer.FPortList[i]);
end;
{------------------------------------------------------------------------}
procedure SetPortInfo(Designer: TMMDesigner; i: Integer; const Info: TInfoRec);
begin
   Designer.FPortList[i] := Pointer(Info.Long);
end;
{-- TMMDesigner ---------------------------------------------------------}
procedure TMMDesigner.RebuildLists;
   procedure AddConn(C1, C2: TComponent);
   begin
      FConnList.Add(C1);
      FConnList.Add(C2);
   end;
   procedure FindReferred(C : TComponent; Prop : Integer; PropType : TPropType);
   var
      i           : Integer;
      R           : TComponent;
      CInfo, RInfo: TInfoRec;
   begin
    for i := 0 to FParentComponent.ComponentCount - 1 do
    begin
       R := FParentComponent.Components[i];
       if C <> R then
       with TPropRec(PropList[Prop]) do
       if ((PropType = ptOutput) and (R is ClassTo)) or
          ((PropType = ptInput) and (R is ClassFrom)) then
          if not HasException(C,R,Prop) and
             (not Assigned(CheckProc) or
              ((PropType = ptOutput) and CheckProc(C,R)) or
              ((PropType = ptInput) and CheckProc(R,C))) then
             begin
                CInfo := GetPortInfo(Self,C.ComponentIndex);
                RInfo := GetPortInfo(Self,R.ComponentIndex);
                if PropType = ptOutput then
                begin
                   CInfo.OutPort := True;
                   RInfo.InPort  := True;
                   if GetPropValue(C,Prop) = R then
                      AddConn(C,R);
                end
                else
                begin
                   RInfo.OutPort := True;
                   CInfo.InPort  := True;
                   if GetPropValue(C,Prop) = R then
                      AddConn(R,C);
                end;
                SetPortInfo(Self,C.ComponentIndex,CInfo);
                SetPortInfo(Self,R.ComponentIndex,RInfo);
             end;
       end;
    end;
var
    i, j : Integer;
    C : TComponent;
begin
    FRebuilding := True;
    try
        if FPortList <> nil then
           FPortList.Clear
        else
           FPortList:= TList.Create;
        if FConnList <> nil then
           FConnList.Clear
        else
           FConnList := TList.Create;
        with FParentComponent do
        begin
           FPortList.Capacity := ComponentCount;
           for i := 0 to ComponentCount - 1 do
               FPortList.Add(nil);
           for i := 0 to ComponentCount - 1 do
           begin
              C := Components[i];
              for j := 0 to PropList.Count - 1 do
              if Allowed[j] <> nil then
              with TPropRec(PropList[j]) do
              if PropType = ptOutput then
              begin
                 if (C is ClassFrom) and CheckPropAvail(C,j,True) then
                     FindReferred(C,j,ptOutput)
              end
              else if PropType = ptInput then
              begin
                 if (C is ClassTo) and CheckPropAvail(C,j,True) then
                     FindReferred(C,j,ptInput)
              end;
           end;
        end;
    finally
        FRebuilding := False;
    end;
    FValidLists := True;
end;
{-- TMMDesigner ---------------------------------------------------------}
procedure TMMDesigner.Notification(AComponent: TComponent; Operation: TOperation);
begin
    inherited Notification(AComponent,Operation);
    FValidLists := False;
end;
{-- TMMDesigner ---------------------------------------------------------}
procedure TMMDesigner.DrawPaintBox;
var
   i: integer;
var
   Info     : TInfoRec;
   procedure DrawConn(C1, C2 : TComponent);
   var
      R1, R2 : TCompRect;
   begin
      GetComponentPos(C1, R1);
      GetComponentPos(C2, R2);
      DrawConnection(R1,R2,True);
   end;
   procedure DrawConnections;
   var
    i : Integer;
   begin
    for i := 0 to FConnList.Count div 2 - 1 do
        DrawConn(TComponent(FConnList[2*i]),TComponent(FConnList[2*i+1]));
   end;
begin
   if IsCompiling then exit;
   if PaintOk then FPaintOk := True;
   if (csDesigning in ComponentState) and FPaintOk and FActive and FVisible then
   with FParentComponent do
   begin
      RefreshForm(True,True);
      SetPen(FColor,FLineWidth,psSolid);
      RebuildLists;
      for i := 0 to ComponentCount-1 do
      begin
         Info := GetPortInfo(Self,i);
         { draw all input and output ports }
         DrawPorts(Components[i],Info.InPort,Info.OutPort);
      end;
      DrawConnections;
      if Adjusting and assigned(_RedrawTrack) then
         _RedrawTrack(True);
      inc(PaintCount);
      if PaintCount >= CreateCount then
      begin
         PaintOk := False;
         PaintCount := 0;
      end;
      FPaintOk := False;
   end
   else if PaintOk and FActive and Adjusting then
   begin
      if assigned(_RedrawTrack) then
         _RedrawTrack(True);
      PaintOK := False;
   end;
end;
{-- TMMDesigner ---------------------------------------------------------}
procedure TMMDesigner.TimerAction(Sender: TObject);
begin
   if AutoUpdate then DrawPaintBox;
end;
{-- TMMDesigner ---------------------------------------------------------}
procedure TMMDesigner.SetLineWidth(aValue: integer);
begin
   if (FLineWidth <> aValue) then
   begin
      FLineWidth := aValue;
      FPaintOk := True;
      DrawPaintBox;
   end;
end;
{-- TMMDesigner ---------------------------------------------------------}
procedure TMMDesigner.SetMargin(aValue: integer);
begin
   if (FMargin <> aValue) then
   begin
      FMargin := aValue;
      FPaintOk := True;
      DrawPaintBox;
   end;
end;
{-- TMMDesigner ---------------------------------------------------------}
procedure TMMDesigner.SetColor(aValue: TColor);
begin
   if (FColor <> aValue) then
   begin
      FColor := aValue;
      FPaintOk := True;
      DrawPaintBox;
   end;
end;
{-- TMMDesigner ---------------------------------------------------------}
procedure TMMDesigner.SetActive(aValue: Boolean);
begin
   if aValue then
   begin
      FPaintOk := True;
      DrawPaintBox;
   end
   else
   begin
      RefreshForm(True,True);
   end;
   FActive := aValue;
end;
{-- TMMDesigner ---------------------------------------------------------}
procedure TMMDesigner.SetUpdate(aValue: Boolean);
begin
   if aValue then
   begin
      Active := False;
      Active := True;
   end;
   FUpdate := False;
end;
{-- TMMDesigner ---------------------------------------------------------}
function TMMDesigner.FindTarget(Form: TForm; Wnd: HWND; var Pt: TPoint;
                                var TargetType: TPropType; var R: TRect): TComponent;
var
   i: Integer;
   function Check(C: TComponent): Boolean;
   begin
      if C = nil then
      begin
         Result := False;
         Exit;
      end;
      Result := True;
      if HasInput(C) and CheckInput(C,Pt,R) then
      begin
         TargetType := ptInput;
         Exit;
      end;
      if HasOutput(C) and CheckOutput(C,Pt,R) then
      begin
         TargetType := ptOutput;
         Exit;
      end;
      Result := False;
   end;
   procedure MapIt;
   begin
      MapWindowPoints(Wnd,Form.Handle,R,2);
      MapWindowPoints(Wnd,Form.Handle,Pt,1);
   end;
begin
   MapIt;
   with FParentComponent do
   for i := 0 to ComponentCount - 1 do
   if Check(Components[i]) then
   begin
      Result := Components[i];
      Exit;
   end;
   Result := nil;
end;
{-- TMMDesigner ---------------------------------------------------------}
function TMMDesigner.HasInput(C: TComponent): Boolean;
begin
   Result := GetPortInfo(Self,C.ComponentIndex).InPort;
end;
{-- TMMDesigner ---------------------------------------------------------}
function TMMDesigner.HasOutput(C: TComponent): Boolean;
begin
   Result := GetPortInfo(Self,C.ComponentIndex).OutPort;
end;
{-- TMMDesigner ---------------------------------------------------------}
function TMMDesigner.HasPotentialInput(C: TComponent): Boolean;
begin
   Result := HasInput(C);
end;
{-- TMMDesigner ---------------------------------------------------------}
function TMMDesigner.HasPotentialOutput(C: TComponent): Boolean;
begin
   Result := HasOutput(C);
end;
{-- TMMDesigner ---------------------------------------------------------}
function TMMDesigner.CheckInput(C: TComponent; Pt: TPoint; var R: TRect): Boolean;
begin
   R := LeftGriff(C);
   if C is TControl then
   begin
      R.TopLeft     := ClientToClient(GetParentForm(C as TControl), (C as TControl).Parent, R.TopLeft);
      R.BottomRight := ClientToClient(GetParentForm(C as TControl), (C as TControl).Parent, R.BottomRight);
   end;
   Result   := PtInRect(R, Pt);
end;
{-- TMMDesigner ---------------------------------------------------------}
function TMMDesigner.CheckOutput(C: TComponent; Pt: TPoint; var R: TRect): Boolean;
begin
   R := RightGriff(C);
   if C is TControl then
   begin
      R.TopLeft     := ClientToClient(GetParentForm(C as TControl), (C as TControl).Parent, R.TopLeft);
      R.BottomRight := ClientToClient(GetParentForm(C as TControl), (C as TControl).Parent, R.BottomRight);
   end;
   Result := PtInRect(R, Pt);
end;
{-- TMMDesigner ---------------------------------------------------------}
function TMMDesigner.HasException(CompFrom: TComponent; CompTo: TComponent;
                      Index: Integer): Boolean;
var
   i         : Integer;
   Pt        : TPropType;
   CFrom, CTo: TClass;
   PName     : string;
begin
   with TPropRec(PropList[Index]) do
   begin
      if CompFrom = nil then
         CFrom := ClassFrom
      else
         CFrom := CompFrom.ClassType;
      if CompTo = nil then
         CTo := ClassTo
      else
         CTo := CompTo.ClassType;
      PName   := PropName;
      Pt      := PropType;
   end;
   for i := 0 to ExcPropList.Count - 1 do
   with TPropRec(ExcPropList[i]) do
   if (PropType = Pt) and (PropName = PName) and
      ((ClassFrom = nil) or CFrom.InheritsFrom(ClassFrom)) and
      ((ClassTo = nil) or CTo.InheritsFrom(ClassTo)) and
      ((@CheckProc = nil) or CheckProc(CompFrom,CompTo)) then
   begin
      Result := True;
      Exit;
   end;
   Result := False;
end;
{-- TMMDesigner ---------------------------------------------------------}
function TMMDesigner.FindProp(Pt: TPropType; CFrom: TComponent; CTo: TComponent;
                  StartFrom: Integer): Integer;
var
    i : Integer;
begin
   for i := StartFrom + 1 to PropList.Count - 1 do
   with TPropRec(PropList[i]) do
   if (PropType = Pt) then
    if Allowed[i] <> nil then
      if (CFrom = nil) or ((CFrom is ClassFrom) and CheckPropAvail(CFrom,i,PropType=ptOutput)) then
         if (CTo = nil) or ((CTo is ClassTo) and CheckPropAvail(CTo,i,PropType=ptInput)) then
            if not HasException(CFrom,CTo,i) then
            begin
               Result := i;
               Exit;
            end;
   Result := -1;
end;
{-- TMMDesigner ---------------------------------------------------------}
function TMMDesigner.FindRef(PropType: TPropType;C: TComponent;StartFrom: Integer): Integer;
begin
   if PropType = ptInput then
      Result := FindProp(ptInput,nil,C,StartFrom)
   else
      Result := FindProp(ptOutput,C,nil,StartFrom);
end;
{-- TMMDesigner ---------------------------------------------------------}
function TMMDesigner.FindRefs(PropType:TPropType;R,C:TComponent;StartFrom:Integer):Integer;
begin
   if PropType = ptInput then
      Result := FindProp(ptOutput,R,C,StartFrom)
   else
      Result := FindProp(ptInput,C,R,StartFrom);
end;
{-- TMMDesigner ---------------------------------------------------------}
function TMMDesigner.FindConnectProp(C1,C2: TComponent): Integer;
var
   i: Integer;
   FirstBusy : Integer;
begin
   FirstBusy := -1;
   i := FindProp(ptOutput,C1,C2,-1);
   while i <> -1 do
   begin
      with TPropRec(PropList[i]) do
      if not Assigned(CheckProc) or CheckProc(C1,C2) then
      begin
         if (GetPropValue(C1,i) = nil) then
         begin
            Result := i;
            Exit;
         end
         else if FirstBusy = -1 then
                 FirstBusy := i;
      end;
      i := FindProp(ptOutput,C1,C2,i);
   end;
   i := FindProp(ptInput,C1,C2,-1);
   while i <> -1 do
   begin
      with TPropRec(PropList[i]) do
      if not Assigned(CheckProc) or CheckProc(C1,C2) then
      begin
         if (GetPropValue(C2,i) = nil) then
         begin
            Result := i;
            Exit;
         end
         else if FirstBusy = -1 then
                 FirstBusy := i;
      end;
      i := FindProp(ptInput,C1,C2,i);
   end;
   Result := FirstBusy;
end;
{-- TMMDesigner ---------------------------------------------------------}
procedure TMMDesigner.Connect(C1,C2: TComponent);
var
    i : Integer;
begin
    i := FindConnectProp(C1,C2);
    if i <> -1 then
    begin
       with TPropRec(PropList[i]) do
       if PropType = ptOutput then
          SetPropValue(C1,i,C2)
       else
          SetPropValue(C2,i,C1);
    end;
end;
{-- TMMDesigner ---------------------------------------------------------}
function TMMDesigner.CanConnect(C1,C2: TComponent): Boolean;
begin
   Result := FindConnectProp(C1,C2) <> -1;
end;
{ Out -> In }
{-- TMMDesigner ---------------------------------------------------------}
procedure TMMDesigner.GetConnected(C: TComponent; List: TList);
var
    i, j: Integer;
    R: TComponent;
begin
   List.Clear;
   for j := 0 to C.Owner.ComponentCount - 1 do
   if C.Owner.Components[j] <> C then
   begin
      R := C.Owner.Components[j];
      i := FindProp(ptOutput,C,R,-1);
      while i <> -1 do
      begin
         if (GetPropValue(C,i) = R) then Break;
         i := FindProp(ptOutput,C,R,i);
      end;
      if i <> -1 then
      begin
         List.Add(R);
         Continue;
      end;
      i := FindProp(ptInput,C,R,-1);
      while i <> -1 do
      begin
         if (GetPropValue(R,i) = C) then Break;
         i := FindProp(ptInput,C,R,i);
      end;
      if i <> -1 then
      begin
         List.Add(R);
         Continue;
      end;
   end;
end;
{ Removes reference from C to others }
{-- TMMDesigner ---------------------------------------------------------}
function TMMDesigner.RemoveRef(C: TComponent; PropType: TPropType): Boolean;
var
   i: Integer;
begin
   i := FindRef(PropType,C,-1);
   while i <> -1 do
   begin
      with TPropRec(PropList[i]) do
      if (GetPropValue(C,i) <> nil) then
      begin { Ok, here it is }
         SetPropValue(C,i,nil);
         Result := True;
         Exit;
      end;
      i := FindRef(PropType,C,i);
    end;
    Result := False;
end;
{ Remove references from others to C }
{-- TMMDesigner ---------------------------------------------------------}
function TMMDesigner.RemoveRefs(C: TComponent; PropType: TPropType): Boolean;
var
   i, j: Integer;
   R : TComponent;
begin
   for j := 0 to C.Owner.ComponentCount - 1 do
   begin
      R := C.Owner.Components[j];
      if R <> C then
      begin
         i := FindRefs(PropType,R,C,-1);
         while i <> -1 do
         begin
            with TPropRec(PropList[i]) do
            if (GetPropValue(R,i) = C) then
            begin
               SetPropValue(R,i,nil);
               Result := True;
               Exit;
            end;
            i := FindRefs(PropType,R,C,i);
         end;
      end;
   end;
   Result := False;
end;
{-- TMMDesigner ---------------------------------------------------------}
function TMMDesigner.RemoveInput(C: TComponent): Boolean;
begin
   Result := RemoveRef(C,ptInput);
   if not Result then
      Result := RemoveRefs(C,ptInput);
end;
{-- TMMDesigner ---------------------------------------------------------}
function TMMDesigner.RemoveOutput(C: TComponent): Boolean;
begin
   Result := RemoveRef(C,ptOutput);
   if not Result then
      Result := RemoveRefs(C,ptOutput);
end;
{-- TMMDesigner ---------------------------------------------------------}
function  TMMDesigner.Allowed : TList;
var
    i : Integer;
begin
   if FAllowed.Count <> PropList.Count then
   begin
      FAllowed.Clear;
      FAllowed.Capacity := PropList.Count;
      for i := 0 to PropList.Count - 1 do
      if FProhibited.IndexOf(TPropRec(PropList[i]).PropGroup) = -1 then
         FAllowed.Add(Pointer(1))
      else
         FAllowed.Add(Pointer(0));
   end;
   Result := FAllowed;
end;
{------------------------------------------------------------------------}
procedure FreeProps; far;
var
   i: integer;
begin
   for i := 0 to PropList.Count-1 do
       TPropRec(PropList[i]).Free;
   PropList.Free;
   for i := 0 to PropList.Count-1 do
       TPropRec(ExcPropList[i]).Free;
   ExcPropList.Free;
end;
{-- TMMDesignerForm -----------------------------------------------------}
procedure TMMDesignerForm.FormShow(Sender: TObject);
   procedure FillGroups;
   var
      i : Integer;
      Group : string;
   begin
      with GroupBox do
      begin
         Items.BeginUpdate;
         try
             Items.Clear;
             for i := 0 to PropList.Count - 1 do
             begin
                Group := TPropRec(PropList[i]).PropGroup;
                if Items.IndexOf(Group) = -1 then
                begin
                   Items.Add(Group);
                   Selected[Items.Count-1] := (Designer.FProhibited.IndexOf(Group) = -1);
                end;
             end;
         finally
            Items.EndUpdate;
         end;
      end;
   end;
begin
   btnHeight.Enabled := Designer.Active;
   ckbActive.Checked := Designer.Active;
   ckbAuto.Checked := Designer.AutoUpdate;
   ckbSound.Checked := Designer.Sound;
   FillGroups;
end;
{-- TMMDesignerForm -----------------------------------------------------}
procedure TMMDesignerForm.CheckBoxClick(Sender: TObject);
begin
   if (Sender = ckbActive) then
   begin
      Designer.Active := ckbActive.Checked;
      btnHeight.Enabled := Designer.Active;
   end
   else if (Sender = ckbAuto) then
   begin
      Designer.AutoUpdate := ckbAuto.Checked;
   end
   else if (Sender = ckbSound) then
   begin
      Designer.Sound := ckbSound.Checked;
   end;
end;
{-- TMMDesignerForm -----------------------------------------------------}
procedure TMMDesignerForm.btnHeightClick(Sender: TObject);
begin
   Adjusting := True;
   Close;
end;
{-- TMMDesignerForm -----------------------------------------------------}
procedure TMMDesignerForm.FormHide(Sender: TObject);
var
   P :TPoint;
   R: TRect;
   procedure SetupProhibited;
   var
      i : Integer;
   begin
      Designer.FProhibited.Clear;
      with GroupBox do
      for i := 0 to Items.Count - 1 do
          if not Selected[i] then
             Designer.FProhibited.Add(Items[i]);
      { Force list rebuilding }
      Designer.FAllowed.Clear;
   end;
begin
   SetupProhibited;
   if Adjusting then
   with Designer do
   begin
      R := FParentForm.ClientRect;
      MapWindowPoints(FParentForm.Handle,0,R,2);
      ClipCursor(@R);
      GetCursorPos(P);
      DragPoint := Point(0,FParentForm.ScreenToClient(P).Y);
      DragDesigner := Designer;
      PaintOK := True;
   end;
end;
{-- TMMDesignerForm -----------------------------------------------------}
procedure TMMDesignerForm.btnAllClick(Sender: TObject);
var
    i : Integer;
begin
    with GroupBox do
    for i := 0 to Items.Count - 1 do
        Selected[i] := True;
end;
{-- TMMDesignerForm -----------------------------------------------------}
procedure TMMDesignerForm.btnNoneClick(Sender: TObject);
var
    i : Integer;
begin
    with GroupBox do
    for i := 0 to Items.Count - 1 do
        Selected[i] := False;
end;
initialization
   {$IFNDEF WIN32}
   AddExitProc(FreeProps);
   {$ENDIF}
   PropList    := TList.Create;
   ExcPropList := TList.Create;
   DesignerForm := nil;
{$IFDEF WIN32}
finalization
   FreeProps;
{$ENDIF}
end.

						