Solved

Retreive a marked text

Posted on 1997-08-28
5
322 Views
Last Modified: 2010-04-06
How can I get the text marked in MS Word, notepad etc.
Example...
I mark the word in .doc file with mouse, click the button in my delphi aplication (dictionary), and the aplication searches through database.
0
Comment
Question by:Brucelee
5 Comments
 
LVL 1

Expert Comment

by:miv
Comment Utility
Do you use Word as an OLE container ?
0
 
LVL 4

Expert Comment

by:itamar
Comment Utility
If you don't mind Copying the text, i.e., mark and type CTRL C,
you can use TClipboard by adding the unit Clipbrd in the uses clause and using the property AsText to get the marked text.

Here is an example that fills a edit text with a marked text in Word, Notepad, any Browsers, etc... :

>>>>>

unit Unit1;

interface

uses
      Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
      Clipbrd, StdCtrls;

type
      TForm1 = class(TForm)
        Edit1: TEdit;
        Button1: TButton;
        procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      end;

var
      Form1: TForm1;
      Clip : TClipboard;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
      Clip := TClipBoard.Create;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
      Edit1.Text := Clip.AsText;
end;

end.

I hope this helps ...
0
 

Author Comment

by:Brucelee
Comment Utility
The idea is OK. But I need it to be more automatic. CTRL C is the unwanted action that I want to step over.

Thanx, Slaven


0
 

Accepted Solution

by:
seitza earned 50 total points
Comment Utility
One way of solving this problem would be to highlight the word you are interested in, within your application.  

Slaven, above, has the right idea.  The general idea would be to:
1:  take the highlighted word, place it on the clipboard
2: Take the word from the clipboard and paste it into your own application where you can do whatever processing you would like to do with it.  As mentioned previously, you would use the pastefromclipboard function.

Your specific problem with Slaven's answer seems to be that you would like to automate the process further, ie, you would not like to type Ctrl-C.

There are many programs on the Internet that allow to send keystrokes from your own application to the active one, using a sendkeys function.  

When a button from your application is pressed, you would
1) make the Word document the active window
2) use sendkeys to send a Ctrl-C to Word
3) then take the word from the Clipboard and do your processing on it.

This definitely works, as I have a similar application that takes information from another window.

Enclosed is a modified version of a "sendkeys" function.  It is lengthy.

unit Sendkey;

interface
procedure SendKeys(s: String);
procedure SendKeysn(s: String; n: longint);
function cvtkey(var s: String; i: Integer; var key: Integer;
                 var count: Integer;
                 var len: Integer; var letshift: Boolean;
                 var shift: Boolean; var letctrl: Boolean;
                 var ctrl: Boolean; var letalt: Boolean;
                 var alt: Boolean; var shiftlock: Boolean): Boolean;

implementation
uses SysUtils, Windows,astrunit;

{ symbol table record }
type
  tokentable = record
    token: string;
    vkey: integer;
  end;
{ global symbol table }
var tbl: array [0..21] of tokentable;
    tbllen: integer;

{ Get a number from the input string }
function GetNum(s: String; i: Integer; var len: Integer): Integer;
var
  tmp: string;
begin
  tmp := '';
  while (s[i]>='0') and (s[i] <='9') do begin
    tmp := tmp + s[i];
    i := i + 1;
    len := len + 1;
  end;
  Result := StrToInt(tmp);
end; { GetNum }

{ Process braced characters }
procedure procbrace( var s: string; i: integer;
                    var key: integer; var len: integer;
                    var count: integer; var letshift: boolean;
                    var letctrl: boolean; var letalt: boolean;
                    var shift: boolean; var ctrl: boolean;
                    var alt: boolean; var shiftlock: boolean);
var
  j: integer;
  tmp: string;
