Прозрачность формы в Win9x.

← →
Saimon (2004-01-02 05:33) [0]

Подскажите, плиз, как в Win9x сделать форму прозрачной.

Зарнее благодарен.

← →
ZLOI13 (2004-01-04 15:27) [1]

В Delphi 6 разработчикам Windows-приложений доступна одна из замечательных возможностей создавать (полу)прозрачные формы (окна). В Delphi 6 класс TForm поддерживает формы со слоями, которые имеют свойства AlphaBlend, AlphaBlendValue, TransparentColor, и TransparentColorValue.

Прозрачность в форме означает то, что пользователь может видить то, что находится позати формы.

Чтобы подготовить форму к прозрачности, Вам потребуется установить свойство AlphaBlend в True. Если AlphaBlend установлено в True, то свойство AlphaBlendValue указывает степень прозрачности. Это свойство позволяет задать значения от 0 до 255. 0 указывает на полную прозрачность окна, в то время как 255 указывает на непрозрачное окно.

Так же возможно устанавливать свойства AlphaBlend и AlphaBlendValue во время разработки (или во время выполнения приложения) при помощи Object Inspector.

Следующая форма диалогового окна About имеет значение AlphaBlendValue установленный в 210.

Возможно, Вы подумаете, что такая возможность в Delphi, может Вам пригодиться довольно редко, однако прозрачностью можно довольно эффективно привлекать внимание пользователей Вашей программы:

procedure TAboutBox.FormClose
(Sender: TObject; var Action: TCloseAction);
var
i, cavb : 0..255;
begin
if AlphaBlend=False then
begin
AlphaBlendValue:=255;
AlphaBlend:=True;
end;
cavb:=AlphaBlendValue;

for i := cavb downto 0 do
begin
AlphaBlendValue := i;
Application.ProcessMessages;
end
end;

Вышеприведённый код, в событие OnClose для формы about, создаёт плавно изменяющийся эффект. Когда пользователь попытается закрыть диалоговое окошко, то форма плавно исчезнет. Делается это путём циклического уменьшения AlphaBlendValue до нуля.

Другие два новый свойства формы в Delphi 6, это TransparentColor и TransparentColorValue. TransparentColor, это булевое свойство, которое указывает, будет определённый цвет, указанный в TransparentColorValue прозрачным. То есть мы можем задать прозрачность только определённому цвету.

В качестве примера, установим TransparentColor для формы About в True. Теперь зададим свойству TransparentColorValue значение clWhite - что соответствует белому. Компонент Memo имеет белый фон, поэтому окошко About будет выглядеть следующим образом:

И взаключении хотелось бы указать на главный недостаток. Все свойства, описанные выше, не будут работать, если приложение запущено не под Windows 2000 или выше, и если процессор на компьютере

← →
Иван Ширко (2004-01-04 16:08) [2]

to ZLOI13[1]
А главное по теме...

Один из способов - установить стиль кисти канвы формы в bsClear (кажется, так называется).
Удачи!

← →
Mihey © (2004-01-04 22:49) [3]

Расчитывать цвет по тому, что за формой путём блендинга.

← →
Думкин © (2004-01-05 07:08) [4]

> [2] Иван Ширко (04.01.04 16:08)
> Один из способов - установить стиль кисти канвы формы в
> bsClear (кажется, так называется).

И потом передвинуть форму. Разве это прозрачность?

← →
Sniper-Max © (2004-01-05 09:00) [5]

Да в общем никак прозрачку в 98 не сделать...
Да и вообще, глючит страшно с Transparent даже...

← →
Saimon (2004-01-07 00:07) [6]

Да-ну нафик, у меня была прога какая-то (не помню) с прозрачной формой и ни капли не глючила и это все в 9х. Эта прога входит в комплект Делфи 5, но щас у меня Дельфи 6, а 5-ая фиг знает где, вот я спрашиваю что да как....

Вот немного из моего архивчика:

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

Вот ответ: Создайте компонент Shape на форме (чтобы предать будущей форме очертание), далее:
Form.borderstyle присваиваете bsNone и на функцию FormPaint ложите код:

