formcont.pas

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

 end;
end;
{$endif D3C3}

{ TFCFormData }
constructor TFCFormData.Create(AForm: TCustomForm);
begin
  FFormClass   := TCustomFormClass(AForm.ClassType);
  FAlign       := fcfaDefault;
  FPosition    := TFCCustomForm(AForm).Position;
  FBorderIcons := TFCCustomForm(AForm).BorderIcons;
  FExtraData   := nil;

  ReadData(AForm);

  TFCCustomForm(AForm).Position := poDesigned;
end;

destructor TFCFormData.Destroy;
begin
  ExtraData.Free;

  inherited;
end;

procedure TFCFormData.ReadData(AForm: TCustomForm);
begin
  DoneShow    := False;
  FForm       := AForm;
  Description := AForm.Caption;

  if Assigned(TFCCustomForm(AForm).OnHide) then
  begin
    FOnHide := TFCCustomForm(AForm).OnHide;
    TFCCustomForm(AForm).OnHide := nil;
  end;

  if Assigned(TFCCustomForm(AForm).OnShow) then
  begin
    FOnShow := TFCCustomForm(AForm).OnShow;
    TFCCustomForm(AForm).OnShow := nil;
  end;

  TFCWinControl(AForm).OnEnter := TFCCustomForm(AForm).OnActivate;
  TFCWinControl(AForm).OnExit  := TFCCustomForm(AForm).OnDeactivate;
end;

procedure TFCFormData.DoHide;
begin
  if DoneShow then
  begin
    if Assigned(FOnHide) then
      Try
          FOnHide(Form);
      Except
        on Exception do
        Application.HandleException(Form);
      End;
      DoneShow := False;
  end;
end;

procedure TFCFormData.DoShow;
begin
  if not DoneShow then
  begin
    if Assigned(FOnShow) then
      Try
        FOnShow(Form);
      Except
        on Exception do
        Application.HandleException(Form);
      End;
    DoneShow := True;
  end;
end;

{ TFCOnFormDestroyData }
procedure TFCOnFormDestroyData.OnFormDestroy(Sender: TObject);
begin
  HideEmbeddedForms(Form);
  OnFormDestroyList.Remove(Self);
  if OnFormDestroyList.Count = 0 then
  begin
    OnFormDestroyList.Free;
    OnFormDestroyList := nil;
  end;
  if Assigned(OnFormDestroyBack) then
    Try
      OnFormDestroyBack(Sender);
    Except
        on Exception do
        Application.HandleException(Sender);
    End;
  Free;
end;

{ TFormContainer }
constructor TFormContainer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FCanvas := TControlCanvas.Create;
  TControlCanvas(FCanvas).Control := Self;

  ControlStyle           :=
    [csAcceptsControls, csCaptureMouse, csClickEvents, csOpaque, csDoubleClicks];
  AutoScroll             := False;
  Locked                 := False;
  FForm                  := nil;
  Width                  := 185;
  Height                 :=  41;
  FBorderStyle           := bsNone;
  FFlickerFree           := True;
  FSaveLRUDestroyedForms := False;
  FLRUFormIndex          :=  0;
  NewLRUFormIndex        :=  0;
  FLRUFormCapacity       := 20;
  FForms                 := TList.Create;
  AllFormsData           := TList.Create;
  FLRUForms              := TList.Create;
  FSafeFormDestroy       := True;
  FBackgroundOptions     := TFCBackgroundOptions.Create;
  DoCheckOnClose         := False;
end;

destructor TFormContainer.Destroy;
var
  i: Integer;
begin
  FBackgroundOptions.Free;
  FBackgroundOptions := nil;
  HideEmbeddedForms(Self);

  if Assigned(FForms) then
    for i:= 1 to FormCount do
      Forms[i].Visible := False;

  if Assigned(AllFormsData) then
    for i:= 0 to AllFormsData.Count-1 do
      TFCFormData(AllFormsData[i]).Free;

  FForms   .Free;
  FLRUForms.Free;
  AllFormsData.Free;

  FCanvas.Free;

  inherited Destroy;
end;

function TFormContainer.GetForms(Index: Integer): TCustomForm;
var
  FData: TFCFormData;
begin
  FData := FormsData[Index];
  if FData <> nil
  then Result := FData.Form
  else Result := nil;
end;

function TFormContainer.FormData: TFCFormData;
begin
  Result := FormsData[IndexOf(FForm)];
end;

function TFormContainer.GetFormData(Index: Integer): TFCFormData;
begin
  if(Index >= 1) and (Index <= FormCount)
  then Result := TFCFormData(FForms[Index-1])
  else Result := nil;
end;

function TFormContainer.GetLRUForm(Index: Integer): TCustomForm;
var
  FData: TFCFormData;
begin
  FData := LRUFormsData[Index];
  if FData <> nil
  then Result := FData.Form
  else Result := nil;
