unit PdxForms;

interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls;

Const
  ID_EXTDLL_BASE = 30000;   // defined in Paradox's RESOURCE.H AND EXTDLL.H
  DESKMSG = ID_EXTDLL_BASE;
  WM_MENUCOMMAND = DESKMSG+12;
  WM_MENUEVENT = DESKMSG+32;

type
  PParadoxFormVar = ^TParadoxForm;
  TParadoxFormClass = class of TParadoxForm;
  TParadoxMenuActionEvent = Procedure ( Sender:TObject; Command:Word; Handled:Boolean ) of Object;
  TCreateFormOverrides = Set of (cfoVisible,cfoNotVisible,cfoChild,cfoNormal);

  TParadoxForm = class(TForm)
  private
    { Private declarations }
    fParentWnd: HWND;
    fChildWindow: Boolean;
    fBlockFree: Boolean;
    fOnMenuAction:TParadoxMenuActionEvent;
    fRefCount:Integer; { Count of interfaces talking to us }
    fOverrides:TCreateFormOverrides;  { Used on Creation to allow Paradox to Override }
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWindowHandle(const Params: TCreateParams); override;
    procedure DestroyWnd; override;
    procedure DestroyWindowHandle; override;
    procedure WMNCCreate(var Message: TWMNCCreate); message WM_NCCREATE;
    procedure WMNCDestroy(var Message: TWMNCDestroy); message WM_NCDESTROY;
    procedure CMShowingChanged(var Message: TMessage); Message CM_ShowingChanged;
    procedure CMTextChanged(var Message: TMessage); Message CM_TextChanged;
    procedure WMMDIActivate(var Message: TWMMDIActivate); Message WM_MDIActivate;
    procedure WMMenuEvent(var Message: TMessage); message WM_MENUEVENT; { Paradox DesktopMenu Event }
    procedure CMMenuChanged(var Message: TMessage); message CM_MenuChanged;
    Function getFormStyle: TFormStyle;
    Procedure setFormStyle(newValue: TFormStyle);
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    Procedure Free;
    Procedure AddRef;
    Procedure Release;
    Procedure ResetMDIMenu;
  Published
    property FormStyle: TFormStyle read getFormStyle write setFormStyle default fsNormal;
    property OnMenuAction:TParadoxMenuActionEvent read fOnMenuAction write fOnMenuAction;
    property IsParadoxMDIChild:Boolean read fChildWindow;
  end;

procedure CreateParadoxForm(
  InstanceClass: TParadoxFormClass;
  Overrides:TCreateFormOverrides;
  var Reference);

{$ifdef APIUSETWIPS}
Function TwipsToPixels(Twips:LongInt):Integer;
Function PixelsToTwips(Pixels:Integer):LongInt;
{$endif}

implementation

Uses PdxAddIn;

constructor TParadoxForm.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fBlockFree := False;
  AddRef; // AddRef ourselves, in case this is a standard Delphi Create
end;

destructor TParadoxForm.Destroy;
begin
  fBlockFree := True; { Block double free! }
  inherited Destroy;
end;

Procedure TParadoxForm.Free;
Begin
  if Assigned(Self) Then
    Release;
End;

Procedure TParadoxForm.AddRef;
Begin
  Inc(fRefCount);
End;

Procedure TParadoxForm.Release;
Begin
  Dec(fRefCount);
  if fRefCount <= 0 Then
    Destroy;
End;





procedure TParadoxForm.CreateParams(var Params: TCreateParams);
begin
   if fParentWnd = 0 Then { Use Paradox Desktop as Parent }
      fParentWnd := Paradox.DesktopClientHandle;

   if cfoVisible    in fOverrides then Visible := True;
   if cfoNotVisible in fOverrides then Visible := False;
   if cfoChild      in fOverrides then fChildWindow := True;
   if cfoNormal     in fOverrides then fChildWindow := False;
   fOverrides := [];
   if FormStyle = fsMDIForm then
     raise exception.create('Paradox Addin Forms can not have FormStyle of fsMDIForm, use fsMDIChild instead.');

   if fChildWindow and (BorderStyle in [bsNone, bsDialog]) then { MDI must have a sizable border }
      BorderStyle := bsSizeable;

    inherited CreateParams(Params);

    with Params do
    begin
      WndParent := fParentWnd;
      if fChildWindow Then Begin { Force it to be MDI }
         Style := (Style or WS_CHILD) and (not WS_POPUP);
         WindowClass.lpfnWndProc := @DefMDIChildProc;
      End;
    end;
end;

