Форум: "Основная";
Текущий архив: 2003.06.09;
Скачать: [xml.tar.bz2];

Вниз

Прозрачность   Найти похожие ветки 

← →
pumba   (2003-05-23 17:47) [0]

Хотел бы у вас спросить, есть ли в делфи такое понятие, как "прозрачность окна". Как с ним работать?

---

← →
Петров Денис   (2003-05-23 18:06) [1]

Есть. Свойство AlphaBlend называется. Если установлено в True, то параметр AlphaBlendValue устанавливает степень прозрачности формы (от 255 - непрозрачная до 0 - невидимая).

---

← →
Opuhshii   (2003-05-23 18:34) [2]

2pumba (23.05.03 17:47)
сие (Свойство AlphaBlend) применимо для Delphi >=6
для версий Delphi меньше 6-й используют функцию из User32

BOOL SetLayeredWindowAttributes (
HWND hwnd, // хэндл нужного окна
COLORREF crKey, // Цвет прозрачности
BYTE bAlpha, // Собственно прозрачность
DWORD dwFlags // флаги
);

Флаги:
LWA_COLORKEY = 1 // использовать цвет прозрачности
LWA_ALPHA = 2 // использовать значение альфы

для того чтоб окно подждерживало прозрачность необходимо установить расширеный стиль окна WS_EX_LAYERED с помощью SetWindowLong. т.е индекс GWL_EXSTYLE и NewLong соответственно то что было и WS_EX_LAYERED.

все радости с прозрачными окнома начинаются с NT5
по-русски W2k и выше.

---

← →
Юрий Зотов   (2003-05-23 21:17) [3]

Из MSDN по поводу SetLayeredWindowAttributes:

Requirements
Windows NT/2000 or later: Requires Windows 2000 or later.
Windows 95/98/Me: Unsupported.

====================

На Королевстве лежит бесплатная (и с исходниками) библиотека компонентов FormRgn Антона Григорьева. Там и прозрачность (для всех Delphi и всех Windows), и еще многое другое.

---

← →
AbrosimovA   (2003-05-29 14:05) [4]

Вот полный код для установки эффекта прозрачности/непрозрачности формы по нажатию кнопки. Работает и в Windows 98.

unit TransForm;

interface

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

type
TForm = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button2Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormActivate(Sender: TObject);

private
{ Private declarations }
public
procedure DoVisible;
procedure DoInvisible;
{ Public declarations }
end;

var
Form: TForm;
FullRgn, ClientRgn, CtlRgn : THandle;
TextRgn : HRGN;
LeftPos : integer;
TopPos : integer;
function Trans():boolean;
procedure FormCreate;

implementation

uses About;

{$R *.DFM}

procedure FormCreate;
begin
Form.Canvas.Font.Name := "Times New Roman";
Form.Canvas.Font.Size := 48;
Form.Canvas.Font.Style := Form.Canvas.Font.Style + [fsBold];
Form.Canvas.Font.Color := clBlue;
Form.Canvas.Brush.Style := bsClear;
LeftPos := (Form.Width - Form.Canvas.TextWidth
("Прозрачность")) Div 2 - 10;
TopPos := Form.Height - 40 - Form.Canvas.TextHeight
("Прозрачность");
Form.Show;
end;

function Trans():boolean;
begin
Form := TForm.Create(Application);
FormCreate;
end;

procedure TForm.DoInvisible;
var
AControl : TControl;
A, Margin, X, Y, CtlX, CtlY : Integer;
bt : TBitmap; // bmp for "text" region
cap, bord : integer;
begin
Margin := ( Width - ClientWidth ) div 2;
cap := GetSystemMetrics(SM_CYCAPTION); // Размер заголовка
bord := GetSystemMetrics(SM_CYSIZEFRAME); // Размер бордюра
// Установка bitmap для текста
bt := TBitmap.Create;
bt.Width := Form.Width;
bt.Height := Form.Height;
bt.Canvas.Font := Form.Canvas.Font;
BeginPath(bt.Canvas.Handle);
SetBkMode(bt.Canvas.Handle,TRANSPARENT);
bt.Canvas.TextOut(LeftPos + Margin,TopPos + cap
+ bord,"Прозрачность");
EndPath(bt.Canvas.Handle);
TextRgn := PathToRegion(bt.Canvas.Handle);

//Сначала получаем регион формы
FullRgn := CreateRectRgn(0, 0, Width, Height);
//Ищем регион клиентской области
X := Margin;
Y := Height - ClientHeight - Margin;
ClientRgn := CreateRectRgn( X, Y, X + ClientWidth, Y
+ ClientHeight );
//Окончательный "трафарет" для всей неклиентской области
CombineRgn( FullRgn, FullRgn, ClientRgn, RGN_DIFF );

//Теперь проходим через все контролы формы и получаем полный
регион.
for A := 0 to ControlCount - 1 do begin
AControl := Controls[A];
if ( AControl is TWinControl ) or ( AControl is
TGraphicControl )
then with AControl do begin
if Visible then begin
CtlX := X + Left;
CtlY := Y + Top;
CtlRgn := CreateRectRgn( CtlX, CtlY, CtlX + Width, CtlY
+ Height );
CombineRgn( FullRgn, FullRgn, CtlRgn, RGN_OR );
end;
end;
end;
// Add the text and free the bmp
CombineRgn( FullRgn, FullRgn, TextRgn, RGN_OR );
bt.Free;
//When the region is all ready, put it into effect:
SetWindowRgn(Handle, FullRgn, TRUE);
end;

procedure TForm.FormClose(Sender: TObject);
begin
//Очищаем все созданные регионы
DeleteObject(ClientRgn);
DeleteObject(FullRgn);
DeleteObject(CtlRgn);
DeleteObject(TextRgn);
end;

procedure TForm.DoVisible;
begin
//Восстановление непрозрачности:
FullRgn := CreateRectRgn(0, 0, Width, Height);
CombineRgn(FullRgn, FullRgn, FullRgn, RGN_COPY);
SetWindowRgn(Handle, FullRgn, TRUE);
end;

procedure TForm.FormPaint(Sender: TObject);
begin
Form.Canvas.TextOut(LeftPos,TopPos,"Прозрачность");
end;

procedure TForm.Button1Click(Sender: TObject);
begin
Form.Close;
end;

procedure TForm.Button2Click(Sender: TObject);
begin
//Эта кнопка переключает между прозрачностью и непрозрачностью
//формы
if Button2.Caption = "Show Form" then begin
DoVisible;
Button2.Caption := "Hide Form";
Form.Caption:= "Непрозрачная форма";
end
else begin
DoInvisible;
Button2.Caption := "Show Form";
Form.Caption:= "Прозрачная форма";
end;
end;

procedure TForm.FormResize(Sender: TObject);
begin
//Сохранение свойств прозрачности формы при изменении ее размера
if Button2.Caption = "Show Form" then
DoInvisible
else
DoVisible;
end;

procedure TForm.FormActivate(Sender: TObject);
begin
SetFocus;
end;

end.

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2003.06.09;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.47 MB
Время: 0.008 c