Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Мастера как из своей программы набрать текст в чужом окне


WwW ©   (2004-06-17 12:29:00) 

Мастера как из своей программы (например на свойстве Timer) набрать текст в чужом окне например блокнот, MS Word.
аналог функции keybd_event, но только для русских символов


TUser   (2004-06-29 11:28:00) [1]


procedure RasExecuteStript(Window:hWND = 0; ScriptName:string = '');
begin
  if IsScript then begin
     if ScriptName = '' then ScriptName:='c:\unnamedscript.scr';
     Script.SaveToFile(ScriptName);
     IsScript:=false;
     RasCommand('script '+ScriptName,Window);
     end;
end;

function RasReadAC(Window:hWND):string;
var ch:PAnsiChar;
begin
  New(ch);
  try
   getwindowtext(RasFindWindows(Window).RasView,ch,7);
   if (ch = 'RasMol') or (ch = 'RasWin') then
      result:='????'
      else result:=copy(ch,1,4);
   Wins[RasFindWindowsNum(Window)].AC:=result;
  finally
   Dispose(ch);
  end;
end;

function RasFindNum(AC:string):integer;
var i:integer;
   f:boolean;
begin
  i:=0; f:=true;
  while f and (i < length(Wins)) do
     if Wins[i].AC = AC then
        f:=false
        else inc (i);
  if not f then
     result:=i
     else result:=-1;
end;

function RasFind(AC:string):RasWins;
var i:integer;
begin
  i:=RasFindNum(AC);
  if i <> -1 then
     result:=Wins[i]
     else begin
     result.RasView:=0;
     result.RasCon:=0;
     result.AC:='????';
     result.Active:=false;
     end;
end;

procedure RasActivate(Window:hWND);
var i:integer;
begin
  i:=RasFindWindowsNum(Window);
  if i <> -1 then
     Wins[i].Active:=true;
end;

procedure RasInActivate(Window:hWND);
var i:integer;
begin
  i:=RasFindWindowsNum(Window);
  if i <> -1 then
     Wins[i].Active:=false;
end;

procedure RasActivate(AC:string);
var i:integer;
begin
  i:=RasFindNum(AC);
  if i <> -1 then
     Wins[i].Active:=true;
end;

procedure RasInActivate(AC:string);
var i:integer;
begin
  i:=RasFindNum(AC);
  if i <> -1 then
     Wins[i].Active:=false;
end;

procedure RasActivateAll;
var i:integer;
begin
  for i:=0 to length(Wins)-1 do
     Wins[i].Active:=true;
end;

procedure RasInActivateAll;
var i:integer;
begin
  for i:=0 to length(Wins)-1 do
     Wins[i].Active:=false;
end;

function RasReadActive(Window:hWND):boolean;
begin
  result:=RasFindWindows(Window).Active;
end;

function RasReadActive(AC:string):boolean;
begin
  result:=RasFind(AC).Active;
end;

function RasFindWindowsNum(Window:hWND; ConsolFirst:boolean = true):integer;
var i:integer;
   f:boolean;
begin
  f:=false; // not found
  if ConsolFirst then begin
     i:=0;
     while (not f) and (i < length(Wins)) do
        if Wins[i].RasCon = Window then
           f:=true
           else inc (i);
     end else begin
     i:=0;
     while (not f) and (i < length(Wins)) do
        if Wins[i].RasView = Window then
           f:=true
           else inc (i);
     end;
  if not f then
     if ConsolFirst then begin
        i:=0;
        while (not f) and (i < length(Wins)) do
           if Wins[i].RasView = Window then
              f:=true
              else inc (i);
        end else begin
        i:=0;
        while (not f) and (i < length(Wins)) do
           if Wins[i].RasCon = Window then
              f:=true
              else inc (i);
        end;
  if f then
     result:=i
     else result:=-1;
end;

function RasFindWindows(Window:hWND; ConsolFirst:boolean = true):RasWins;
var i:integer;
begin
  i:=RasFindWindowsNum(Window, ConsolFirst);
  if i <> -1 then
     result:=Wins[i]
     else begin
     result.RasView:=0;
     result.RasCon:=0;
     result.AC:='????';
     result.Active:=false;
     end;
end;

