Translucent TRichView Control

[mamouri]

Hi,

I want to create a translucent TRichView control. Background of the control should be translucent (for example with Alpha = 155) and Texts are fully visible.

There are two ideas I'm thinking of for creating such controlg:

1- Paint TRichView into another Canvas and change alpha of white pixels (assuming TRichView background is white)
This is good method and it seems working but it's slow because all frames are painting double. (first in RichView and second in the new Canvas)

2- Override paint method of TRichView and mix TRichview background pixels with the image control behind of TRichView to simulate Alphas. (This is exactly the method that TPNGImage paint images.

I'm not sure is there better method for having a translucent TRichview control? And which one of the method I mentioned above is better? Does overriding Paint method of TRichView is easy?

[mamouri]

Ok... I think I make things too complicated. Simply I need a transparent RichView control.

[mamouri]

Hi,

I create a small component descanted from TCustomControl which hold a TRichView inside itself and Paint RichView content into it's canvas. Here it's:

Code: Select all

unit TransparentRichView;

interface

uses Messages, Windows, Classes, Forms, Graphics, Controls, RichView;

type
  TTransparentRichView = class(TCustomControl)
  private
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;

    procedure WMMouseWheel(var Message: TWMMouseWheel); message WM_MOUSEWHEEL;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  protected
    procedure Paint; override;
  public
    RV: TRichView;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property TabStop default True;
  end;

procedure DrawParentImage( Control: TControl; Dest: TCanvas; InvalidateParent: Boolean = False ); overload;
procedure DrawParentImage( Control: TControl; DC: HDC; InvalidateParent: Boolean = False ); overload;

implementation

{ TTransparentRichView }

procedure DrawParentImage( Control: TControl; Dest: TCanvas; InvalidateParent: Boolean = False );
begin
  DrawParentImage( Control, Dest.Handle, InvalidateParent );
end;


procedure DrawParentImage( Control: TControl; DC: HDC; InvalidateParent: Boolean = False );
var
  SaveIndex: Integer;
  P: TPoint;
begin
  if Control.Parent = nil then
    Exit;
  SaveIndex := SaveDC( DC );
  GetViewportOrgEx( DC, P );

  SetViewportOrgEx( DC, P.X - Control.Left, P.Y - Control.Top, nil );
  IntersectClipRect( DC, 0, 0, Control.Parent.ClientWidth, Control.Parent.ClientHeight );

  if not ( csDesigning in Control.ComponentState ) then
  begin
    Control.Parent.Perform( wm_EraseBkgnd, DC, 0 );
    Control.Parent.Perform( wm_PrintClient, DC, prf_Client );
  end
  else
  begin
    // Wrapping the following calls in a try..except is necessary to prevent
    // cascading access violations in the Form Designer (and ultimately the
    // shutting down of the IDE) in the Form Designer under the following
    // specific condition:
    //   1. Control on Form Designer supports Transparency (thus this procedure
    //      is called).
    //   2. Control is selected in the Form Designer such that grab handles are
    //      visible.
    //   3. User selects File|Close All Files, or Creates a New Application
    //      (i.e. Anything that closes the current project).
    //   4. Cascading access violations are created inside the IDE Form Designer
    //
    // The same problem also occurs in Delphi 7 under Windows XP if you add a
    // Delphi32.exe.manifest to the Delphi\Bin folder. This will cause controls
    // such as TPanel to appear transparent when on the Form Designer. Repeating
    // the steps above, will result in the cascading access violations as
    // described above.

    try
      Control.Parent.Perform( wm_EraseBkgnd, DC, 0 );
      Control.Parent.Perform( wm_PrintClient, DC, prf_Client );
    except
    end;
  end;

  RestoreDC( DC, SaveIndex );

  if InvalidateParent then
  begin
    if not ( Control.Parent is TCustomControl ) and
       not ( Control.Parent is TCustomForm ) and
       not ( csDesigning in Control.ComponentState ) then
    begin
      Control.Parent.Invalidate;
    end;
  end;
end;

procedure TTransparentRichView.CMEnter(var Message: TCMEnter);
begin
  inherited;
  Invalidate;
end;

procedure TTransparentRichView.CMExit(var Message: TCMExit);
begin
  inherited;
  Invalidate;
end;

constructor TTransparentRichView.Create(AOwner: TComponent);
begin
  inherited;
  TabStop := True;
  ControlStyle := ControlStyle - [csOpaque];

  RV := TRichView.Create(Self);
  RV.ParentWindow := Application.ActiveFormHandle;

  DoubleBuffered := True;
end;

destructor TTransparentRichView.Destroy;
begin
  RV.Free;
  inherited;
end;

procedure TTransparentRichView.Paint;
begin
  RV.RVData.PaintTo(Canvas, ClientRect, False, False, False, False, 0, 0);
end;

procedure TTransparentRichView.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  DrawParentImage(Self, Message.DC, True);

  // Do not call inherited -- prevents TWinControl.WMEraseBkgnd from
  // erasing background. Set Msg.Result to 1 to indicate background is painted
  // by the control.
  Message.Result := 1;
end;

procedure TTransparentRichView.WMMouseWheel(var Message: TWMMouseWheel);
begin
  RV.VScrollPos := RV.VScrollPos + Round(RV.WheelStep * (RV.VScrollMax div Message.WheelDelta));
  Invalidate;
end;

end.

This is working, but it have some problems:
1- It has flicker. I even set DoubleBuffered to True in constructor and override WMEraseBkgnd method but the control still has flicker.
2- Scroll is not accurate

Could somebody take a look to this code and improve it?