formcont.pas

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

end;

function TFormContainer.HasNextLRUForm: Boolean;
begin
  Result :=
    (LRUFormCount   > 0) and
    (FLRUFormIndex <> 0) and
    (FLRUFormIndex <> LRUFormCount);
end;

function TFormContainer.HasPriorLRUForm: Boolean;
begin
  Result :=
    (LRUFormCount   > 0) and
    (FLRUFormIndex <> 1);
end;

function TFormContainer.ShowNextLRUForm(DestroyCurrent: Boolean): Boolean;
begin
  Result := ShowNextLRUFormEx(DestroyCurrent, nil,
    nil, fcfaDefault);
end;

function TFormContainer.ShowNextLRUFormEx(
  DestroyCurrent: Boolean;
  Transition: TTransitionEffect;
  BackgrOptions: TFCBackgroundOptions;
  Align: TFCFormAlign): Boolean;
begin
  Result := False;
  if not HasNextLRUForm then
    exit;

  Result :=
    ShowLRUFormEx(FLRUFormIndex + 1,
      DestroyCurrent,
      Transition,
      BackgrOptions,
      Align);
end;

function TFormContainer.ShowPriorLRUForm(DestroyCurrent: Boolean): Boolean;
begin
  Result := ShowPriorLRUFormEx(DestroyCurrent, nil,
    nil, fcfaDefault);
end;

function TFormContainer.ShowPriorLRUFormEx(
  DestroyCurrent: Boolean;
  Transition: TTransitionEffect;
  BackgrOptions: TFCBackgroundOptions;
  Align: TFCFormAlign): Boolean;
var
  Index: Integer;
begin
  Result := False;
  if not HasPriorLRUForm then
    exit;

  if FLRUFormIndex = 0
  then Index := LRUFormCount
  else Index := FLRUFormIndex - 1;

  Result :=
    ShowLRUFormEx(Index,
      DestroyCurrent,
      Transition,
      BackgrOptions,
      Align);
end;

procedure TFormContainer.DestroyForm(F: TCustomForm);
var
  Index: Integer;
  FormData: TFCFormData;
begin
  if F = nil then
    Exit;

  if F = FForm
  then ShowForm(nil, True)
  else
  begin
    If Assigned(OnFormDestroy) then
    Try
    OnFormDestroy(Self, Form);
    Except
      on Exception  Do
      Application.HandleException(Self);
    End;
    Index := IndexOf(F) - 1;
    FormData := FormsData[Index+1];
    if SaveLRUDestroyedForms
    then DestroyingLRUForm(FormData)
    else DeleteLRUForm(F);
    FForms.Delete(Index);
    DeleteFormData(FormData);

    F.Visible := False;
    if SafeFormDestroy
    then F.Release
    else F.Free
  end;

  Assert(CheckFormsData, 'CheckFormsData'); //EROC itnA
end;

procedure TFormContainer.DestroyAllForms;
var
  i: Integer;
begin
  for i := FormCount downto 1 do
    DestroyForm(Forms[i]);
end;

function TFormContainer.CheckFormsData: Boolean;
var
  i: Integer;
begin
  Result := true;

  for i:= 0 to AllFormsData.Count-1 do
  begin
    if(FForms   .IndexOf(AllFormsData[i]) = -1) and
      (FLRUForms.IndexOf(AllFormsData[i]) = -1) then
    begin
      Result := False;
      break;
    end;
  end;

  if Result then
  begin
    for i:= 0 to FForms.Count-1 do
    begin
      if(AllFormsData.IndexOf(FForms[i]) = -1) then
      begin
        Result := False;
        break;
      end;
    end;
  end;

  if Result then
  begin
    for i:= 0 to FLRUForms.Count-1 do
    begin
      if(AllFormsData.IndexOf(FLRUForms[i]) = -1) then
      begin
        Result := False;
        break;
      end;
    end;
  end;
end;

procedure TFormContainer.DeleteFormData(FData: TFCFormData);
begin
  if(FForms.IndexOf(FData) = -1) and (FLRUForms.IndexOf(FData) = -1) then
  begin
    if AllFormsData.Remove(FData) <> -1 then
      TFCFormData(FData).Free;
  end;
end;

function TFormContainer.DeleteLRUForm(F: TCustomForm): Boolean;
var
  Index,
  Count: Integer;
