{ $Id: carbonwsforms.pp 27247 2010-09-01 20:11:57Z dmitry $}
{
 *****************************************************************************
 *                             CarbonWSForms.pp                              *
 *                               ------------                                *
 *                                                                           *
 *                                                                           *
 *****************************************************************************

 *****************************************************************************
 *                                                                           *
 *  This file is part of the Lazarus Component Library (LCL)                 *
 *                                                                           *
 *  See the file COPYING.modifiedLGPL.txt, included in this distribution,    *
 *  for details about the copyright.                                         *
 *                                                                           *
 *  This program is distributed in the hope that it will be useful,          *
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
 *                                                                           *
 *****************************************************************************
}
unit CarbonWSForms;

{$mode objfpc}{$H+}

interface

// defines
{$I carbondefines.inc}

uses
  // Libs
  MacOSAll,
  CarbonUtils,
  // LCL
  Controls, Forms, Graphics, LCLType, LMessages, LCLProc, Classes,
  // Widgetset
  WSForms, WSLCLClasses, WSProc,
  // LCL Carbon
  CarbonDef, CarbonPrivate, CarbonWSControls;

type

  { TCarbonWSScrollingWinControl }

  TCarbonWSScrollingWinControl = class(TWSScrollingWinControl)
  published
    class function  CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
    class procedure ScrollBy(const AWinControl: TScrollingWinControl; const DeltaX, DeltaY: integer); override;
  end;

  { TCarbonWSScrollBox }

  TCarbonWSScrollBox = class(TWSScrollBox)
  published
  end;

  { TCarbonWSCustomFrame }

  TCarbonWSCustomFrame = class(TWSCustomFrame)
  published
  end;

  { TCarbonWSFrame }

  TCarbonWSFrame = class(TWSFrame)
  published
  end;

  { TCarbonWSCustomForm }
  TCarbonWSCustomFormClass = class of TCarbonWSCustomForm;
  TCarbonWSCustomForm = class(TWSCustomForm)
  published
    class function  CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;

    class procedure CloseModal(const ACustomForm: TCustomForm); override;
    class procedure ShowModal(const ACustomForm: TCustomForm); override;

    class procedure ShowHide(const AWinControl: TWinControl); override;
    
    class procedure SetBorderIcons(const AForm: TCustomForm; const ABorderIcons: TBorderIcons); override;
    class procedure SetFormBorderStyle(const AForm: TCustomForm; const AFormBorderStyle: TFormBorderStyle); override;

    class procedure SetAlphaBlend(const ACustomForm: TCustomForm; const AlphaBlend: Boolean; const Alpha: Byte); override;
    class procedure SetFormStyle(const ACustomForm: TCustomForm; const ANewFormStyle, AOldFormStyle: TFormStyle); override;

    class procedure SetPopupParent(const ACustomForm: TCustomForm;
      const APopupMode: TPopupMode; const APopupParent: TCustomForm); override;
  end;

  { TCarbonWSForm }

  TCarbonWSForm = class(TWSForm)
  published
  end;

  { TCarbonWSHintWindow }

  TCarbonWSHintWindow = class(TWSHintWindow)
  published
    class function  CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
  end;

  { TCarbonWSScreen }

  TCarbonWSScreen = class(TWSScreen)
  published
  end;

  { TCarbonWSApplicationProperties }

  TCarbonWSApplicationProperties = class(TWSApplicationProperties)
  published
  end;


implementation

uses
  CarbonProc, CarbonDbgConsts;
  

{ TCarbonWSScrollingWinControl }

{------------------------------------------------------------------------------
  Method:  TCarbonWSScrollingWinControl.CreateHandle
  Params:  AWinControl - LCL control
           AParams     - Creation parameters
  Returns: Handle to the window in Carbon interface

  Creates new scrolling window control in Carbon interface with the specified
  parameters
 ------------------------------------------------------------------------------}
class function TCarbonWSScrollingWinControl.CreateHandle(const AWinControl: TWinControl;
  const AParams: TCreateParams): TLCLIntfHandle;
begin
  Result := TLCLIntfHandle(TCarbonScrollingWinControl.Create(AWinControl, AParams));
end;

{------------------------------------------------------------------------------
  Method:  TCarbonWSScrollingWinControl.ScrollBy
  Params:  AWinControl - LCL scrolling win control
           DX, DY      -

  Scrolls the content of the passed window
 ------------------------------------------------------------------------------}
class procedure TCarbonWSScrollingWinControl.ScrollBy(const AWinControl: TScrollingWinControl; const DeltaX, DeltaY: integer);
begin
  if not CheckHandle(AWinControl, Self, 'ScrollBy') then Exit;

  TCarbonWidget(AWinControl.Handle).ScrollBy(DeltaX, DeltaY);
end;

{ TCarbonWSCustomForm }

{------------------------------------------------------------------------------
  Method:  TCarbonWSCustomForm.CreateHandle
  Params:  AWinControl - LCL control
           AParams     - Creation parameters
  Returns: Handle to the window in Carbon interface

  Creates new window in Carbon interface with the specified parameters
 ------------------------------------------------------------------------------}
class function TCarbonWSCustomForm.CreateHandle(const AWinControl: TWinControl;
  const AParams: TCreateParams): TLCLIntfHandle;
var
  frm : TCustomForm;
