unit UnitFrmEditTextExternal;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, UnitFrmTooltipNew, ExtCtrls, UnitClipQueue;

type
  TfrmEditTextExternal = class(TObject)
  private
    { Private declarations }
    pic: TPicture;
    sl : TStringList;
  protected
    procedure RectEvent(r : TRect; enable : boolean);
  public
    { Public declarations }
    constructor Create;
    procedure EditClip(ci : TClipItem); overload;
    procedure EditClip(s : string); overload;
    procedure SaveClip(fullname:string; ci : TClipItem);
    procedure EditClipboard;
  end;

var
  frmEditTextExternal: TfrmEditTextExternal;

implementation

uses UnitPaste, ShellAPI, UnitMisc, UnitPopupGenerate, clipbrd,
  UnitFrmClipboardManager, StrUtils, UnitToken, UnitFrmConfig, UnitFrmEditItem,
  UnitFrmDebug, UnitFocusManager;

{$R *.dfm}

constructor TfrmEditTextExternal.Create;
begin
    sl := TStringList.Create;
    pic := TPicture.Create;
    //ci := nil;
end;

function GetProcessID(hThread: THandle): DWORD; stdcall; external 'kernel32.dll' name 'GetProcessId';

type TMyNotifyEvent = procedure (r: TRect; enable : boolean) of object;

type TEditThread = class(TThread)
    private
        fresult : string;

        ftext : string;
        fclip : TClipItem;
        fTextMode : boolean;
        fOnRect : TMyNotifyEvent;
    protected
        procedure Execute; override;
    public
        procedure SetClip(text : string); overload;
        procedure SetClip(clip : TClipItem); overload;

        property OnRect : TMyNotifyEvent read fOnRect write fOnRect;
end;

procedure TfrmEditTextExternal.RectEvent(r : TRect; enable : boolean);
var tt : TFrmTooltipNew;
begin
	if enable then begin
        tt := TFrmTooltipNew.Create(nil);
        tt.HideHeader;
        tt.SmallFontOnce := true;
        tt.ShowTooltip('Changes to the file are saved to the clipboard.',
            point(r.left, r.top)
        );
        tt.TimClose.Interval := 2500;
        tt.TimClose.Enabled := true;
    end else begin
		//tt.free;
        Application.ProcessMessages;
    end;
end;

procedure TfrmEditTextExternal.EditClip(ci: TClipItem);
var
    t : TEditThread;
begin
    t := TEditThread.create(true);
    t.FreeOnTerminate := true;
    t.Priority := tpNormal;
    t.OnRect := self.RectEvent;
    if (ci.GetFormat = CF_DIB) then begin
        t.SetClip(ci);
    end else begin
        t.SetClip(ci.GetAsPlaintext);
    end;
    t.start;
end;

procedure TfrmEditTextExternal.EditClip(s: string);
var
    t : TEditThread;
begin
    t := TEditThread.create(true);
    t.FreeOnTerminate := true;
    t.OnRect := self.RectEvent;
    t.Priority := tpNormal;
    t.SetClip(s);
    t.start;
end;

procedure TfrmEditTextExternal.EditClipboard;
begin
    if frmconfig.cbEditClipWindow.Checked then begin
        TFocusManager.ForceForeground(FrmEditItem.Handle);
        frmEditItem.Top := Mouse.CursorPos.Y;
        frmEditItem.left := Mouse.CursorPos.x;
        FrmEditItem.SetText(CurrentClipboard.GetAsPlaintext, nil);
        FrmEditItem.Show;
    end else begin
        CurrentClipboard.GetClipboardItem(0);
        self.EditClip(CurrentClipboard);
    end;
end;

function TimeOf(filename : string) : integer;
var fh : Thandle;
begin
    fh := FileOpen(filename, fmOpenRead);
    result := FileGetDate(fh);
    fileclose(fh);
end;

procedure TfrmEditTextExternal.SaveClip(fullname: string; ci: TClipItem);
var s : string;
begin
	case ci.GetFormatType  of
    FT_RICHTEXT: begin
        ci.GetAnsiText(s);
        sl.SetText(pchar(s));
        sl.SaveToFile(fullname);
    end;
    FT_PICTURE: begin
        ci.GetDIB(pic);
        pic.SaveToFile(fullname);
    end;
    else begin
        sl.SetText(pchar(ci.GetAsPlaintext));
        sl.SaveToFile(fullname, TEncoding.Unicode);
    end;
    end;
end;




{ TEditThred }


procedure TEditThread.Execute;
var
	StartInfo  : _StartupInfo;
    ProcInfo   : _PROCESS_INFORMATION;
    SEInfo: TShellExecuteInfo;
    b : longbool;
    tempname,  path : string;


    r : TRect;
    h, WindowBefore : THandle;
    pid, pid2 : Cardinal;



    strArray : array[0..max_path] of char;
    wait : integer;
    i : integer;
    time1 : integer;
//    sl : TStringList;
    sl : TStringStream;
    pic : TPicture;