begin
  Result := False;
  Index := 0;
  Count := FLRUForms.Count;
  while Index < Count do
  begin
    if TFCFormData(FLRUForms[Index]).Form = F
    then
    begin
      if DeleteLRUFormByIndex(Index+1)
      then
      begin
        Result := True;
        Dec(Count);
      end
      else Inc(Index);
    end
    else Inc(Index);
  end;
end;

function TFormContainer.DeleteLRUFormByIndex(Index: Integer): Boolean;
var
  FData: TFCFormData;
begin
  Result := False;

  if(Index >= 1) and (Index <= FLRUForms.Count) then
  begin
    FData := LRUFormsData[Index];
    FLRUForms.Delete(Index-1);
    DeleteFormData(FData);
    Result := True;
    if FLRUFormIndex   >= Index then
      Dec(FLRUFormIndex);
    if NewLRUFormIndex >= Index then
      Dec(NewLRUFormIndex);
  end;
end;

function TFormContainer.GetPalette: HPALETTE;
begin
  Result := BackgroundOptions.GetPalette;
end;

procedure TFormContainer.SetBackgroundOptions(Value: TFCBackgroundOptions);
begin
  BackgroundOptions.Assign(Value);
end;

procedure Scrolled(Control: TFormContainer);
begin
  if not(csDestroying in Control.ComponentState) then
  begin
    if Control.BackgroundOptions.IsActive then
      Control.BackgroundOptions.ControlChanged(Control);

    {$ifdef D7UP}
    if ThemeServices.ThemesEnabled                  and
       Assigned(Control.Parent)                     and
       (csParentBackground in Control.ControlStyle) then
       Control.Invalidate;
    {$endif D7UP}
  end;
end;

procedure TFormContainer.WMHScroll(var Message: TWMHScroll);
begin
    inherited;
    Scrolled(Self);
end;

procedure TFormContainer.WMVScroll(var Message: TWMVScroll);
begin
    inherited;
    Scrolled(Self);
end;

procedure TFormContainer.WMWindowPosChanged(var Message: TWMWindowPosChanged);
begin
  Invalidate;

  inherited;

  if(not(csDestroying in ComponentState)) and BackgroundOptions.IsActive then
    BackgroundOptions.ControlChanged(Self);
end;

procedure TFormContainer.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  {$ifdef D7UP}
  if BEParentBackgroundPainted(Handle) then
    BackgroundOptions.DrawBackGround(Message.DC, Rect(0, 0, 0, 0));
  {$endif D7UP}
  Message.Result := 1;
end;

procedure TFormContainer.WMPaint(var Message: TWMPaint);
begin
  PaintHandler(Message);
end;

procedure TFormContainer.PaintWindow(DC: HDC);
begin
  FCanvas.Lock;
  try
    FCanvas.Handle := DC;
    try
      {$ifndef D3C3}
      TControlCanvas(FCanvas).UpdateTextFlags;
      {$endif D3C3}
      Paint;
    finally
      FCanvas.Handle := 0;
    end;
  finally
    FCanvas.Unlock;
  end;
end;

procedure TFormContainer.Paint;
var
  R: TRect;
  Flags: Longint;
begin
  BackgroundOptions.DrawBackGround(Canvas.Handle, Canvas.ClipRect);

  if csDesigning in ComponentState then
  begin
    Canvas.Pen  .Style := psDash;
    Canvas.Brush.Style := bsClear;
    Canvas.Rectangle(0, 0, ClientWidth, ClientHeight);
    Canvas.Pen  .Style := psSolid;

    R := ClientRect;
    Canvas.Brush.Color := clWhite;
    Canvas.Brush.Style := bsSolid;
    Flags := DT_SINGLELINE or DT_CENTER or DT_VCENTER or DT_END_ELLIPSIS;
    {$ifndef D3C3}
    Flags := DrawTextBiDiModeFlags(Flags);
    {$endif D3C3}
    DrawText(Canvas.Handle, PChar(Name), -1, R, Flags);
  end;
end;

procedure TFormContainer.SetName(const NewName: TComponentName);
begin
  inherited;

  Invalidate;
end;

procedure TFormContainer.SetParent(AParent: TWinControl);
begin
  inherited;
  if BackgroundOptions <> nil then
    BackgroundOptions.Control := Self;
end;