procedure TForm1.FormPaint(Sender: TObject);
var
I: Integer;
FullRgn,
ClientRgn,
ControlRgn: THandle;
Margin,
MarginX,
MarginY,
X,
Y: Integer;
W,H,S :Integer;
bX,bY :Integer;
c :TColor;
begin
Margin := (Width - ClientWidth) div 2;
FullRgn := CreateRectRgn(0, 0, Width, Height);
MarginX := Margin;
MarginY := Height - ClientHeight - Margin;
ClientRgn := CreateRectRgn(MarginX, MarginY, MarginX + ClientWidth, MarginY + ClientHeight);
CombineRgn(FullRgn, FullRgn, ClientRgn, RGN_DIFF);
DeleteObject(ClientRgn);
for I:=0 to ControlCount-1 do
begin
X := MarginX + Controls[I].Left;
Y := MarginY + Controls[I].Top;
W:=Controls[I].Width;
H:=Controls[I].Height;
{}
if controls[i] is timage then begin
with controls[i] as tImage do begin
c:=Picture.Bitmap.Canvas.Pixels[0,0];
for bX:=0 to Picture.Bitmap.Width-1 do begin
for bY:=0 to Picture.Bitmap.Height-1 do begin
if Picture.Bitmap.Canvas.Pixels[bX,bY]<>c then begin
ControlRgn := CreateRectRgn(X+bX, Y+bY, X + bX+1, Y + bY+1);
CombineRgn(FullRgn, FullRgn, ControlRgn, RGN_OR);
DeleteObject(ControlRgn);
end;
end;
end;
end;
end else
{}
if controls[i] is tShape then begin
if W < H then S := W else S := H;
if (Controls[i] as tshape).Shape in [stSquare, stRoundSquare, stCircle] then
begin
Inc(X, (W - S) div 2);
Inc(Y, (H - S) div 2);
W := S;
H := S;
end;
Inc(W); Inc(H); Inc(S);
case (controls[i] as tshape).Shape of
stRectangle, stSquare:
ControlRgn := CreateRectRgn(X, Y, X + W, Y + H);
stRoundRect, stRoundSquare:
ControlRgn := CreateRoundRectRgn(X, Y, X + W, Y + H, S div 4, S div 4);
stCircle, stEllipse:
ControlRgn:=CreateEllipticRgn(X, Y, X + W, Y + H);
else
ControlRgn := CreateRectRgn(X, Y, X + W, Y + H);
end;
CombineRgn(FullRgn, FullRgn, ControlRgn, RGN_OR);
DeleteObject(ControlRgn);
end else
{}
begin
ControlRgn := CreateRectRgn(X, Y, X + W, Y + H);
CombineRgn(FullRgn, FullRgn, ControlRgn, RGN_OR);
DeleteObject(ControlRgn);
end;
end;
SetWindowRgn(Handle, FullRgn, True);
DeleteObject(FullRgn);
end;

procedure TForm1.Shape1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);

const
SC_DragMove = $F012; { a magic number }
begin
ReleaseCapture;
form1.perform(WM_SysCommand, SC_DragMove, 0);
end;

Ещё пример:

unit Unit1;

interface

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

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
function CreateRgnFromBitmap(rgnBitmap: TBitmap): HRGN;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

function TForm1.CreateRgnFromBitmap(rgnBitmap: TBitmap): HRGN;
var
transColor: TColor;
i, j: Integer;
width, height: Integer;
left, right: Integer;
rectRgn: HRGN;
begin
Result := 0;
width := rgnBitmap.Width;
height := rgnBitmap.Height;
transColor := rgnBitmap.Canvas.Pixels[width - 1, height - 1];
for i := 0 to height - 1 do
begin
left := -1;
for j := 0 to width - 1 do
begin
if left < 0 then
begin
if rgnBitmap.Canvas.Pixels[j, i] <> transColor then
left := j;
end
else
if rgnBitmap.Canvas.Pixels[j, i] = transColor then
begin
right := j;
rectRgn := CreateRectRgn(left, i, right, i + 1);
if Result = 0 then
Result := rectRgn
else
begin
CombineRgn(Result, Result, rectRgn, RGN_OR);
DeleteObject(rectRgn);
end;
left := -1;
end;
end;
if left >= 0 then
begin
rectRgn := CreateRectRgn(left, i, width, i + 1);
if Result = 0 then
Result := rectRgn
else
begin
CombineRgn(Result, Result, rectRgn, RGN_OR);
DeleteObject(rectRgn);
end;
end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var b:TBitmap;
n:HRGN;
begin
b:= TBitmap.Create;
b.LoadFromFile("c:\1.bmp");
n:= CreateRgnFromBitmap(b);
SetWindowRgn(Form1.Handle,n,True);
end;

end.

Нужно создать файл 1.bmp и на белом фоне нарисовать черную фигуру. Какова фигура такой и будет форма

Ещё прозрачная форма

var
FullRgn, ClientRgn, CtlRgn : THandle;

{Скрыть фон формы}
procedure TForm1.FormCreate(Sender: TObject);
var
AControl : TControl;
A, Margin, X, Y, CtlX, CtlY : Integer;
begin
Margin := ( Width - ClientWidth ) div 2;
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;
SetWindowRgn(Handle, FullRgn, TRUE);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
DeleteObject(ClientRgn);
DeleteObject(FullRgn);
DeleteObject(CtlRgn);
end;

{Показать форму}
procedure TForm1.dxButton2Click(Sender: TObject);
begin
FullRgn := CreateRectRgn(0, 0, Width, Height);
CombineRgn(FullRgn, FullRgn, FullRgn, RGN_COPY);
SetWindowRgn(Handle, FullRgn, TRUE);
end;

Желаю успехов

Если мало, то сообщи на мыло, млжет чего подберу.

Да это всё фигня, это не проблема. Вот как сделать форму полупрозрачной, т.е. AlphaBlendинг. Есть у кого алгоритм???

Можно компонентом Theme Engine. Но у меня его нет, если кто найдёт - то сообщите!

Прозрачность формы в Win9x. Найти похожие ветки