(*
/*
CLASS {NATIVE_Clipboard|_Delphi}, NATIVE,
ABSTRACT :

NATIVE: "uses NATIVE_Clipboard;" .
*/
*)
unit NATIVE_Clipboard;

interface

uses {$IFDEF KOL}
		KOL, Windows, shlobj, ShellApi
	 {$ELSE}
	 	{$IFDEF FPC}
	 		{$IFNDEF NOINTERFACES} Interfaces, {$ENDIF} Forms, Clipbrd
		 	{$IFDEF LINUX}
		 		, gtk2, gdk2
		 	{$ELSE}
		 		,Windows, shlobj, ShellApi
		 	{$ENDIF}
		{$ELSE}
		    Clipbrd, Windows, shlobj, ShellApi
		{$ENDIF}
	 	, SysUtils, Classes
	 {$ENDIF}
	 , AL4
	 ;

//===========================================
function Get_clipboard_text: String;
procedure Set_clipboard_text(const s: {$IFDEF FPC} Str {$ELSE} String {$ENDIF});
function Clipboard_has_text: Boolean;

function Files_from_clipboard(Paths: DynAStr): Byte;
procedure Files_to_clipboard(Paths: DynAStr; Op: Byte);
function Clipboard_has_files: Boolean;


implementation

{$IFDEF FPC}
procedure init4clipboard;
begin
	if Application = nil then
	begin
		Application.Initialize;
	end;
end;
{$ENDIF}

{$IFDEF KOL}

function Get_clipboard_text: String;
begin
    Result := Clipboard2WText;
end;
{$ELSE}

{$IFnDEF FPC}
function Get_clipboard_text_W: String;
var gbl: THandle;
    str: PWideChar;
begin
  Result := '';
  if OpenClipboard( 0 ) then
  begin
    if IsClipboardFormatAvailable( CF_UNICODETEXT ) then
    begin
      gbl := GetClipboardData( CF_UNICODETEXT );
      if gbl <> 0 then
      begin
        str := GlobalLock( gbl );
        if str <> nil then
        begin
          Result := str;
          GlobalUnlock( gbl );
        end;
      end;
    end;
    CloseClipboard;
  end;
end;
{$ENDIF}

function Get_clipboard_text: String;
begin
    //C.Open; -- necessary only to group operations
	{$IFDEF FPC}
		init4clipboard;
    	RESULT := Clipboard.AsText;
	{$ELSE}
    	{$IFDEF KOL}
    		RESULT := Clipboard2WText;
    	{$ELSE}
			Result := Get_clipboard_text_W;
    	{$ENDIF}
    {$endif}
end;
{$ENDIF}

{$IFDEF KOL}

procedure Set_clipboard_text(
const s: String);
begin
    WText2Clipboard(s);
end;
{$ENDIF}
{$IFDEF FPC}

procedure Set_clipboard_text(
const s: Str);
{$IFDEF LINUX}
var c: PGtkClipboard;
	t: String;
{$ENDIF}
begin
	{$IFDEF LINUX}
	t := s.As_string;
	c := gtk_clipboard_get(GDK_SELECTION_CLIPBOARD);
	gtk_clipboard_set_text(c, PChar(t), Length(t));
	gtk_clipboard_store(c);
	{$ELSE}
	init4clipboard;
	//writeln('set as clipboad: ' + s);
	Clipboard.AsText := s; //.As_string;
	{$ENDIF}
end;
{$ENDIF}
{$IFnDEF KOL)}
{$IFnDEF FPC}

procedure Set_clipboard_text(
const s: String);
var gbl: THandle;
    str: PAnsiChar;
    WS: WideString;
