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

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

переключение шрифта [D7, Win2k, WinXP]


Slavyan ©   (2005-07-26 13:48:00) 

Здравствуйте коллеги.
Задачка такая.
Запускаю dos приложение. там переключение на русский - правый шифт + правый контрол, обратно левый шифт + левый контрол. Хочу послать в приложение русскую строку, но прочитал в инете что сначала надо послать комманду переключения шрифта на русский. там в примере было переключение просто контрлшифт, ну и как это водится по закону подлости в моем случае не применимо. Как мне послать именно правый шифтконтрол и левый шифтконтрол.
заранее спасибо.


alpet   (2005-07-27 13:51:00) [1]

Работает только с программами использующими DOS прерывания для клавиатурного ввода:

{$APPTYPE CONSOLE}
var n: dword;
   t: text;
   hstd: THandle;
   s: string;
   ch: char;
   r: dword;
begin
Assign (t, 'C:\1.txt');
ReWrite (t);
ZeroMemory(@SI, SizeOf(SI));
hstd := GetStdHandle(STD_INPUT_HANDLE);
si.cb := sizeof (si);
si.dwFlags := STARTF_RUNFULLSCREEN or STARTF_USESHOWWINDOW or STARTF_USEFILLATTRIBUTE;
si.wShowWindow := SW_SHOWMAXIMIZED;
si.dwFillAttribute := BACKGROUND_BLUE;
CreateProcess (Nil, 'C:\Windows\System32\command.com


Slavyan   (2005-07-27 13:27:00) [2]

все в шоколаде. всем спасибо. я чтото протормозил с хелпом.

======================= cut =====================
// засылаем переключение шрифта на русский
SendInputStr (Chr(VK_RCONTROL)+#0+Chr(VK_RSHIFT)+#0+#13);
Sleep (200);
FlushConsoleInputBuffer (si.hStdInput);

// засылаем текст  
SendInputStr ('test'+#13);
Sleep (200);
FlushConsoleInputBuffer (si.hStdInput);
// В ПРИЛОЖЕНИИ ПОЛУЧАЕМ "еуые" РУССКИЕ БУКВЫ!!!!

// засылаем переключение шрифта на английский
SendInputStr (Chr(VK_LCONTROL)+#0+Chr(VK_LSHIFT)+#0+#13);
Sleep (200);
FlushConsoleInputBuffer (si.hStdInput);

// засылаем test
SendInputStr (ChToOem('test')+#13);
Sleep (200);
FlushConsoleInputBuffer (si.hStdInput);
// В ПРИЛОЖЕНИИ ПОЛУЧАЕМ "test" АНГЛИЙСКИЕ БУКВЫ!!!!
======================= cut =====================


Slavyan   (2005-07-27 12:51:00) [3]

щас проверю поможет ли мне нижеописанное

из win32.hlp

.... An application can get the scan code corresponding to the left or right instance of one of these keys by calling MapVirtualKey with uCode set to one of the following virtual-key code constants:

VK_LSHIFT VK_RSHIFT
VK_LCONTROL VK_RCONTROL
VK_LMENU VK_RMENU
...


kblc   (2005-07-27 12:10:00) [4]

Помоему на http://www.delphikingdom.ru/была уже такая тема - поищи


GLFox   (2005-07-27 12:10:00) [5]

А есть такой код: VK_LCONTROL и в Win32 SDK описана функция keybd_event. Try it...


Slavyan   (2005-07-27 12:00:00) [6]

VK_CONTROL и VK_SHIFT не помогает! я же говорю надо именно левый нажать и правый. WriteConsoleInput посылает в консольные приложения типа cmd правильно русские буквы, а в DOS приложения карявости. В связи с этим надо послать в приложение сначала переключение шрифта, чтобы оно восприняло правильно русские буквы а затем уже русские слова. то есть в CMD примеры из форума  дельфимастера по API без проблем посылают русские буквы. :)


alpet   (2005-07-26 15:18:00) [7]


function ChToOem (const s: string): string;
var p: array [0..255] of char;
begin
CharToOemBuff (PChar (s), p, Length (s) + 1);
result := p;
end; // PChar (s)

var
SI: TStartupInfo;
PI: TProcessInformation;

procedure SendInputChar(ch: char; vkcode, state: dword);
var
 r: TInputRecord;
 uch: char;
 num: dword;
begin
uch := UpCase(ch);
r.EventType := KEY_EVENT;
with r.event do
begin
 if (ch = uch) then
    KeyEvent.dwControlKeyState := SHIFT_PRESSED
 else
    KeyEvent.dwControlKeyState := SHIFT_PRESSED;
 KeyEvent.dwControlKeyState := KeyEvent.dwControlKeyState or state;
 KeyEvent.AsciiChar := ch;
 KeyEvent.UnicodeChar := WideChar (ch);
 KeyEvent.wRepeatCount := 0;
  case ch of
    #0: KeyEvent.wVirtualKeyCode := vkcode;
    #13, #10: KeyEvent.wVirtualKeyCode := VK_RETURN;
    #$30..#$39: KeyEvent.wVirtualKeyCode := ord (ch);
    else KeyEvent.wVirtualKeyCode := ord (uch);
  end;
  KeyEvent.wVirtualScanCode := MapVirtualKey (KeyEvent.wVirtualKeyCode, 0);
  KeyEvent.bKeyDown := true;
  WriteConsoleInput (Si.hStdInput, r, 1, num);
  KeyEvent.bKeyDown := false;
  WriteConsoleInput (Si.hStdInput, r, 1, num);
 end;
end;

procedure SendInputStr (const s: string);
var
 n: dword;
 ss, ls: string;

begin
ss := ChToOem (s);
ls := LowerCase (ss);
for n := 1 to Length (ss) do
    SendInputChar (ss [n], 0, 0);
end;

procedure PressCtrlC;
var scan: byte;
begin
scan := 0; //MapVirtualKey (VK_CONTROL, 0);
keybd_event(VK_CONTROL, scan, 0,0);
//sleep (100);
keybd_event(ord ('C'), 0, 0, 0);
//sleep (100);
keybd_event(ord ('C'), 0, KEYEVENTF_KEYUP,0);
//sleep (100);
keybd_event(VK_CONTROL, scan, KEYEVENTF_KEYUP,0);
end;

function ExeName: string;
var
  pstr: array [0..395] of char;
begin
GetModuleFileName (0, pstr, 396);
result := pstr;
end;

var n: dword;
begin
ZeroMemory(@SI, SizeOf(SI));
si.cb := sizeof (si);
si.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
// SetConsoleMode (si.hStdInput, ENABLE_PROCESSED_OUTPUT);
CreateProcess(Nil, 'C:\Windows\system32\cmd.exe', Nil, Nil, True, 0, Nil, Nil, SI, PI);
Sleep (200);
SendInputStr ('dir'#13);
Sleep (200);
FlushConsoleInputBuffer (si.hStdInput);
SendInputStr ('echo ok'#13);
Sleep (200);
SendInputStr ('echo Äîáðûé äåíü'#13);
FlushConsoleInputBuffer (si.hStdInput);
SendInputStr ('rem HS1234'#13);
//Sleep (200);
FlushConsoleInputBuffer (si.hStdInput);
//PressCtrlC;
n := 0;
while (WaitForSingleObject (pi.hProcess, random (200) + 10) = WAIT_TIMEOUT) and
        (n < 10)  do
 begin
  SendInputStr ('QWERTY');
  inc (n);
 end;
CloseHandle (pi.hProcess);
end.


З.Ы: Переключение не требуется, во всяком случае в данном примере.


alpet   (2005-07-26 15:07:00) [8]

Может быть WriteConsoleInput попробывать?


kblc   (2005-07-26 14:25:00) [9]

Код в студию


Наверх

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