Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2004.10.03;
Скачать: [xml.tar.bz2];

Вниз

Создание компонента просмотра буфера обмена   Найти похожие ветки 

 
Davinchi ©   (2004-09-08 21:01) [0]

Компонент работает только при явном уразании Handle окна. Если Handle передать через переменную, то компонент не работает - В ЧЕМ ПРИЧИНА???
Вот реальный отрывок моего кода. Для проверки необходимо кинуть на форму TMemo. При копировании из мемо появляется сообщение содержащее скопированный текст - при явном описании Handle, если закоментарить эту строку и открыть строку выше - то не работает - ???


unit Unit1;

interface

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

type
 TForm1 = class(TForm)
   Memo1: TMemo;
   procedure FormCreate(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

type
 TVcotClip = class(TCustomControl)
 private
   { Private declarations }
   FViewerHandle: HWnd;
   FNextViewerHandle: HWnd;
 protected
   { Protected declarations }
   procedure SetViewerHandle(Value: HWnd);
 public
   { Public declarations }
   destructor Destroy; override;
   procedure WMDrawClipboard(var message : TMessage); message WM_DRAWCLIPBOARD;
   procedure WMChangeCBCHain(var message : TMessage); message WM_CHANGECBCHAIN;
   property ViewerHandle: HWnd read FViewerHandle write SetViewerHandle;
 end;

var
 Form1: TForm1;
 VcotClip: TVcotClip;

implementation

{$R *.dfm}

destructor TVcotClip.Destroy;
begin
 inherited Destroy;
 ChangeClipboardChain(FViewerHandle, FNextViewerHandle);
end;

procedure TVcotClip.SetViewerHandle(Value: HWnd);
begin
 FViewerHandle := Value;
 FNextViewerHandle := SetClipboardViewer(FViewerHandle); // ??? так не работает :-(
//  FNextViewerHandle := SetClipboardViewer(Handle); // так работает :-)
end;

procedure TVcotClip.WMDrawClipboard(var message : TMessage);
begin
message.Result:=SendMessage(WM_DRAWCLIPBOARD, FNextViewerHandle, 0, 0);
 if Clipboard.AsText<>"" then
  begin
     ShowMessage("Буфер обмена изменился на:"+#$D#$A+Clipboard.AsText);
   end;
end;

procedure TVcotClip.WMChangeCBCHain(var message : TMessage);
begin
if message.wParam = FNextViewerHandle then
  begin
  FNextViewerHandle := message.lParam;
  message.Result := 0;
 end
 else
 message.Result := SendMessage(FNextViewerHandle, WM_CHANGECBCHAIN, message.wParam, message.lParam);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 VcotClip := TVcotClip.Create(Form1);
 VcotClip.Parent := Form1;
 VcotClip.Visible:=True;
 VcotClip.SetViewerHandle(Handle);

 // забиваем мемо любым текстом, что было над чем эксперементировать с копированием
 Memo1.Lines.LoadFromFile("C:\Windows\System.ini");
end;

end.


 
Slym   (2004-09-09 05:45) [1]

FViewerHandle:=AllocateHwnd


 
Davinchi ©   (2004-09-11 17:17) [2]

AllocateHwnd - это вариант, но этот компонент находится в ДЛЛ, которую загружает приложение изменяющее буфер обмена.
AllocateHwnd необходимо передать WndProc, а его я немогу (или не знаю как) получить от того приложения, которое загружает ДЛЛ.


 
Slym   (2004-09-17 09:08) [3]

library Project2;

uses
 SysUtils,Windows, Messages,Classes;

type
 TChangeNotifier=procedure;stdcall;
 TVcotClip = class
 private
   FViewerHandle: HWnd;
   FNextViewerHandle: HWnd;
   FChangeNotifier:TChangeNotifier;
 protected
   procedure MsgHandler(var Message: TMessage);
 public
   constructor Create(ChangeNotifier:TChangeNotifier);
   destructor Destroy; override;
 end;

{ TVcotClip }

constructor TVcotClip.Create(ChangeNotifier: TChangeNotifier);
begin
 FViewerHandle:=AllocateHwnd(MsgHandler);
 FNextViewerHandle:=SetClipboardViewer(FViewerHandle);
 if FNextViewerHandle=0 then
   RaiseLastOSError;
end;

destructor TVcotClip.Destroy;
begin
 ChangeClipboardChain(FViewerHandle, FNextViewerHandle);
 DeallocateHWnd(FViewerHandle);
 inherited;
end;

procedure TVcotClip.MsgHandler(var Message: TMessage);
begin
 if Message.Msg=WM_DRAWCLIPBOARD then
 begin
   SendMessage(Message.Msg, FNextViewerHandle,Message.WParam,Message.LParam);
   if assigned(FChangeNotifier) then
     FChangeNotifier;
 end;
 if Message.Msg=WM_CHANGECBCHAIN then
 begin
   if Message.WParam = FNextViewerHandle then
     FNextViewerHandle := Message.LParam
   else
     SendMessage(FNextViewerHandle, Message.Msg, Message.WParam, Message.LParam);
 end;
end;

function SetClipboardHandler(ChangeNotifier: TChangeNotifier):THandle;stdcall;
begin
 result:=THandle(TVcotClip.Create(ChangeNotifier));
end;

function RemoveClipboardHandler(ClipboardHandler: THandle):LongBool;stdcall;
begin
 result:=false;
 if ClipboardHandler<>0 then
 begin
   TObject(ClipboardHandler).Free;
   result:=true;
 end;
end;

exports SetClipboardHandler,RemoveClipboardHandler;

begin
end.



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2004.10.03;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.46 MB
Время: 0.032 c
11-1081013421
Delphi5.01
2004-04-03 21:30
2004.10.03
TKOLPaintBox


14-1094817192
Kraj
2004-09-10 15:53
2004.10.03
Выключение


6-1090467238
НовиЧок
2004-07-22 07:33
2004.10.03
Блокировка ошибок в WebBrowser e


14-1095162390
Knight
2004-09-14 15:46
2004.10.03
Можно ли использовать помощников MS в своих программах?


1-1095316993
Чайник
2004-09-16 10:43
2004.10.03
Перелив цветов





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский