CODEWITHSUNDEEP
delphidelphi-xe2
user1803300
user1803300

Reputation:

How to make the form transparent without the border?

I would like to know if it is possible to make the Form transparent (AlphaBlend) without the Border (where the minimize button is and all that) being transparent too? If it is, how can I do it?

Screen shot

Upvotes: 1

Views: 1007

Answers (1)

Dalija Prasnikar
Dalija Prasnikar

Reputation: 28539

It is possible, but any controls you put on such form will not be visible.

Here is some base code to get you started, but I have never used it on forms with border, so there might be possible issues with border functionality. Most likely, you will have to create bitmap that will include window border and set alpha for that part to 255;

procedure PremultiplyBitmap(Bitmap: TBitmap);
var
  Row, Col: Integer;
  p: PRGBQuad;
begin
  Bitmap.AlphaFormat := afPremultiplied;
  for Row := 0 to Bitmap.Height - 1 do
    begin
      Col := Bitmap.Width;
      p := Bitmap.ScanLine[Row];
      while (Col > 0) do
        begin
          p.rgbBlue := p.rgbReserved * p.rgbBlue div 255;
          p.rgbGreen := p.rgbReserved * p.rgbGreen div 255;
          p.rgbRed := p.rgbReserved * p.rgbRed div 255;
          inc(p);
          dec(Col);
        end;
    end;
end;

procedure PremultiplyBitmapAlpha(Bitmap: TBitmap; Alpha: byte);
var
  Row, Col: Integer;
  p: PRGBQuad;
begin
  Bitmap.AlphaFormat := afPremultiplied;
  for Row := 0 to Bitmap.Height - 1 do
    begin
      Col := Bitmap.Width;
      p := Bitmap.ScanLine[Row];
      while (Col > 0) do
        begin
          p.rgbReserved := Alpha;
          p.rgbBlue := p.rgbReserved * p.rgbBlue div 255;
          p.rgbGreen := p.rgbReserved * p.rgbGreen div 255;
          p.rgbRed := p.rgbReserved * p.rgbRed div 255;
          inc(p);
          dec(Col);
        end;
    end;
end;

procedure BlendForm(Form: TCustomForm; Bmp: TBitmap);
var
  BitmapPos: TPoint;
  BitmapSize: TSize;
  BlendFunction: TBlendFunction;
begin
   BitmapPos := Point(0, 0);
   BitmapSize.cx := Bmp.Width;
   BitmapSize.cy := Bmp.Height;

   BlendFunction.BlendOp := AC_SRC_OVER;
   BlendFunction.BlendFlags := 0;
   BlendFunction.SourceConstantAlpha := 255;
   BlendFunction.AlphaFormat := AC_SRC_ALPHA;

   UpdateLayeredWindow(Form.Handle, 0, nil, @BitmapSize, Bmp.Canvas.Handle, @BitmapPos, 0, @BlendFunction, ULW_ALPHA);
end;

procedure TForm1.CreateWnd;
var
  ExStyle: DWORD;
begin
  inherited;
  ExStyle := GetWindowLong(Handle, GWL_EXSTYLE);
  if (ExStyle and WS_EX_LAYERED = 0) then
    SetWindowLong(Handle, GWL_EXSTYLE, ExStyle or WS_EX_LAYERED);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  Bmp: TBitmap;
begin
  Bmp := TBitmap.Create;
  try
    Bmp.PixelFormat := pf32bit;
    Bmp.Width := ClientWidth;
    Bmp.Height := ClientHeight;
    PremultiplyBitmapAlpha(Bmp, 200);
    BlendForm(Form1, Bmp);
  finally
    Bmp.Free;
  end;
end;

Bitmaps you use have to be 32-bit bitmaps. If you want to blend whole bitmap with some alpha value, you can use PremultiplyBitmapAlpha procedure, and if your bitmap has alpha channel you can then use PremultiplyBitmap procedure.

For speed improvements you can use premultiplied byte table like this:

var
  PreMult: array[byte, byte] of byte;

procedure InitializePreMult;
var
  Row, Col: Integer;
begin
  // precalculate all possible values of a*b
  for Row := 0 to 255 do
    for Col := Row to 255 do
      PreMult[Row, Col] := Row*Col div 255;
end;

and then PremultiplyBitmap procedure would use that lookup table:

procedure PremultiplyBitmap(Bitmap: TBitmap);
var
  Row, Col: integer;
  p: PRGBQuad;
begin
  for Row := 0 to Bitmap.Height-1 do
  begin
    Col := Bitmap.Width;
    p := Bitmap.ScanLine[Row];
    while (Col > 0) do
    begin
      p.rgbBlue := PreMult[p.rgbReserved, p.rgbBlue];
      p.rgbGreen := PreMult[p.rgbReserved, p.rgbGreen];
      p.rgbRed := PreMult[p.rgbReserved, p.rgbRed];
      inc(p);
      dec(Col);
    end;
  end;
end;

Upvotes: 1

Related Questions