alpha key - transparency

[sk.Silvia]

i found out how to make transparetnt windows in delphi

Delphi-Quellcode:

const
  WS_EX_LAYERED = $80000;
  LWA_COLORKEY = 1;
  LWA_ALPHA    = 2;

type
 TSetLayeredWindowAttributes = function (
     hwnd : HWND;         // handle to the layered win8dow
     crKey : TColor;      // specifies the color key
     bAlpha : byte;       // value for the blend function
     dwFlags : DWORD      // action
     ): BOOL; stdcall;

procedure SetTransparentForm(AHandle : THandle; AValue : byte = 0);
  var Info: TOSVersionInfo;
      SetLayeredWindowAttributes: TSetLayeredWindowAttributes;

  begin
  //Check Windows version
  Info.dwOSVersionInfoSize := SizeOf(Info);
  GetVersionEx(Info);
  if (Info.dwPlatformId = VER_PLATFORM_WIN32_NT) and (Info.dwMajorVersion >= 5) then
      begin
      SetLayeredWindowAttributes := GetProcAddress(GetModulehandle(user32), 'SetLayeredWindowAttributes');
      if Assigned(SetLayeredWindowAttributes) then
        begin
        SetWindowLong(AHandle, GWL_EXSTYLE, GetWindowLong(AHandle, GWL_EXSTYLE) or WS_EX_LAYERED);
        //Make form transparent
        SetLayeredWindowAttributes(AHandle, 0, AValue, LWA_ALPHA);
        end;
      end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 SetTransparentForm(Handle, 255);
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
  begin
   SetTransparentForm(Handle,TrackBar1.Position);
   Application.ProcessMessages;
  end;

this works on the whle form
now, how could i make any object transparent? or have different transparency on different possitions of the form?
i heared sometthing about alpha key or smt like that but dont know more

[turboPASCAL]

You can make any transparency Object with Delphi 2006 and up (TTransparentControl & TCustomTransparentControl)
For versions under D2006 this function is not available.

Sorry bad en.

[sk.Silvia]

so there is no way to make transparent objects in Delphi?

cause i tried

Delphi-Quellcode:

SetTransparentForm(Image1.Canvas.Handle,TrackBar1.Position);

and it didnt worked:(

[SirThornberry]

your "SetTransparentForm" works only for top-level windows. If a window has a Parent this will not work.
If you need Alphatransparenz you have to write your own components.

you can get the image of your parent componenty with:

Delphi-Quellcode:

Parent.Perform(WM_ERASEBKGND, DC, 0);
Parent.Perform(WM_PAINT, DC, 0);

then you can use this picture in your own component to blend it with your components pic.

[Edit]
I found a solution for controls derived from (oder was heißt abgeleitet) TCustomControl like TPanel
[/Edit]

[SirThornberry]

here is a solution how to make Controls derived from TCustomControl AlphaTransparent.

You have to override the Paint-Methode and there you have to get the parent-picture. This picture you have to blend with the inherited-Paint picture. And then you simply have to paint this blended picture to the real Canvas.

Here is an example for TPanel (unit uAlphaTransPanel):

Delphi-Quellcode:

unit uAlphaTransPanel;

interface

uses
  windows, graphics, classes, ExtCtrls, messages;

type
  TPanel = class(ExtCtrls.TPanel)
  protected
    procedure Paint; override;
  private
    fAlphaVal : Byte;
    fBmpParent: TBitmap;
    fBmpOwn   : TBitmap;
    procedure FSetAlphaVal(AValue: Byte);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property AlphaBlendValue: Byte read fAlphaVal write FSetAlphaVal default 255;
  end;

implementation

constructor TPanel.Create(AOwner: TComponent);
begin
  fAlphaVal  := 255;
  fBmpParent := TBitmap.Create;
  fBmpOwn    := TBitmap.Create;
  inherited Create(AOwner);
end;

destructor TPanel.Destroy;
begin
  inherited Destroy;
  fBmpOwn.Free;
  fBmpParent.Free;
end;

procedure TPanel.FSetAlphaVal(AValue: Byte);
begin
  if (AValue <> fAlphaVal) then
  begin
    fAlphaVal := AValue;
    Invalidate;
  end;
end;

procedure TPanel.Paint;
var LOldCanvas: TCanvas;
    LBlendFunc: TBlendFunction;
begin
  if (fAlphaVal < 255) and HandleAllocated and Assigned(Parent) then
  begin
    fBmpOwn.Width  := Width;
    fBmpOwn.Height := Height;
    LOldCanvas := Canvas;
    PPointer(@Canvas)^ := fBmpOwn.Canvas;
    inherited Paint;
    PPointer(@Canvas)^ := LOldCanvas;

    fBmpParent.Width  := Parent.Width;
    fBmpParent.Height := Parent.Height;
    Parent.Perform(WM_ERASEBKGND, fBmpParent.Canvas.Handle, 0);
    Parent.Perform(WM_PAINT, fBmpParent.Canvas.Handle, 0);

    LBlendFunc.BlendOp             := AC_SRC_OVER;
    LBlendFunc.BlendFlags          := 0;
    LBlendFunc.SourceConstantAlpha := not(fAlphaVal);
    LBlendFunc.AlphaFormat         := 0;

    AlphaBlend(fBmpOwn.Canvas.Handle, 0, 0, Width, Height,
               fBmpParent.Canvas.Handle, Left, Top, Width, Height, LBlendFunc);

    BitBlt(Canvas.Handle, 0, 0, Width, Height, fBmpOwn.Canvas.Handle, 0, 0, SRCCOPY);
  end else
    inherited;
end;

end.

Now you have to write this unit at the last position in your "uses" (must be behind the original-unit).

Zitat:

[...]
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, uAlphaTransPanel;
[...]

Now TPanel supports alphatransparenz. Simply write:

Delphi-Quellcode:

Panel1.AlphaBlendValue := 127;

and your Panel is transparent (50%)

If the Background under the Panel will be changed the panel ist not notified and so the panel shows the old picture. In this case you have manually update the Panel (Call Panel.Invalidate)

[turboPASCAL]

Die Idee ist nicht schlecht. Ein Problem gibt es noch, wenn man das Fenster ausserhalb des sichtbaten Bereiches verschiebt (auf dem sich das tr. Panel befindet) kommt eine AV.

Zitat:

---------------------------
Benachrichtigung über Debugger-Exception
---------------------------
Im Projekt Project1.exe ist eine Exception der Klasse ERangeError aufgetreten. Meldung: 'Fehler bei Bereichsprüfung'. Prozeß wurde angehalten. Mit Einzelne Anweisung oder Start fortsetzen.
---------------------------
OK Hilfe
---------------------------

Delphi-Quellcode:

// An diesen beiden stellen
Parent.Perform(WM_ERASEBKGND, fBmpParent.Canvas.Handle, 0);
Parent.Perform(WM_PAINT, fBmpParent.Canvas.Handle, 0);

:thumb:

[sk.Silvia]

woow its great:)))