全國最多中醫師線上諮詢網站-台灣中醫網
發文 回覆 瀏覽次數:3518
推到 Plurk!
推到 Facebook!

關於WM_DRAWCLIPBOARD 和SetClipboardViewer

答題得分者是:歸木淡
Lordaeron
初階會員


發表:22
回覆:93
積分:33
註冊:2004-05-19

發送簡訊給我
#1 引用回覆 回覆 發表時間:2009-09-02 22:16:02 IP:114.36.xxx.xxx 訂閱
現在遇到的情況是
WM_DRAWCLIPBOARD 這個message 只有在form create SetClipboardViewer 時跑一次, 之後就都沒有再收到 WM_DRAWCLIPBOARD 這個message 了.
一整個怪.
請問有人遇過相同的情形或
有什麼方法來debug 一下看WM_DRAWCLIPBOARD跑到哪裏去了.
再測了一下, 因為SetClipboardViewer返回0 而getlasterror 也一樣回0 ,但發覺沒收到過WM_CHANGECBCHAIN.
探究一下結果, 就是我的程式跑完後, 其它SetClipboardViewer的程式都變成無效了.

編輯記錄
Lordaeron 重新編輯於 2009-09-03 00:56:24, 註解 無‧
Lordaeron 重新編輯於 2009-09-03 12:59:46, 註解 無‧
歸木淡
中階會員


發表:1
回覆:49
積分:75
註冊:2005-09-07

發送簡訊給我
#2 引用回覆 回覆 發表時間:2009-09-04 05:38:34 IP:130.132.xxx.xxx 訂閱
沒有完整的程式很難分析, 以我的經驗以下的程序工作得很好:
[code delphi]
type
tXXXForm = class(tForm)
...
private
FNextInChain : THandle;

procedure WMDrawClipboard(var Msg: TMessage); message WM_DRAWCLIPBOARD;
procedure WMChangeCBChain(var Msg: TMessage); message WM_CHANGECBCHAIN;
end;

procedure tXXXForm.FormCreate(Sender: tObject);
begin
FNextInChain:=SetClipboardViewer(Handle);
end;

procedure tXXXForm.FormDestroy(Sender: tObject);
begin
ChangeClipboardChain(Handle, FNextInChain);
end;

procedure TAvForm.WMDrawClipboard(var Msg:TMessage);
begin
DoSomething;
if FNextInChain<>0 then
SendMessage(FNextInChain,WM_DrawClipboard,0,0);
end;

procedure TAvForm.WMChangeCBChain(var Msg: TMessage);
var
Remove, Next: THandle;
begin
Remove := Msg.WParam;
Next := Msg.LParam;
with Msg do
if FNextInChain = Remove
then fNextInChain := Next
else if FNextInChain <> 0
then SendMessage(FNextInChain, WM_ChangeCBChain, Remove, Next);
end;
[/code]
Lordaeron
初階會員


發表:22
回覆:93
積分:33
註冊:2004-05-19

發送簡訊給我
#3 引用回覆 回覆 發表時間:2009-09-04 06:08:03 IP:114.36.xxx.xxx 訂閱
也就是你的code 哪樣子寫而已.
這種東西, 都是一大抄, 但我是寫在main form 以外的其它new 出來 的form 中, 而這樣子的form 可能會有多個.
所以我在想, 會不會是這原因.
另外也比較好奇orbit downloader 的monitor clipboard 功能被我一整, 就不work 了.

歸木淡
中階會員


發表:1
回覆:49
積分:75
註冊:2005-09-07

發送簡訊給我
#4 引用回覆 回覆 發表時間:2009-09-04 07:42:15 IP:99.137.xxx.xxx 訂閱
由你所說的來看, 可能性有三
1) 沒有SendMessage給FNextInChain
2) FNextInChain是local varible 而不是object field
3) SetClipboardViewer所用的Handle重覆了

沒有代碼真的沒法分析.....
Lordaeron
初階會員


發表:22
回覆:93
積分:33
註冊:2004-05-19

發送簡訊給我
#5 引用回覆 回覆 發表時間:2009-09-04 08:23:56 IP:218.32.xxx.xxx 訂閱
--------------變數區----------------------
private
FRecBmp, FScrBmp: TBitmap;
FCCmd: TCtlCmd;
FRect: TRect;
FItem: TListItem;
FSysMenu: HMENU;
FControl: Boolean;
NextInChain : THandle;

--------------method 區-------------
procedure TfrmView.WMDrawClipboard(var Msg:TMessage) ;
var
s:String;
begin
if TntClipboard.HasFormat( CF_UNICODETEXT ) or TntClipboard.HasFormat(cf_text) then
begin
TntClipboard.Open;
s := WideStringToUTF8(TntClipboard.AsWideText);
TntClipboard.Close;
FCCmd.Cmd := 18;
FCCmd.X := length(s);
SendCmd(FCCmd);
send(socketid,s[1], FCCmd.X,0);
end;
//pass the message on to the next window
//if NextInChain <> 0 then
SendMessage(NextInChain, WM_DrawClipboard,Msg.WParam, Msg.LParam);
Msg.Result := 0;
end;
procedure TfrmView.WMChangeCBChain(var Msg: TMessage) ;
var
Remove, Next: THandle;
begin
Remove := Msg.WParam;
Next := Msg.LParam;
with Msg do
if NextInChain = Remove then
NextInChain := Next
else if NextInChain <> 0 then
SendMessage(NextInChain, WM_ChangeCBChain, Remove, Next);
Msg.Result := 0;
end;
procedure TfrmView.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.WndParent := 0;
end;

procedure TfrmView.FormCreate(Sender: TObject);
var
iErr:integer;
begin
//inherited;
DoubleBuffered := True;
FSysMenu := GetSystemMenu(Handle, False);
AppendMenu(FSysMenu, MF_SEPARATOR, IDM_SEP, nil);
AppendMenu(FSysMenu, MF_STRING, IDM_CTRL, IDM_CTRLS);
mycaption:='';
FControl := true;
isCloseSvr := false;
isClosing := false;
hasLogin :=false;
FRecBmp := TBitmap.Create;
FScrBmp := TBitmap.Create;
NextInChain := SetClipboardViewer(Handle) ;
iErr:=GetLastError();
if iErr<>0 then
begin

end;
if NextInChain=0 then
begin
iErr:=GetClipboardViewer();
if iErr=Handle then
begin
mycaption:='';
end;
end;
DragAcceptFiles(Handle, True);
dec:=nil;
end;
procedure TfrmView.FormDestroy(Sender: TObject);
begin
ChangeClipboardChain(Handle,NextInChain);
end;
===================引 用 歸木淡 文 章===================
由你所說的來看, 可能性有三
1) 沒有SendMessage給FNextInChain
2) FNextInChain是local varible 而不是object field
3) SetClipboardViewer所用的Handle重覆了

沒有代碼真的沒法分析.....
歸木淡
中階會員


發表:1
回覆:49
積分:75
註冊:2005-09-07

發送簡訊給我
#6 引用回覆 回覆 發表時間:2009-09-04 09:28:38 IP:99.137.xxx.xxx 訂閱
看了閣下的程式, 我認為問題可能出在
[code delphi]
TntClipboard.Open;
s := WideStringToUTF8(TntClipboard.AsWideText);
TntClipboard.Close;
FCCmd.Cmd := 18;
FCCmd.X := length(s);
SendCmd(FCCmd);
send(socketid,s[1], FCCmd.X,0);
[/code]
我認為這一段並沒有被執行完, 所以後面的SendMessage便沒有機會運行, 又因為SetClipboardViewer時便會立即收到WM_DRAWCLIPBOARD, 所以從SetClipboardViewer那一刻起你的Clipboard chain便斷了.

我寫了一個相似的multi-form程序, 一切都很正常
[code delphi]
unit Unit1;

interface

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

type
TForm1 = class(TForm)
ListBox1: TListBox;
btnClose: TButton;
btnNewForm: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btnNewFormClick(Sender: TObject);
private
NextInChain : THandle;
procedure WMDrawClipboard(var Msg: TMessage); message WM_DRAWCLIPBOARD;
procedure WMChangeCBChain(var Msg: TMessage); message WM_CHANGECBCHAIN;
protected
procedure CreateParams(var Params: TCreateParams); override;
end;

