unit UnitFrmSearch;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Contnrs, UnitClipQueue, UnitMenuItemTagdata, Generics.Collections;

type TMenuItemTagData = class(TObject)
    caption : string;
    name : string;
    text : string;
    clip : TClipItem;
    prefix : string;
    itemtype : TItemType;
    itemindex : integer;
    icon : HICON;
    PermanentGroupID : integer;

    public
        constructor Create();
end;
type TMenuList = TList<TMenuItemTagData>;

type
  TfrmSearch = class(TForm)
    lvResults: TListView;
    timTypePause: TTimer;
    StatusBar1: TStatusBar;
    Panel1: TPanel;
    txtFind: TLabeledEdit;

    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormShow(Sender: TObject);
    procedure txtFindKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure timTypePauseTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure lvResultsClick(Sender: TObject);
    procedure lvResultsMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure lvResultsKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure lvResultsDrawItem(Sender: TCustomListView; Item: TListItem;
      Rect: TRect; State: TOwnerDrawState);
    procedure txtFindKeyPress(Sender: TObject; var Key: Char);
    procedure CreateParams(var Params: TCreateParams); override;
     procedure WMActivate(Var msg:tMessage); message WM_ACTIVATE;
    procedure lvResultsData(Sender: TObject; Item: TListItem);
  private
    { Private declarations }
        LastFind : string;
        TextToPaste : string;
        ObjectList : TMenuList;
        finitialtop : integer;
        SkipCleanup : boolean;
        LastClip : TClipITem;
        LastClipType : TItemType;
        FreeLastClip : boolean;
        fClipboardOnly : boolean;
        statusOverride : string;
        procedure StoreSelectedClip;
        procedure ClearResults;
  public

    { Public declarations }
        procedure ShowAutomatted(foregroundwindow : THandle=0);
        procedure ShowAutomattedPasteOnly;
        function GetTextToPaste : string;
        function GetClipToPaste : TClipItem;
        property initialtop : integer read finitialtop;
        property ClipboardOnly : boolean read fClipboardOnly write fClipboardOnly;
  end;

type
    TSearchItems = class(TThread)
private
    faborted : boolean;
    frunning : boolean;


    procedure FinishGUIUpdate;
    procedure UpdateGUI;
protected
    procedure Execute; override;
public
    procedure Abort;
    procedure WaitAbort;
    property Aborted : boolean read faborted;
    property Running : boolean read frunning;
end;

var
  frmSearch: TfrmSearch;

implementation

uses UnitFrmPermanentNew,  UnitPaste, UnitTWideChar, UnitMisc,
   UnitFrmMainPopup, UnitPopupGenerate, Math, StrUtils, UnitFrmClipboardManager,
  UnitClipDatabase, UnitFrmDebug, UnitFocusManager;

{$R *.dfm}

var src : TSearchItems;

const WIDTH_FUDGE = 2;

constructor TMenuItemTagData.Create;
begin
    caption := '';
    name := '';
    text := '';
    prefix := '';
    clip := nil;
    itemtype := IT_NONE;
    itemindex := -1;
    icon := 0;
    PermanentGroupID := -1;
end;


procedure TfrmSearch.ClearResults;
var i : integer;
    mitd : TMenuItemTagData;
begin
  	//
    // Clips from the Remove Clips list are generated new
    // As are complex permanent clips
    // - not deleting them leaks memory
    // - don't delete the stored clip
    for I := 0 to objectlist.count - 1 do begin
        mitd := self.ObjectList.Items[i];
        if mitd.itemtype = IT_PERMANENT then begin
        	if mitd.clip <> nil then begin
            	myfree(mitd.clip);
            end;
        end;
    end;

    lvResults.Clear;
    ObjectList.Clear;

end;


procedure TfrmSearch.CreateParams(var Params: TCreateParams);
begin
    inherited;
    if CheckWin32Version(6, 0) then
       params.WindowClass.Style := params.WindowClass.style or CS_DROPSHADOW;
