![](/img/trans.png)
[英]How to change selected text attribute into bold in TMemo in delphi 7 ?
[英]Transparent TMemo - text appears to remain selected when it isn't
我希望在Delphi 7中獲得有關透明TMemo控件的幫助。我在網上找到了一些行之有效的代碼,在一定程度上刷新率有點令人討厭,但我可以接受。 主要問題是未選擇的文本看起來就像是實際被選擇的一樣。
這是使用SelectAll()選擇所有文本的地方;
在這里,實際上沒有選擇任何文本,但是以前已經選擇過該文本,請注意,浮行提示鍵入將在“改進”中的“ p”之后進行。
最后是一張圖片,顯示了差異。
我覺得很奇怪的是,例如,當我按下箭頭鍵時,錯誤的突出顯示消失了,但是當使用鼠標時卻沒有。
此自定義TMemo的代碼如下:
unit TrMemo;
interface
uses
Messages, Controls, StdCtrls, classes;
const TMWM__SpecialInvalidate=WM_USER+1111;
type
TTransparentMemo = class(TMemo)
private
procedure SpecialInvalidate(var Message:TMessage); message TMWM__SpecialInvalidate;
procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
procedure WMSetText(var Message:TWMSetText); message WM_SETTEXT;
procedure CNCTLCOLOREDIT(var Message:TWMCTLCOLOREDIT); message CN_CTLCOLOREDIT;
procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
protected
procedure CreateParams(var Params: TCreateParams); override;
public
constructor Create(AOwner: TComponent); override;
end;
procedure Register;
implementation
uses Windows;
{ TTransparentMemo }
procedure TTransparentMemo.WMHScroll(var Message: TWMHScroll);
begin
inherited;
PostMessage(Handle,TMWM__SpecialInvalidate,0,0);
end;
procedure TTransparentMemo.WMVScroll(var Message: TWMVScroll);
begin
SendMessage(Handle,TMWM__SpecialInvalidate,0,0);
inherited;
PostMessage(Handle,TMWM__SpecialInvalidate,0,0);
end;
procedure TTransparentMemo.CNCTLCOLOREDIT(var Message:TWMCTLCOLOREDIT);
begin
with Message do
begin
SetBkMode(ChildDC,TRANSPARENT);
Result:=GetStockObject(HOLLOW_BRUSH)
end
end;
procedure TTransparentMemo.WMSetText(var Message:TWMSetText);
begin
inherited;
if not (csDesigning in ComponentState) then PostMessage(Handle,TMWM__SpecialInvalidate,0,0)
end;
procedure TTransparentMemo.SpecialInvalidate(var Message:TMessage);
var
r:TRect;
begin
if (Parent <> nil) then
begin
r:=ClientRect;
r.TopLeft:=Parent.ScreenToClient(ClientToScreen(r.TopLeft));
r.BottomRight:=Parent.ScreenToClient(ClientToScreen(r.BottomRight));
InvalidateRect(Parent.Handle,@r,true);
RedrawWindow(Handle,nil,0,RDW_FRAME+RDW_INVALIDATE);
end;
end;
procedure TTransparentMemo.WMKeyDown(var Message: TWMKeyDown);
begin
SendMessage(Handle,TMWM__SpecialInvalidate,0,0);
inherited;
PostMessage(Handle,TMWM__SpecialInvalidate,0,0);
end;
procedure TTransparentMemo.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
Message.Result:=1
end;
constructor TTransparentMemo.Create(AOwner: TComponent);
begin
inherited;
ControlStyle:=[csCaptureMouse, csDesignInteractive, csClickEvents, csSetCaption, csOpaque, csDoubleClicks, csReplicatable, csNoStdEvents];
end;
procedure TTransparentMemo.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
ExStyle:=ExStyle or WS_EX_TRANSPARENT and not WS_EX_WINDOWEDGE
and not WS_EX_STATICEDGE and not WS_EX_DLGMODALFRAME and not
WS_EX_CLIENTEDGE;
end;
end;
procedure Register;
begin
RegisterComponents('Samples', [tTransparentMemo]);
end;
end.
任何提示/提示/答案將不勝感激! 提前加油!
這不是一個完整的修復程序,但是您可以例如執行以下操作
protected
procedure Click; override;
procedure TTransparentMemo.Click;
begin
PostMessage(Handle,TMWM__SpecialInvalidate,0,0);
inherited;
end;
等等。 也許有更好的地方可以做到這一點。 在您的VCL源(StdCtrls.pas)一看,你會發現在一些TCustomEdit
或TCustomMemo
這將是更好的選擇覆蓋。
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.