var
Form1: TForm1;

implementation

uses
Clipbrd;

{$R *.DFM}

procedure TForm1.WMDrawClipboard(var Msg:TMessage) ;
var
s:String;
begin
s:=Clipboard.AsText;
Listbox1.Items.Append(s);
if NextInChain <> 0 then
SendMessage(NextInChain, WM_DrawClipboard,Msg.WParam, Msg.LParam);
Msg.Result := 0;
end;

procedure TForm1.WMChangeCBChain(var Msg: TMessage) ;
var
Remove, Next: THandle;
begin
Remove := Msg.WParam;
Next := Msg.LParam;
with Msg do
if NextInChain = Remove then
NextInChain := Next
else if NextInChain <> 0 then
SendMessage(NextInChain, WM_ChangeCBChain, Remove, Next);
Msg.Result := 0;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
NextInChain := SetClipboardViewer(Handle);
end;

procedure TForm1.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.WndParent := 0;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
ChangeClipboardChain(Handle, NextInChain);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=caFree;
end;

procedure TForm1.btnCloseClick(Sender: TObject);
begin
Close;
end;

procedure TForm1.btnNewFormClick(Sender: TObject);
begin
with TForm1.create(nil) do
begin
Left:=Self.Left 50;
show;
end;
end;

end.
[/code]
可以確認有問題的真是那一段代碼, 你有沒有逐步執行過? 你可以把
[code delphi]
if NextInChain <> 0 then
SendMessage(NextInChain, WM_DrawClipboard,Msg.WParam, Msg.LParam);
[/code]
提到procedure 的最初部分, 以保證它執行了. 不過該段程式的問題仍然存在.
Lordaeron
初階會員


發表:22
回覆:93
積分:33
註冊:2004-05-19

發送簡訊給我
#7 引用回覆 回覆 發表時間:2009-09-04 09:42:51 IP:60.250.xxx.xxx 訂閱
當然是有step trace 過.
我的WMDrawClipboard 的sendmessage 是保證有執行, 哪段if 是被註解的.
而且open clipboard 的哪段是確認有被完整執行的.
但WMChangeCBChain 則是重未收到過
歸木淡
中階會員


發表:1
回覆:49
積分:75
註冊:2005-09-07

發送簡訊給我
#8 引用回覆 回覆 發表時間:2009-09-04 10:18:17 IP:99.137.xxx.xxx 訂閱
我建議你把代碼不妨把代碼改成以下試試
[code delphi]
procedure TfrmView.WMDrawClipboard(var Msg:TMessage) ;
var
s:String;
begin
if NextInChain <> 0 then // 不應省, 第一個form的NextInChain 很可能=0
SendMessage(NextInChain, WM_DrawClipboard, 0, 0);
s:=Clipboard.asText;
Caption:=s;
{ if TntClipboard.HasFormat( CF_UNICODETEXT ) or TntClipboard.HasFormat(cf_text) then
begin
TntClipboard.Open;
s := WideStringToUTF8(TntClipboard.AsWideText);
TntClipboard.Close;
FCCmd.Cmd := 18;
FCCmd.X := length(s);
SendCmd(FCCmd);
send(socketid,s[1], FCCmd.X,0);
end;
//pass the message on to the next window
//if NextInChain <> 0 then
SendMessage(NextInChain, WM_DrawClipboard,Msg.WParam, Msg.LParam);
Msg.Result := 0;}
end;
[/code]
看看caption 是否都改了便知道錯的是那一段還是其他地方.

至於WMChangeCBChain, 因為你Destroy的Form 一般就是最新加入Clipboard chain的, 所以移除它時不會產生WMChangeCBChain.
要令到WMChangeCBChain執行, 應該打開兩個TfrmView, 然後關掉先打開的那個. 例如:
[code delphi]
var
f1, f2,: TfrmView;
begin
f1:=TfrmView.create(nil);
f2:=TfrmView.create(nil);
f1.free;
[/code]
這時因為在Clipboard chain中f1在f2前面 (f2.NextInChain=f1.Handle), 移去f1時會令F2.WMChangeCBChain執行.
Lordaeron
初階會員


