vms Postado Novembro 30, 2007 Denunciar Share Postado Novembro 30, 2007 ola pessoalencontrei 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;interfaceuses 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;implementationconstBorderRec: array[TBorderStyle]of Integer = (1, -1);procedure Register;begin RegisterComponents('Transparent Components', [TTransEdit, TTransMemo]);end;function GetScreenClient(Control: TControl): TPoint;varp: TPoint;beginp := Control.ClientOrigin;ScreenToClient(Control.Parent.Handle, p);Result := p;end;constructor TTransEdit.Create(AOwner: TComponent);begininherited Create(AOwner);FAlignText := taLeftJustify;FTransparent := false;FPainting := false; end;destructor TTransEdit.Destroy;begininherited Destroy;end;procedure TTransEdit.SetAlignText(Value: TAlignment);beginif FAlignText <> Value thenbegin FAlignText := Value; RecreateWnd; Invalidate;end;end;procedure TTransEdit.SetTransparent(Value: Boolean);beginif FTransparent <> Value thenbegin FTransparent := Value; Invalidate;end;end;procedure TTransEdit.WMEraseBkGnd(var Message: TWMEraseBkGnd);varDC: hDC;i: integer;p: TPoint;beginif FTransparent thenbegin 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);begininherited;if FTransparent thenif not FPainting thenRepaintWindow;end;procedure TTransEdit.WMNCPaint(var Message: TMessage);begininherited;end;procedure TTransEdit.CNCtlColorEdit(var Message: TWMCtlColorEdit);begininherited;if FTransparent thenSetBkMode(Message.ChildDC, 1);end;procedure TTransEdit.CNCtlColorStatic(var Message: TWMCtlColorStatic);begininherited;if FTransparent thenSetBkMode(Message.ChildDC, 1);end;procedure TTransEdit.CMParentColorChanged(var Message: TMessage);begininherited;if FTransparent thenInvalidate;end;procedure TTransEdit.WMSize(var Message: TWMSize);begininherited;Invalidate; end;procedure TTransEdit.WMMove(var Message: TWMMove);begininherited;Invalidate;end;procedure TTransEdit.RepaintWindow;varDC: hDC;TmpBitmap, Bitmap: hBitmap;beginif FTransparent thenbegin 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);constAlignments: array [TAlignment] of DWord = (ES_LEFT, ES_RIGHT, ES_CENTER);begininherited CreateParams(Params);Params.Style := Params.Style or ES_MULTILINE or Alignments[FAlignText];end;procedure TTransEdit.Change;beginRepaintWindow;inherited Change;end;procedure TTransEdit.SetParent(AParent: TWinControl);begininherited SetParent(AParent);end;// Transparent Memoconstructor TTransMemo.Create(AOwner: TComponent);begininherited Create(AOwner);FAlignText := taLeftJustify;FTransparent := false;FPainting := false;end;destructor TTransMemo.Destroy;begininherited Destroy;end;procedure TTransMemo.SetAlignText(Value: TAlignment);beginif FAlignText <> Value thenbegin FAlignText := Value; RecreateWnd; Invalidate;end;end;procedure TTransMemo.SetTransparent(Value: Boolean);beginif FTransparent <> Value thenbegin FTransparent := Value; Invalidate;end;end;procedure TTransMemo.WMEraseBkGnd(var Message: TWMEraseBkGnd);varDC: hDC;i: integer;p: TPoint;beginif FTransparent thenbegin 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);begininherited;if FTransparent thenif not FPainting thenRepaintWindow;end;procedure TTransMemo.WMNCPaint(var Message: TMessage);begininherited;end;procedure TTransMemo.CNCtlColorEdit(var Message: TWMCtlColorEdit);begininherited;if FTransparent thenSetBkMode(Message.ChildDC, 1);end;procedure TTransMemo.CNCtlColorStatic(var Message: TWMCtlColorStatic);begininherited;if FTransparent thenSetBkMode(Message.ChildDC, 1);end;procedure TTransMemo.CMParentColorChanged(var Message: TMessage);begininherited;if FTransparent thenInvalidate;end;procedure TTransMemo.WMSize(var Message: TWMSize);begininherited;Invalidate;end;procedure TTransMemo.WMMove(var Message: TWMMove);begininherited;Invalidate;end;procedure TTransMemo.RepaintWindow;varDC: hDC;TmpBitmap, Bitmap: hBitmap;beginif FTransparent thenbegin 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);constAlignments: array [TAlignment] of DWord = (ES_LEFT, ES_RIGHT, ES_CENTER);begininherited CreateParams(Params);Params.Style := Params.Style or ES_MULTILINE or Alignments[FAlignText];end;procedure TTransMemo.Change;beginRepaintWindow;inherited Change;end;procedure TTransMemo.SetParent(AParent: TWinControl);begininherited SetParent(AParent);end;end. Citar Link para o comentário Compartilhar em outros sites More sharing options...
0 Felipee Postado Novembro 30, 2007 Denunciar Share Postado Novembro 30, 2007 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. Citar Link para o comentário Compartilhar em outros sites More sharing options...
0 Micheus Postado Novembro 30, 2007 Denunciar Share Postado Novembro 30, 2007 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 Citar Link para o comentário Compartilhar em outros sites More sharing options...
0 vms Postado Dezembro 5, 2007 Autor Denunciar Share Postado Dezembro 5, 2007 valeu micheus, mas não deu certo Citar Link para o comentário Compartilhar em outros sites More sharing options...
0 Jhonas Postado Dezembro 5, 2007 Denunciar Share Postado Dezembro 5, 2007 experimente este http://www.trichview.com/rvfiles/richview.zipa outra sugestão seria criar este componente por exemplounit 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. Citar Link para o comentário Compartilhar em outros sites More sharing options...
0 vms Postado Dezembro 5, 2007 Autor Denunciar Share Postado Dezembro 5, 2007 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 transparentejá baixei esse richview, mas ele sharewarede qualquer forma, valeu pela dica! Citar Link para o comentário Compartilhar em outros sites More sharing options...
0 Jhonas Postado Dezembro 5, 2007 Denunciar Share Postado Dezembro 5, 2007 qual componente voce esta se referindo ??? se voce digita e ele deixa de ser transparente pode ser um bug que passou desapercebido no codigo.... Citar Link para o comentário Compartilhar em outros sites More sharing options...
0 vms Postado Dezembro 5, 2007 Autor Denunciar Share Postado Dezembro 5, 2007 o TranspRichText1quando vou digitando a linha digitada vai ficando branca e deixa de ser transparente Citar Link para o comentário Compartilhar em outros sites More sharing options...
0 Jhonas Postado Dezembro 5, 2007 Denunciar Share Postado Dezembro 5, 2007 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 Citar Link para o comentário Compartilhar em outros sites More sharing options...
Pergunta
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!
Link para o comentário
Compartilhar em outros sites
8 respostass a esta questão
Posts Recomendados
Participe da discussão
Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.