procedure TParadoxForm.CreateWindowHandle(const Params: TCreateParams);
var
  CreateStruct: TMDICreateStruct;
begin
  if IsParadoxMDIChild and not (csDesigning in ComponentState) then
  begin
    if fParentWnd = 0 then
      raise EInvalidOperation.Create('Paradox desktop unassigned, can''t create form as MDI child');
    with CreateStruct do
    begin
      szClass := Params.WinClassName;
      szTitle := Params.Caption;
      hOwner := HInstance;
      X := Params.X;
      Y := Params.Y;
      cX := Params.Width;
      cY := Params.Height;
      style := Params.Style;
      lParam := Longint(Params.Param);
    end;
    WindowHandle := SendMessage(fParentWnd,
      WM_MDICREATE, 0, Longint(@CreateStruct));
    { Include(FFormState, fsCreatedMDIChild); }
    //ResetMDIMenu;
  end else
  begin
    inherited CreateWindowHandle(Params);
  end;
end;

procedure TParadoxForm.DestroyWnd;
begin
  fBlockFree := True;  { Delphi is going to recreate the window }
  inherited;
  fBlockFree := False;
end;

procedure TParadoxForm.DestroyWindowHandle;
begin
  { if fsCreatedMDIChild in FFormState then }
  if IsParadoxMDIChild and not (csDesigning in ComponentState) and
     (fParentWnd <> 0) then
    SendMessage(fParentWnd, WM_MDIDESTROY, Handle, 0)
  else
    inherited DestroyWindowHandle;
//  ClientHandle := 0;
end;

procedure TParadoxForm.WMNCCreate(var Message: TWMNCCreate);
begin
  if IsParadoxMDIChild and not (csDesigning in ComponentState) then
    begin
      DefaultHandler( Message ); { Calling inherited messes up the MDI child system menu }
      Menu := Menu;  { Reinitializes the menu, equiv to SetMenu(fMenu) }
    end
  else
    inherited;
end;

procedure TParadoxForm.WMNCDestroy(var Message: TWMNCDestroy);
begin
  inherited;
  if not fBlockFree then  
    Close;  { non Delphi Parent is shutting down }
end;

procedure TParadoxForm.CMShowingChanged(var Message: TMessage);
const
  ShowCommands: array[TWindowState] of Integer =
    (SW_SHOWNORMAL, SW_MINIMIZE, SW_SHOWMAXIMIZED);
var
  X,Y :Integer;
  ParentRect:TRect;
