unit PhiForm;

interface

uses
{$IFDEF MSWINDOWS}
  Windows, Messages, ShellAPI,
{$ENDIF}
  Classes,
{$IFDEF VCL}
  Graphics, Controls, Forms, Dialogs,
{$ELSE}
  QForms,
{$ENDIF}
  SysUtils;

type
  TPhiForm = class(TForm)
{$IFDEF VCL}
  private
    FQueryingEndSession: Boolean;  // [ap-dev:1435] 
    FShortCutEnabled: Boolean;
    FOnCreateParams: TNotifyEvent;
    FOnDropFiles: TNotifyEvent;
    FOnCopyData: TNotifyEvent;
    procedure DoDropFiles(var Msg: TWMDropFiles); message WM_DropFiles;
    procedure DoCopyData(var Msg: TWMCopyData); message WM_CopyData;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WMQueryEndSession(var Message: TWMQueryEndSession); message WM_QUERYENDSESSION;  // [ap-dev:1435]
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure CopyData(Receiver: HWND; Data: String);
    function IsShortCut(var Message: TWMKey): Boolean; override;
    procedure inherited_Paint;
  published
    property ShortCutEnabled: Boolean read FShortCutEnabled write FShortCutEnabled;
    property OnCreateParams: TNotifyEvent read FOnCreateParams write FOnCreateParams;
    property OnDropFiles: TNotifyEvent read FOnDropFiles write FOnDropFiles;
    property OnCopyData: TNotifyEvent read FOnCopyData write FOnCopyData;
    property QueryingEndSession: Boolean read FQueryingEndSession write FQueryingEndSession; // [ap-dev:1435]
{$ENDIF}
  end;

procedure Init_PhiForm;

implementation

uses
  Rubies,
{$IFDEF PHIEMBED}
{$IFDEF VCL}
  uCreateParams,
  uForm,
{$ENDIF}
  PhiMainUnit;
{$ELSE}
  Pythia;
{$ENDIF}

{$IFDEF VCL}
{$R *.dfm}
{$ELSE}
{$R *.xfm}
{$ENDIF}

var
  id_paint: Tid;

{$IFDEF VCL}
function TPhiForm.IsShortCut(var Message: TWMKey): Boolean;
begin
  if ShortCutEnabled then
    Result := inherited IsShortCut(Message)
  else
    Result := False;
end;

constructor TPhiForm.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FShortCutEnabled := True;
end;

procedure TPhiForm.CreateParams(var Params: TCreateParams);
var
  v: Tvalue;
begin
  inherited;
  Params.ExStyle := Params.EXStyle or WS_EX_ACCEPTFILES or WS_EX_APPWINDOW;
  if rb_block_given_p <> 0 then
  begin
    v := CreateParams_alloc(Params);
    rb_obj_instance_eval(0, nil, v);
    CreateParams_assign(Params, v);
  end;
end;

procedure TPhiForm.DoDropFiles(var Msg: TWMDropFiles);
var
  recv, data: Tvalue;
  FileName: array[0..MAX_PATH] of Char;
  i, Count: integer;
Begin
  recv := Self.tag;
  if recv = 0 then Exit;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_drop_files'));
  rb_ary_push(data, recv);
  Count := DragQueryFile(Msg.Drop, DWord(-1), FileName, SizeOf(FileName));
  for i := 0 to count-1 do
  begin
    DragQueryFile(Msg.Drop, i, FileName, SizeOf(FileName));
    rb_ary_push(data, rb_str_new2(FileName));
  end;
  DragFinish(Msg.Drop);
  PhiCallProtect(data);
end;

procedure TPhiForm.CopyData(Receiver: HWND; Data: String);
var
  CDS: TCopyDataStruct;
begin
  CDS.dwData := 1;
  CDS.cbData := Length(Data);
  CDS.lpData := PChar(Data);
  SendMessage(Receiver, WM_COPYDATA, Handle, LParam(@CDS));
end;

procedure TPhiForm.DoCopyData(var Msg: TWMCopyData);
var
  recv, data: Tvalue;
begin
  recv := tag;
  if recv = 0 then Exit;
  data := rb_ary_new;
  rb_ary_push(data, rb_intern('on_copy_data'));
  rb_ary_push(data, recv);
  rb_ary_push(data, INT2FIX(Msg.From));
  rb_ary_push(data, rb_str_new(Msg.CopyDataStruct^.lpData, Msg.CopyDataStruct^.cbData));
  PhiCallProtect(data);
end;

// [ap-dev:1435]
procedure TPhiForm.WMQueryEndSession(var Message: TWMQueryEndSession);
begin
  FQueryingEndSession := true;
  inherited;
  FQueryingEndSession := false;
end;

procedure TPhiForm.Paint;
begin
  rb_funcall2(Self.tag, id_paint, 0, nil);
end;

procedure TPhiForm.inherited_Paint;
begin
  inherited Paint;
end;
{$ENDIF}

procedure Init_PhiForm;
begin
  id_paint := rb_intern('paint');
end;

end.
