Недавно добавленные исходники

•  DeLiKaTeS Tetris (Тетрис)  160

•  TDictionary Custom Sort  3 337

•  Fast Watermark Sources  3 088

•  3D Designer  4 847

•  Sik Screen Capture  3 341

•  Patch Maker  3 553

•  Айболит (remote control)  3 658

•  ListBox Drag & Drop  3 015

•  Доска для игры Реверси  81 693

•  Графические эффекты  3 945

•  Рисование по маске  3 249

•  Перетаскивание изображений  2 629

•  Canvas Drawing  2 752

•  Рисование Луны  2 580

•  Поворот изображения  2 189

•  Рисование стержней  2 168

•  Paint on Shape  1 568

•  Генератор кроссвордов  2 235

•  Головоломка Paletto  1 767

•  Теорема Монжа об окружностях  2 229

•  Пазл Numbrix  1 685

•  Заборы и коммивояжеры  2 057

•  Игра HIP  1 282

•  Игра Go (Го)  1 230

•  Симулятор лифта  1 475

•  Программа укладки плитки  1 216

•  Генератор лабиринта  1 548

•  Проверка числового ввода  1 365

•  HEX View  1 497

•  Физический маятник  1 358

 
скрыть


Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Delphi Sources

Полупрозрачная форма в 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.

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





Похожие по теме исходники

Аудио Деформатор

Weather Info 2 (информация о погоде)

Оптимальное кодирование информации

Информация о процессах

 



Copyright © 2004-2024 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте