formcont.pas

delphi2007界面效果控件源码

  {$ifndef D9UP}
  procedure UpdateActionLists(Operation: TOperation);
  var
    I: Integer;
    Component: TComponent;
  begin
    for I := 0 to FForm.ComponentCount - 1 do
    begin
      Component := FForm.Components[I];
      if Component is TCustomActionList then
        case Operation of
          opInsert: AddActionList(TCustomActionList(Component));
          opRemove: RemoveActionList(TCustomActionList(Component));
        end;
    end;
  end;
  {$endif D9UP}

var
  aux,
  i: Integer;
  SaveFormData: TFCFormData;
  ParentForm: TCustomForm;
  FCOnFormDestroyData: TFCOnFormDestroyData;
  CloseAction: TCloseAction;
begin
  if Locked then
    raise EFormContainerError.Create(rsFCLockedFormCont);

  Locked := True;
  try
    if Value <> FForm then
    begin
      if(FForm <> nil) then
      begin
        aux := IndexOf(FForm)-1;
        SaveFormData := FormData;

        {$ifndef D9UP}
        UpdateActionLists(opRemove);
        {$endif D9UP}

        if Assigned(TFCCustomForm(FForm).OnClose) then
        begin
          if DestroyCurrent
          then CloseAction := caFree
          else CloseAction := caHide;
          try
            TFCCustomForm(FForm).OnClose(FForm, CloseAction);
          except
            on Exception do Application.HandleException(Self);
          end;

          if DoCheckOnClose then
          begin
            case CloseAction of
              caFree: DestroyCurrent := True;
              caHide: DestroyCurrent := False;
            end;
          end;
        end;

        if FForm.Menu <> nil then
        begin
          ParentForm := GetParentForm(Self);
          if ParentForm.Menu <> nil then
            ParentForm.Menu.Unmerge(FForm.Menu);
        end;

        if DestroyCurrent
        then
        begin
          if Assigned(OnFormDestroy) then
          begin
            try
              OnFormDestroy(Self, Form);
            except
              on Exception do Application.HandleException(Self);
            end;
          end;

          HideEmbeddedForms(FForm);
          FForm.Visible := False;
          SaveFormData.DoHide;

          if SaveLRUDestroyedForms
          then
          begin
            if(NewLRUFormIndex = 0)
            then
            begin
              if(LRUFormIndex <> 0) and (LRUFormIndex <> LRUFormCount)
              then
              begin
                for i := LRUFormCount downto LRUFormIndex+1 do
                  DeleteLRUFormByIndex(LRUFormCount);
              end
              else
              begin
                if LRUFormIndex = 0 then
                  FLRUForms.Add(FForms[aux]);
              end;
            end
            else
            begin
              if LRUFormIndex = 0 then
                FLRUForms.Add(FForms[aux]);
            end;
          end
          else
          begin
            if(NewLRUFormIndex = 0) then
            begin
              if(LRUFormIndex <> 0) and (LRUFormIndex <> LRUFormCount) then
              begin
                for i := LRUFormCount downto LRUFormIndex do
                  DeleteLRUFormByIndex(LRUFormCount);
              end;
            end;

            DeleteLRUForm(FForm);
          end;

          FForms.Delete(aux);
          DeleteFormData(SaveFormData);

          if(not(csDestroying in ComponentState)) and
            (GetParentForm(FForm) <> nil) then
          begin
            try
              if SaveLRUDestroyedForms then
                DestroyingLRUForm(SaveFormData);
            except
              on Exception do Application.HandleException(Self);
            end;

            if SafeFormDestroy
            then FForm.Release
            else FForm.Free
          end;
        end
        else
        begin
          if(csDestroying in ComponentState) and
            (Application.MainForm = nil)     and
            (TFCCustomForm(GetParentForm(Self)).FormStyle = fsMDIChild)
          then
          begin
            try
              FForm.Visible := False;
            except
              on E: EInvalidOperation do
              begin
                if E.Message <> SNoMDIForm then
                  raise;
              end;
            end;
          end
          else FForm.Visible := False;
          SaveFormData.DoHide;
          if(NewLRUFormIndex = 0)
          then
          begin
            if(LRUFormIndex <> 0) and (LRUFormIndex <> LRUFormCount)
            then
            begin
              for i := LRUFormCount - LRUFormIndex downto 1 do
                DeleteLRUFormByIndex(LRUFormCount);
            end
            else
            begin
              if LRUFormIndex = 0 then
                FLRUForms.Add(FForms[aux]);
            end;
          end
          else
          begin
            if LRUFormIndex = 0 then
              FLRUForms.Add(FForms[aux]);
          end;
        end;
      end;

      if LRUFormCount > LRUFormCapacity then
        DeleteLRUFormByIndex(1);

      FLRUFormIndex := 0;
      FForm         := Value;

      if FForm <> nil then
      begin
        if NewLRUFormIndex <> 0 then
          FLRUFormIndex := NewLRUFormIndex;
        FormData.DoShow;
        AdjustForm(False);
        FForm.Visible := True;

        ParentForm := GetParentForm(Self);
        if(FForm.Menu <> nil) and FForm.Menu.AutoMerge then
        begin
          if ParentForm.Menu <> nil then
            ParentForm.Menu.Merge(FForm.Menu);
        end;

        {$ifndef D9UP}
        UpdateActionLists(opInsert);
        {$endif D9UP}

        if(ParentForm.ParentWindow = 0)            and
          (GetOnFormDestroyData(ParentForm) = nil) then
        begin
          FCOnFormDestroyData                   := TFCOnFormDestroyData.Create;
          FCOnFormDestroyData.Form              := ParentForm;
          FCOnFormDestroyData.OnFormDestroyBack := TFCCustomForm(ParentForm).OnDestroy;

          if OnFormDestroyList = nil then
            OnFormDestroyList := TList.Create;

          OnFormDestroyList.Add(FCOnFormDestroyData);

          TFCCustomForm(ParentForm).OnDestroy := FCOnFormDestroyData.OnFormDestroy;
        end;
      end;
    end;
  finally
    Locked := False;
  end;