function TFormContainer.CheckOnClose(Default: Boolean): Boolean;
begin
  DoCheckOnClose := True;
  Result         := Default;
end;

{ TFCEmbeddedForm }

constructor TFCEmbeddedForm.Create(AOwner: TComponent);

  function FindUniqueName(const Parent: TWinControl;
    const Name: string): string;
  var
    i: Integer;
  begin
    i := 0;
    Result := Name;
    while Parent.FindComponent(Result) <> nil do
    begin
      Inc(i);
      Result := Format('%s_%d', [Name, i]);
    end;
  end;

var
  ParentValue: TWinControl;
begin
  FBackgroundOptions         := TFCBackgroundOptions.Create;
  FBackgroundOptions.Control := Self;
  FAlignment                 := fcfaCenter;

  inherited;

  ParentValue := FindControl(ParentWindow);
  if ParentValue <> nil then
    Name := FindUniqueName(ParentValue, Name);

  BorderStyle  := bsNone;
  ClientWidth  := ClientWidth;
  ClientHeight := ClientHeight;
end;

procedure TFCEmbeddedForm.CreateParams(var Params: TCreateParams);
begin
  BorderStyle := bsNone;

  inherited;
end;

destructor TFCEmbeddedForm.Destroy;
begin
  FBackgroundOptions.Free;
  FBackgroundOptions := nil;

  inherited;
end;

function TFCEmbeddedForm.GetPalette: HPALETTE;
begin
  Result := BackgroundOptions.GetPalette;
end;

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

function TFCEmbeddedForm.ParentFormContainer: TFormContainer;
begin
  if Parent = nil
  then Result := nil
  else Result := Parent as TFormContainer;
end;

procedure TFCEmbeddedForm.SetBackgroundOptions(Value: TFCBackgroundOptions);
begin
  BackgroundOptions.Assign(Value);
end;

procedure TFCEmbeddedForm.SetParent(AParent: TWinControl);
begin
  inherited;
  if BackgroundOptions <> nil then
    BackgroundOptions.Control := Self;
end;

{$ifdef BCB}
procedure TFCEmbeddedForm.WMPaint(var Message: TWMPaint);
var
  SaveDesigner: {$ifdef D3C3}TDesigner{$else}{$ifdef D6UP}IDesignerHook{$else}IDesigner{$endif D6UP}{$endif D3C3};
begin
  SaveDesigner := Designer;
  if BackgroundOptions.IsActive then
    Designer := nil;

  inherited;

  Designer := SaveDesigner;
end;

procedure TFCEmbeddedForm.Paint;
var
  R: TRect;
begin
  if BackgroundOptions.IsActive
  then
  begin
    R := Canvas.ClipRect;
    BackgroundOptions.DrawBackGround(Canvas.Handle, R);
  end;

  inherited;
end;
{$else}
procedure TFCEmbeddedForm.PaintWindow(DC: HDC);
var
  R: TRect;
begin
  Canvas.Lock;
  try
    Canvas.Handle := DC;
    try
      if BackgroundOptions.IsActive
      then
      begin
        R := Canvas.ClipRect;
        BackgroundOptions.DrawBackGround(DC, R);
        Paint;
      end
      else
      begin
        if Designer <> nil
        then Designer.PaintGrid
        else Paint;
      end;
    finally
      Canvas.Handle := 0;
    end;
  finally
    Canvas.Unlock;
  end;
end;
{$endif BCB}

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

procedure TFCEmbeddedForm.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
  if BackgroundOptions.IsActive
  then
  begin
    {$ifdef D7UP}
    if BEParentBackgroundPainted(Handle) then
      BackgroundOptions.DrawBackGround(Message.DC, Rect(0, 0, 0, 0));
    {$endif D7UP}
    Message.Result := 1;
  end
  else inherited;
end;

procedure TFCEmbeddedForm.WMWindowPosChanged(
  var Message: TWMWindowPosChanged);
begin
  inherited;

  if(not(csDestroying in ComponentState)) and
    BackgroundOptions.IsActive then
    BackgroundOptions.ControlChanged(Self);
end;

procedure TFCEmbeddedForm.CMParentFontChanged(var Message: TMessage);
Begin
  If ParentFont And (Message.WParam=0)And(ParentFormContainer<>Nil) Then
      Font:=ParentFormContainer.Font
  Else
    Inherited;
end;

end.