mmdesign.pas

一套及时通讯的原码

      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;