Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 426
  • Last Modified:

Semi-transparency

I've seen programs which are semi-transparent, I've been told this is an API feature of Windows 2000. I want an example of how one can make stuff semi-transparent.

Simple enough, huh? :o)


cheers

J
0
sageryd
Asked:
sageryd
  • 9
  • 3
  • 2
  • +4
1 Solution
 
edeyCommented:
First off, are you trying to do this under win2k, or all win32 in general?


GL
Mike
0
 
ITugayCommented:
Hi sageryd,

I did component (D5 only) that able to make your form and all visual controls on it semitransparent (W95, W98, NT4). Just drop it on the form, adjust alfablending value and it's all :-). Also you will be able to type text in TEdit or browse data in TDBGrid. Most of visual controls works properly in "semitransparency mode".

http://i-g-o-r.virtualave.net/

------
Igor.

PS: I'm not sure that somebody like to use it in real applications, so, it builded just for enjoy :-)

0
 
sagerydAuthor Commented:
In fact I just recently downloaded your component from Torry's, but it wasn't what I wanted, because it only updates the background image once, and it's very slow. Thus I need the API call for it. edey, w2k only, as I'd reckon it will only work in w2k because the other versions don't have the proper stuff for it.


j
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
ITugayCommented:
sageryd,

yes, you are right, only w2k able to work fast.

-----
Igor.

PS: I told you, my component is just funny stuff :-)
0
 
sagerydAuthor Commented:
Yep, it said so on your site.
0
 
sagerydAuthor Commented:
It's something with.. "UpdateLayeredWindow" I think. Hmmm.
0
 
sagerydAuthor Commented:
Found this guys, maybe you could help me translate it into Delphi code?

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dnwui/html/layerwin.asp
0
 
intheCommented:
Hi,
you can get some layered windows stuff here:

http://www.delphifreestuff.com/cgi-bin/dfs_components2.cgi?dfslayeredform

its a form but it has all code if you wanted to use for something else
0
 
MadshiCommented:
If you have Delphi6, just do this:

yourForm.AlphaBlend := true;
yourForm.AlphaBlend := 128;

Yes, it's that easy...   :-)

If you don't have D6, call:

const
  LWA_ALPHA = $00000002;
  WS_EX_LAYERED = $00080000;

var SetLayeredWindowAttributes = function (windowHandle: dword; colKey: COLORREF; alpha: byte; flags: dword) : boolean; stdcall;

  SetLayeredWindowAttributes := GetProcAddress(GetModuleHandle(user32), 'SetLayeredWindowAttributes');
  if @SetLayeredWindowAttributes <> nil then begin
    SetWindowLong(windowHandle, GWL_EXSTYLE, GetWindowLong(windowHandle) or WS_EX_LAYERED);
    SetLayeredWindowAttributes(windowHandle, 0, 128, LWA_ALPHA);
  end;

Not tested...

Regards, Madshi.
0
 
sagerydAuthor Commented:
Didn't work properly. I want Delphi 6.... :)
0
 
alanwhincupCommented:
Try:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure FormOpaque;
    procedure FormTransparent(Percent : ShortInt);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

const
  LWA_ALPHA = $2;
  GWL_EXSTYLE = (-20);
  WS_EX_LAYERED = $80000;
  WS_EX_TRANSPARENT = $20;

implementation

{$R *.DFM}

{Try this one}
procedure TForm1.FormOpaque;
var
  Old : LongInt;
begin
  Old := GetWindowLongA(Handle, GWL_EXSTYLE);
  SetWindowLongA(Handle, GWL_EXSTYLE, Old and ((not 0) - WS_EX_LAYERED));
end;

{or this one}
procedure TForm1.FormTransparent(Percent : ShortInt);
var
  SetLayeredWindowAttributes : function (hwnd: LongInt; crKey: byte; bAlpha: byte; dwFlags: LongInt): LongInt; stdcall;
  Old : LongInt;
  User32 : Cardinal;
begin
  User32 := LoadLibrary('USER32');
  if User32 <> 0 then
  try
    SetLayeredWindowAttributes := GetProcAddress(User32, 'SetLayeredWindowAttributes');
    if @SetLayeredWindowAttributes <> nil then
    begin
      Old := GetWindowLongA(Handle, GWL_EXSTYLE);
      SetWindowLongA(Handle, GWL_EXSTYLE, Old or WS_EX_LAYERED);
      SetLayeredWindowAttributes(Handle, 0, (255 * Percent) div 100, LWA_ALPHA);
    end;
  finally
    FreeLibrary(User32);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FormTransparent(10); {or try FormOpague;}
end;

end.

Cheers,

Alan
0
 
sagerydAuthor Commented:
It doesn't recognize "WS_EX_LAYERED" or "LWA_ALPHA".
0
 
MadshiCommented:
>> Didn't work properly.

What does that mean? Did it not compile correctly? Or did it compile correctly, but you saw no difference? In the latter case I don't know what to do...   :-(

Regards, Madshi.
0
 
sagerydAuthor Commented:
Didn't compile. gtg now, was supposed to meet a friend a couple of mins ago. Keep thinking for me will ya! :)

cheers
0
 
MadshiCommented:
Okay, this does compile for me, but I can't test it, don't have installed win2k in the moment...

function MakeWindowTransparent(windowHandle: dword) : boolean;
const LWA_ALPHA     = $00000002;
      WS_EX_LAYERED = $00080000;