end;

function TFormContainer.CreateForm(AClass: TCustomFormClass): TCustomForm;
var
  aux: TCustomForm;
  FData: TFCFormData;
  Method: Pointer;
  FCGetExtraData: TFCGetExtraData;
begin
  if Locked then
    raise EFormContainerError.Create(rsFCLockedFormCont);

  Result := nil;
  Locked := True;
  try
    aux := AClass.CreateParented(Handle);

    if TFCCustomForm(aux).BorderStyle <> bsNone then
    begin
      aux.Release;
      raise EFormContainerError.Create(Format(rsFCBorderStyle, [AClass.ClassName]));
    end;
    if TFCCustomForm(aux).FormStyle <> fsNormal then
    begin
      aux.Release;
      raise EFormContainerError.Create(Format(rsFCStyle, [AClass.ClassName]));
    end;
    if aux.WindowState <> wsNormal then
    begin
      aux.Release;
      raise EFormContainerError.Create(Format(rsFCState, [AClass.ClassName]));
    end;
    if aux.Visible then
    begin
      aux.Release;
      raise EFormContainerError.Create(Format(rsFCVisible, [AClass.ClassName]));
    end;

    if AClass.InheritsFrom(TFCEmbeddedForm) then
    begin
      if TFCEmbeddedForm(aux).ParentFont then
      begin
        TFCEmbeddedForm(aux).Perform(CM_PARENTFONTCHANGED, 0, 0);
        TFCEmbeddedForm(aux).NotifyControls(CM_PARENTFONTCHANGED);
      end;
    end;

    InsertComponent(aux);
    InsertControl(aux);
    aux.BringToFront;

    if NewLRUFormIndex = 0
    then
    begin
      FData := TFCFormData.Create(aux);
      AllFormsData.Add(FData);
    end
    else
    begin
      FData := LRUFormsData[NewLRUFormIndex];
      FData.ReadData(aux);

      if aux is TFCEmbeddedForm
      then
      begin
        if Assigned(TFCEmbeddedForm(aux).OnGetExtraData) then
        begin
          try
            TFCEmbeddedForm(aux).OnGetExtraData(Self, FData.ExtraData);
          except
            on Exception do Application.HandleException(Self);
          end;
        end
      end
      else
      begin
        Method := aux.MethodAddress('FCGetExtraData');

        if Method <> nil then
        begin
          with TMethod(FCGetExtraData) do
          begin
            Code := Method;
            Data := aux;
          end;

          try
            FCGetExtraData(FData.ExtraData);
          except
            on Exception do Application.HandleException(Self);
          end;
        end;
      end;
    end;

    FForms.Add(FData);

    if Assigned(OnFormCreate) then
    begin
      try
        OnFormCreate(Self, aux);
      except
        on Exception do Application.HandleException(Self);
      end;
    end;

    Result := aux;
  finally
    Locked := False;
  end;
end;

function TFormContainer.CreateShowForm(AClass: TCustomFormClass;
  DestroyCurrent: Boolean): TCustomForm;
begin
  Result := CreateForm(AClass);
  ShowForm(Result, DestroyCurrent);
end;

function TFormContainer.CreateShowFormEx(AClass: TCustomFormClass;
  DestroyCurrent: Boolean; Transition: TTransitionEffect;
  BackgrOptions: TFCBackgroundOptions; Align: TFCFormAlign): TCustomForm;
begin
  Result := CreateForm(AClass);
  ShowFormEx(Result, DestroyCurrent, Transition, BackgrOptions, Align);
