formcont.pas

delphi2007界面效果控件源码

  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
    begin
      try
        FOnHide(Form);
      except
        on Exception do Application.HandleException(Form);
      end;
    end;

    DoneShow := False; // DoShow can be executed now
  end;
end;

procedure TFCFormData.DoShow;
begin
  if not DoneShow then
  begin
    if Assigned(FOnShow) then
    begin
      try
        FOnShow(Form);
      except
        on Exception do Application.HandleException(Form);
      end;
    end;

    DoneShow := True; // DoShow can not be re-executed
  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
  begin
    try
      OnFormDestroyBack(Sender);
    except
      on Exception do Application.HandleException(Sender);
    end;
  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;
          poDesktopCenter,
          poOwnerFormCenter,
          poScreenCenter  : Result := fcfaCenter;
          poMainFormCenter: Result := fcfaMainFormCenter;
          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 D9UP}
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 D9UP}

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
  begin
    if Assigned(TFCEmbeddedForm(aux).OnGetExtraDataClass) then
    begin
      try
        if FormData.ExtraData = 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
  end
  else
  begin
    Method1 := aux.MethodAddress('FCGetExtraDataClass');
    Method2 := aux.MethodAddress('FCSetExtraData');

    if(Method1 <> nil) and (Method2 <> nil) then
    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);