zoukankan      html  css  js  c++  java
  • TrMemo控件

    unit TrMemo;
    
    {$R-}
    interface
    
    uses
      Windows, 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
    
    { 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('cool!', [tTransparentMemo]);
    end;
    
    end.
    View Code
  • 相关阅读:
    日期时间工具类
    jQuery 使用attr()方式设置 checked 失效原因及解决方法
    vue总结
    【笔记】golang中使用protocol buffers的底层库直接解码二进制数据
    【笔记】对golang的大量小对象的管理真的是无语了……
    【记录一个问题】thanos receiver在更换tsdb文件后,内存并未显著下降
    【笔记】论文阅读:《Gorilla: 一个快速, 可扩展的, 内存式时序数据库》
    【分享】thanos receiver的grafana报表配置
    【采坑小计】thanos receiver的官方文档中,并未说明tsdb落盘的配置方式
    【记录一个问题】thanos receiver在tsdb切换期间,导致remote write接口失败增加
  • 原文地址:https://www.cnblogs.com/blogpro/p/11453379.html
Copyright © 2011-2022 走看看