var SetLayeredWindowAttributes : function (windowHandle: dword; colKey: COLORREF; alpha: byte; flags: dword) : boolean; stdcall;
begin
  SetLayeredWindowAttributes := GetProcAddress(GetModuleHandle(user32), 'SetLayeredWindowAttributes');
  result := @SetLayeredWindowAttributes <> nil;
  if result then begin
    SetWindowLong(windowHandle, GWL_EXSTYLE, GetWindowLong(windowHandle, GWL_EXSTYLE) or WS_EX_LAYERED);
    SetLayeredWindowAttributes(windowHandle, 0, 128, LWA_ALPHA);
  end;
end;

Regards, Madshi.
0
 
alanwhincupCommented:
Mine compiles... but also can't test until i get to my Win 2k box. Will test soon though.
0
 
intheCommented:
madshi of course it works  ;-),
here one ive been using

const
  LWA_COLORKEY=$00000001;
  LWA_ALPHA=$00000002;
  WS_EX_LAYERED=$00080000;
type
 TSetLayeredWindowAttributes = function (
            hwnd : HWND;
            crKey :  TCOLORREF;
            bAlpha : byte;
            dwFlags : DWORD
            ): BOOL; stdcall;
  var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
  Info: TOSVersionInfo;
  F: TSetLayeredWindowAttributes;
begin
 inherited;
 form1.color := clred;
 F := GetProcAddress(GetModulehandle(user32),
'SetLayeredWindowAttributes');
    if Assigned(F) then begin
  SetWindowLong(Handle, GWL_EXSTYLE,GetWindowLong(Handle,GWL_EXSTYLE)or WS_EX_LAYERED);
   F(Form1.Handle,0,150,LWA_ALPHA);
   end;
  end;


now if you replace
  F(Form1.Handle,0,150,LWA_ALPHA);
with
 F(Form1.Handle,ColorToRGB(CLRed),150,LWA_COLORKEY);
leaving form1.color to clred and it makes anything red on the form go completely transparent..

oh and while were at these new functions here is first working example i ever seen of UpdateLayeredWindow() :
 (credit to some russion dude i couldnt read the name)
it looks pretty smart ,just a bit confusing at first to see whats going on.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

Const
  WS_EX_LAYERED = $80000;
  LWA_COLORKEY  = 1;
  LWA_ALPHA     = 2;
  ULW_COLORKEY  = 1;
  ULW_ALPHA     = 2;
  ULW_OPAQUE    = 4;

var
  Form1: TForm1;
  bmp, old_bmp : HBITMAP;
  DC : HDC;
  bits : array[0..199,0..255] of integer;

Function SetLayeredWindowAttributes(hWnd : HWND; crKey : COLORREF;
                                    bAlpha : Byte; dwFlags : DWORD): BOOL;
stdcall;


Function UpdateLayeredWindow(hWnd : HWND;
                             hdcDst : HDC; pptDst : PPoint; psize : PSize;
                             hdcSrc : HDC; pptSrc : PPoint;
                             crKey  : COLORREF;
                             pblend : PBlendFunction;
                             dwFlags : DWORD): BOOL; stdcall;

implementation

{$R *.DFM}

Function SetLayeredWindowAttributes; external 'user32.dll';
Function UpdateLayeredWindow; external 'user32.dll';

procedure TForm1.FormCreate(Sender: TObject);
var
  i : integer;
begin
  Width := 256; Height := 200;
  if SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE)
or WS_EX_LAYERED) = 0 then
    ShowMessage(SysErrorMessage(GetLastError));
   //UNCOMMENT BELOW FOR DIFFERENT
  //if not SetLayeredWindowAttributes(Handle, 0,170, LWA_ALPHA) then
  //  ShowMessage(SysErrorMessage(GetLastError));

  for i := 0 to 255 do
    bits[0,i] := (i shl 24) or $FF;
  for i := 1 to 199 do
    bits[i] := bits[0];
  for i := 0 to 19 do
   begin
     bits[i, 236+i] := bits[i, 236+i] or $FF00;
     bits[i, 255-i] := bits[i, 255+i] or $FF00;
   end;
  bmp := CreateBitmap(Width, Height, 1, 32, @bits[0,0]);
  DC := CreateCompatibleDC(Canvas.Handle);
  old_bmp := SelectObject(DC, bmp);
end;

procedure TForm1.FormShow(Sender: TObject);
var
  pt1, pt2 : TPoint;
  sz : TSize;
  bf : TBlendFunction;
begin
  pt1 := Point(100, 100);
  pt2 := Point(0, 0);
  sz.cx := Width;
  sz.cy := Height;
  bf.BlendOp := AC_SRC_OVER;
  bf.BlendFlags := 0;
  bf.SourceConstantAlpha := $FF;
  bf.AlphaFormat := 1;
  UpdateLayeredWindow(Handle, Canvas.Handle, @pt1, @sz, DC, @pt2,0, @bf,
ULW_ALPHA);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  SelectObject(DC, old_bmp);
  DeleteObject(bmp);
  DeleteDC(DC);
end;

end.
0
 
sagerydAuthor Commented:
Too complicated for me to understand, but it worked just fine! :)

Thanx.
0
 
ginsonicCommented:
I use alike ideea to make semitransparent hints . See www.delphipages.com for TgnHint2k .
I just make a fast capture of the desktop and then a simple alpha-blending operation.
0
 
sagerydAuthor Commented:
But that would be slower.
0

Featured Post

Become an Android App Developer

Ready to kick start your career in 2018? Learn how to build an Android app in January’s Course of the Month and open the door to new opportunities.

  • 9
  • 3
  • 2
  • +4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now