duvidas com componente

[vms]

ola pessoal

encontrei na net esse componente que que deixa um Memo e um edit transparente transparente "TransMemo"

é possivel esse codigo pra deixar um RichEdit ou DBRichEdit transparente? como?

obrigado pela atenção!

unit TranComp;

interface

uses

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

StdCtrls, ComCtrls;

type

TCtrl = class(TWinControl);

TTransEdit = class(TEdit)

private

FAlignText: TAlignment;

FTransparent: Boolean;

FPainting: Boolean;

procedure SetAlignText(Value: TAlignment);

procedure SetTransparent(Value: Boolean);

procedure WMPaint(var Message: TWMPaint); message WM_PAINT;

procedure WMNCPaint (var Message: TMessage); message WM_NCPAINT;

procedure WMEraseBkGnd(var Message: TWMEraseBkGnd); message WM_ERASEBKGND;

procedure CNCtlColorEdit(var Message: TWMCtlColorEdit); message CN_CTLCOLOREDIT;

procedure CNCtlColorStatic(var Message: TWMCtlColorStatic); message CN_CTLCOLORSTATIC;

procedure CMParentColorChanged(var Message: TMessage); message CM_PARENTCOLORCHANGED;

procedure WMSize(var Message: TWMSize); message WM_SIZE;

procedure WMMove(var Message: TWMMove); message WM_MOVE;

protected

procedure RepaintWindow;

procedure CreateParams(var Params: TCreateParams); override;

procedure Change; override;

procedure SetParent(AParent: TWinControl); override;

public

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

published

property AlignText: TAlignment read FAlignText write SetAlignText default taLeftJustify;

property Transparent: Boolean read FTransparent write SetTransparent default false;

end;

// Transparent Memo

TTransMemo = class(TMemo)

private

FAlignText: TAlignment;

FTransparent: Boolean;

FPainting: Boolean;

procedure SetAlignText(Value: TAlignment);

procedure SetTransparent(Value: Boolean);

procedure WMPaint(var Message: TWMPaint); message WM_PAINT;

procedure WMNCPaint (var Message: TMessage); message WM_NCPAINT;

procedure WMEraseBkGnd(var Message: TWMEraseBkGnd); message WM_ERASEBKGND;

procedure CNCtlColorEdit(var Message: TWMCtlColorEdit); message CN_CTLCOLOREDIT;

procedure CNCtlColorStatic(var Message: TWMCtlColorStatic); message CN_CTLCOLORSTATIC;

procedure CMParentColorChanged(var Message: TMessage); message CM_PARENTCOLORCHANGED;

procedure WMSize(var Message: TWMSize); message WM_SIZE;

procedure WMMove(var Message: TWMMove); message WM_MOVE;

protected

procedure RepaintWindow;

procedure CreateParams(var Params: TCreateParams); override;

procedure Change; override;

procedure SetParent(AParent: TWinControl); override;

public

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

published

property AlignText: TAlignment read FAlignText write SetAlignText default taLeftJustify;

property Transparent: Boolean read FTransparent write SetTransparent default false;

end;

procedure Register;

implementation

const

BorderRec: array[TBorderStyle]of Integer = (1, -1);

procedure Register;

begin

RegisterComponents('Transparent Components', [TTransEdit, TTransMemo]);

end;

function GetScreenClient(Control: TControl): TPoint;

var

p: TPoint;

begin

p := Control.ClientOrigin;

ScreenToClient(Control.Parent.Handle, p);

Result := p;

end;

constructor TTransEdit.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

FAlignText := taLeftJustify;

FTransparent := false;

FPainting := false;

end;

destructor TTransEdit.Destroy;

begin

inherited Destroy;

end;

procedure TTransEdit.SetAlignText(Value: TAlignment);

begin

if FAlignText <> Value then

begin

FAlignText := Value;

RecreateWnd;

Invalidate;

end;

end;

procedure TTransEdit.SetTransparent(Value: Boolean);

begin

if FTransparent <> Value then

begin

FTransparent := Value;

Invalidate;

end;

end;

procedure TTransEdit.WMEraseBkGnd(var Message: TWMEraseBkGnd);

var

DC: hDC;

i: integer;

p: TPoint;

begin

if FTransparent then

begin

if Assigned(Parent) then

begin