begin
  count := 1;
  { 3 cases: x, xxx, xxx ##}
  { if single character case }
  if (s[i+2] = ')') or (s[i+2] = ' ') then begin
    if s[i+2] = ')' then begin
      count := GetNum(s, i+3,len);
      len := len+1;
    end;
    len := len + 2;
  { convert quoted key }
    key := Integer(s[i+1]);
  { convert key -- pass zero to prevent special interp. }
    cvtkey(s,0,key,count,len,letshift,shift,
           letctrl,ctrl,letalt,alt,shiftlock);
  end
  else begin { multicharacter sequence }
    { find next brace or space }
    j := 1;
    tmp := '';
   

    while (s[i+j]<> ' ') and (s[i+j] <>'}') do begin
      tmp := tmp+s[i+j];
      j := j + 1;
      len := len + 1;
    end;
    if s[i+j] = ' ' then begin { read count }
      count := GetNum(s,i+j+1,len);
      len := len+1;
    end;
    len := len + 1;
    { check for special tokens }
    tmp := UpperCase(tmp);
    if tmp[1]='F' then begin { Function Keys }
      key := GetNum(tmp,2,j)+VK_F1-1;
      exit;

    end;
    { chop token to 3 characters or less }
    if Length(tmp)>3 then tmp := Copy(tmp,1,3);
    { handle pause specially }
    if CompareStr(tmp,'PAU')= 0 then begin
      Sleep(count);
      key := 0;
      exit;
    end;


    { find entry in table }
    key := 0;
    for j := 0 to tbllen-1 do begin
      if CompareStr(tbl[j].token,tmp) = 0 then begin
        key := tbl[j].vkey;
        break;
      end;
    end;
    { if key is 0 here, then something is BAD! }
  end; { else - of token processing }
end;  { end procbrace }

{Wrapper around kebyd_event}
procedure keybd(vk: integer; down: Boolean);
var
  scan, flg: Integer;
begin
  scan := MapVirtualKey(vk,0);  { find VK }
  if down then flg := 0 else flg := KEYEVENTF_KEYUP;
  keybd_event(vk,scan,flg,0);
end; { keybd }

function cvtkey(var s: String; i: integer; var key: Integer;
                var count: integer; var len: integer;
                var letshift: Boolean;
                var shift: boolean; var letctrl: boolean;
                var ctrl: boolean; var letalt : boolean;
                var alt : boolean; var shiftlock : boolean): Boolean;
var rv: longint;
      c: char;
begin
  if i <> 0 then begin { if i = 0 then supress special processing }
    len := 1;
    count := 1;
  end;
  Result :=false;
  if i <> 0 then c:=s[i] else c := chr(0);
  { scan for special character }
  case c of
    '{': begin procbrace(s,i,key,len,count,letshift,
                         letctrl,letalt,shift,ctrl,
                         alt,shiftlock);
               if key = 0 then Result := True; exit;
         end;
    '~': begin key := VK_RETURN;
         end;
    '+': begin shift:= true;
               Result := true;
         end;
    '^': begin ctrl := true;
               Result := true;
         end;
    '/': begin alt:=true;
               Result := true;
         end;
    '(': begin shiftlock:=true;
               Result:=true;
         end;
    ')': begin shiftlock:= false;
               Result:=true;
         end;
      {  something is wrong with this case statement is else part of it? }
    else begin
      if c= chr(0) then c:= chr(key);
      rv:=VKKeyScan(c);  { normal character }
      key := rv and $FF;
      if (rv and $100) = $100 then
        letshift := true else letshift := false;
      if (rv and $200) = $200 then
        letctrl:= true else letctrl := false;
      if (rv and $400) = $400 then
        letalt:=true else letalt:=false;
      end;
    end; {else ?? case }
end; { cvtkey }

{ The Main Point...}
procedure SendKeys(s:string);
var
  i,j: integer;
  c: char;
  key: integer;
  shift,letshift,ctrl,letctrl,alt,letalt,shiftlock: boolean;
  len,count: integer;
begin
  { init }
  len := 1;
  shiftlock :=false;
  letalt :=false;
  alt :=false;
  letctrl :=false;
  ctrl:=false;
  letshift :=false;
  shift :=false;
  { for each character in string }
  for i := 1 to length(s) do begin
    if len<>1 then begin
      len := len-1;
      continue;
    end;
    c:=s[i];
    {convert key }
    if cvtkey(s,i,key,count,len,letshift,shift,
              letctrl,ctrl,letalt,alt,shiftlock) then
      continue;
    { fake modifier keys }
    if shift or letshift then keybd(VK_SHIFT,True);
    if ctrl or letctrl then keybd(VK_CONTROL,True);
    if alt or letalt then keybd(VK_MENU,True);
    { do requested number of keystrokes }
    for j := 1 to count do begin
      keybd(key,true);
      keybd(key,false);
      sleep(50);
    end;
    { clear modifier unless locked }
    if alt or letalt and not shiftlock then
      keybd(VK_MENU,false);
    if ctrl or letctrl and not shiftlock then
      keybd(VK_CONTROL,false);
    if shift or letshift and not shiftlock then
      keybd(VK_SHIFT,false);
    if not shiftlock then begin
      alt:= false;
      ctrl:= false;
      shift:= false;
    end;
  end; { for }
end; { SendKeys }

procedure SendKeysn(s:string; n:longint);
{ same as sendkeys but pauses for n milliseconds instead of 50 }
var
  i,j: integer;
  c: char;
  key: integer;
  shift,letshift,ctrl,letctrl,alt,letalt,shiftlock: boolean;
  len,count: integer;
begin
  { init }
  len := 1;
  shiftlock :=false;
  letalt :=false;
  alt :=false;
  letctrl :=false;
  ctrl:=false;
  letshift :=false;
  shift :=false;
  { for each character in string }
  for i := 1 to length(s) do begin
    if len<>1 then begin
      len := len-1;
      continue;
    end;
    c:=s[i];
    {convert key }
    if cvtkey(s,i,key,count,len,letshift,shift,
              letctrl,ctrl,letalt,alt,shiftlock) then
      continue;
    { fake modifier keys }
    if shift or letshift then keybd(VK_SHIFT,True);
    if ctrl or letctrl then keybd(VK_CONTROL,True);
    if alt or letalt then keybd(VK_MENU,True);
    { do requested number of keystrokes }
    for j := 1 to count do begin
      keybd(key,true);
      keybd(key,false);
      sleep(n);
    end;
    { clear modifier unless locked }
    if alt or letalt and not shiftlock then
      keybd(VK_MENU,false);
    if ctrl or letctrl and not shiftlock then
      keybd(VK_CONTROL,false);
    if shift or letshift and not shiftlock then
      keybd(VK_SHIFT,false);
    if not shiftlock then begin
      alt:= false;
      ctrl:= false;
      shift:= false;
    end;
  end; { for }
end; { SendKeysn }

initialization
  tbl[0].token:='BAC';
  tbl[0].vkey:=VK_BACK;
  tbl[1].token:='BS';
  tbl[1].vkey:=VK_BACK;
  tbl[2].token:='BKS';
  tbl[2].vkey:=VK_BACK;
  tbl[3].token:='BRE';
  tbl[3].vkey:= VK_CANCEL;
  tbl[4].token:= 'CAP';
  tbl[4].vkey:= VK_CAPITAL;
  tbl[5].token := 'DEL';
  tbl[5].vkey := VK_DELETE;
  tbl[6].token := 'DOW';
  tbl[6].vkey := VK_DOWN;
  tbl[7].token := 'END';
  tbl[7].vkey := VK_END;
  tbl[8].token := 'ENT';
  tbl[8].vkey := VK_RETURN;
  tbl[9].token := 'ESC';
  tbl[9].vkey := VK_ESCAPE;
  tbl[10].token := 'HEL';
  tbl[10].vkey := VK_HELP;
  tbl[11].token := 'HOM';
  tbl[11].vkey := VK_HOME;
  tbl[12].token := 'INS';
  tbl[12].vkey := VK_INSERT;
  tbl[13].token := 'LEF';
  tbl[13].vkey := VK_LEFT;
  tbl[14].token := 'NUM';
  tbl[14].vkey := VK_NUMLOCK;
  tbl[15].token := 'PGD';
  tbl[15].vkey := VK_NEXT;
  tbl[16].token := 'PGU';
  tbl[16].vkey := VK_PRIOR;
  tbl[17].token := 'PRT';
  tbl[17].vkey := VK_SNAPSHOT;
  tbl[18].token := 'RIG';
  tbl[18].vkey := VK_RIGHT;
  tbl[19].token := 'SCR';
  tbl[19].vkey := VK_SCROLL;
  tbl[20].token := 'TAB';
  tbl[20].vkey := VK_TAB;
  tbl[21].token := 'UP';
  tbl[21].vkey:= VK_UP;
  tbllen:=22;
end.

end.

I hope that this helps in some way.  Andy - seitza@docker.com
0
 

Expert Comment

by:seitza
Comment Utility
Further details are available should you need them.
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
When you create an app prototype with Adobe XD, you can insert system screens -- sharing or Control Center, for example -- with just a few clicks. This video shows you how. You can take the full course on Experts Exchange at http://bit.ly/XDcourse.
This video demonstrates how to create an example email signature rule for a department in a company using CodeTwo Exchange Rules. The signature will be inserted beneath users' latest emails in conversations and will be displayed in users' Sent Items…

763 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now