Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 18.02.2009, 11:44   #1
AndrzejX
Пользователь
 
Регистрация: 12.11.2008
Сообщений: 55
По умолчанию Контроль буфера обмена

Всем привет! Написал простую программку для контроля буфера - содержится ли там определённая текстовая фраза. Программка должна висеть в памяти, но при этом, естественно, не мешать обычной работе. Проверка:
Код:
try
 if ClipBoard.asText='Нужная фраза'
  then ...
except
end;
Всё работает. Но при попытке, например при работе в Word'е, поместить что-либо в буфер происходит задержка в несколько секунд. Это не называется "не мешать". Можно ли что-то сделать?
AndrzejX вне форума Ответить с цитированием
Старый 18.02.2009, 11:48   #2
KORN
Банхаммер
Участник клуба
 
Аватар для KORN
 
Регистрация: 17.02.2007
Сообщений: 1,754
По умолчанию

как ты отслеживаешь изменение буфера7
Перед тем как спросить ищи на форуме и в GOOGLE
KORN вне форума Ответить с цитированием
Старый 18.02.2009, 11:55   #3
AndrzejX
Пользователь
 
Регистрация: 12.11.2008
Сообщений: 55
По умолчанию

Запускаю цикл и проверяю как в предыдущем посте через каждые 100 мс
Вот прога:
Код:
program Bufer;

uses Windows, ClipBrd, ShellAPI;

var Msg: TMsg;

{$R *.res}

begin
while GetMessage(Msg, HInstance, 0, 0) do
 begin
  TranslateMessage(Msg);
  DispatchMessage(Msg);
  try
   if ClipBoard.AsText<>'Фраза'
    then ;
  except
  end;
  sleep(100); //если убрать, то загрузка процессора - 50%
 end;
end.

Последний раз редактировалось AndrzejX; 18.02.2009 в 12:03.
AndrzejX вне форума Ответить с цитированием
Старый 18.02.2009, 12:11   #4
KORN
Банхаммер
Участник клуба
 
Аватар для KORN
 
Регистрация: 17.02.2007
Сообщений: 1,754
По умолчанию

Код:
begin
while true do
 begin
  try
   if ClipBoard.AsText<>'Фраза'
    then ;
  except
  end;
  sleep(100); //если убрать, то загрузка процессора - 50%
 end;
end.
а так7
Перед тем как спросить ищи на форуме и в GOOGLE
KORN вне форума Ответить с цитированием
Старый 18.02.2009, 12:15   #5
AndrzejX
Пользователь
 
Регистрация: 12.11.2008
Сообщений: 55
По умолчанию

Я с этого начинал. Сейчас ещё разок проверю... Как выясняется, задержка происходит только в первый раз. Затем всё нормально. Так должно быть?

Последний раз редактировалось AndrzejX; 18.02.2009 в 12:21.
AndrzejX вне форума Ответить с цитированием
Старый 18.02.2009, 12:18   #6
KORN
Банхаммер
Участник клуба
 
Аватар для KORN
 
Регистрация: 17.02.2007
Сообщений: 1,754
По умолчанию

тебе не нужно получать никакие сообщения и их обрабатывать, да и задержку можно где то в 300 или 500 сделать
Перед тем как спросить ищи на форуме и в GOOGLE
KORN вне форума Ответить с цитированием
Старый 18.02.2009, 12:28   #7
AndrzejX
Пользователь
 
Регистрация: 12.11.2008
Сообщений: 55
По умолчанию

Всё это я делал. Но одна задержка устраивает. KORN, спасибо большое!

Последний раз редактировалось AndrzejX; 18.02.2009 в 12:56.
AndrzejX вне форума Ответить с цитированием
Старый 20.02.2009, 00:03   #8
Somebody
Участник клуба
 
Регистрация: 08.10.2007
Сообщений: 1,185
По умолчанию

Код:
uses
  Windows, Messages;
const
  HWND_MESSAGE = HWND(-3);
  WndClassName = 'ClipboardControlWndClass';
var
  hNextWindow: HWND;

function WndProc(hWindow: HWND; Msg: Cardinal; wParam, lParam: Integer): Integer; stdcall;
var
  hClipboardData: THandle;
  pData: PChar;
begin
  Result := 0;
  case Msg of
    WM_CREATE:
      hNextWindow := SetClipboardViewer(hWindow);
    WM_DESTROY:
    begin
      ChangeClipboardChain(hWindow, hNextWindow);
      PostQuitMessage(0);
    end;
    WM_CLOSE:
      DestroyWindow(hWindow);
    WM_CHANGECBCHAIN:
    begin
      if HWND(wParam) = hNextWindow then
        hNextWindow := HWND(lParam)
      else if hNextWindow <> 0 then
        SendMessage(hNextWindow, Msg, wParam, lParam);
    end;
    WM_DRAWCLIPBOARD:
    begin
      if IsClipboardFormatAvailable(CF_TEXT) and
        OpenClipboard(hWindow) then
      begin
        hClipboardData := GetClipboardData(CF_TEXT);
        if hClipboardData <> 0 then
        begin
          pData := GlobalLock(hClipboardData);
          if pData <> nil then
          begin
            if Pos('Hello', pData) <> 0 then
              Beep(2000, 100);
            GlobalUnlock(hClipboardData);
          end;
        end;
        CloseClipboard();
        if hNextWindow <> 0 then
          SendMessage(hNextWindow, Msg, wParam, lParam);
      end;
    end;
    else
      Result := DefWindowProc(hWindow, Msg, wParam, lParam);
  end;
end;

var
  WindowClass: WNDCLASS;
  Mess: MSG;
begin
  FillChar(WindowClass, SizeOf(WindowClass), 0);
  WindowClass.lpfnWndProc := @WndProc;
  WindowClass.hInstance := hInstance;
  WindowClass.lpszClassName := WndClassName;
  RegisterClass(WindowClass);
  CreateWindow(WndClassName, nil, 0, 0, 0, 0, 0, HWND_MESSAGE, 0, hInstance, nil);
  while GetMessage(Mess, 0, 0, 0) do
    DispatchMessage(Mess);
  halt(Mess.wParam);
end.

Последний раз редактировалось Somebody; 20.02.2009 в 00:05.
Somebody вне форума Ответить с цитированием
Старый 20.02.2009, 07:30   #9
AndrzejX
Пользователь
 
Регистрация: 12.11.2008
Сообщений: 55
По умолчанию

Грандиозно! Проблема решена. КАК ЭТО РАБОТАЕТ - буду разбираться. Спасибо.
AndrzejX вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
очистка буфера обмена beegl Общие вопросы Delphi 21 04.01.2017 11:01
печать из буфера Марксист Общие вопросы Delphi 2 28.07.2008 14:00
неформатированный текст из буфера в TWebBrowser? element Компоненты Delphi 0 09.12.2007 11:46
TWebBorwser - страничка из буфера OrdJONY Работа с сетью в Delphi 6 09.11.2007 18:56