Question

I want to create a form, but just use it to keep an image. (Like a splash form)

To create a form like these I use these lines:

SetWindowLong(Handle, GWL_EXSTYLE, LexStyle or WS_EX_LAYERED);
UpdateLayeredWindow(Handle, 0, nil, @LBitmapSize, LBitmap.Canvas.Handle, 0,
  @LBlendFunction, ULW_ALPHA);

This image is a PNG image with transparent layer.

The form must have a parent form or must have the behavior of a form that have it.

That is the problem, if I add some component on this form, this just doesn’t show the component.
And if I set a parent form to it, this lose its transparency.

But I need to add components in this and I need to set a parent to the form.

Some one knows other way to do this?

Answer 1

You can try not set Parent property directly but use subclassing …

Suppose TParentForm is parent form and TAlphaForm is form with image.

When creating TAlphaForm instance, pass instance of TParentForm as Owner parameter and change WndProc of owner form in constructor.

Next is example code for TAlphaForm:

type
  TAlphaForm = class(TForm)
  private
    FParentWndProc : TWndMethod;
    FParentForm    : TCustomForm;

    procedure HookWindowProc(var Message: TMessage);

  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
  end;

Implementation:

constructor TAlphaForm.Create(AOwner: TComponent);
begin
  inherited;

  if(Assigned(AOwner) and (Owner is TCustomForm)) then begin

    FParentForm := TCustomForm(Owner);
    // Subclass owner window 
    FParentWndProc := FParentForm.WindowProc;
    FParentForm.WindowProc := HookWindowProc;
    // Need to repaint to show initial picture
    if(FParentForm.HandleAllocated) then FParentForm.Invalidate;

  end else begin

    FParentForm := nil;
    FParentWndProc := nil;

  end;

end;

destructor TAlphaForm.Destroy;
begin
  if(Assigned(FParentForm)) then begin
    // Restore original WndProc and repaint to restore original look if available  
    FParentForm.WindowProc := FParentWndProc;
    if(FParentForm.HandleAllocated) then FParentForm.Invalidate;
    FParentForm := nil;
    FParentWndProc := nil;
  end;
  inherited;
end;

procedure TAlphaForm.HookWindowProc(var Message: TMessage);
begin

  if( not (Assigned(FParentForm) and Assigned(FParentWndProc)) )
    then exit;

  FParentWndProc(Message);

  if(Message.Msg = WM_PAINT) then begin
    // Paint alpha image here on Owner's form canvas
    // Here is sample painting
    FParentForm.Canvas.Pen.Width := 3;
    FParentForm.Canvas.Pen.Color := clRed;
    FParentForm.Canvas.Ellipse(FParentForm.ClientRect);
  end else if(Message.Msg = WM_SIZE) then begin 
    // Needed because the whole form must be repainted
    FParentForm.Invalidate;
  end;

end;

For me solution works with this parent form code:

type
  TForm1 = class(TForm)
    Button2: TButton;
    Button3: TButton;
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
    FAlpha : TForm;
  public
    { Public declarations }
    constructor Create(AOwner : TComponent); override;
  end;

Implementation:

procedure TForm1.Button2Click(Sender: TObject);
begin
  if(not Assigned(FAlpha)) then FAlpha := TAlphaForm.Create(Self);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  FreeAndNil(FAlpha);
end;

constructor TForm1.Create(AOwner: TComponent);
begin
  inherited;
  FAlpha := nil;
end;