end;
procedure TfrmSearch.WMActivate(Var msg:tMessage);
begin
     {ignore all the inactive messages that appear until we've had a chance
    to paint and be visible to the user}
	if Msg.WParam = WA_INACTIVE then begin
        if Self.ModalResult  = mrNone then
            self.ModalResult := mrCancel;
    end;
end;
procedure TfrmSearch.FormCreate(Sender: TObject);
begin
//    src := TSearchItems.Create(true);
//    src.Priority := tpHigher;

    ObjectList := TMenuList.Create;
    lvResults.Columns[0].width := lvResults.ClientWidth - WIDTH_FUDGE;

    lvResults.HandleNeeded;
end;


procedure TfrmSearch.ShowAutomatted(foregroundwindow:Thandle=0);
var
    h : THandle;
begin
	h := GetForegroundWindow;
    TFocusManager.ForceForeground(self.Handle);

    TextToPaste := '';
    statusOverride := '';
    if (h=0) and (foregroundwindow=0) then begin
        statusOverride := 'Pasting to Clipboard only';
      	frmsearch.StatusBar1.Panels[1].Text := statusOverride;
        fClipboardOnly := true;
    end;
    self.SkipCleanup := true;
    if frmSearch.Visible = false then frmSearch.ShowModal;

    if foregroundwindow=0 then begin
    	TFocusManager.ForceForeground(h);
    end else begin
        TFocusManager.ForceForeground(foregroundwindow);
    end;


    if FrmSearch.ModalResult = mrOK then begin
    	if fClipboardOnly then begin
        	paste.SetClipboardOnlyOnce;
        end else begin
            if LastClipType = IT_TEMP then
                frmClipboardManager.DisablePasteProtectionOnce;
        end;
        if (self.LastClipType = IT_PERMANENT) and (Paste.IsMacro(TextToPaste)) then begin
            Paste.SendMacro(TextToPaste);
        end else begin
            if lastClip = nil then begin
                Paste.SendPlainText(self.TextToPaste);
            end else begin
                Paste.SendClip(self.LastClip);
            end;
        end;
    end;

    fClipboardOnly := false;
end;
procedure TfrmSearch.ShowAutomattedPasteOnly;
var
    h : Thandle;
begin

	h := GetForegroundWindow;
    TFocusManager.ForceForeground(self.Handle);
    TextToPaste := '';

    statusOverride := 'Pasting to Clipboard only';
    frmsearch.StatusBar1.Panels[1].Text := statusOverride;
    fClipboardOnly := true;

    self.SkipCleanup := true;
    if frmSearch.Visible = false then frmSearch.ShowModal;

    TFocusManager.ForceForeground(h);


    if FrmSearch.ModalResult = mrOK then begin
    	if fClipboardOnly then begin
        	paste.SetClipboardOnlyOnce;
        end;
        if ((self.LastClipType = IT_PERMANENT) and Paste.IsMacro(texttopaste)) then begin
            Paste.SendMacro(TextToPaste);
        end else begin
            if lastClip = nil then begin
                Paste.SendPlainText(self.TextToPaste);
            end else begin
                Paste.SendClip(self.LastClip);
            end;
        end;
    end;

    fClipboardOnly := false;
end;

function TfrmSearch.GetClipToPaste: TClipItem;
begin
    result := self.LastClip;
end;
function TfrmSearch.GetTextToPaste: string;
begin
    result := TextToPaste;
end;


procedure TfrmSearch.FormShow(Sender: TObject);
var h : THandle;
begin

    self.AutoSize := false;
    self.Height := 272;
    self.AutoSize := true;

    TFocusManager.ForceForeground(self.Handle);


    if (LastClip <> nil) then begin
    	if FreeLastClip then begin
        	myfree(LastClip);
        end;
    	LastClip := nil;
    end;

    StatusBar1.panels[0].text := 'Keys:  [Up/Down]  [Pageup/Pagedown]  [Enter/Esc]';
    frmsearch.Top := (screen.Height div 2) - (frmsearch.clientheight div 2);
    frmsearch.left := (screen.Width div 2) - (frmsearch.Width div 2);


    Application.ProcessMessages;

    finitialtop := self.BoundsRect.top;
    self.ClearResults;

    txtFind.SetFocus;
    txtFind.SelectAll;
    if txtfind.Text <> '' then begin
        timTypePauseTimer(self);
    end;