DC := Message.DC;

i := SaveDC(DC);

p := GetScreenClient(self);

p.x := -p.x;

p.y := -p.y;

MoveWindowOrg(DC, p.x, p.y);

SendMessage(Parent.Handle, $0014, DC, 0);

TCtrl(Parent).PaintControls(DC, nil);

RestoreDC(DC, i);

end;

end else inherited;

end;

procedure TTransEdit.WMPaint(var Message: TWMPaint);

begin

inherited;

if FTransparent then

if not FPainting then

RepaintWindow;

end;

procedure TTransEdit.WMNCPaint(var Message: TMessage);

begin

inherited;

end;

procedure TTransEdit.CNCtlColorEdit(var Message: TWMCtlColorEdit);

begin

inherited;

if FTransparent then

SetBkMode(Message.ChildDC, 1);

end;

procedure TTransEdit.CNCtlColorStatic(var Message: TWMCtlColorStatic);

begin

inherited;

if FTransparent then

SetBkMode(Message.ChildDC, 1);

end;

procedure TTransEdit.CMParentColorChanged(var Message: TMessage);

begin

inherited;

if FTransparent then

Invalidate;

end;

procedure TTransEdit.WMSize(var Message: TWMSize);

begin

inherited;

Invalidate;

end;

procedure TTransEdit.WMMove(var Message: TWMMove);

begin

inherited;

Invalidate;

end;

procedure TTransEdit.RepaintWindow;

var

DC: hDC;

TmpBitmap, Bitmap: hBitmap;

begin

if FTransparent then

begin

FPainting := true;

HideCaret(Handle);

DC := CreateCompatibleDC(GetDC(Handle));

TmpBitmap := CreateCompatibleBitmap(GetDC(Handle), Succ(ClientWidth), Succ(ClientHeight));

Bitmap := SelectObject(DC, TmpBitmap);

PaintTo(DC, 0, 0);

BitBlt(GetDC(Handle), BorderRec[borderStyle], BorderRec[borderStyle], ClientWidth, ClientHeight, DC, 1, 1, SRCCOPY);

SelectObject(DC, Bitmap);

DeleteDC(DC);

ReleaseDC(Handle, GetDC(Handle));

DeleteObject(TmpBitmap);

ShowCaret(Handle);

FPainting := false;

end;

end;

procedure TTransEdit.CreateParams(var Params: TCreateParams);

const

Alignments: array [TAlignment] of DWord = (ES_LEFT, ES_RIGHT, ES_CENTER);

begin

inherited CreateParams(Params);

Params.Style := Params.Style or ES_MULTILINE or Alignments[FAlignText];

end;

procedure TTransEdit.Change;

begin

RepaintWindow;

inherited Change;

end;

procedure TTransEdit.SetParent(AParent: TWinControl);

begin

inherited SetParent(AParent);

end;

// Transparent Memo

constructor TTransMemo.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

FAlignText := taLeftJustify;

FTransparent := false;

FPainting := false;

end;

destructor TTransMemo.Destroy;

begin

inherited Destroy;

end;

procedure TTransMemo.SetAlignText(Value: TAlignment);

begin

if FAlignText <> Value then

begin

FAlignText := Value;

RecreateWnd;

Invalidate;

end;

end;

procedure TTransMemo.SetTransparent(Value: Boolean);

begin

if FTransparent <> Value then

begin

FTransparent := Value;

Invalidate;

end;

end;

procedure TTransMemo.WMEraseBkGnd(var Message: TWMEraseBkGnd);

var

DC: hDC;

i: integer;

p: TPoint;

begin

if FTransparent then

begin

if Assigned(Parent) then

begin

DC := Message.DC;

i := SaveDC(DC);

p := GetScreenClient(self);

p.x := -p.x;

p.y := -p.y;

MoveWindowOrg(DC, p.x, p.y);

SendMessage(Parent.Handle, $0014, DC, 0);

TCtrl(Parent).PaintControls(DC, nil);

RestoreDC(DC, i);

end;

end else inherited;

end;

procedure TTransMemo.WMPaint(var Message: TWMPaint);

begin

inherited;

if FTransparent then

if not FPainting then

RepaintWindow;

end;

procedure TTransMemo.WMNCPaint(var Message: TMessage);

begin

inherited;

end;