begin
  if csDesigning in AWinControl.ComponentState then
    Result := TLCLIntfHandle(TCarbonDesignWindow.Create(AWinControl, AParams))
  else
    Result := TLCLIntfHandle(TCarbonWindow.Create(AWinControl, AParams));
  frm:=TCustomForm(AWinControl);
  if Assigned(frm) then
  begin
    if (AParams.WndParent<>0) and ((AParams.Style and WS_CHILD) = 0) then
      SetWindowGroup(TCarbonWindow(Result).Window, GetWindowGroupOfClass(kHelpWindowClass));
  end;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonWSCustomForm.CloseModal
  Params:  ACustomForm - LCL custom form

  Closes modal window in Carbon interface
 ------------------------------------------------------------------------------}
class procedure TCarbonWSCustomForm.CloseModal(const ACustomForm: TCustomForm);
begin
  if not CheckHandle(ACustomForm, Self, 'CloseModal') then Exit;
  
  TCarbonWindow(ACustomForm.Handle).CloseModal;
end;

{------------------------------------------------------------------------------
  Method:  TCarbonWSCustomForm.ShowModal
  Params:  ACustomForm - LCL custom form

  Shows modal window in Carbon interface
 ------------------------------------------------------------------------------}
class procedure TCarbonWSCustomForm.ShowModal(const ACustomForm: TCustomForm);
begin
  if not CheckHandle(ACustomForm, Self, SShowModal) then Exit;

  TCarbonWindow(ACustomForm.Handle).ShowModal;
end;

class procedure TCarbonWSCustomForm.ShowHide(const AWinControl: TWinControl);
var
  nCmdShow : Integer;
begin
  if not CheckHandle(AWinControl, Self, 'ShowHide') then Exit;

  if AWinControl.HandleObjectShouldBeVisible then
  begin
    case TCustomForm(AWinControl).WindowState of
      wsMaximized: nCmdShow := SW_SHOWMAXIMIZED;
      wsMinimized: nCmdShow := SW_SHOWMINIMIZED;
    else
      nCmdShow := SW_SHOW;
    end;
    TCarbonWindow(AWinControl.Handle).ShowHide(True);
    TCarbonWindow(AWinControl.Handle).Show(nCmdShow);
  end
  else
    TCarbonWindow(AWinControl.Handle).ShowHide(False);
end;

{------------------------------------------------------------------------------
  Method:  TCarbonWSCustomForm.SetBorderIcons
  Params:  AForm        - LCL custom form
           ABorderIcons - Border icons

  Sets the border icons of window  in Carbon interface
 ------------------------------------------------------------------------------}
class procedure TCarbonWSCustomForm.SetBorderIcons(const AForm: TCustomForm;
  const ABorderIcons: TBorderIcons);
begin
  if not CheckHandle(AForm, Self, 'SetBorderIcons') then Exit;

  TCarbonWindow(AForm.Handle).SetBorderIcons(ABorderIcons);
end;

{------------------------------------------------------------------------------
  Method:  TCarbonWSCustomForm.SetFormBorderStyle
  Params:  AForm            - LCL custom form
           AFormBorderStyle - Form border style

  Sets the form border style of window in Carbon interface
 ------------------------------------------------------------------------------}
class procedure TCarbonWSCustomForm.SetFormBorderStyle(const AForm: TCustomForm;
  const AFormBorderStyle: TFormBorderStyle);
begin
  if not CheckHandle(AForm, Self, 'SetFormBorderStyle') then Exit;

  TCarbonWindow(AForm.Handle).SetFormBorderStyle(AFormBorderStyle);
end;

class procedure TCarbonWSCustomForm.SetAlphaBlend(const ACustomForm: TCustomForm; const AlphaBlend: Boolean; const Alpha: Byte);
var
  v : single;
begin
  if not CheckHandle(ACustomForm, Self, 'SetFormBorderStyle') then Exit;
  if not AlphaBlend then v:=1 else v:=Alpha/255;
  SetWindowAlpha( TCarbonWindow(ACustomForm.Handle).Window, v);
end;

class procedure TCarbonWSCustomForm.SetFormStyle(const ACustomForm:TCustomForm;
  const ANewFormStyle,AOldFormStyle:TFormStyle);
var
  newClass  : WindowClass;
begin
  if not CheckHandle(ACustomForm, Self, 'SetFormStyle') then Exit;

  case ANewFormStyle of
    fsStayOnTop, fsSplash: newClass:=kFloatingWindowClass;
    fsSystemStayOnTop: newClass:=kUtilityWindowClass;
  else
    newClass:=kDocumentWindowClass;
  end;
  OSError(
    SetWindowGroup( TCarbonWindow(ACustomForm.Handle).Window, GetWindowGroupOfClass(newClass)),
    Self, 'SetFormStyle', 'SetWindowGroup');
end;

class procedure TCarbonWSCustomForm.SetPopupParent(const ACustomForm:TCustomForm;
  const APopupMode:TPopupMode;const APopupParent:TCustomForm);
begin
  //todo: better "popup-parent" hanlding
  if Assigned(APopupParent) and (APopupParent.Handle<>0) then
  begin
    SetWindowGroup( TCarbonWindow(ACustomForm.Handle).Window, GetWindowGroupOfClass(kHelpWindowClass));
  end
  else
    SetFormStyle(ACustomForm, ACustomForm.FormStyle, ACustomForm.FormStyle);
end;

{ TCarbonWSHintWindow }

{------------------------------------------------------------------------------
  Method:  TCarbonWSHintWindow.CreateHandle
  Params:  AWinControl - LCL control
           AParams     - Creation parameters
  Returns: Handle to the window in Carbon interface

  Creates new hint window in Carbon interface with the specified parameters
 ------------------------------------------------------------------------------}
class function TCarbonWSHintWindow.CreateHandle(const AWinControl: TWinControl;
  const AParams: TCreateParams): TLCLIntfHandle;
begin
  Result := TLCLIntfHandle(TCarbonHintWindow.Create(AWinControl, AParams));
end;

end.
