VCL component Opacity/transparence

Question

Is it possible to make e.g 20% transparent TMemo or other vcl component? like TButton or TEdit?

While googling for solution I've found this:

From Here, then I thought, if I draw image on form (OnPaint) then set AlphaBlend ON, I could achieve this effect but with no success, when the whole form is transparent, main needed effect is not achieved, no bg pic behind memo.

The effect I want to achieve: (it's done in photoshop)

Is this possible? if is, how? (i don't ask for full src code anybody, just article or little example if possible, or direction, whatever just the way i can understand it)

thnx for attention.

---

I've found the solution, create alphablended form on the form with image background, then add memo on the added form and align it to client, not the best way, but it works fine:

procedure TForm1.Button1Click(Sender: TObject);
var
 MM : TMyMemo; frm : TForm;
begin
 frm := TForm.Create(Form1);
 frm.BorderStyle := bsNone;
 frm.AlphaBlend := true;
 frm.AlphaBlendValue := 150;
 frm.Left     := Form1.Left + 90;
 frm.Top      := Form1.Top + 90;
 frm.Width    := 300;
 frm.Height   := 300;
 frm.Position := poDesigned;
 frm.Visible := true;

 MM             := TMyMemo.Create(frm);
 MM.Parent      := frm;
 MM.BorderStyle := bsNone;
 MM.ParentColor := False;
 MM.Align       := alClient;
 MM.Color       := clBlack;
 MM.Font.Color  := clWhite;
 MM.Font.Name   := 'Sylfaen';
 MM.Font.Size   := 11;
 MM.Visible     := True;

 frme := True;
end;

But there is another problem, when i press on memo, background form loses focus, when i set new forms' parent to Form1,above problem is solved but transparent effect is gone (window is still transparent but you can see through bg window without visible background) how can i solve this problem?

Answer 1

I think this question is asked very often (maybe not here, but I have seen it many times before). The strange thing is, the answer almost never comes up although it is there, hidden among all people discussing the question. Maybe the question here will help improve the search process in the future, simply because it's stackoverflow :-)

Anyway, here is the answer I found last year (see code below). Not mine, but works for me - link to author. Essentially, the code defines a derived richedit with custom event handler for the WM_ERASEBACKGROUND message.

unit TransparentRichEdit;

{ Component made by Proger_XP | http://Proger.i-Forge.net }

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, StdCtrls, ComCtrls, Graphics;

type
  TTransparentRichEdit = class (TRichEdit)
  protected
    FCanvas: TCanvas;
    FBackground: TPicture;

    procedure CreateWnd; override;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;

    procedure SetBackground(const Value: TPicture);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Background: TPicture read FBackground write SetBackground;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Miscellaneous', [TTransparentRichEdit]);
end;

{ TTransparentRichEdit }

constructor TTransparentRichEdit.Create(AOwner: TComponent);
begin
  inherited;
  FCanvas := TCanvas.Create;
  FBackground := TPicture.Create;
end;

destructor TTransparentRichEdit.Destroy;
begin
  FBackground.Free;
  FCanvas.Free;
  inherited;
end;

procedure TTransparentRichEdit.CreateWnd;
begin
  inherited;
  SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_TRANSPARENT);
end;

procedure TTransparentRichEdit.WMEraseBkgnd(var Message: TWMEraseBkgnd);
var
  UpdateRect: TRect;
  Rgn: HRGN;
  ToBeErased: Boolean;
  Mem: TBitmap;
begin
  ToBeErased:= false;
  Mem := TBitmap.Create;
  try
    Mem.Width := ClientWidth;
    Mem.Height := ClientHeight;

    FCanvas.Handle := Message.DC;
    Message.Result := 1;

    if not GetUpdateRect(Handle, UpdateRect, ToBeErased) then
      UpdateRect := Rect(0, 0, ClientWidth, ClientHeight);
    with UpdateRect do
      Rgn := CreateRectRgn(Left, Top, Right, Bottom);
    SelectClipRgn(FCanvas.Handle, Rgn);

    FCanvas.Draw(0, 0, FBackground.Graphic);
  finally
    Mem.Free;
  end;
end;

 procedure TTransparentRichEdit.SetBackground(const Value: TPicture);
 begin
   FBackground.Assign(Value);
   Repaint;
 end;

 end.