procedure TTransMemo.CNCtlColorEdit(var Message: TWMCtlColorEdit);

begin

inherited;

if FTransparent then

SetBkMode(Message.ChildDC, 1);

end;

procedure TTransMemo.CNCtlColorStatic(var Message: TWMCtlColorStatic);

begin

inherited;

if FTransparent then

SetBkMode(Message.ChildDC, 1);

end;

procedure TTransMemo.CMParentColorChanged(var Message: TMessage);

begin

inherited;

if FTransparent then

Invalidate;

end;

procedure TTransMemo.WMSize(var Message: TWMSize);

begin

inherited;

Invalidate;

end;

procedure TTransMemo.WMMove(var Message: TWMMove);

begin

inherited;

Invalidate;

end;

procedure TTransMemo.RepaintWindow;

var

DC: hDC;

TmpBitmap, Bitmap: hBitmap;

begin

if FTransparent then

begin

FPainting := true;

HideCaret(Handle);

DC := CreateCompatibleDC(GetDC(Handle));

TmpBitmap := CreateCompatibleBitmap(GetDC(Handle), Succ(ClientWidth), Succ(ClientHeight));

Bitmap := SelectObject(DC, TmpBitmap);

PaintTo(DC, 0, 0);

BitBlt(GetDC(Handle), BorderRec[borderStyle], BorderRec[borderStyle], ClientWidth, ClientHeight, DC, 1, 1, SRCCOPY);

SelectObject(DC, Bitmap);

DeleteDC(DC);

ReleaseDC(Handle, GetDC(Handle));

DeleteObject(TmpBitmap);

ShowCaret(Handle);

FPainting := false;

end;

end;

procedure TTransMemo.CreateParams(var Params: TCreateParams);

const

Alignments: array [TAlignment] of DWord = (ES_LEFT, ES_RIGHT, ES_CENTER);

begin

inherited CreateParams(Params);

Params.Style := Params.Style or ES_MULTILINE or Alignments[FAlignText];

end;

procedure TTransMemo.Change;

begin

RepaintWindow;

inherited Change;

end;

procedure TTransMemo.SetParent(AParent: TWinControl);

begin

inherited SetParent(AParent);

end;

end.

[Felipee]

cara,

sugiro você não ficar mexendo muito com isso não.

quando você tracar a versao de seu delphi isso vai te dar dor de cabecas...

abraco,

felipee.

[Micheus]

encontrei na net esse componente que que deixa um Memo e um edit transparente transparente "TransMemo"

é possivel esse codigo pra deixar um RichEdit ou DBRichEdit transparente? como?

se quiser arriscar, apenas duplique o código do TTransMemo e o descenda da classes em questão. Tipo, TTransMemo = class(TRichEdit).

Não é garantido que funcione, experimente.

Abraços

[vms]

valeu micheus, mas não deu certo

[Jhonas]

experimente este

http://www.trichview.com/rvfiles/richview.zip

a outra sugestão seria criar este componente por exemplo

unit TRQRRichText1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  QuickRpt, Qrctrls;

type
  TTranspRichText1 = class(TQRRichText)
  private
    FText: string;
    FFont: TFont;
    FHighlight, FShadow: TColor;
    FOnEnter: TNotifyEvent;
  protected
    procedure Click; override;
    procedure Paint; override;
    procedure KeyPress( var Key: char ); override;
    procedure KeyUp( var Key: word; Shift: TShiftState ); override;
    procedure CreateParams( var Params: TCreateParams ); override;
    procedure setText( const s: string );
    procedure setFont( f: TFont );
    procedure WMSetFocus( var message: TMessage ); message WM_SetFocus;
    procedure WMKillFocus( var message: TMessage ); message WM_KillFocus;
    procedure repaint;
  public
    constructor Create( AOwner: TComponent ); override;
    destructor Destroy; override;
  published
    property Font: TFont read FFont write setFont;
    property Text: string read FText write setText;
    property HighlightColor: TColor read FHighlight write FHighlight default clWhite;
    property ShadowColor: TColor read FShadow write FShadow default clBlack;
    property OnEnter: TNotifyEvent read FOnEnter write FOnEnter;
  end;

procedure Register;

implementation