end;
procedure TfrmSearch.FormHide(Sender: TObject);
begin
    if (src <> nil) and (src.Running) then begin
        src.WaitAbort;
    end;

    if self.ModalResult = mrOK then self.StoreSelectedClip;
    self.ClearResults;
end;
procedure TfrmSearch.StoreSelectedClip;
var     mitd : TMenuItemTagData;
    i : integer;

    newclip : string;
    location : string;
begin
    FreeLastClip := false;

    if lvResults.Selected = nil then EXIT;

    i := integer(lvResults.Selected.data);
    mitd := self.ObjectList.Items[ i ];


    newclip := mitd.caption;
    LastClipType := mitd.itemtype;
    case mitd.itemtype of
        IT_POPUPCLIP: begin
            LastClip := mitd.clip;
        end;
        IT_TEMP: begin
            LastClip := TClipITem.Create;
            TClipDatabase.LoadRemoved(LastClip, mitd.itemindex);
            FreeLastclip := true;
        end;
        IT_PERMANENT: begin
            location := frmPermanent.PermFoldersGetItem( mitd.PermanentGroupID  );
            LastClip := TPermanentClipItem.Create;
            TClipDatabase.LoadPermanent(LastClip,mitd.itemindex, location);
            FreeLastClip := true;
        end;
    end;
end;


{virtual listview for speed}
procedure TfrmSearch.lvResultsData(Sender: TObject; Item: TListItem);
var mitd : TMenuItemTagData;
begin
    mitd :=  ObjectList.items[item.Index];
    item.Caption := mitd.caption;
    item.data := Pointer(item.index);
end;
procedure TfrmSearch.lvResultsDrawItem(Sender: TCustomListView; Item: TListItem;Rect: TRect; State: TOwnerDrawState);
var wc : TWideChar;
    ci : TClipItem;
    c : TColor;
    mitd : TMenuItemTagData;
    ico : HICON;
    h, th : integer;

    cnv : TCanvas;
begin
	cnv := TListView(Sender).Canvas;
    cnv.Brush.Style := bsClear;

    h := (rect.Bottom - rect.top) + 1;
    th := cnv.TextHeight('ALKJDFIOJ');


    c := cnv.Pen.Color;
    if Item.Selected  then begin
        cnv.Pen.Color := clHighlight;
        cnv.Brush.Color := dimcolor(clWindow);
    end else begin
        cnv.Pen.Color := clWindow;
        cnv.Brush.Color := clWindow;
    end;
        {rect.left := 0;
        rect.Right := rect.left + (lvResults.Width);}
    cnv.Rectangle(rect);
    InflateRect(rect,-1,-1);
    cnv.FillRect(rect);
    InflateRect(rect,1+WIDTH_FUDGE,1);

    cnv.Pen.Color := c;
    try
        if integer(item.Data) >= ObjectList.Count then
            EXIT;
        mitd := ObjectList.items[integer(item.data)];
        if UnitMisc.UniSupported then begin
            wc := TWideChar.Create;

            case mitd.itemtype of
                IT_POPUPCLIP: wc.Append('[Popup]:    ');
                IT_TEMP: wc.Append('[Removed]:  ');
                IT_PERMANENT: wc.Append('[Permanent]: ');
            end;
            if mitd.clip = nil then begin
                wc.AppendUnicode(mitd.caption);
                ico := UnitClipQueue.ClipDataDefaultIcon;
            end else begin
                ci := mitd.clip;
                wc.AppendUnicode(ci.GetAsPlaintext);

                ico := ci.CData.GetHICON;
            end;

            DrawIconEX(
                cnv.handle
                , rect.Left+2, rect.Top+1, ico,
                h-2, h-2,
                0,0,DI_NORMAL
            );

            if (h  <=  th) then begin
                Windows.TextOutW(
                    cnv.Handle ,
                    rect.Left + h + 3, rect.Top, wc.Memory, wc.StrLength
                );
            end else begin
                Windows.TextOutW(
                    cnv.Handle ,
                    rect.Left + h + 3, floor((h-th)/2) + rect.Top, wc.Memory, wc.StrLength
                );
            end;
        end else begin
            Windows.TextOut(
                cnv.Handle,
                rect.Left, rect.Top, pchar(mitd.caption) , length(mitd.caption)
                );
        end;
    except

    end;