end;

function TFormContainer.GetLRUFormData(Index: Integer): TFCFormData;
begin
  if(Index >= 1) and (Index <= LRUFormCount)
  then Result := TFCFormData(FLRUForms[Index-1])
  else Result := nil;
end;

procedure TFormContainer.SetLRUFormCapacity(Value: Integer);
var
  i: Integer;
begin
  if FLRUFormCapacity <> Value then
  begin
    FLRUFormCapacity := Value;

    if FLRUFormCapacity < LRUFormCount then
    begin  // Eliminate LRU forms
      for i := LRUFormCount - FLRUFormCapacity downto 1 do
        DeleteLRUFormByIndex(1);
    end;
    if FLRUFormCapacity < FLRUForms.Capacity then
      FLRUForms.Capacity := FLRUFormCapacity;
  end;
end;

function TFormContainer.FormCount: Integer;
begin
  Result := FForms.Count;
end;

function TFormContainer.LRUFormCount: Integer;
begin
  Result := FLRUForms.Count;
end;

function TFormContainer.IndexOf(Value: TCustomForm): Integer;
var
  i: Integer;
begin
  Result := 0;
  for i:=0 to FForms.Count-1 do
    if TFCFormData(FForms[i]).Form = Value then
    begin
      Result := i + 1;
      Break;
    end;
  if Result = 0 then
    raise EFormContainerError.Create(Format(rsFCUnknownForm, [Value.Name]));
end;

function TFormContainer.GetPicture: TPicture;
begin
  Result := BackgroundOptions.Picture;
end;

procedure TFormContainer.SetPicture(const Value: TPicture);
begin
  BackgroundOptions.Picture := Value;
end;

function TFormContainer.GetVersion: String;
begin
  Result := BilleniumEffectsVersion;
end;

procedure TFormContainer.SetVersion(const Value: String);
begin
end;

function TFormContainer.GetFormAlignToUse(Form: TCustomForm): TFCFormAlign;
var
  FormData: TFCFormData;
  BorderIcons: TBorderIcons;
  Position: TPosition;
begin
  Result := FormAlign;
  if Result = fcfaDefault
  then
  begin
    if Form is TFCEmbeddedForm
    then Result := TFCEmbeddedForm(Form).Alignment
    else
    begin
      FormData    := FormsData[IndexOf(Form)];
      BorderIcons := FormData.BorderIcons;
      Position    := FormData.Position;

      if biMaximize in BorderIcons
      then Result := fcfaClient
      else
        case Position of
          poDesigned: Result := fcfaNone;
{$ifndef D3C3}
          poDesktopCenter,
{$endif D3C3}
{$ifdef D5UP}
          poOwnerFormCenter,
{$endif D5UP}
          poScreenCenter  : Result := fcfaCenter;
{$ifdef D5UP}
          poMainFormCenter: Result := fcfaMainFormCenter;
{$endif D5UP}
          else Result := fcfaTopLeft;
        end;
    end;
  end;
end;

procedure TFormContainer.AdjustForm(CheckVisible: Boolean);
var
  LeftNew, TopNew, WidthNew, HeightNew: Integer;
  P: TPoint;
  ParentForm: TCustomForm;
  AlignToUse: TFCFormAlign;
begin
  if(FForm <> nil) and (FForm.Visible or (not CheckVisible)) then
  begin
    with FForm do
    begin
      LeftNew   := 0;
      TopNew    := 0;
      WidthNew  := 0;
      HeightNew := 0;

      AlignToUse := GetFormAlignToUse(FForm);

      case AlignToUse of
        fcfaClient: { it磗 sizeable, so we adjust it to fit the Parent }
        begin
          LeftNew   := 0;
          TopNew    := 0;
          WidthNew  := Self.ClientWidth;
          HeightNew := Self.ClientHeight;
        end;
        fcfaTopLeft: { it maintains its size, and positions at (0, 0) }
        begin
          LeftNew   := 0;
          TopNew    := 0;
          WidthNew  := Width;
          HeightNew := Height;
        end;
        fcfaCenter: { it maintains its size, and positions at center }
        begin
          WidthNew  := Width;
          HeightNew := Height;

          if(Self.ClientWidth >= WidthNew)
          then { it磗 smaller horizontally, so we center it in the Parent }
            LeftNew := (Self.ClientWidth - WidthNew ) div 2
          else { it磗 bigger horizontally, so we position it at 0 }
            LeftNew := 0;
          if(Self.ClientHeight >= HeightNew)
          then { it磗 smaller vertically, so we center it in the Parent }
            TopNew := (Self.ClientHeight - HeightNew) div 2
          else { it磗 bigger vertically, so we position it at 0 }
            TopNew := 0;
        end;
        fcfaMainFormCenter: { it maintains its size, and positions at center of
                              main form }
        begin
          WidthNew   := Width;
          HeightNew  := Height;

          ParentForm := GetParentForm(Self);
          P.x        := (ParentForm.ClientWidth  - WidthNew ) div 2;
          P.y        := (ParentForm.ClientHeight - HeightNew) div 2;
          P          := ParentForm.ClientToScreen(P);
          P          := Self.ScreenToClient(P);
          LeftNew    := P.x;
          TopNew     := P.y;
        end;
        fcfaNone:
        begin
          LeftNew   := Left;
          TopNew    := Top;
          WidthNew  := Width;
          HeightNew := Height;
        end;
      end;

      if IsScrollBarVisible(Self, Self.Handle, sbHorizontal) then
      begin
        LeftNew  := Left;
        WidthNew := Width;
      end;

      if IsScrollBarVisible(Self, Self.Handle, sbVertical) then
      begin
        TopNew    := Top;
        HeightNew := Height;
      end;

      if(LeftNew  <> Left ) or (TopNew    <> Top   ) or
        (WidthNew <> Width) or (HeightNew <> Height) then
      begin
        SetBounds(LeftNew, TopNew, WidthNew, HeightNew);
        FForm.Realign;
      end;
    end;
  end;