constructor TTranspRichText1.Create( AOwner: TComponent );
begin
  inherited Create( AOwner );
  FFont := TFont.Create;
  FHighlight := clWhite;
  FShadow := clBlack;
  TabStop := true;
end;

destructor TTranspRichText1.Destroy;
begin
  FFont.Free;
  inherited Destroy;
end;

procedure TTranspRichText1.Paint;
begin
  ControlStyle := ControlStyle - [csOpaque];
  with Canvas do
  begin
    Brush.Style := bsClear;
    FillRect( ClipRect );
    if (TForm(Owner).ActiveControl = self) then
    begin
      Pen.Color := FHighlight;
      MoveTo( 0, Height - 1 );
      LineTo( 0, 0 );
      LineTo( Width - 1, 0 );
      Pen.Color := FShadow;
      LineTo( Width - 1, Height - 1 );
      LineTo( 0, Height - 1 );
    end;
    Font.Assign( self.Font );
    TextOut( 2, (Height - TextHeight( FText )) div 2, FText );
  end;
end;

procedure TTranspRichText1.CreateParams( var Params: TCreateParams );
begin
  inherited CreateParams( Params );
  Params.ExStyle := Params.ExStyle or WS_EX_Transparent;
  Params.Style := Params.Style or WS_TabStop;
end;

procedure TTranspRichText1.setFont( f: TFont );
begin
  FFont.Assign( f );
end;

procedure TTranspRichText1.setText( const s: string );
begin
  FText := s;
  Paint;
end;

procedure TTranspRichText1.WMSetFocus( var message: TMessage );
begin
  Paint;
  inherited;
end;

procedure TTranspRichText1.WMKillFocus( var message: TMessage );
begin
  repaint;
  inherited;
end;

procedure TTranspRichText1.repaint;
var
  r: TRect;
begin
  r := Rect( Left, Top, Left + Width, Top + Height );
  InvalidateRect( TForm(Owner).Handle, @r, false );
  SendMessage( TForm(Owner).Handle, WM_Paint, 0, 0 );
  Paint;
end;

procedure TTranspRichText1.Click;
begin
  setFocus;
  inherited Click;
end;

procedure TTranspRichText1.KeyPress( var Key: char );
begin
  if (Key = #8) then
  begin
    if FText <> '' then
      FText := Copy( FText, 1, Length( FText ) - 1 );
    repaint;
  end
  else
    Text := FText + Key;
  inherited KeyPress( Key );
end;

procedure TTranspRichText1.KeyUp( var Key: word; Shift: TShiftState );
begin
  if (Key = 46) then
  begin
    if FText <> '' then
      FText := Copy( FText, 1, Length( FText ) - 1 );
    repaint;
  end
  else if Key = 13 then
  begin
    if Assigned( FOnEnter ) then
      FOnEnter( self );
  end;
  inherited KeyUp( Key, Shift );
end;

procedure Register;
begin
  RegisterComponents( 'Samples', [TTranspRichText1] );
end;

end.

[vms]

Jhonas, cara fiquei tão feliz quando vi o componente dando certo,

mas infelizmente ele deixa de ser transparente quando se digita algo,

minha intençao é fazer um editor de texto, mas com uma imagem no fundo, já procurei como colocar a imagem direto no richedit (como o word)mas não encontrei nada, estou apelando para transparente

já baixei esse richview, mas ele shareware

de qualquer forma, valeu pela dica!

[Jhonas]

qual componente voce esta se referindo ??? se voce digita e ele deixa de ser transparente pode ser um bug que passou desapercebido no codigo....

[vms]

o TranspRichText1

quando vou digitando a linha digitada vai ficando branca e deixa de ser transparente

[Jhonas]

Colega, este componente que eu postei para voce é pra ser colocado num FORM e não no QR ( experimente e vera que ele fica transparente em um form, o fundo branco basta trocar pela cor do formulario )

ainda não tive tempo para testar para o QR, mas voce pode tentar esta modificação no codigo.

OBS: não esqueça de desistalar o componente antes de efetuar a modificação.

procedure TTranspRichText1.repaint;
var
  r: TRect;
begin
  r := Rect( Left, Top, Left + Width, Top + Height );
  InvalidateRect( TQuickRep(Owner).Handle, @r, false );
  SendMessage( TQuickRep(Owner).Handle, WM_Paint, 0, 0 );
  Paint;
end;

abraço