Здравствуйте!!! Мастера помогите, а в частности Rouse, пожалуйста!!! Вы мне давали код. Я его немного переделал. Мне нужно перехватить вставку из буфера обмена данных в ячейки Stringgrid. Вот есть код, но только действует для edit:

...

Код

procedure ControlOnEnter(Sender: TObject); procedure ControlOnExit(Sender: TObject); private    OldWindowProcessor: TWndMethod;    procedure NewWindowProc(var Message: TMessage);  public    { Public declarations }  end; procedure TForm1.NewWindowProc(var Message: TMessage); begin  if Message.Msg = WM_PASTE  then   begin  //здесь выполняются инструкции после перехвата  end  else OldWindowProcessor(Message); end; procedure TForm1.ControlOnEnter(Sender: TObject); begin if not (Sender is TEdit) and    not (Sender is TStringGrid) then Exit; OldWindowProcessor:=TControl(Sender).WindowProc; TControl(Sender).WindowProc := NewWindowProc; end; procedure TForm1.ControlOnExit(Sender: TObject); begin if not (Sender is TEdit) and    not (Sender is TStringGrid) then Exit; TControl(Sender).WindowProc := OldWindowProcessor; end;

Для Stringgrid и edit в процедурах onenter и onexit соответствено ставим процедуры ControlOnEnter и ControlOnExit.

Спасибо заранее за ответ!!! Помогите ламеру!!!!

Цитата

Ламер - он и в Африке ламер...

Это сообщение отредактировал(а) Girder - 8.5.2005, 07:46

Help!!! На помощь...помогите мне пожалуйста уважаемые мастера Delphi!!! Что только я уже не перепробовал!!!

Я конечно не проверял и особо не смотрел код, но что-то мне подсказывает, что нужно написать вот так:

Код

procedure ControlOnEnter(Sender: TObject); procedure ControlOnExit(Sender: TObject); private    OldWindowProcessor: TWndMethod;    procedure NewWindowProc(var Message: TMessage);  public    { Public declarations }  end; procedure TForm1.NewWindowProc(var Message: TMessage); begin  if Message.Msg = WM_PASTE  then   begin  //здесь выполняются инструкции после перехвата  end  else OldWindowProcessor(Message); end; procedure TForm1.ControlOnEnter(Sender: TObject); begin if  (Sender is TEdit) or (Sender is TStringGrid) then begin   OldWindowProcessor:=TControl(Sender).WindowProc;   TControl(Sender).WindowProc := NewWindowProc; end; end; procedure TForm1.ControlOnExit(Sender: TObject); begin if  (Sender is TEdit) or (Sender is TStringGrid) then   TControl(Sender).WindowProc := OldWindowProcessor; end;

Grol а с чего ты взял... что обязательно должно быть сообщение WM_Paste(или какое нить еще ) при вставке(или наоборот) из буфера.

Вот компонент... для перехвата некоторых функций при работе с буфером обмена... для своего приложения(ClipboardHook.pas) - после инсталяции появится в Samples:

Код

unit ClipboardHook; interface uses   Windows, SysUtils, Classes, ExtCtrls; type  TFOnOpenClipboard = procedure(Sender:TObject; hWndNewOwner:HWND; var opContinue:Boolean) of object;  TFOnGetClipboardData = procedure(Sender:TObject; hWndNewOwner:HWND; uFormat:DWord; var opContinue:Boolean) of object;  TFOnSetClipboardData = procedure(Sender:TObject; hWndNewOwner:HWND; uFormat:DWord; hMem:THandle; var opContinue:Boolean) of object; type   TClipboardHook = class(TComponent)   private     { Private declarations }     FOnOpenClipboard:TFOnOpenClipboard;     FOnGetClipboardData:TFOnGetClipboardData;     FOnSetClipboardData:TFOnSetClipboardData;   protected     { Protected declarations }   public     { Public declarations }     constructor Create(AOwner: TComponent); override;     destructor Destroy; override;     //------------------------------------------------   published     { Published declarations }     property OnOpenClipboard:TFOnOpenClipboard read FOnOpenClipboard write FOnOpenClipboard;     property OnGetClipboardData:TFOnGetClipboardData read FOnGetClipboardData write FOnGetClipboardData;     property OnSetClipboardData:TFOnSetClipboardData read FOnSetClipboardData write FOnSetClipboardData;   end; procedure Register; implementation type  TcOpen=function(hWndNewOwner:HWND):Bool; stdcall;  TgcData=function(uFormat:DWord):THandle; stdcall;  TscData=function(uFormat:DWord; hMem:Thandle):THandle; stdcall;  TOP_H = packed record   Push:Byte;   Address:DWord;   Ret:Byte;  end;  var OC_Addr,GCD_Addr,SCD_Addr:Pointer;     OP:DWord;     cOpen,rcOpen,gcData,rgcData,scData,rscData:TOP_H;     WPM:DWord;     sComponent:TObject; {***************************Start:TClipboardHook***************************} function Open_Clipboard(hWndNewOwner:HWND):Bool; stdcall; var c:Boolean; begin  c:=true;  if Assigned(TClipboardHook(sComponent).FOnOpenClipboard) then   TClipboardHook(sComponent).FOnOpenClipboard(sComponent,hWndNewOwner,c);  if c then   begin    WriteProcessMemory(OP,OC_Addr,@rcOpen,SizeOf(rcOpen),WPM);    Result:=TcOpen(OC_Addr)(hWndNewOwner);    WriteProcessMemory(OP,OC_Addr,@cOpen,SizeOf(cOpen),WPM);   end else Result:=false; end; function Get_ClipboardData(uFormat:DWord):THandle; stdcall; var c:Boolean;     Win:DWord; begin           c:=true;  Win:=GetOpenClipboardWindow();  if (Win<>0)and(Assigned(TClipboardHook(sComponent).FOnGetClipboardData)) then   TClipboardHook(sComponent).FOnGetClipboardData(sComponent,Win,uFormat,c);  if c then   begin    WriteProcessMemory(OP,GCD_Addr,@rgcData,SizeOf(rgcData),WPM);    Result:=TgcData(GCD_Addr)(uFormat);    WriteProcessMemory(OP,GCD_Addr,@gcData,SizeOf(gcData),WPM);   end else Result:=0; end; function Set_ClipboardData(uFormat:DWord; hMem:THandle):THandle; stdcall; var c:Boolean;     Win:DWord; begin           c:=true;  Win:=GetOpenClipboardWindow();  if (Win<>0)and(Assigned(TClipboardHook(sComponent).FOnSetClipboardData)) then   TClipboardHook(sComponent).FOnSetClipboardData(sComponent,Win,uFormat,hMem,c);  if c then   begin    WriteProcessMemory(OP,SCD_Addr,@rscData,SizeOf(rscData),WPM);    Result:=TscData(SCD_Addr)(uFormat,hMem);    WriteProcessMemory(OP,SCD_Addr,@scData,SizeOf(scData),WPM);   end else Result:=0; end; {****************************End:TClipboardHook****************************} {##############################################################################} constructor TClipboardHook.Create(AOwner:TComponent); var Dll:DWord; begin  inherited Create(Aowner);  if (csDesigning in ComponentState) then exit;  sComponent:=Self;  DLL:=LoadLibrary('user32.dll');  if DLL<>0 then   begin    OC_Addr:=GetProcAddress(DLL,'OpenClipboard');    GCD_Addr:=GetProcAddress(DLL,'GetClipboardData');    SCD_Addr:=GetProcAddress(DLL,'SetClipboardData');    if (OC_Addr<>nil)or(GCD_Addr<>nil)or(SCD_Addr<>nil) then     begin            OP:=OpenProcess(PROCESS_ALL_ACCESS,false,GetCurrentProcessID);      if OP<>0 then       begin        if OC_Addr<>nil then         begin          cOpen.Push:=$68;          cOpen.Address:=DWord(@Open_Clipboard);          cOpen.Ret:=$C3;          ReadProcessMemory(OP,OC_Addr,@rcOpen,SizeOf(rcOpen),WPM);          WriteProcessMemory(OP,OC_Addr,@cOpen,SizeOf(cOpen),WPM);         end;        if GCD_Addr<>nil then         begin          gcData.Push:=$68;          gcData.Address:=DWord(@Get_ClipboardData);          gcData.Ret:=$C3;          ReadProcessMemory(OP,GCD_Addr,@rgcData,SizeOf(rgcData),WPM);          WriteProcessMemory(OP,GCD_Addr,@gcData,SizeOf(gcData),WPM);         end;        if SCD_Addr<>nil then         begin          scData.Push:=$68;          scData.Address:=DWord(@Set_ClipboardData);          scData.Ret:=$C3;          ReadProcessMemory(OP,SCD_Addr,@rscData,SizeOf(rscData),WPM);          WriteProcessMemory(OP,SCD_Addr,@scData,SizeOf(scData),WPM);         end;       end;     end;    FreeLibrary(Dll);   end; end; destructor TClipboardHook.destroy; begin  if (OC_Addr<>nil) then WriteProcessMemory(OP,OC_Addr,@rcOpen,SizeOf(rcOpen),WPM);  if OP<>0 then CloseHandle(OP);  inherited destroy; end; procedure Register; begin   RegisterComponents('Samples', [TClipboardHook]); end; {##############################################################################} end.

Вот пример его использования:
-"Запрет" работы с буфером для всех TEdit;
-"Запрет" работы с буфером при вставке для TStringGrid;
-"Запрет" работы с буфером при копировании(вырезке) для TMemo;

Код

procedure TForm1.ClipboardHook1OpenClipboard(Sender: TObject;   hWndNewOwner: HWND; var opContinue: Boolean); var ClassName:array [0..1024] of char;     i:integer; begin  i:=GetClassName(hWndNewOwner,ClassName,1024);  if i<>0 then   begin    if AnsiCompareText('TEdit',Copy(ClassName,0,i))=0 then     opContinue:=false;    Edit1.Text:='OpenClipboard: '+Copy(ClassName,1,i);   end; end;                procedure TForm1.ClipboardHook1GetClipboardData(Sender: TObject;   hWndNewOwner: HWND; uFormat: Cardinal; var opContinue: Boolean); var ClassName:array [0..1024] of char;     i:integer; begin  i:=GetClassName(GetParent(hWndNewOwner),ClassName,1024);  if i<>0 then   begin    if AnsiCompareText('TStringGrid',Copy(ClassName,1,i))=0 then     opContinue:=false;    i:=GetClassName(hWndNewOwner,ClassName,1024);     Edit1.Text:='WP_Paste: '+Copy(ClassName,1,i);   end; end; procedure TForm1.ClipboardHook1SetClipboardData(Sender: TObject;   hWndNewOwner: HWND; uFormat, hMem: Cardinal; var opContinue: Boolean); var ClassName:array [0..1024] of char;     i:integer; begin  i:=GetClassName(hWndNewOwner,ClassName,1024);  if i<>0 then   begin    if AnsiCompareText('TMemo',Copy(ClassName,0,i))=0 then     opContinue:=false;    Edit1.Text:='WP_Copy(Cut): '+Copy(ClassName,1,i);   end; end;

PS: По большому счету... данный код(компонент) тоже не панацея на все 100%

Удачи.

Girder - я только начинающий, можно так сказать. А ты пишешь такой код, что он мне вообще непонятен. Мне как бы хотелось немного попроще, но все равно спасибо тебе за то, что помогаешь!!! Также всем спасибо!!! Girder, а если вот в моем коде, что там можно сделать??? Еще раз спасибо всем!!!

Это сообщение отредактировал(а) Girder - 8.5.2005, 17:32

Girder - я посмотрел Ваш компонент, он действительно действует, спасибо за это! Очень Вам благодарен!!! Только есть одно, но как мне в вашем компоненте строковой переменной присвоить содержание буфера обмена.

Например: (это ваш код)

Код

procedure TForm1.ClipboardHook1GetClipboardData(Sender: TObject;   hWndNewOwner: HWND; uFormat: Cardinal; var opContinue: Boolean); var ClassName:array [0..1024] of char;     i:integer;        //объявляю строковую переменную    str:string; begin  i:=GetClassName(GetParent(hWndNewOwner),ClassName,1024);  if i<>0 then   begin    if AnsiCompareText('TStringGrid',Copy(ClassName,1,i))=0 then     opContinue:=false;    i:=GetClassName(hWndNewOwner,ClassName,1024);     Edit1.Text:='WP_Paste: '+Copy(ClassName,1,i);       //после этого мне нужно, чтоб я содержания буфера вставил в str переменную   str:=clipboard...//дальше что то у меня не получается   end; end;

