Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Полупрозрачная форма в Win2000

Обнаружил в Windows 2000 полноценную реализацию полупрозрачности:

- Вы замечали, как быстро работает Windows2000? Я тоже нет...


const
  WS_EX_LAYERED = $80000;

  LWA_COLORKEY = 1;
  LWA_ALPHA = 2;

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

function SetLayeredWindowAttributes; external 'user32.dll';

procedure TForm1.FormCreate(Sender: TObject);
begin
  if SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE)
  or WS_EX_LAYERED) = 0 then
    ShowMessage(SysErrorMessage(GetLastError));

  if not SetLayeredWindowAttributes(Handle, 0, 128, LWA_ALPHA) then
    // ^^^ степень прозрачности
    // 0 - полная прозрачность
    // 255 - полная непрозрачность
    ShowMessage(SysErrorMessage(GetLastError));
end;

Есть более продвинутые возможности (например, альфа-канал в битмапе)
http://msdn.microsoft.com/isapi/msdnlib.idc?theURL=/library/techart/layerwin.htm


unit TransparentWnd;

interface

uses
  Windows, Messages, Classes, Controls, Forms;

type
  _Percentage = 0..100;

  TTransparentWnd = class(TComponent)
  private
    { Private declarations }
  protected
    { Protected declarations }
    _percent: _Percentage;
    _auto: boolean;
    User32: HMODULE;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    //These work on a Handle
    //It doesn't change the Percent Property Value!
    procedure SetTransparentHWND(hwnd: THandle; percent : _Percentage);

    //These work on the Owner (a TWinControl decendant is the Minumum)
    //They don't change the Percent Property Value!
    procedure SetTransparent; overload;
    procedure SetTransparent(percent : _Percentage); overload;

    procedure SetOpaqueHWND(hwnd : THandle);
    procedure SetOpaque;
  published
    { Published declarations }
    //This works on the Owner (a TWinControl decendant is the Minumum)
    property Percent: _Percentage read _percent write _percent default 0;

    property AutoOpaque: boolean read _auto write _auto default false;
end;

procedure register;

implementation

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

var
  SetLayeredWindowAttributes: function (hwnd: LongInt; crKey: byte;
    bAlpha: byte; dwFlags: LongInt): LongInt; stdcall;

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

  User32 := LoadLibrary('USER32.DLL');
  if User32 <> 0 then
    @SetLayeredWindowAttributes := GetProcAddress(User32, 'SetLayeredWindowAttributes')
  else
    SetLayeredWindowAttributes := nil;
end;

destructor TTransparentWnd.Destroy;
begin
  if User32 <> 0 then
    FreeLibrary(User32);

  inherited;
end;

procedure TTransparentWnd.SetOpaqueHWND(hwnd: THandle);
var
  old: THandle;
begin
  if IsWindow(hwnd) then
  begin
    old := GetWindowLongA(hwnd,GWL_EXSTYLE);
    SetWindowLongA(hwnd, GWL_EXSTYLE, old and ((not 0)-WS_EX_LAYERED));
  end;
end;

procedure TTransparentWnd.SetOpaque;
begin
  Self.SetOpaqueHWND((Self.Owner as TWinControl).Handle);
end;

procedure TTransparentWnd.SetTransparent;
begin
  Self.SetTransparentHWND((Self.Owner as TWinControl).Handle, Self._percent);
end;

procedure TTransparentWnd.SetTransparentHWND(hwnd: THandle; percent : _Percentage);
var
  old: THandle;
begin
  if (User32 <> 0) and (Assigned(SetLayeredWindowAttributes)) and (IsWindow(hwnd)) then
    if (_auto=true) and (percent=0) then
      SetOpaqueHWND(hwnd)
    else
    begin
      percent := 100 - percent;
      old := GetWindowLongA(hwnd, GWL_EXSTYLE);
      SetWindowLongA(hwnd, GWL_EXSTYLE, old or WS_EX_LAYERED);
      SetLayeredWindowAttributes(hwnd, 0, (255 * percent) div 100, LWA_ALPHA);
    end;
end;

procedure TTransparentWnd.SetTransparent(percent: _Percentage);
begin
  Self.SetTransparentHWND((Self.Owner as TForm).Handle, percent);
end;

procedure register;
begin
  RegisterComponents('Win32', [TTransparentWnd]);
end;

end.

Это компонент, для Дельфи, инкапсулирующий нужные функции

Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.