end;

{mouse keyboard interactions}
procedure TfrmSearch.timTypePauseTimer(Sender: TObject);
begin
    timTypePause.Enabled := false;
    if txtFind.text = '' then lvResults.Items.Clear;
    if lastfind <> txtFind.text then begin
        FrmDebug.AppendLog('TSearchItems.timTypePauseTimer');
        if (src <> nil) and src.Running then begin
            src.WaitAbort;
            src.Free;
        end;
        self.ClearResults;

        FrmDebug.AppendLog('TSearchItems.timTypePauseTimer creating thread');
        src := TSearchItems.Create;
        src.Priority := tpHigher;
    end;

    lastFind := txtFind.text;
end;
procedure TfrmSearch.txtFindKeyDown(Sender: TObject; var Key: Word;Shift: TShiftState);
begin
    if (not (key in [VK_UP,VK_DOWN])) then begin
    timTypePause.Enabled := false;
    timTypePause.Enabled := true;
    end;

    if (key = VK_RETURN) or (key = VK_ESCAPE) then begin
        key := 0;
        if (frmSearch.txtFind.Text <> '') and (frmsearch.ObjectList.Count = 0) then begin
            lastFind := '';
            timTypePauseTimer(self);
        end;
    end;
end;
procedure TfrmSearch.txtFindKeyPress(Sender: TObject; var Key: Char);
begin
    if (key=chr(vk_return)) or (key=chr(VK_ESCAPE)) then begin
        key := #0;
    end;
end;
procedure TfrmSearch.FormKeyDown(Sender: TObject; var Key: Word;Shift: TShiftState);
begin
    if key = VK_ESCAPE  then begin
        key := 0;
        self.ModalResult := mrCancel;
    end;
    if lvresults.Items.Count = 0 then EXIT;

    case key of
    VK_UP:
        begin
        if (lvresults.Selected <> nil) then begin
            if lvresults.Selected.Index <> 0 then begin
                lvresults.Selected := lvresults.items[lvresults.Selected.index -1];
            end;
            lvresults.Selected.MakeVisible(false);
            key := 0;
            end;
        end;
    VK_DOWN:
        begin
        if (lvResults.Selected <> nil) then begin
            if lvresults.Selected.Index <> (lvresults.items.count-1) then begin
                lvresults.Selected := lvresults.items[lvresults.Selected.index +1];
            end;
            lvresults.Selected.MakeVisible(false);

            key := 0;
            end;
        end;
    VK_RETURN:
        begin
            key := 0;

            self.TextToPaste := '';
            if lvresults.Selected <> nil then begin
                self.TextToPaste := lvResults.Selected.caption;
                self.modalresult := mrOK;
            end;
        end;
    VK_NEXT: // page down
        begin
            lvResults.Scroll(0,lvResults.height -50);
            lvResults.Selected := lvResults.TopItem;
        end;
    VK_PRIOR: // page up
        begin
            lvResults.Scroll(0,-lvResults.height +50);
            lvResults.Selected := lvResults.TopItem;            
        end;

    end;
end;
procedure TfrmSearch.lvResultsClick(Sender: TObject);
begin
    txtFind.SetFocus;
end;
procedure TfrmSearch.lvResultsKeyDown(Sender: TObject; var Key: Word;Shift: TShiftState);
begin
    if key=VK_ESCAPE then begin
        key := 0;
        self.ModalResult := mrCancel;
    end;
    txtFind.SetFocus;