end;

function TFormContainer.FormAlign: TFCFormAlign;
begin
  if FForm <> nil
  then Result := FormData.Align
  else Result := fcfaDefault;
end;

function TFormContainer.CloseQuery: Boolean;
begin
  Result := (FForm = nil) or FForm.CloseQuery;
end;

function TFormContainer.CloseQueryAll: Boolean;
var
  i: Integer;
begin
  Result := True;
  for i := FormCount downto 1 do
  begin
    Result := Forms[i].CloseQuery;
    if not Result then break;
  end;
end;

procedure TFormContainer.AlignControls(AControl: TControl; var Rect: TRect);
begin
  inherited AlignControls(AControl, Rect);
  AdjustForm(True);
end;

procedure TFormContainer.CreateParams(var Params: TCreateParams);
const
  BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := Style or BorderStyles[FBorderStyle];
    if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then
    begin
      Style := Style and not WS_BORDER;
      ExStyle := ExStyle or WS_EX_CLIENTEDGE;
    end;
    WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
  end;
end;

procedure TFormContainer.SetBorderStyle(Value: TBorderStyle);
begin
  if FBorderStyle <> Value then
  begin
    FBorderStyle := Value;
    RecreateWnd;
  end;
end;
(*
{$ifndef D3C3}
procedure TFormContainer.AddActionList(ActionList: TCustomActionList);
var
  Form: TCustomForm;
begin
  Form := GetParentForm(Self);
  if Form <> nil then
  begin
    if TFCCustomForm(Form). .FActionLists = nil then
      TFCCustomForm(Form).FActionLists := TList.Create;
    TFCCustomForm(Form).FActionLists.Add(ActionList);
  end;
end;

procedure TFormContainer.RemoveActionList(ActionList: TCustomActionList);
var
  Form: TCustomForm;
begin
  Form := GetParentForm(Self);
  if (Form <> nil) and (TFCCustomForm(Form).FActionLists <> nil) then
    TFCCustomForm(Form).FActionLists.Remove(ActionList);
end;

procedure TFormContainer.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;

  case Operation of
    opInsert:
      if AComponent is TCustomActionList then
        AddActionList(TCustomActionList(AComponent));
    opRemove:
      if AComponent is TCustomActionList then
        RemoveActionList(TCustomActionList(AComponent));
  end;

end;
{$endif D3C3}
*)
procedure TFormContainer.DestroyingLRUForm(FormData: TFCFormData);
var
  aux: TCustomForm;
  Method1,
  Method2: Pointer;
  ExtraDataClass: TFCExtraDataClass;
  FCGetExtraDataClass: TFCGetExtraDataClass;
  FCSetExtraData     : TFCSetExtraData;
begin
  aux := FormData.FForm;
  FormData.FForm := nil;
  If aux Is TFCEmbeddedForm  Then //V34
  Begin
    if Assigned(TFCEmbeddedForm(aux).OnGetExtraDataClass) Then
    Try
      If FormData.FExtraData = Nil Then
      Begin
        TFCEmbeddedForm(aux).OnGetExtraDataClass(Self,ExtraDataClass);
        FormData.ExtraData:=ExtraDataClass.Create;
      End;
        If Assigned(TFCEmbeddedForm(aux).OnSetExtraData) Then
          TFCEmbeddedForm(aux).OnSetExtraData(Self,FormData.ExtraData);
    Except
      on Exception  Do
        Application.HandleException(Self);
    End;
  End
  Else
  Begin
    Method1 := aux.MethodAddress('FCGetExtraDataClass');
    Method2 := aux.MethodAddress('FCSetExtraData');
    if(Method1 <> nil) and (Method2 <> nil) then