Помогите мне пожалуйста еще раз и я уж точно от Вас отстану. :-))) Ламера Ведь так и действуют, что узнают всю информацию от других, я в том числе...Спасибо заранее!!!

Это сообщение отредактировал(а) Girder - 9.5.2005, 09:42

Ну в данном случаи... более простой вариант не много изменить код компонента

Вот тебе новый вариант ClipboardHook.pas:

Код

unit ClipboardHook; interface uses   Windows, SysUtils, Classes, ExtCtrls; type  TFOnOpenClipboard = procedure(Sender:TObject; hWndNewOwner:HWND; var opContinue:Boolean) of object;  TFOnGetClipboardData = procedure(Sender:TObject; hWndNewOwner:HWND; uFormat:DWord; hClipboardObject: THandle; var opContinue:Boolean) of object;  TFOnSetClipboardData = procedure(Sender:TObject; hWndNewOwner:HWND; uFormat:DWord; hMem:THandle; var opContinue:Boolean) of object; type   TClipboardHook = class(TComponent)   private     { Private declarations }     FOnOpenClipboard:TFOnOpenClipboard;     FOnGetClipboardData:TFOnGetClipboardData;     FOnSetClipboardData:TFOnSetClipboardData;   protected     { Protected declarations }   public     { Public declarations }     constructor Create(AOwner: TComponent); override;     destructor Destroy; override;     //------------------------------------------------   published     { Published declarations }     property OnOpenClipboard:TFOnOpenClipboard read FOnOpenClipboard write FOnOpenClipboard;     property OnGetClipboardData:TFOnGetClipboardData read FOnGetClipboardData write FOnGetClipboardData;     property OnSetClipboardData:TFOnSetClipboardData read FOnSetClipboardData write FOnSetClipboardData;   end; procedure Register; implementation type  TcOpen=function(hWndNewOwner:HWND):Bool; stdcall;  TgcData=function(uFormat:DWord):THandle; stdcall;  TscData=function(uFormat:DWord; hMem:Thandle):THandle; stdcall;  TOP_H = packed record   Push:Byte;   Address:DWord;   Ret:Byte;  end;  var OC_Addr,GCD_Addr,SCD_Addr:Pointer;     OP:DWord;     cOpen,rcOpen,gcData,rgcData,scData,rscData:TOP_H;     WPM:DWord;     sComponent:TObject; {***************************Start:TClipboardHook***************************} function Open_Clipboard(hWndNewOwner:HWND):Bool; stdcall; var c:Boolean; begin  c:=true;  if Assigned(TClipboardHook(sComponent).FOnOpenClipboard) then   TClipboardHook(sComponent).FOnOpenClipboard(sComponent,hWndNewOwner,c);  if c then   begin    WriteProcessMemory(OP,OC_Addr,@rcOpen,SizeOf(rcOpen),WPM);    Result:=TcOpen(OC_Addr)(hWndNewOwner);    WriteProcessMemory(OP,OC_Addr,@cOpen,SizeOf(cOpen),WPM);   end else Result:=false; end; function Get_ClipboardData(uFormat:DWord):THandle; stdcall; var c:Boolean;     Win:DWord; begin           c:=true;  Win:=GetOpenClipboardWindow();  WriteProcessMemory(OP,GCD_Addr,@rgcData,SizeOf(rgcData),WPM);  Result:=TgcData(GCD_Addr)(uFormat);  WriteProcessMemory(OP,GCD_Addr,@gcData,SizeOf(gcData),WPM);  if (Win<>0)and(Assigned(TClipboardHook(sComponent).FOnGetClipboardData)) then   TClipboardHook(sComponent).FOnGetClipboardData(sComponent,Win,uFormat,Result,c);  if c=false then Result:=0; end; function Set_ClipboardData(uFormat:DWord; hMem:THandle):THandle; stdcall; var c:Boolean;     Win:DWord; begin           c:=true;  Win:=GetOpenClipboardWindow();  if (Win<>0)and(Assigned(TClipboardHook(sComponent).FOnSetClipboardData)) then   TClipboardHook(sComponent).FOnSetClipboardData(sComponent,Win,uFormat,hMem,c);  if c then   begin    WriteProcessMemory(OP,SCD_Addr,@rscData,SizeOf(rscData),WPM);    Result:=TscData(SCD_Addr)(uFormat,hMem);    WriteProcessMemory(OP,SCD_Addr,@scData,SizeOf(scData),WPM);   end else Result:=0; end; {****************************End:TClipboardHook****************************} {##############################################################################} constructor TClipboardHook.Create(AOwner:TComponent); var Dll:DWord; begin  inherited Create(Aowner);  if (csDesigning in ComponentState) then exit;  sComponent:=Self;  DLL:=LoadLibrary('user32.dll');  if DLL<>0 then   begin    OC_Addr:=GetProcAddress(DLL,'OpenClipboard');    GCD_Addr:=GetProcAddress(DLL,'GetClipboardData');    SCD_Addr:=GetProcAddress(DLL,'SetClipboardData');    if (OC_Addr<>nil)or(GCD_Addr<>nil)or(SCD_Addr<>nil) then     begin            OP:=OpenProcess(PROCESS_ALL_ACCESS,false,GetCurrentProcessID);      if OP<>0 then       begin        if OC_Addr<>nil then         begin          cOpen.Push:=$68;          cOpen.Address:=DWord(@Open_Clipboard);          cOpen.Ret:=$C3;          ReadProcessMemory(OP,OC_Addr,@rcOpen,SizeOf(rcOpen),WPM);          WriteProcessMemory(OP,OC_Addr,@cOpen,SizeOf(cOpen),WPM);         end;        if GCD_Addr<>nil then         begin          gcData.Push:=$68;          gcData.Address:=DWord(@Get_ClipboardData);          gcData.Ret:=$C3;          ReadProcessMemory(OP,GCD_Addr,@rgcData,SizeOf(rgcData),WPM);          WriteProcessMemory(OP,GCD_Addr,@gcData,SizeOf(gcData),WPM);         end;        if SCD_Addr<>nil then         begin          scData.Push:=$68;          scData.Address:=DWord(@Set_ClipboardData);          scData.Ret:=$C3;          ReadProcessMemory(OP,SCD_Addr,@rscData,SizeOf(rscData),WPM);          WriteProcessMemory(OP,SCD_Addr,@scData,SizeOf(scData),WPM);         end;       end;     end;    FreeLibrary(Dll);   end; end; destructor TClipboardHook.destroy; begin  if (OC_Addr<>nil) then WriteProcessMemory(OP,OC_Addr,@rcOpen,SizeOf(rcOpen),WPM);  if OP<>0 then CloseHandle(OP);  inherited destroy; end; procedure Register; begin   RegisterComponents('Samples', [TClipboardHook]); end; {##############################################################################} end.

