[delphi] Моргание при перерисовке

kill-still

Нужен прозрачный лабел, который можно будет выделить и скопировать. Написал такой класс, а он моргает сцуко когда сильно большой текст выводишь. =/ Что можете предложить/посоветовать/придумать? Может у кого есть уже котовый класс?

unit Transparent;



interface



uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls;



const

  TMWM__SpecialInvalidate = WM_USER + 1111;



type

  TTransparentEdit = class(StdCtrls.TMemo)

  private

    FClarity  : Boolean;

    procedure SetClarity(const Value: Boolean);

    procedure KeyPress(var Key: Char);  override;

    { Private declarations }

  protected

    { Protected declarations }

    procedure CMEraseBkgnd    (var Message: TWMEraseBkgnd);    Message WM_ERASEBKGND;

    procedure WMSetText        (var Message: TWMSetText);

    procedure SpecialInvalidate(var Message: TMessage);        message TMWM__SpecialInvalidate;

    procedure CNCTLCOLOREDIT  (var Message: TWMCTLCOLOREDIT);  message CN_CTLCOLOREDIT;

    procedure WMKeyDown        (var Message: TWMKeyDown);      message WM_KEYDOWN;

    procedure WMKillFocus      (Var Message: TWMKillFocus);    Message WM_KillFocus;

    procedure WMLButtonDown    (Var Message: TWMLButtonDown);  Message WM_LButtonDown;

    procedure WMMove          (Var Message: TWMLButtonDown);  Message WM_Move;

    procedure WMMouseMove      (Var Message: TWMMouseMove);    Message WM_MouseMove;

    procedure CreateParams(var Params: TCreateParams); override;

    procedure CreateWnd; override;

    procedure WMCut(Var Message: TWMMouseMove);  Message WM_CUT;

    procedure WMPaste(Var Message: TWMMouseMove);  Message WM_Paste;

  public

    { Public declarations }

    constructor Create(AOwner: TComponent); override;

    procedure  Invalidate; override;

    property    Clarity:Boolean read FClarity write SetClarity default True;

  end;



procedure Register;



implementation



{ TEdit }

procedure Register;

begin

  RegisterComponents('Samples', [TTransparentEdit]);

end;



procedure TTransparentEdit.KeyPress(var Key: Char);

begin

  key:=#0;

end;



procedure TTransparentEdit.WMPaste(Var Message: TWMMouseMove);

begin



end;



procedure TTransparentEdit.WMCut(Var Message: TWMMouseMove);

begin



end;



procedure TTransparentEdit.CMEraseBkgnd(var Message: TWMEraseBkgnd);

begin

  if Clarity then

    Message.Result := 1;

end;



procedure TTransparentEdit.CNCTLCOLOREDIT(var Message: TWMCTLCOLOREDIT);

begin

  if Clarity then

  with Message do

    begin

      SetBkMode(ChildDC,Windows.TRANSPARENT);

      Result:=GetStockObject(HOLLOW_BRUSH);

    end

  else inherited;

end;



constructor TTransparentEdit.Create(AOwner: TComponent);

begin

  inherited create(AOwner);

  BorderStyle := bsNone;

  BevelKind := bkNone;

  Clarity:=true;

end;



procedure TTransparentEdit.CreateParams(var Params: TCreateParams);

begin

  inherited CreateParams(Params);

  if (CsDesigning in ComponentState) then exit;

  with Params do

  begin

    ExStyle:=ExStyle or WS_EX_TRANSPARENT;

  end;

end;



procedure TTransparentEdit.CreateWnd;

begin

  inherited CreateWnd;

  if Clarity then

  begin

    SetWindowLong(Parent.Handle, GWL_STYLE,

      GetWindowLong(Parent.Handle, GWL_STYLE) and not WS_CLIPCHILDREN);

  end;

end;



procedure TTransparentEdit.Invalidate;

begin

  if Clarity then PostMessage(Handle,TMWM__SpecialInvalidate,0,0)

    else inherited;

end;



procedure TTransparentEdit.SetClarity(const Value: Boolean);

begin

  FClarity := Value;

end;



procedure TTransparentEdit.SpecialInvalidate(var Message: TMessage);

var

  rect:TRect;

begin

  if Parent<>nil then

  begin

    rect:=ClientRect;

    rect.TopLeft:=Parent.ScreenToClient(ClientToScreen(rect.TopLeft;

    rect.BottomRight:=Parent.ScreenToClient(ClientToScreen(rect.BottomRight;

    InvalidateRect(Parent.Handle,@rect,true);

    RedrawWindow(Handle,nil,0,RDW_FRAME+RDW_INVALIDATE)

  end;

end;



procedure TTransparentEdit.WMKeyDown(var Message: TWMKeyDown);

begin



  SendMessage(Handle,TMWM__SpecialInvalidate,0,0);

  inherited;

  PostMessage(Handle,TMWM__SpecialInvalidate,0,0);

end;



procedure TTransparentEdit.WMKillFocus(var Message: TWMKillFocus);

begin

  inherited;

  if not (csDesigning in ComponentState) then

    PostMessage(Handle,TMWM__SpecialInvalidate,0,0)

end;



procedure TTransparentEdit.WMLButtonDown(var Message: TWMLButtonDown);

begin

  inherited;

  if not (csDesigning in ComponentState) then

    PostMessage(Handle,TMWM__SpecialInvalidate,0,0);

end;



procedure TTransparentEdit.WMMouseMove(var Message: TWMMouseMove);

begin

  inherited;

  if not (csDesigning in ComponentState) then

    PostMessage(Handle,TMWM__SpecialInvalidate,0,0);

end;



procedure TTransparentEdit.WMMove(var Message: TWMLButtonDown);

begin

  inherited;

  //if not (csDesigning in ComponentState) then

    PostMessage(Handle,TMWM__SpecialInvalidate,0,0);

end;



procedure TTransparentEdit.WMSetText(var Message: TWMSetText);

begin

  inherited;

  if not (csDesigning in ComponentState) then

    PostMessage(Handle,TMWM__SpecialInvalidate,0,0);

end;



end.  

kill-still

Да, я там под конец Edit на Memo заменил, чтобы неск. строк можно было выводить, не обращайте внимания.

klyv

TEdit с Color = clBtnFace, Border = bsNone, ReadOnly = true - не подойдёт?

kill-still

Читать умеешь?

Нужен прозрачный лабел

pitrik2

прозрачный

что это значит?
чтобы на нем текст был цветом фона? ну дык задай ему цвет текста
или это нечно другое?

kill-still

Transparent - прозрачность фона.
Чтобы текст можно было положить на изображение, или градиент.