uform1.~pas

formContainer for delphi,是一个delphi form动画现实的组件

unit UForm1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, ToolWin, FormCont, teForm,TransEff,Menus;

type
  TMainForm = class(TForm)
    FormTransitions: TFormTransitions;
    MainFormContainer: TFormContainer;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    MainMenu1: TMainMenu;
    transition1: TMenuItem;
    TWipeTransition1: TMenuItem;
    TFlickerFreeTransition1: TMenuItem;
    TSlideTransition1: TMenuItem;
    TBlendTransition1: TMenuItem;
    TPushTransition1: TMenuItem;
    TDripTransition1: TMenuItem;
    Notransition1: TMenuItem;
    TFuseTransition1: TMenuItem;
    ToolButton5: TToolButton;
    procedure ToolButton1Click(Sender: TObject);
    procedure ToolButton2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ToolButton3Click(Sender: TObject);
    procedure transition1Click(Sender: TObject);
    procedure ToolButton5Click(Sender: TObject);
  private
    CurrentIndex:integer;
    procedure AppIdle(Sender: TObject; var Done: Boolean);
    Function FindForm(F:TCustomForm):integer;

    { Private declarations }
  public
   TransEffct: TTransitionEffect;
    { Public declarations }
  end;

var
  MainForm: TMainForm;



implementation

uses UForm2, UForm3, UForm4,teSlide ,teBlend,tePush,TeDrip,TeFuse,teWipe;

{$R *.DFM}

procedure TMainForm.FormCreate(Sender: TObject);
begin
  CurrentIndex:=0;
  TransEffct := TWipeTransition.Create;
  TransEffct.FlickerFreeWhenDisabled := True;
  TransEffct.Milliseconds            := 500;
  (TransEffct as TWipeTransition).BandWidth := 150;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
var i,n,k,m:integer;
begin
  MainFormContainer.DestroyAllForms;
  TransEffct.Free;
end;

procedure TMainForm.AppIdle(Sender: TObject; var Done: Boolean);
var  i,  VisibleCount: Integer;
begin
  VisibleCount := 0;
  for i:=0 to Screen.FormCount-1 do
    if IsWindowVisible(Screen.Forms[i].Handle) then
      Inc(VisibleCount);

  caption :=
    Format(
      '现在已经创建了%d个, Formcount=%d,LURFormsCount=%d,其中有 %d visible on screen，index=%d',
      [Screen.FormCount,MainFormContainer.FormCount,MainFormContainer.LRUFormCount, VisibleCount,CurrentIndex]);

  Done := True;
end;

procedure TMainForm.ToolButton1Click(Sender: TObject);
var
  SaveCursor: TCursor;
 i:integer;
begin
  i:=FindForm(Form2);
  if i>0 then
  begin
      if MainFormContainer.form=Form2 then exit;
      mainFormContainer.ShowLRUForm(i,False);
      exit;
  end;

  SaveCursor := Screen.Cursor;
  Screen.Cursor := crHourglass;
  try
    Form2 := TForm2(MainFormContainer.CreateForm(TForm2));
    MainFormContainer.ShowFormEx(Form2, False, TransEffct, nil, fcfaDefault);
  finally
    Screen.Cursor := SaveCursor;
  end;
  Application.OnIdle:= AppIdle;

end;
Function TMainForm.FindForm(F:TCustomForm):integer;
var i:integer;
begin
    result:=0;
    try
       for i:=MainFormContainer.FormCount downto 1 do
       if MainFormContainer.Forms[i]=F then break;
       result:=i;
    except
       On E:exception do
       begin
           result:=0;
       end;
    end;
end;

procedure TMainForm.ToolButton2Click(Sender: TObject);
var i:integer;
begin
  i:=FindForm(Form3);
  if i>0 then
  begin
      if MainFormContainer.form=Form3 then exit;
      mainFormContainer.ShowLRUForm(i,False);
      exit;
  end;
  Form3 := TForm3(MainFormContainer.CreateForm(TForm3));
  MainFormContainer.ShowFormEx(Form3, False, TransEffct, nil, fcfaDefault);
  Application.OnIdle:= AppIdle;

end;

procedure TMainForm.ToolButton3Click(Sender: TObject);
var
  SaveCursor: TCursor;
 i:integer;
begin
  i:=FindForm(Form4);
  if i>0 then
  begin
      if MainFormContainer.form=Form4 then exit;
      mainFormContainer.ShowLRUForm(i,False);
      exit;
  end;

  SaveCursor := Screen.Cursor;
  Screen.Cursor := crHourglass;
  try
    Form4 := TForm4(MainFormContainer.CreateForm(TForm4));
    MainFormContainer.ShowFormEx(Form4, False, TransEffct, nil, fcfaDefault);
  finally
    Screen.Cursor := SaveCursor;
  end;
  Application.OnIdle:= AppIdle;

end;

procedure TMainForm.transition1Click(Sender: TObject);
var selected:TmenuItem;
    TransEffct1: TTransitionEffect;
begin
  selected:=(sender as Tmenuitem);
  if (selected=Notransition1) or (Selected = TFlickerFreeTransition1)
  then TransEffct1 := TFlickerFreeTransition.Create
    else if Selected = TWipeTransition1
    then
    begin
      TransEffct1 := TWipeTransition.Create;
      TransEffct1.Milliseconds := 500;
    end
    else if Selected = TSlideTransition1
    then
    begin
      TransEffct1 := TSlideTransition.Create;
      TransEffct1.Milliseconds := 500;
    end
    else if Selected = TPushTransition1
    then
    begin
      TransEffct1 := TPushTransition.Create;
      TransEffct1.Milliseconds := 500;
    end
    else if Selected =TDripTransition1
    then
    begin
      TransEffct1 := TDripTransition.Create;
      TransEffct1.Milliseconds := 2000;
    end
    else if Selected = TFuseTransition1
    then
    begin
      TransEffct1 := TFuseTransition.Create;
      TransEffct1.Milliseconds := 500;
    end
    else if Selected = TBlendTransition1
    then
    begin
      TransEffct1 := TBlendTransition.Create;
      TransEffct1.Milliseconds := 1000;
    end;

    if assigned(TransEffct1) then
    begin
         selected.Checked:=True;
         if TransEffct1<>TransEffct then
         begin
             TransEffct.free;
             TransEffct:=TransEffct1;
             TransEffct1:=nil;
         end
         else TransEffct1.free;

    end;
end;

procedure TMainForm.ToolButton5Click(Sender: TObject);
begin
   CurrentIndex:=CurrentIndex+1;
   if CurrentIndex>MainFormContainer.LRUFormCount then CurrentIndex:=1;
   if(CurrentIndex<=0) or(CurrentIndex>MainFormContainer.LRUFormCount) then exit;
   MainFormContainer.ShowLRUFormEx(CurrentIndex,False,TransEffct);
end;

end.