begin
  { If we're a Paradox MDI child, we have to do the centering... }
  if IsParadoxMDIChild and Not Showing and not (csDesigning in ComponentState) and
     (Position = poScreenCenter) then
    if Windows.GetClientRect( fParentWnd, ParentRect ) then
      begin
        { ParentRect.TopLeft is always 0,0 }
        X := (ParentRect.Right - Width) div 2;
        Y := (ParentRect.Bottom - Height) div 2;
        if X < 0 then X := 0;
        if Y < 0 then Y := 0;
        SetBounds(X, Y, Width, Height);
        Position := poDesigned;
      end;

  inherited;

  if Showing then
    AddRef
  Else
    Release;

  if IsParadoxMDIChild and not (csDesigning in ComponentState) then
    { We've got more work to do }
    if Showing then
      begin
        { Fake a size message to get MDI to behave }
        if WindowState = wsMaximized then
        begin
          SendMessage(fParentWnd, WM_MDIRESTORE, Handle, 0);
          ShowWindow(Handle, SW_SHOWMAXIMIZED);
        end
        else
        begin
          ShowWindow(Handle, ShowCommands[WindowState]);
          CallWindowProc(@DefMDIChildProc, Handle, WM_SIZE, SIZE_RESTORED,
            Width or (Height shl 16));
          BringToFront;
        end;
        SendMessage(fParentWnd, WM_MDIREFRESHMENU, 0, 0);
        //ResetMDIMenu;
      end
    else
      begin { Hidden }
          { DestroyHandle; { ??? }
      end;
end;

procedure TParadoxForm.CMTextChanged(var Message: TMessage);
begin
  inherited;
  if IsParadoxMDIChild and (fParentWnd <> 0) then
    SendMessage(fParentWnd, WM_MDIREFRESHMENU, 0, 0);
end;

procedure TParadoxForm.WMMDIActivate(var Message: TWMMDIActivate);
var
  IsActive: Boolean;
  ActivateMsg :TWMActivate;
begin
  inherited;
  if IsParadoxMDIChild then
  begin
    IsActive := Message.ActiveWnd = Handle;
    { SetActive(IsActive);}
    { if IsActive and (csPalette in Application.MainForm.ControlState) then
      Application.MainForm.PaletteChanged(True); }
    if IsActive Then
      ActivateMsg.Active := WA_ACTIVE
    else
      ActivateMsg.Active := WA_INACTIVE;

    ActivateMsg.ActiveWindow := Message.ActiveWnd;
    ActivateMsg.Minimized := WindowState = wsMinimized; { ??? }

    Message.Result := SendMessage(Self.Handle, WM_ACTIVATE, TMessage(ActivateMsg).WParam, TMessage(ActivateMsg).LParam);

    If IsActive Then
      Begin
//        Paradox.ParadoxInterface.SetDeskMenu;

//Uncomment these two line to bring the standard desktop menu and toolbar back 			
//        SendMessage(Paradox.DesktopHandle, 30020, 0, 0);
//        ResetMDIMenu;
			End;
  end;
end;


procedure TParadoxForm.CMMenuChanged(var Message: TMessage);
begin
  Inherited;
//*  ResetMDIMenu;
end;

Procedure TParadoxForm.ResetMDIMenu;
//var
  //MenuHandle: HMenu;
  //WindowMenuHandle: HMenu;
  //Redraw: Boolean;
Begin
  if IsParadoxMDIChild and not (csDesigning in ComponentState) then
    if HandleAllocated then
      {if Menu <> Nil then
        begin
          MenuHandle := 0;
          if Menu <> nil then MenuHandle := Menu.Handle;
          WindowMenuHandle := 0;
          if WindowMenu <> nil then WindowMenuHandle := WindowMenu.Handle;
          Redraw := Windows.GetMenu(fParentWnd) <> MenuHandle;
          SendMessage(fParentWnd, WM_MDISETMENU, MenuHandle, WindowMenuHandle);
          if Redraw then DrawMenuBar(fParentWnd);
        end
      else // No Menu }
        Paradox.ParadoxInterface.SetDeskMenu; // If we didn't set out own menu, then show desktop
End;

procedure TParadoxForm.WMMenuEvent(var Message: TMessage); { Paradox DesktopMenu Event }
begin
//  inherited;
  MessageBeep(0);
end;

Function TParadoxForm.getFormStyle: TFormStyle;
Begin
  if fChildWindow then
    Result := fsMDIChild
  else
    Result := Inherited FormStyle;
End;

Procedure TParadoxForm.setFormStyle(newValue: TFormStyle);
Begin
  if Not IsParadox Then
    Begin
      Inherited;
      Exit;
    End;

  if FormStyle = fsMDIForm then
    raise exception.create('Paradox Addin Forms can not have FormStyle of fsMDIForm, use fsMDIChild instead.');
  if FormStyle = newValue then exit;
  if not (csDesigning in ComponentState) then { Free window in current state }
    DestroyHandle;
  fChildWindow := (newValue = fsMDIChild); { save MDI State }
  { now lie to Delphi }
  if fChildWindow then
    Inherited FormStyle := fsNormal
  else
    Inherited FormStyle := newValue;
{  if not (csDesigning in ComponentState) then
    Begin
      RecreateWnd;
      UpdateControlState;
    End; }
End;

{ ------------------------------------------------------------------------
{ Used to instantiate the forms when created from inside Paradox.  Allows
  for overriding visible and child attributes }

procedure CreateParadoxForm(
  InstanceClass: TParadoxFormClass;
  Overrides:TCreateFormOverrides;
  var Reference);
var
  Instance: TParadoxForm;
begin
  Instance := TParadoxForm(InstanceClass.NewInstance);
  TComponent(Reference) := Instance;
  try
    Instance.fOverrides := Overrides;
    Instance.Create(Application);

    if (GetWindow(Instance.Handle, GW_OWNER) <> 0)
       and (Instance.IsParadoxMDIChild) then
       Raise Exception.create('Window Owner should not be defined for MDI Child');
  except
    TComponent(Reference) := nil;
    Instance.Free;
    raise;
  end;
end;

{$ifdef APIUSETWIPS}  { Obsolete code for converting to/from twips - no longer required }
Const TwipsPerInch = 1440;

Function TwipsToPixels(Twips:LongInt):Integer;
Begin
  Result := MulDiv( Twips, Screen.PixelsPerInch, TwipsPerInch );
end;

Function PixelsToTwips(Pixels:Integer):LongInt;
Begin
  Result := MulDiv( Pixels, TwipsPerInch, Screen.PixelsPerInch );
end;
{$endif}

end.

