formcont.pas

Do your applications look a little boring? Would you like to get spectacular yet easy to use visual

    begin
      with TMethod(FCGetExtraDataClass) do
      begin
        Code := Method1;
        Data := aux;
      end;
      with TMethod(FCSetExtraData) do
      begin
        Code := Method2;
        Data := aux;
      end;
      Try
        if FormData.ExtraData = nil then
          FormData.ExtraData := FCGetExtraDataClass.Create;
        FCSetExtraData(FormData.ExtraData);
      Except
        on Exception  Do
          Application.HandleException(Self);
      End;
    end;
  End;
end;

procedure TFormContainer.SetForm(Value: TCustomForm; DestroyCurrent: Boolean);
(*
 {$ifndef D3C3}
  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 D3C3}
*)
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 D3C3}
        UpdateActionLists(opRemove);
        {$endif D3C3}
*)
        if Assigned(TFCCustomForm(FForm).OnClose) then
        begin
          if DestroyCurrent then
            CloseAction := caFree
          else
            CloseAction := caHide;
          Try                             //V3.4
            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      //V3.4
          Try
            OnFormDestroy(Self, Form);
          Except
            on Exception do
            Application.HandleException(Self);
          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
          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 D3C3}
        UpdateActionLists(opInsert);
        {$endif D3C3}
*)
        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              //V34
      If  TFCCustomForm(aux).ParentFont Then
    Begin
      TFCCustomForm(aux).Perform(45064,0,0);
      TFCCustomForm(aux).NotifyControls(45064);
    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 //V34
      Begin
        if Assigned(TFCEmbeddedForm(aux).OnGetExtraData) then
        Try
          TFCEmbeddedForm(aux).OnGetExtraData(Self,FData.FExtraData);
        Except
          on Exception  Do
            Application.HandleException(Self);
        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
   Try
     OnFormCreate(Self, aux);
   Except
     on Exception Do
      Application.HandleException(Self); //V3.4
   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
      Try
        OnFormChange(Self, Form, AForm, CanChange);
      Except
        on Exception Do
        Application.HandleException(Self);
      End;

      if not CanChange then
        Abort;

      SaveActiveControl := Screen.ActiveControl;

      if (TransitionToUse <> nil) and
         TransitionToUse.Prepared and
        (TransitionToUse.Passes = 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;

  NewLRUFormIndex := Index;
  try
    FData := LRUFormsData[Index];
    if FData.Form = nil then
      CreateForm(FData.FormClass);

    Result := True;
    ShowFormEx(FData.Form, DestroyCurrent,
      Transition, BackgrOptions,
      Align);
    finally
      NewLRUFormIndex := 0;
    end;