begin
    if not OpenClipboard( 0 ) then Exit; {>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
	EmptyClipboard;
	WS := s;
	if WS <> '' then
	begin
	  gbl := GlobalAlloc( GMEM_DDESHARE, (Length( WS ) + 1) * 2 );
	  if gbl <> 0 then
	  begin
	    str := GlobalLock( gbl );
	    Move( WS[ 1 ], str^, (Length( WS ) + 1) * 2 );
	    GlobalUnlock( gbl );
	    SetClipboardData( CF_UNICODETEXT, gbl ); 
	  end;
	end;
	CloseClipboard;
end;
{$ENDIF}
{$ENDIF}

function Clipboard_has_text(): Boolean;
{$IFDEF FPC}
var List: TStringList;
	i: Integer;
{$ENDIF}
begin
	RESULT := false;
	{$IFnDEF SMALLER_CODE}
		if Result then ;
	{$ENDIF}
{$IFDEF FPC}
	List := TStringList.Create();
	try
		Clipboard.SupportedFormats(List);
		for i := 0 to List.Count-1 do
		begin
			case List[i] of
			'Rich Text Format', 'text/plain', 'UTF8_STRING':
				begin 
					RESULT := TRUE;
					Exit;
				end;
			end;
		end;
	finally
		List.Free;
	end;
{$ELSE}
	Result := IsClipboardFormatAvailable(CF_OEMTEXT)
		   or IsClipboardFormatAvailable(CF_TEXT)
		   or IsClipboardFormatAvailable(CF_UNICODETEXT);
{$ENDIF}
end;

procedure Files_to_clipboard(Paths: DynAStr; Op: Byte);
{$IFDEF LINUX}
var s: String;
	i: Integer;
{$ELSE}
type PCardinal = ^Cardinal;
var gbl: THandle;
    dropFiles: PDropFiles;
    iLen: Integer;
    List: String;
    f: Cardinal;
    d: PCardinal;
{$ENDIF}
begin
{$IFDEF LINUX}
	Clipboard.Clear();
	if Paths.Count() = 0 then Exit;
	s := '';
	for i := 0 to Paths.Count()-1 do
		s := s + Paths.GetStrings(i) + Char($10);
	Clipboard.AsText := Trim(s);
{$ELSE}
	List := '';
	for iLen := 0 to Paths.Count()-1 do
		List := List + Paths.GetStrings(iLen) + #0;
	iLen := Length(List) + 1;
	gbl := GlobalAlloc( GMEM_DDESHARE or GMEM_MOVEABLE or GMEM_ZEROINIT,
		Sizeof(TDropFiles) + iLen);
	if gbl = 0 then Exit;
	
	if OpenClipboard( 0 ) then
	try
		EmptyClipboard();
		dropFiles := GlobalLock(gbl);
		dropFiles^.pFiles := Sizeof(TDropFiles);
		Move(List[1], (PChar(dropFiles) + Sizeof(TDropFiles))^, iLen);
		GlobalUnlock(gbl);
		//Clipboard.SetAsHandle(CF_HDROP, gbl);
		SetClipboardData(CF_HDROP, gbl);
		if Op = 1 then
		begin
			f := RegisterClipboardFormat('Preferred DropEffect'
			{CFSTR_PREFERREDDROPEFFECT});
			gbl := GlobalAlloc(GMEM_SHARE or GMEM_MOVEABLE or GMEM_ZEROINIT,
				Sizeof(DWORD));
			d := PCardinal(GlobalLock(gbl));
			d^ := 2; //DROPEFFECT_MOVE;
			SetClipboardData(f, gbl);
			GlobalUnlock(gbl);
		end;
	finally
		CloseClipboard();
	end;
{$ENDIF}
end;

function Files_from_clipboard(Paths: DynAStr): Byte;
{$IFDEF LINUX}
var s: String;
	sl: TStringList;
	i: Integer;
{$ELSE}
var f: THandle;
	buffer: array[0..MAX_PATH] of AnsiChar;
	i, numFiles: Integer;
	deffect, chandle: THandle;
	Mem: Pointer;
{$ENDIF}
begin
	Result := 0;
	Paths.Clear();
{$IFDEF LINUX}
	s := Get_clipboard_text();
	if s = '' then Exit;
	sl := TStringList.Create();
	try
		sl.Text := s;
		for i := 0 to sl.Count-1 do
			if FileExists(sl[i]) or DirectoryExists(sl[i]) then
				Paths.Add(-1, sl[i]); 
	finally
		sl.Free;
	end;
{$ELSE}
	if OpenClipboard( 0 ) then
	try
		if not Clipboard_has_files() then Exit;
		//f := Clipboard.GetAsHandle(CF_HDROP);
		f := GetClipboardData(CF_HDROP);
		if f = 0 then Exit;
		numFiles := DragQueryFile(f, $FFFFFFFF, nil, 0);
		for i := 0 to numFiles-1 do
		begin
			buffer[0] := #0;
			DragQueryFile(f, i, buffer, Sizeof(buffer));
			Paths.Add(-1, buffer);
		end;
		
		deffect := RegisterClipboardFormat('Preferred DropEffect'
			{CFSTR_PREFERREDDROPEFFECT});
		if deffect <> 0 then
		begin
			//chandle := Clipboard.GetAsHandle(deffect);
			chandle := GetClipboardData(deffect);
			if chandle <> 0 then
			begin
				Mem := GlobalLock(chandle);
				try
					if PByte(Mem)^ = 2 then Result := 1;
				finally
					GlobalUnlock(chandle);
				end;
			end;
		end;
	finally
		CloseClipboard();
	end;	
{$ENDIF}
end;

function Clipboard_has_files(): Boolean;
{$IFDEF LINUX}
var paths: DynAStr;
{$ENDIF}
begin
{$IFDEF LINUX}
	Result := false;
	paths := New_DynAStr();
	try
		Files_from_clipboard(paths);
		Result := paths.Count() > 0;
	finally
		paths.Free;
	end;
{$ELSE}
	Result := IsClipboardFormatAvailable(CF_HDROP);
{$ENDIF}
end;

(*
/*
CONST STR:
    NATIVE_Import_clipboard = @
    "uses NATIVE_Clipboard;"

    NATIVE_Text_from_clipboard = @
    "    RESULT := Get_clipboard_text;"

    NATIVE_Text_to_clipboard = @
    "    Set_clipboard_text(X_Text);"

    NATIVE_Clipboard_has_text = @
    "    RESULT := Clipboard_has_text();"

    NATIVE_Files_from_clipboard = @
    "    RESULT := Files_from_clipboard(X_Paths);"

    NATIVE_Files_to_clipboard = @
    "    Files_to_clipboard(X_Paths, X_Op);"

    NATIVE_Clipboard_has_files = @
    "    RESULT := Clipboard_has_files();"

    .
    

    
END
*/
*)

end.
