TRichView.com

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.