發表:22
回覆:93
積分:33
註冊:2004-05-19

發送簡訊給我
#9 引用回覆 回覆 發表時間:2009-09-04 10:36:46 IP:60.248.xxx.xxx 訂閱
確認過的事情有.
1. 若orbit downloader 有選clipboard monitoring, 則NextInChain不為0
2. 若
orbit downloader 沒選clipboard monitoring, 則NextInChain為0
3. 若sendmessage 確定有跑, 而且根據microsoft 的管例, 要不要check 也是無所謂的
4. WMChangeCBChain 一直都沒收到過
5. 一樣影響到orbit downloader的clipboard monitoring 功能.

所以, 看起來像見鬼了

歸木淡
中階會員


發表:1
回覆:49
積分:75
註冊:2005-09-07

發送簡訊給我
#10 引用回覆 回覆 發表時間:2009-09-04 13:28:53 IP:99.137.xxx.xxx 訂閱
<meta content="text/html; charset=utf-8" http-equiv="Content-Type" /><meta content="Word.Document" name="ProgId" /><meta content="Microsoft Word 9" name="Generator" /><meta content="Microsoft Word 9" name="Originator" /><link href="file:///C:/DOCUME~1/Owner/LOCALS~1/Temp/msoclip1/01/clip_filelist.xml" rel="File-List" /><!--[if gte mso 9]><xml> Normal 0 0 2 </xml><![endif]--><style type="text/css"> <!-- /* Font Definitions */ @font-face {font-family:新細明體; panose-1:2 2 3 0 0 0 0 0 0 0; mso-font-alt:PMingLiU; mso-font-charset:136; mso-generic-font-family:roman; mso-font-pitch:variable; mso-font-signature:3 137232384 22 0 1048577 0;} @font-face {font-family:"\@新細明體"; panose-1:2 2 3 0 0 0 0 0 0 0; mso-font-charset:136; mso-generic-font-family:roman; mso-font-pitch:variable; mso-font-signature:3 137232384 22 0 1048577 0;} /* Style Definitions */ p.MsoNormal, li.MsoNormal, div.MsoNormal {mso-style-parent:""; margin:0in; margin-bottom:.0001pt; mso-pagination:none; font-size:12.0pt; font-family:"Times New Roman"; mso-fareast-font-family:新細明體; mso-font-kerning:1.0pt;} /* Page Definitions */ @page {mso-page-border-surround-header:no; mso-page-border-surround-footer:no;} @page Section1 {size:8.5in 11.0in; margin:56.7pt 56.7pt 56.7pt 56.7pt; mso-header-margin:.5in; mso-footer-margin:.5in; mso-paper-source:0;} div.Section1 {page:Section1;} --> </style> 根據WM_DRAWCLIPBOARDWM_CHANGECBCHAIN的處理方法,可以想像到Windows Clipboard monitors的工作原理:
我想windows並沒有記下所有MonitorHandle,相反,它只記下最後的一個Handle (LastCBHandle)。當你使用SetClipboardViewer時,Windows便返回舊值,而將新的Handle記下:
Result:= LastCBHandle;
LastCBHandle:=Handle;
在一般情況下Windows是沒有Clipboard monitor的,所以你第一次執行SetClipboardViewer時,返回的值一般是0,這是你所說的情況2。而情況1orbit downloader 有選clipboard monitoring時,orbit downloader在你使用SetClipboardViewer前便已經裝上了Clipboard monitor,所以返回的NextInChain便是orbit downloaderwndHandle,當然不會是零。
<!--[if !supportEmptyParas]--> <!--[endif]-->
當你使用ChangeClipboardChain移除Clipboard monitors時,Windows首先看看要移除的Handle是否等於LastCBHandle,是的話它直接把LastCBHandle變成NextInChain,否則的話才會發出WM_CHANGECBCHAIN
if hWndRemove=LastCBHandle
then LastCBHandle:= NextInChain
else SendMessage(LastCBHandle, WM_CHANGECBCHAIN, hWndRemove, NextInChain);
你的WMChangeCBChain 一直都沒收到過,這是因為a) 只有formfree時,formdestroy中的ChangeClipboardChain才會執行,所以你必須把form free了;b) formHandle不能等於LastCBHandle,即它不是最後加入的form。在我的例子中,如果我依次打開了ABC三個formWMChangeCBChain被執行的次數和關閉Form的次序有關:
C, B, A: 0
C, A, B: 1
B, C, A: 1
B, A, C: 2
A, C, B: 2
A, B, C: 3
所以你的WMChangeCBChain 一直都沒收到過並不奇怪。
<!--[if !supportEmptyParas]--> <!--[endif]-->
至於5,我認為是WM_DRAWCLIPBOARD Chain斷了,orbit downloader收不到WM_DRAWCLIPBOARD,當然不工作。
因此我覺得你的SendMessage很可能出了問題,至於是甚麼問題........只能如你所說,有點靈異,因為我的例子和你的基本上一樣,卻沒有問題。我只能建議你真的試試我上一帖所說的修改,看看1)orbit downloader能否工作,2)Caption是否改了。另外,Trace時注意NextInChain,看看它是否一直是同一個值。
<!--[if !supportEmptyParas]--> <!--[endif]-->
再不行,試試我的例子,看看靈異的是你的系統,還是你的代碼........
Lordaeron
初階會員


發表:22
回覆:93
積分:33
註冊:2004-05-19

發送簡訊給我
#11 引用回覆 回覆 發表時間:2009-09-04 13:46:56 IP:61.222.xxx.xxx 訂閱

[code delphi]
procedure TfrmView.WMDrawClipboard(var Msg:TMessage) ;
var
s:String;
begin
{if TntClipboard.HasFormat( CF_UNICODETEXT ) or TntClipboard.HasFormat(cf_text) then
begin
TntClipboard.Open;
s := WideStringToUTF8(TntClipboard.AsWideText);
TntClipboard.Close;
FCCmd.Cmd := 18;
FCCmd.X := length(s);
SendCmd(FCCmd);
send(socketid,s[1], FCCmd.X,0);
end;}
//Caption:=TntClipboard.asText;
//pass the message on to the next window
if NextInChain <> 0 then
SendMessage(NextInChain, WM_DrawClipboard,Msg.WParam, Msg.LParam);
Msg.Result := 0;
end;
[/code]
全註解起來了, 問題一樣存在.
當SetClipboardViewer 時, 會馬上收到一個WM_DrawClipboard, 所以當時NextInChain 還是為 0, 而自此以後, 音訊就全無了

歸木淡
中階會員


發表:1
回覆:49
積分:75
註冊:2005-09-07

發送簡訊給我
#12 引用回覆 回覆 發表時間:2009-09-05 00:05:57 IP:130.132.xxx.xxx 訂閱
這樣看來真的很奇怪,我也想不到別的原因,你可以檢查一下:
1)別的Form有用SetClipboardViewer而沒有處理WM_DRAWCLIPBOARD的嗎?你可以簡單的把tfrmView.FormCreate中的SetClipboardViewer注釋掉,看看orbit downloader是否變正常
2)看看你是否在別處也定義了NextInChain,NextInChain應該定義在tfrmView的Private部分。
3)試試把SendMessage(NextInChain, WM_DrawClipboard, Msg.WParam, Msg.LParam);
改成SendMessage(NextInChain, WM_DrawClipboard, 0, 0);
我知道這看來不必要,因為兩者應該都是0,但是我TRACE時發現Msg.WParam竟然可能不是0。當然,理論上這不應構成任何問題。
Lordaeron
初階會員


發表:22
回覆:93
積分:33
註冊:2004-05-19

發送簡訊給我
#13 引用回覆 回覆 發表時間:2009-09-05 00:26:25 IP:114.24.xxx.xxx 訂閱
1. 確定沒有, 註解掉後, orbit downloader 正常得很, 確定是我的SetClipboardViewer 後, 就斷掉了整個link 了.
2. NextInChain 只有一處
3. 都試過了
最後, 根據spy 的觀察, 整個processs 都沒收到過WM_DrawClipboard
===================引 用 歸木淡 文 章===================
這樣看來真的很奇怪,我也想不到別的原因,你可以檢查一下:
1)別的Form有用SetClipboardViewer而沒有處理WM_DRAWCLIPBOARD的嗎?你可以簡單的把tfrmView.FormCreate中的SetClipboardViewer注釋掉,看看orbit downloader是否變正常
2)看看你是否在別處也定義了NextInChain,NextInChain應該定義在tfrmView的Private部分。
3)試試把SendMessage(NextInChain, WM_DrawClipboard, Msg.WParam, Msg.LParam);
改成SendMessage(NextInChain, WM_DrawClipboard, 0, 0);
我知道這看來不必要,因為兩者應該都是0,但是我TRACE時發現Msg.WParam竟然可能不是0。當然,理論上這不應構成任何問題。
編輯記錄
Lordaeron 重新編輯於 2009-09-05 00:29:47, 註解 無‧
Lordaeron 重新編輯於 2009-09-05 01:02:19, 註解 無‧
歸木淡
中階會員


發表:1
回覆:49
積分:75
註冊:2005-09-07

發送簡訊給我
#14 引用回覆 回覆 發表時間:2009-09-05 00:42:14 IP:130.132.xxx.xxx 訂閱
只能說,實在是奇怪
對不起,幫不了忙,反而讓你多花時間

Lordaeron
初階會員


發表:22
回覆:93
積分:33
註冊:2004-05-19

發送簡訊給我
#15 引用回覆 回覆 發表時間:2009-09-05 01:08:28 IP:114.24.xxx.xxx 訂閱
也沒什麼, 就討論討論囉, 雖然你講的做法, 我本來就反復測過好幾遍了
而且, 以前程式的clipboard monitoring 是work 的, 但後來不知加了什麼東西, 還是哪裏不對了, 就整個沒反應了.
只能碰運氣看看, 實在是也搞不懂為何WM_DRAWCLIPBOARD 會從spy 中看是沒有收到過, 不是SetClipboardViewer 時, 一定會收到一次的嘛.

===================引 用 歸木淡 文 章===================
只能說,實在是奇怪
對不起,幫不了忙,反而讓你多花時間

Lordaeron
初階會員


發表:22
回覆:93
積分:33
註冊:2004-05-19

發送簡訊給我
#16 引用回覆 回覆 發表時間:2009-09-07 16:50:55 IP:60.248.xxx.xxx 訂閱
終於找到原因了, 這樣做就掛了, form 完全收不到message 了.


[code delphi]
pItem := lvA.Items.Add; //lvA 是一個 TListView
pItem.Caption := 'N';
pItem.SubItems.Add('111');
activeform := TForm2.Create(Self);
activeform.Position:=poScreenCenter;
pItem.SubItems.Objects[0] := activeform;
activeform.Show;
[/code]

歸木淡
中階會員


發表:1
回覆:49
積分:75
註冊:2005-09-07

發送簡訊給我
#17 引用回覆 回覆 發表時間:2009-09-07 22:24:52 IP:99.137.xxx.xxx 訂閱
但是這裏好像沒有問題........
Lordaeron
初階會員


發表:22
回覆:93
積分:33
註冊:2004-05-19

發送簡訊給我
#18 引用回覆 回覆 發表時間:2009-09-07 22:39:35 IP:114.24.xxx.xxx 訂閱
不會吧? 我今天特別測一下, 加上這一段後, form2 是依然在畫面上, 但就是無法收到notify 了, 而orbit downloader 也一樣斷了.
歸木淡
中階會員


發表:1
回覆:49
積分:75
註冊:2005-09-07

發送簡訊給我
#19 引用回覆 回覆 發表時間:2009-09-07 23:12:08 IP:99.137.xxx.xxx 訂閱
我是說, 從這一段看不到為甚麼會引起問題.
Lordaeron
初階會員


發表:22
回覆:93
積分:33
註冊:2004-05-19

發送簡訊給我
#20 引用回覆 回覆 發表時間:2009-09-07 23:41:40 IP:114.24.xxx.xxx 訂閱
我也認為沒問題的

[code delphi]
unit clip1;