end;

procedure TFormContainer.ShowFormEx(AForm: TCustomForm; DestroyCurrent: Boolean;
  Transition: TTransitionEffect; BackgrOptions: TFCBackgroundOptions;
  Align: TFCFormAlign);

  function Destroying(Control: TControl): Boolean;
  begin
    Result := (csDestroying in Control.ComponentState) or
              ((Control.Parent <> nil) and Destroying(Control.Parent));
  end;

var
  SaveActiveControl: TControl;
  TransitionToUse: TTransitionEffect;
  DestroyTransition: Boolean;
  ParentForm: TCustomForm;
  CanChange,
  IsPrepared: Boolean;
begin
  try
    DestroyTransition := False;
    TransitionToUse := nil;

    if not Destroying(Self) then
    begin
      if AForm <> nil then
        TFCFormData(FForms[IndexOf(AForm)-1]).Align := Align;

      if(Transition = nil) and FlickerFree
      then
      begin
        TransitionToUse   := TFlickerFreeTransition.Create(nil);
        TransitionToUse.FlickerFreeWhenDisabled :=
          FlickerFreeTransition.FlickerFreeWhenDisabled;
        DestroyTransition := True;
      end
      else TransitionToUse := Transition;
    end;

    if TransitionToUse <> nil then
    begin
      if AutoScroll
      then IsPrepared := TransitionToUse.Prepare(Parent, BoundsRect)
      else IsPrepared := TransitionToUse.Prepare(Self  , ClientRect);
      if not IsPrepared then
      begin
        if DestroyTransition then
        begin
          TransitionToUse.Free;
          DestroyTransition := False;
        end;
        TransitionToUse := nil;
      end;
    end;

    try
      CanChange := True;
      if Assigned(OnFormChange) then
      begin
        try
          OnFormChange(Self, Form, AForm, CanChange);
        except
          on Exception do Application.HandleException(Self);
        end;
      end;
    if not CanChange then
        Abort;

      SaveActiveControl := Screen.ActiveControl;

      if(TransitionToUse <> nil)          and
         TransitionToUse.Prepared         and
        (TransitionToUse.Passes(nil) = 2) then
      begin
        SetForm(nil, DestroyCurrent);

        TransitionToUse.Prepare2ndPass;

        SetForm(AForm, False);
      end
      else SetForm(AForm, DestroyCurrent);

      if(BackgrOptions <> nil) and (BackgrOptions <> BackgroundOptions) then
        BackgroundOptions.Assign(BackgrOptions);

      if FForm <> nil then
      begin
        if(Screen.ActiveControl = nil) or
          (Screen.ActiveControl = FForm) or
          (not Screen.ActiveControl.TabStop) or
          ((SaveActiveControl <> nil) and
            (Screen.ActiveControl <> SaveActiveControl) and
            not IsChild(AForm.Handle, Screen.ActiveControl.Handle)) then
        begin
          if(FForm <> nil) and (IsWindowVisible(Handle)) then
          begin
            if FForm.ActiveControl <> nil
            then FForm.ActiveControl.SetFocus
            else SendMessage(FForm.Handle, WM_NEXTDLGCTL, 0, 0);
          end
          else
          begin
            ParentForm := GetParentForm(Self);
            if(FForm.ActiveControl <> nil) and FForm.ActiveControl.CanFocus
            then ParentForm.ActiveControl := FForm.ActiveControl
            else
              if IsWindowVisible(ParentForm.Handle) then
                SendMessage(FForm.Handle, WM_NEXTDLGCTL, 0, 0);
          end;
        end;
      end;
      if(TransitionToUse <> nil) and TransitionToUse.Prepared and (Form = AForm) then
        TransitionToUse.Execute;
    finally
      if TransitionToUse <> nil then TransitionToUse.UnPrepare;
      if DestroyTransition then TransitionToUse.Free;
    end;
  finally
    DoCheckOnClose := False;
  end;
end;

procedure TFormContainer.ShowForm(AForm: TCustomForm; DestroyCurrent: Boolean);
begin
  ShowFormEx(AForm, DestroyCurrent, nil,
    nil, fcfaDefault);
end;

function TFormContainer.ShowLRUForm(Index: Integer;
  DestroyCurrent: Boolean): Boolean;
begin
  Result := ShowLRUFormEx(Index, DestroyCurrent, nil,
    nil, fcfaDefault);
end;

function TFormContainer.ShowLRUFormEx(Index: Integer;
  DestroyCurrent: Boolean;
  Transition: TTransitionEffect;
  BackgrOptions: TFCBackgroundOptions;
  Align: TFCFormAlign): Boolean;
var
  FData: TFCFormData;
begin
  Result := False;
  if(Index < 1) or (Index > FLRUForms.Count) or (Index = FLRUFormIndex) then
    Exit;