teform.pas

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

unit teForm;

interface

{$INCLUDE teDefs.inc}

uses
  SysUtils, Classes, TransEff, teBkgrnd, FormCont,
  {$ifdef CLX}
  QForms, QGraphics, QControls, QDialogs;
  {$else}
  Windows, Messages, Forms, Graphics, Controls;//, Dialogs;
  {$endif CLX}

type
  TTECustomForm = class(TCustomForm);

  TFormTransitions = class(TComponent)
  private
    FBackgroundOptions: TFCBackgroundOptions;
    FDestroyTransitions: Boolean;
    FEnabled: Boolean;
    FOwnerForm: TTECustomForm;
    FShowTransition: TTransitionEffect;
    WasVisible: Boolean;
    WindowProcBak: TWndMethod;

    procedure SetBackgroundOptions(Value: TFCBackgroundOptions);
    procedure SetShowTransition(const Value: TTransitionEffect);
    function  GetVersion: String;
    procedure SetVersion(const Value: String);

    procedure ActivateHookForm(const Activate: Boolean);
    procedure ActivateHookMDIClient(const Activate: Boolean; ClientHandle: HWND);
    procedure ActivateHookMDIClientTrans(const Activate: Boolean);
    procedure ActivateHookMDIClientBkgrnd(const Activate: Boolean;
      ClientHandle: HWND);
    procedure NewWindowProc(var Message: TMessage);
  protected
    function  CanEnable: Boolean;
    function  GetPalette: HPALETTE;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;

    property OwnerForm: TTECustomForm read FOwnerForm;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
  published
    property BackgroundOptions: TFCBackgroundOptions read FBackgroundOptions write SetBackgroundOptions;
    property DestroyTransitions: Boolean read FDestroyTransitions write FDestroyTransitions default True;
    property Enabled: Boolean read FEnabled write FEnabled default True;
    property ShowTransition: TTransitionEffect read FShowTransition write SetShowTransition default nil;
    property Version: String read GetVersion write SetVersion stored False;
  end;

implementation

uses {$ifndef D3C3}FlatSB,{$endif D3C3} teRender;

const
  rsOnlyOne      = 'Only one FormTransitions component is allowed per form';
  rsEmbeddedForm = 'A FormTransitions component is not necessary in a TFCEmbeddedForm';

type
  TFCWinControl = class(TWinControl);

var
  SaveMDIClientWndProc: Pointer = nil;
  MDIClientLocked     : Boolean = False;
  NestedFormTransition: Boolean = False;
  LockMDIClient       : Boolean = False;
  MDIClientBkOptions  : TFCBackgroundOptions = nil;
  MDIClients          : TStringList = nil;

function LockWindow(Window: HWnd; CheckRegion: Boolean): HRGN;
begin
  if not CheckRegion
  then Result := 0
  else
  begin
    Result := CreateRectRgn(0, 0, 0, 0);
    if GetWindowRgn(Window, Result) = ERROR then
    begin
      DeleteObject(Result);
      Result := 0;
    end;
  end;

  SetWindowRgn(Window, CreateRectRgn(0, 0, 0, 0), False);
end;
  
function UnlockWindow(Window: HWnd; Rgn: HRGN; CheckRegion: Boolean): HRGN;
var
  OSRgn,
  RgnCopy: HRGN;
begin
  Result := 0;
  SetWindowRgn(Window, 0, False);
  if Rgn <> 0 then
  begin
    Result := Rgn;
    OSRgn := CreateRectRgn(0, 0, 0, 0);
    try
      GetWindowRgn(Window, OSRgn);
      if not EqualRgn(OSRgn, Rgn) then // check if it is a XP theme region
      begin
        RgnCopy := CreateRectRgn(0, 0, 0, 0);
        CombineRgn(RgnCopy, Rgn, 0, RGN_COPY);
        SetWindowRgn(Window, RgnCopy, False);
      end;
    finally
      DeleteObject(OSRgn);
    end;
  end;

  if CheckRegion and (Result = 0) then
  begin
    SendMessage(Window, WM_NCPAINT, 0, 0); // Fix a problem with XP themes

    Result := CreateRectRgn(0, 0, 0, 0);
    if GetWindowRgn(Window, Result) = ERROR then
    begin
      DeleteObject(Result);
      Result := 0;
    end;
  end;
end;

function MaximizedChildren: Boolean;
var
  I: Integer;
begin
  Result := False;

  if Application.MainForm = nil then
    Exit;

  for I := 0 to Application.MainForm.MDIChildCount - 1 do
    if Application.MainForm.MDIChildren[I].WindowState = wsMaximized then
    begin
      Result := True;
      Exit;
    end;
end;

function MDIClientWndProc(Wnd: HWND;
  Msg, WParam, LParam: Longint): Longint; stdcall;

  function CallDefWndProc: Longint;
  begin
    Result := CallWindowProc(SaveMDIClientWndProc, Wnd, Msg, WParam, LParam);
  end;

var
  DC: HDC;
  PS: TPaintStruct;
  R: TRect;