interface

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

type
TmainForm = class(TForm)
Button1: TButton;
lvA: TListView;
procedure Button1Click(Sender: TObject);
private
activeform:TForm2;
{ Private declarations }
public
{ Public declarations }
end;

var
mainForm: TmainForm;

implementation


{$R *.dfm}

procedure TmainForm.Button1Click(Sender: TObject);
var
pItem: TListItem;
begin
pItem := lvA.Selected;
if Assigned(pItem) then
begin
if Assigned(pItem.SubItems.Objects[0]) then
begin
try
ShowWindow(TForm2(pItem.SubItems.Objects[0]).Handle, SW_SHOW);
SetForegroundWindow(TForm2(pItem.SubItems.Objects[0]).Handle);
activeform:=TForm2(pItem.SubItems.Objects[0]);
except
end;
end;
end
else
begin
pItem := lvA.Items.Add;
pItem.Caption := 'N';
pItem.SubItems.Add('111');
activeform := TForm2.Create(Self);
activeform.Position:=poScreenCenter;
pItem.SubItems.Objects[0] := activeform;
activeform.Show;
end;
end;

end.

[/code]

[code delphi]
unit clip;

interface

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

type
TForm2 = class(TForm)

procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);

private
NextInChain : THandle;
procedure WMDrawClipboard(var Msg: TMessage); message WM_DRAWCLIPBOARD;
procedure WMChangeCBChain(var Msg: TMessage); message WM_CHANGECBCHAIN;
protected
procedure CreateParams(var Params: TCreateParams); override;
end;

var
Form2: TForm2;

implementation

uses
Clipbrd;

{$R *.DFM}

procedure TForm2.WMDrawClipboard(var Msg:TMessage) ;
var
s:String;
begin
if NextInChain <> 0 then
SendMessage(NextInChain, WM_DrawClipboard,Msg.WParam, Msg.LParam);
Msg.Result := 0;
end;

procedure TForm2.WMChangeCBChain(var Msg: TMessage) ;
var
Remove, Next: THandle;
begin
Remove := Msg.WParam;
Next := Msg.LParam;
with Msg do
if NextInChain = Remove then
NextInChain := Next
else if NextInChain <> 0 then
SendMessage(NextInChain, WM_ChangeCBChain, Remove, Next);
Msg.Result := 0;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
inherited;
NextInChain := SetClipboardViewer(Handle);
end;

procedure TForm2.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.WndParent := 0;
end;

procedure TForm2.FormDestroy(Sender: TObject);
begin
ChangeClipboardChain(Handle, NextInChain);
end;

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=caFree;
end;

procedure TForm2.btnCloseClick(Sender: TObject);
begin
Close;
end;



procedure TForm2.FormShow(Sender: TObject);
begin
//showmessage(inttostr(NextInChain));
end;

end.

[/code]
但實際就是有問題.
===================引 用 歸木淡 文 章===================
我是說, 從這一段看不到為甚麼會引起問題.
歸木淡
中階會員


發表:1
回覆:49
積分:75
註冊:2005-09-07

發送簡訊給我
#21 引用回覆 回覆 發表時間:2009-09-08 05:31:30 IP:99.137.xxx.xxx 訂閱
呵呵, 有完整代碼便方便多了.

當你用
[code delphi] activeform.Position:=poScreenCenter;[/code]
時, delphi 會呼叫RecreateWnd; 這時舊的Handle會被Destroy重建, 即是說, Windows記下的handle己經失效, 它便沒法把WM_DRAWCLIPBOARD傳給Form.
解決方法倒是不難
[code delphi]
type
TForm2 = class(TForm)
....
private
procedure CMRecreateWnd(var Message: TMessage); message CM_RECREATEWND;
end;

...

procedure TForm2.CMRecreateWnd(var Message: TMessage);
begin
ChangeClipboardChain(Handle, NextInChain);
inherited;
NextInChain := SetClipboardViewer(Handle);
end;[/code]
一直有用Clip monitor, 現在才知還有這一問題. 說真的, delphi動不動便RecreateWnd真是挺煩的.
系統時間:2017-10-17 21:13:38
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!