begin
    inherited;
    sl := TStringStream.Create;
    pic := TPicture.Create;

    FillChar(StartInfo, SizeOf(StartInfo), #0);
    FillChar(ProcInfo, SizeOf(ProcInfo), #0);
    FillChar(SEInfo, SizeOf(SEInfo), #0);

    StartInfo.cb := SizeOf(TStartupInfo);
    StartInfo.wShowWindow := SW_normal;
    StartInfo.dwX := CW_USEDEFAULT;
    StartInfo.dwY := CW_USEDEFAULT;

    // Create a temp file with the clipboard contents
    ExpandEnvironmentStrings('%TEMP%', strArray, MAX_PATH);
    Randomize;

    if fTextMode  then begin
        tempname := strArray + '\ac' + IntToStr(1000+random(8999)) + IntToStr(1000+random(8999)) + '.txt';

        sl.WriteString(ftext);
        sl.SaveToFile(tempname);
        //sl.SetText(pchar(ftext));
//        sl.SaveToFile(tempname, TEncoding.Unicode);
    end else begin
        tempname := strArray + '\ac ' + IntToStr(1000+random(8999)) + IntToStr(1000+random(8999)) + '.bmp';
        fclip.GetDIB(pic);
        pic.SaveToFile(tempname);
    end;
    time1 := TimeOf(tempname);

    SEInfo.cbSize := SizeOf(TShellExecuteInfo);
    SEInfo.fMask := SEE_MASK_NOCLOSEPROCESS;
    SEInfo.Wnd := Application.Handle;
    SEInfo.lpFile := PChar(tempname);
    SEInfo.nShow := SW_SHOWNORMAL;

    // run associate program on the temp file (use system default or INI override program)
    // wait for an exit and then load the temp file into the clipboard
    // It's OK if the file wasn't changed.

    if LowerCase(ExtractFileExt(tempname)) = '.txt' then begin
        path := FrmConfig.GetTXTProgram;
    end else if LowerCase(ExtractFileExt(tempname)) = '.bmp'  then begin
        path := FrmConfig.GetBMPProgram;
    end;

    if (path='') then begin
        path := GetAssociation(tempname, 'edit');
        if path = '' then begin
            path := GetAssociation(tempname);
        end;
    end else begin
        if Pos('%1', path)=0 then begin
            path := path + ' "%1"';
        end;
    end;
    ExpandEnvironmentStrings(pchar(path),strArray,MAX_PATH);
    path := lowercase(strArray);

    path := replacestr(path,'%1', tempname);

    windowbefore := Windows.GetForegroundWindow;
    b := CreateProcess(nil, pchar( path),nil,nil,false, CREATE_NEW_PROCESS_GROUP+NORMAL_PRIORITY_CLASS,nil,nil,StartInfo,ProcInfo);
    if (b) then begin
        seinfo.hProcess := ProcInfo.hProcess;

        // wait for the program to access input,
        // find the toplevel window handle with the same ProcessID
        // Display tooltip at TopLeft of that window

        WaitForInputIdle(seinfo.hProcess, INFINITE);
        pid := GetProcessID(SEInfo.hProcess);
        mysleep(10);

        Application.ProcessMessages;


        // wait until a new foreground window appears
        i := 0;

        while (windowbefore = GetForegroundWindow) do begin
            if i = 100 then begin
                FrmDebug.AppendLog('No new window detected');
                BREAK;
            end;
            mysleep(10);
            inc(i);
        end;

        if GetForegroundWindow <> windowbefore then begin
            h := GetForegroundWindow;
        end else begin
            h := GetTopWindow(0);
        end;
        while (h <> 0) do begin
            if GetParent(h) = 0 then begin

                Windows.GetWindowThreadProcessId(h, @pid2);
                if (pid = pid2) then begin
                    //mysleep(500);
                    fillchar(r, sizeof(r), #0);
                    windows.GetWindowRect(h, r);
                    BREAK;
                end;
            end;
            h := Windows.GetNextWindow(h, GW_HWNDNEXT);
        end;

        windows.GetWindowRect(h, r);
        if assigned(fOnRect) then begin
            fOnRect(r, true);
        end;


        if fTextMode then begin
            mysleep(10);  // without the wait, the tooltip sometimes appears blank - Investigate!
        end else begin
            Application.ProcessMessages; // Used for EditClip(ci) mode
        end;

        // wait for a close and return the text
        // The text may be unchanged

        FrmDebug.AppendLog('Showing tooltip');
        wait := WaitForSingleObject(SEInfo.hProcess, 3500);
        if assigned(fOnRect) then begin
            FrmDebug.AppendLog('closing tooltip');
            fOnRect(r, false);
        end;
        if (wait = WAIT_TIMEOUT) then begin
            FrmDebug.AppendLog('inifite wait');
        	WaitForSingleObject(SEInfo.hProcess, infinite);
        end;
        FrmDebug.AppendLog('sleep');
        mysleep(100);

        //
        // Optionally save to Clipboard and let the popup detect our own clips
        //
        if fTextMode then begin
            fresult := '';
            if time1 <> TimeOF(tempname) then begin
                FrmDebug.AppendLog('loading ' + tempname);
                sl.LoadFromFile(tempname);

                fresult := sl.DataString;

                FrmDebug.AppendLog('pasting ' + fresult);
                Paste.SetClipboardOnlyOnce;
                frmClipboardManager.DisablePasteProtectionOnce;
                Paste.SendPlainText(fresult);
            end;
        end else begin
            pic.LoadFromFile(tempname);
            if time1 <> TimeOF(tempname) then begin
                frmClipboardManager.DisablePasteProtectionOnce;
                clipboard.Assign(pic);
            end;
        end;
        DeleteFile(tempname);
    end else begin
        // TODO, stop being lazy and add some real error reporting here
    end;

    myfree(sl);
    myfree(pic);
    {No idea why, the application "window" is being shown afterwords}
    ShowWindow(Application.Handle, SW_HIDE);
    SetWindowLong(Application.Handle, GWL_EXSTYLE,
    GetWindowLong(Application.Handle, GWL_EXSTYLE) or WS_EX_TOOLWINDOW);
end;

procedure TEditThread.SetClip(text: string);
begin
    ftext := text;
    fclip := nil;

    fTextMode := true;
end;

procedure TEditThread.SetClip(clip: TClipItem);
begin
    fclip := clip;
    ftext := '';

    fTextMode := false;
end;

initialization
begin
	frmEditTextExternal := TfrmEditTextExternal.Create;
end;
end.