begin
  Result := 0;
  case Msg of
    WM_MDICREATE:
    begin
      try
        if(Application.MainForm <> nil)                and
          IsWindowVisible(Application.MainForm.Handle) and
          (not NestedFormTransition)                   and
          (not TETransitionPrepared)                   and
          LockMDIClient
        then
        begin
          LockWindow(Application.MainForm.ClientHandle, False);
          MDIClientLocked := True;
        end
        else MDIClientLocked := False;
      finally
        LockMDIClient := False;
      end;
      Result := CallDefWndProc;
    end;
    WM_ERASEBKGND:
    begin
      if MDIClientBkOptions.IsActive
      then Result := 1
      else Result := CallDefWndProc;
    end;
    WM_PAINT:
    begin
      if MDIClientBkOptions.IsActive
      then
      begin
        DC := WParam;
        if DC = 0
        then
        begin
          DC := BeginPaint(Application.MainForm.ClientHandle, PS);
          try
            if IsRectEmpty(PS.rcPaint) then
              GetClientRect(Application.MainForm.ClientHandle, PS.rcPaint);
            MDIClientBkOptions.DrawBackGround(DC, PS.rcPaint);
          finally
            if WParam = 0 then
              EndPaint(Application.MainForm.ClientHandle, PS);
          end;
        end
        else
        begin
          GetClientRect(Application.MainForm.ClientHandle, R);
          MDIClientBkOptions.DrawBackGround(DC, R);
        end;
      end
      else Result := CallDefWndProc;
    end;
    WM_SIZE,
    WM_VSCROLL,
    WM_HSCROLL:
    begin
      Result := CallDefWndProc;
      if(not(csDestroying in MDIClientBkOptions.Control.ComponentState)) and
         MDIClientBkOptions.IsActive                                     and
        (MDIClientBkOptions.PictureMode <> fcpmTile)                     then
        InvalidateRect(Application.MainForm.ClientHandle, nil, True);
    end

    else Result := CallDefWndProc;
  end;
end;

procedure MDIClientWndProcSubclass(ClientHandle: HWND);
begin
  Assert(SaveMDIClientWndProc = nil);

  if ClientHandle = 0 then
    ClientHandle := Application.MainForm.ClientHandle;
  Assert(ClientHandle <> 0);

  SaveMDIClientWndProc :=
    Pointer(GetWindowLong(ClientHandle, GWL_WNDPROC));
  SetWindowLong(ClientHandle, GWL_WNDPROC, Longint(@MDIClientWndProc));
end;

procedure RestoreMDIClientWndProc;
begin
  if(Application.MainForm <> nil)            and
    (Application.MainForm.ClientHandle <> 0) then
    SetWindowLong(Application.MainForm.ClientHandle, GWL_WNDPROC,
      Longint(@SaveMDIClientWndProc));
  SaveMDIClientWndProc := nil;
end;

{ TFormTransitions }

constructor TFormTransitions.Create(AOwner: TComponent);
var
  i: Integer;
begin
  if Assigned(AOwner) then
  begin
    if AOwner is TFCEmbeddedForm then
      raise Exception.Create(rsEmbeddedForm);

    for i := 0 to AOwner.ComponentCount - 1 do
      if AOwner.Components[i] is TFormTransitions then
        raise Exception.Create(rsOnlyOne);
  end;

  inherited Create(AOwner);

  FBackgroundOptions  := TFCBackgroundOptions.Create;
  FDestroyTransitions := True;
  FEnabled            := True;
  FShowTransition     := nil;

  if Assigned(AOwner) and (AOwner is TCustomForm)
  then
  begin
    FOwnerForm := TTECustomForm(AOwner);
    ActivateHookForm(True);
    if OwnerForm.FormStyle = fsMDIChild then
      ActivateHookMDIClientTrans(True);

    if csDesigning in Componentstate then
      BackgroundOptions.Control := OwnerForm;
  end
  else FOwnerForm := nil;
end;

destructor TFormTransitions.Destroy;
begin
  ActivateHookForm(False);
  if(OwnerForm<>Nil) Then   //V34
    If (OwnerForm.FormStyle = fsMDIChild)  then
     ActivateHookMDIClientTrans(False)
  else
  begin
    if OwnerForm.FormStyle = fsMDIForm then
      ActivateHookMDIClientBkgrnd(False, 0);
  end;

  if DestroyTransitions and Assigned(FShowTransition) then
    FShowTransition.Free;

  FBackgroundOptions.Free;

  inherited;
end;

procedure TFormTransitions.ActivateHookForm(const Activate: Boolean);
begin
  if Activate
  then
  begin
    if(not Assigned(WindowProcBak)) then
    begin
      WasVisible := OwnerForm.Visible;
      WindowProcBak := OwnerForm.WindowProc;
      OwnerForm.WindowProc := NewWindowProc;
    end;
  end
  else
  begin
    if Assigned(Owner) and Assigned(WindowProcBak) then
      OwnerForm.WindowProc := WindowProcBak;
    WindowProcBak := nil;
  end;
end;

procedure TFormTransitions.ActivateHookMDIClient(const Activate: Boolean;
  ClientHandle: HWND);
begin
  if csDesigning in OwnerForm.ComponentState then
    exit;

  if Activate
  then
  begin
    if MDIClients = nil then
    begin
      MDIClients := TStringList.Create;
      MDIClientWndProcSubclass(ClientHandle);
    end;
    MDIClients.Add(ClassName);
  end
  else
  begin
    MDIClients.Delete(MDIClients.IndexOf(ClassName));
    if MDIClients.Count = 0 then
    begin
      MDIClients.Free;
      RestoreMDIClientWndProc;
    end;
  end;
end;

procedure TFormTransitions.ActivateHookMDIClientTrans(const Activate: Boolean);
begin
  if Activate then
  begin
    if OwnerForm.FormStyle = fsMdiChild then
      LockMDIClient :=
        Enabled and
        ((OwnerForm.WindowState = wsMaximized) or MaximizedChildren);
  end;
  ActivateHookMDIClient(Activate, 0);
end;

procedure TFormTransitions.ActivateHookMDIClientBkgrnd(const Activate: Boolean;
  ClientHandle: HWND);
begin
  if Activate
  then MDIClientBkOptions := BackgroundOptions
  else MDIClientBkOptions := nil;
  ActivateHookMDIClient(Activate, ClientHandle);
end;  //EROC itnA