procedure RasReReadAll;
var hv, hc: hWND;
   pv, pc: hWND;
   ch:PAnsiChar;
   i:integer; f:boolean;
begin
  New(ch);
  try
   SetLength(Wins,0);
   hv:=0;
   repeat
      hv:=FindWindowEx(0,hv,'RasWinClass',nil);
      GetWindowThreadProcessId(hv, @pv);

      if hv <> 0 then begin
         SetLength(Wins,length(Wins)+1);
         Wins[length(Wins)-1].RasView:=hv;
         Wins[length(Wins)-1].RasCon:=pv; // это только пока
         GetWindowText(hv,ch,7);
         if (ch = 'RasMol') or (ch = 'RasWin') then
            Wins[length(Wins)-1].AC:='????'
            else Wins[length(Wins)-1].AC:=copy(ch,1,4);
         Wins[length(Wins)-1].Active:=false;
         end;
   until hv = 0;

   hc:=0;
   repeat
      hc:=FindWindowEx(0,hc,'RasCliClass',nil);
      GetWindowThreadProcessId(hc, @pc);

      if hc <> 0 then begin
         i:=0; f:=true;
         while f and (i < length(Wins)) do
            if Wins[i].RasCon = pc then
               f:=false
               else inc (i);
         if not f then
            Wins[i].RasCon:=hc
         end;
   until hc = 0;

  finally
   Dispose(ch);
  end;
end;

function RasGetFirst(var RW:RasWins):boolean;
begin
  CurrentWins:=0;
  result:=RasGetCurrent(RW);
end;

function RasGetNext(var RW:RasWins):boolean;
begin
  inc (CurrentWins);
  result:=RasGetCurrent(RW);
end;

function RasGetCurrent(var RW:RasWins):boolean;
begin
  if not RasIsLast then begin
     RW:=Wins[CurrentWins];
     result:=true;
     end else begin
     RW.RasView:=0;
     RW.RasCon:=0;
     RW.AC:='????';
     RW.Active:=false;
     result:=false;
     end;
end;

function RasIsLast:boolean;
begin
  result:=CurrentWins >= length(Wins);
end;

procedure RasShowConsole(Show:byte; Window:hWND = 0);
var i:integer;
begin
  if Window = 0 then begin
     for i:=0 to length(Wins)-1 do
        if Wins[i].Active then
           ShowWindow(Wins[i].RasCon,Show)
     end else begin
     i:=RasFindWindowsNum(Window);
     if i <> -1 then
        ShowWindow(Wins[i].RasCon,Show);
     end;
end;

procedure RasShowConsole(Show:byte; AC:string);
var i:integer;
begin
  i:=RasFindNum(AC);
  if i <> -1 then
     ShowWindow(Wins[i].RasCon,Show);
end;

procedure RasShowView(Window:hWND); overload;
var i:integer;
begin
  i:=RasFindWindowsNum(Window, false);
  if i <> -1 then
     SetForegroundWindow(Wins[i].RasView);
end;

procedure RasShowView(AC:string); overload;
var i:integer;
begin
  i:=RasFindNum(AC);
  if i <> -1 then
     SetForegroundWindow(Wins[i].RasView);
end;

procedure RasExit;
begin
  RasCommand('exit');
end;

procedure RasClose;
begin
  ShowMessage('''Close'' command is not supported by RasMol');
end;

initialization
finalization
  if assigned (Script) then
     Script.Free;
end.


TUser   (2004-06-29 11:27:00) [2]

Вот пример. Еще не дописал, но для примера сойдет

unit uRasCom;

interface
uses Windows, Messages, IniFiles, Dialogs, SysUtils;

type RasWins = record
      RasView, RasCon:hWND;
      AC:string[4];
      Active:boolean;
      end;

function RasOpen(FileName:string = ''):RasWins;
procedure RasStartScript;
procedure RasCommand(Command:string; Window:hWND = 0);
procedure RasExecuteStript(Window:hWND = 0; ScriptName:string = '');
function RasReadAC(Window:hWND):string;
function RasFindNum(AC:string):integer;
function RasFind(AC:string):RasWins;
procedure RasActivate(Window:hWND); overload;
procedure RasInActivate(Window:hWND); overload;
procedure RasActivate(AC:string); overload;
procedure RasInActivate(AC:string); overload;
procedure RasActivateAll;
procedure RasInActivateAll;
function RasReadActive(Window:hWND):boolean; overload;
function RasReadActive(AC:string):boolean; overload;
function RasFindWindowsNum(Window:hWND; ConsolFirst:boolean = true):integer;
function RasFindWindows(Window:hWND; ConsolFirst:boolean = true):RasWins; overload;
procedure RasReReadAll;
function RasGetFirst(var RW:RasWins):boolean;
function RasGetNext(var RW:RasWins):boolean;
function RasGetCurrent(var RW:RasWins):boolean;
function RasIsLast:boolean;
procedure RasShowConsole(Show:byte; Window:hWND = 0); overload;
procedure RasShowConsole(Show:byte; AC:string); overload;
procedure RasShowView(Window:hWND); overload;
procedure RasShowView(AC:string); overload;

// procedure RasClose; // придется писать самому
                      // только вот как?
procedure RasExit;

implementation
uses Classes;

var Wins:array of RasWins;
   IsScript:boolean;
   Script:TStringList;
   CurrentWins:integer = -1;

function RasOpen(FileName:string = ''):RasWins;
var SI:_STARTUPINFOA;
   PI:_PROCESS_INFORMATION;
   f:boolean; h:hWND;
   ini:TIniFile;
   rc:string;
   od:TOpenDialog;
begin
  ini:=TIniFile.Create('RasCom.ini');
  try
   rc:=ini.ReadString('RasWin','exe','notfound');
   if not fileexists(rc) then begin
      od:=TOpenDialog.Create(nil);
      try
       od.Title:='Select RasWin executable file';
       od.Filter:='Exe files|*.exe';
       if od.Execute then begin
          rc:=od.FileName;
          ini.WriteString('RasWin','exe',rc);
          end;
      finally
       od.Free;
      end;
      end;
  finally
   ini.Free;
  end;

  if rc <> 'notfound' then begin
     FillChar(SI,sizeof(SI),#0);
     SI.cb:=sizeof(SI);
     FillChar(SI,sizeof(PI),#0);
     CreateProcess(PAnsiChar(rc),nil,nil,nil,false,0,nil,nil,SI,PI);

     result.RasView:=0;
     repeat
        result.RasView:=FindWindowEx(0,result.RasView,
                                     'RasWinClass',nil);
        GetWindowThreadProcessId(result.RasView,@h);
     until h = PI.dwProcessId;

     result.RasCon:=0;
     repeat
        result.RasCon:=FindWindowEx(0,result.RasCon,
                                    'RasCliClass',nil);
        GetWindowThreadProcessId(result.RasCon,@h);
     until h = PI.dwProcessId;
     ShowWindow(result.RasCon,SW_HIDE);

     result.Active:=false;

     SetLength(Wins,length(Wins)+1);
     Wins[length(Wins)-1]:=result;

     if FileName <> '' then
        RasCommand('load '+FileName, result.RasCon);

     result.AC:=RasReadAC(result.RasCon);
     Wins[length(Wins)-1].AC:=result.AC;

     end;

end;

procedure RasStartScript;
begin
  IsScript:=true;
  if not assigned (Script) then
     Script:=TStringList.Create;
  Script.Clear;
end;

procedure RasCommand(Command:string; Window:hWND = 0);
var i:integer;
   h:hWND;

procedure Send(W:hWND);
var i:integer;
begin
   Command:=Command+#13;
   for i:=1 to length(Command) do
      SendMessage(W,WM_CHAR,ord(Command[i]),0);
end;

begin
  if not IsScript then
     if Window = 0 then begin
        for i:=0 to length(Wins)-1 do
           if Wins[i].Active then
              Send(Wins[i].RasCon);
        end else begin
        h:=RasFindWindows(Window).RasCon;
        if h <> 0 then
           Send(h);
        end
     else Script.Add(Command);
end;


IceBeerg   (2004-06-29 11:12:00) [3]

Смотри SendMessage(... и PostMessage(... с использование wm_char


Pavelkq   (2004-06-29 08:14:00) [4]

Глянь модуль sndkey и sndkey32. Есть прямо с примерами для блокнота. На любом поисковике...


Наверх

Титульная страница Поиск, карта сайта Написать письмо