end;
procedure TfrmSearch.lvResultsMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
  var li : TListItem;
begin
    li := lvResults.GetItemAt(x,y);
    if li <> nil then begin
        self.TextToPaste := li.caption;
        self.ModalResult := mrOK;
    end;
end;

{ TSearchItems }

procedure TSearchItems.Abort;
begin
    Terminate;
end;
procedure TSearchItems.WaitAbort;
begin
    self.Abort;
//    while not self.Aborted do
//        mysleep(10);
end;
procedure TSearchItems.Execute;
var i,j, x, TestCnt, AddFirstCnt : integer;
    find, text,textNobreak : string;
label    AbortExit;

    function TestText(sub, source : string; var mitd : TMenuItemtagData) : boolean;
    var res : integer;
        original : string;
        c : cardinal;
    begin
   	    if ((testCnt mod 50) = 0) then Synchronize(UpdateGUI);
        original := source;
        sub := lowercase(sub);
        source := lowercase(source);

        // favor items with searchstring at the start

        res := pos(sub, source);

        result := false;
        if (res > 0) and (res < 5) then begin
            mitd := TMenuItemTagData.Create;
            frmsearch.ObjectList.Insert(AddFirstCnt, mitd);
            inc(AddFirstCnt);
            result := true;
        end else if (res > 0) then begin
            mitd := TMenuItemTagData.Create;
            frmsearch.ObjectList.add(mitd);
            result := true;
        end;

        inc(TestCnt);
    end;
var mitd : TMenuItemTagData;
    lasthint : string;
    ci : TClipItem;
    cl : TClipList;
    caption : string;
    idx : integer;
    c : Cardinal;
begin
    inherited;

    FrmDebug.AppendLog('TSearchItems.Execute');

    frunning := true;
    faborted := false;

    Synchronize(
    procedure begin
    find := frmSearch.txtFind.Text;
    lasthint := frmsearch.StatusBar1.Panels[1].Text;
    frmsearch.StatusBar1.Panels[1].Text := 'Searching ...';
    frmsearch.lvResults.Height := 145;
    frmsearch.AutoSize := false;
    frmsearch.Height := 100;
    frmsearch.AutoSize := true;
    frmSearch.ObjectList.Capacity := 5000;
    Application.ProcessMessages;
    end
    );

    TestCnt := 0;
    AddFirstCnt := 0;


    if find <> '' then begin
        // search both name and contents of Perm Items
        TClipDatabase.StartBatch;
        cl := TClipList.Create(true);

        for i := 0 to FrmPermanent.PermFoldersGetCount - 1 do begin
            TClipDatabase.LoadPermanentClips(cl, frmPermanent.PermFoldersGetItem(i));
            for j := 0 to cl.Count - 1 do begin
                ci := cl[j];
                text := ci.getDisplayText;
                if not TestText(find, text, mitd) then begin
                    if (ci.GetFormatType = FT_UNICODE) then begin
                        text := ci.GetAsPlaintext;
                        if TestText(find, text, mitd) then begin
                            mitd := frmsearch.ObjectList.Items[idx];
                            mitd.caption := text;
                            mitd.itemtype := IT_PERMANENT;
                            mitd.PermanentGroupID := i;
                            mitd.itemindex := j;
                       end;
                    end;
                end else begin
                    mitd.caption := ci.GetAsPlaintext;
                    mitd.itemtype := IT_PERMANENT;
                    mitd.PermanentGroupID := i;
                    mitd.itemindex := j;
                    mitd.clip := TClipItem.Create;
                    TClipDatabase.LoadPermanent(mitd.clip,j, frmPermanent.PermFoldersGetItem(i));
                end;

                if self.terminated then BREAK;
            end;
            cl.Clear;
            if self.terminated then begin
                TClipDatabase.EndBatch;
                goto AbortExit;
            end;
        end;
        myfree(cl);

        for i := 0 to ClipQueue.GetQueueCount - 1 do begin
            text := ClipQueue.GetItemText(i);
            if TestText(find, text, mitd) then begin
                mitd.caption := text;
                mitd.clip := ClipQueue.GetClipItem(i);
                mitd.itemtype := IT_POPUPCLIP;
                mitd.itemindex := i;
            end;
            if self.terminated then begin
                TClipDatabase.EndBatch;
                goto AbortExit;
            end;
        end;
        TClipDatabase.EndBatch;




        TClipDatabase.StartTextOnlyData;
        i := 0;
        textNobreak := StringReplace(find, chr($20), chr($a0),[rfReplaceAll]);

        while (TClipDatabase.LoadNextText(text)) do begin
            if TestText(textNobreak, text, mitd) then begin
                mitd.caption := text;
                mitd.itemtype := IT_TEMP;
                mitd.clip := nil;
                mitd.itemindex := i;
            end;
            if self.terminated then begin
                TClipDatabase.EndTextOnlyData;
                goto AbortExit;
            end;
            inc(i);
        end;
        TClipDatabase.EndTextOnlyData;
    end;

AbortExit:
    if terminated then begin
        faborted := true;
    end;
    Synchronize(
        procedure begin
            frmSearch.lvResults.Items.Count := frmSearch.ObjectList.Count;
            if (frmsearch.statusOverride <> '') then begin
                frmsearch.StatusBar1.Panels[1].Text := frmsearch.statusOverride;
            end else begin
                frmsearch.StatusBar1.Panels[1].Text := '';
                if frmSearch.txtFind.Text <> '' then begin
                    frmsearch.StatusBar1.Panels[1].Text := 'Found: ' + IntToStr(frmSearch.lvResults.Items.Count);
                end;

            end;
            Application.ProcessMessages;
        end
    );

    if terminated then EXIT;
    Synchronize( FinishGUIUpdate );
end;


procedure TSearchItems.UpdateGUI;
begin
    if frmsearch.StatusBar1.Panels[1].Text = 'Searching ...' then begin
        frmsearch.StatusBar1.Panels[1].Text := 'Searching ';
    end else begin
        frmsearch.StatusBar1.Panels[1].Text := 'Searching ...';
    end;
    Application.ProcessMessages;
end;

procedure TSearchItems.FinishGUIUpdate;
var x : integer;
begin
    frmsearch.lvresults.align := alnone;
    frmsearch.lvresults.clientheight := 200;
    frmsearch.Top := (screen.Height div 2) - ((frmsearch.BoundsRect.Bottom - frmsearch.BoundsRect.Top) div 2);
    frmsearch.left := (screen.Width div 2) - (frmsearch.clientWidth div 2);

    if frmsearch.lvResults.selected = nil then begin
        if frmsearch.lvResults.Items.Count > 0 then begin
            frmsearch.lvResults.selected := frmsearch.lvResults.items[0];
        end;
    end;
    Application.ProcessMessages;
    x := frmsearch.lvResults.Canvas.TextHeight('ABCDEFGHIJLKMNONQ') * 4;


    while (frmsearch.lvResults.VisibleRowCount < frmsearch.lvResults.Items.Count) and
        (frmsearch.height < 650) do begin
        frmsearch.lvResults.clientheight := frmsearch.lvResults.clientheight + X + 2;
        Application.ProcessMessages;
        frmsearch.Top := frmsearch.top - 6;
    end;


    frmsearch.AutoSize := false;
    frmsearch.height := frmsearch.lvResults.ClientHeight + frmsearch.Panel1.height + frmsearch.StatusBar1.Height - 100;
    frmsearch.AutoSize := true;


    Application.ProcessMessages;
    frmsearch.lvResults.clientheight := frmsearch.lvResults.clientheight + X * 2;
    frmsearch.lvresults.align := alclient;

    frmsearch.Top := (screen.Height div 2) - ((frmsearch.BoundsRect.Bottom - frmsearch.BoundsRect.Top) div 2);
    frmsearch.left := (screen.Width div 2) - (frmsearch.clientWidth div 2);
end;

end.