Вот тогда... как рещается твоя проблемма(если речь идет о запросе текста... из буфера ):

Код

procedure TForm1.ClipboardHook1GetClipboardData(Sender: TObject;   hWndNewOwner: HWND; uFormat, hClipboardObject: Cardinal;   var opContinue: Boolean); var ClassName:array [0..1024] of char;     i:DWord;     Str,t:string;     pStr:Pointer; begin  i:=GetClassName(GetParent(hWndNewOwner),ClassName,1024);  if i<>0 then   begin    if AnsiCompareText('TStringGrid',Copy(ClassName,1,i))=0 then     begin      pStr:=GlobalLock(hClipboardObject);      if pStr<>nil then       begin        case uFormat of         CF_TEXT: Str:=PChar(pStr);         CF_UNICODETEXT: Str:=PWideChar(pStr);         CF_OEMTEXT: begin                      i:=0;                      while PChar(DWord(pStr)+i)^<>#0 do inc(i);                      if i>0 then                       begin                        SetLength(t,i);                        OemToChar(PChar(pStr),PChar(t));                        Str:=t;                        SetLength(t,0);                       end;                     end;        else         Str:='';        end;        GlobalUnlock(hClipboardObject);       end;      if Str<>'' then Caption:=Str; //Сбрасываем текст из буфера в Caption     // opContinue:=false; //Запрет на вставку     end;    i:=GetClassName(hWndNewOwner,ClassName,1024);    Edit1.Text:='WP_Paste: '+Copy(ClassName,1,i);   end; end;

PS: Пользуйся тегами CODE - а то твои посты тяжело читать

Удачи.