Прозрачная цветная форма

← →
Griffin (2002-10-13 21:03) [0]

Уважаемые господа, подскажите, плз, как сделать под Win98 прозрачную цветную форму. Заранее благодарен.

← →
Anatoly Podgoretsky (2002-10-13 21:21) [1]

Прозрачнаи и одновременно цветная :-)

← →
Юрий Зотов (2002-10-13 22:31) [2]

Библиотека FormRgn и аналогичные ей. Ищите на torry в разделе "компоненты" по ключевому слову "transparent".

← →
pirat (2002-10-14 02:01) [3]

Я такую компоненту только одну видел. Для Delphi называлась Glass.

← →
Griffin (2002-10-15 21:55) [4]

---------- Anatoly Podgoretsky:
Светофильтр, видите ли, ПРОЗРАЧНЫЙ и одновременно ЦВЕТНОЙ

---------- Юрий Зотов
Большое Вам спасибо, закачал себе оттуда кучу всего, буду разбираться

---------- pirat
А где ее достать-то?

← →
Anatoly Podgoretsky (2002-10-15 22:14) [5]

Griffin © (15.10.02 21:55)
Светофильтр не прозрачный, потому он и фильтр, он полупрозрачный, часть пропускает, часть задерживает

← →
Griffin (2002-10-16 22:07) [6]

---------- Anatoly Podgoretsky:
:-)))

← →
Griffin (2002-10-16 22:14) [7]

Уважаемые мастера, если кто знает, напишите, можно ли действительно сделать ПРОЗРАЧНУЮ (полуПРОЗРАЧНУЮ) ЦВЕТНУЮ форму (или контрол)средствами именно Win98?
Под Win2k существуют "layered window", насколько я знаю, так что эта тема не столь интересна.
Заранее признателен всем, кого хотя бы заинтересует мой вопрос.

← →
Anatoly Podgoretsky (2002-10-16 22:39) [8]

Под 9х существуют только поделки, частично работающие, лучше сказать не работающие, иммитирующие такое поведение.
Смотри на файловых архивах, в первую очередь на Торри и найдещь

← →
TankMan (2002-10-17 01:16) [9]

Искал я на торри... ну нашел я примеры... ну работают некоторые наверное под 2000 винды...а те что под 98 делают только полностью прозрачными не прозрачными... а нужно же полупрозрачную форму например... может я не досмотрел? Подскажите слепцу.

← →
MBo (2002-10-17 06:25) [10]

delphi.vitpc.com статья А.Григорьева

← →
Griffin (2002-10-17 10:59) [11]

---------- Anatoly Podgoretsky
Большое спасибо. Как я понял, не стоит пытаться сделать такое под Win9x, а сразу под Win2k ?
---------- TankMan
Все верно, в этом и состоит вопрос --- КАК такое же сделать под Win9x ? А на torry все примеры по этой теме под новые версии.
---------- MBo
Спасибо, скачал, будем разбираться...

← →
Evgeny (2002-10-17 12:07) [12]

Есть такая компонента и прекрасно работает была описана в факах на http://www.akzhan.midi.ru

← →
TankMan (2002-10-18 01:59) [13]

>>MBo
Это ты про статью про основы работы с Вин Апи? Или другую какую? Дайте ссылку чтоли... если не та, а если та... то... прийдется это все читать и перечитывать...

>>Evgeny
Не мог бы топочнее... какая именно компонента?... я что-то не нашел... (плохо наверное я ищю.. но уж что поделаешь :( )

← →
Sharik_212 (2002-10-18 15:49) [14]

пользуйся....
function TForm1.BitmapToRegion(Bitmap: TBitmap; TransColor: TColor): HRGN;
var
X, Y: Integer;
XStart: Integer;
begin
Result := 0;
with Bitmap do Begin
for Y := 0 to Height - 1 do begin
X := 0;
while X < Width do begin
// ¦Ёюяєёърхь яЁючЁрўэvх Єюўъш
while (X < Width) and (Canvas.Pixels[X, Y] = TransColor) do
Inc(X);
if X >= Width then
Break;
XStart := X;
// ¦Ёюяєёърхь эхяЁючЁрўэvх Єюўъш
while (X < Width) and (Canvas.Pixels[X, Y] <> TransColor) do
Inc(X);
// Tючфр¬ь эютvщ яЁ ьюєуюы№эvщ Ёхушюэ ш фюсрты хь хую ъ
// Ёхушюэє тёхщ ърЁЄшэъш
if Result = 0 then
Result := CreateRectRgn(XStart, Y, X, Y + 1)
else
CombineRgn(Result, Result, CreateRectRgn(XStart, Y, X, Y + 1), RGN_OR);
end; //while X < Width
end; //for Y := 0 to Height - 1
End; //with Bitmap
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
rgn:=BitmapToRegion(Image1.Picture.Bitmap, clWhite);
SetWindowRgn(Handle, rgn, True);
end;

← →
Sharik_212 (2002-10-18 15:54) [15]

Только установи, свойства формы без рамки.

← →
TankMan (2002-10-18 22:14) [16]

>>Sharik_212
А где в твоем примере ПОЛУ-прозрачность... я что-то не нашел :(

← →
Evgeny (2002-10-19 09:02) [17]

Прошу прощения, ошибся с адресом. Получи.

1. Часть.

{*************************************************************}
{ TGlassy component for Delphi 3 and higher }
{ Version: 1.0 }
{ Idea: Anton Grigoriev (grigorievab@mail.ru) }
{ Author: Aleksey Kuznetsov (info@utilmind.com) }
{ Home Page: http://www.utilmind.com }
{ Created: June, 12, 1999 }
{ Modified: June, 12, 1999 }
{*************************************************************}
{ Компонента (наследник TPaintBox) отрисовывает себя как }
{ прозрачная часть формы (показывает что находится под формой)}
{ с настраиванием цветом "стекла" и степенью прозрачности. }
{*************************************************************}
{ This component (inherited from TPaintBox) will draw itself }
{ as transparent part of form (shows what be under form), }
{ with possibility to set "glass" color and degree of the }
{ transparency. }
{*************************************************************}
{ Additional properties: }
{ TranspColor: TColor - color of "glass". }
{ Transparency: 1..100 - degree of transparency. }
{ Moveable: Boolean - if true then form can be moved (dragged)}
{ using the client area of form }
{*************************************************************}
{ Please see demo program for more information. }
{*************************************************************}
{ IMPORTANT NOTE: }
{ This software is provided "as-is", without any express or }
{ implied warranty. In no event will the author be held }
{ liable for any damages arising from the use of this }
{ software. }
{ Permission is granted to anyone to use this software for }
{ any purpose, including commercial applications, and to }
{ alter it and redistribute it freely, subject to the }
{ following restrictions: }
{ 1. The origin of this software must not be misrepresented, }
{ you must not claim that you wrote the original software. }
{ If you use this software in a product, an acknowledgment }
{ in the product documentation would be appreciated but is }
{ not required. }
{ 2. Altered source versions must be plainly marked as such, }
{ and must not be misrepresented as being the original }
{ software. }
{ 3. This notice may not be removed or altered from any }
{ source distribution. }
{*************************************************************}
unit Glassy;

interface

uses
Windows, Messages, Classes, Graphics, Controls, Forms, ExtCtrls;

type
THoundred = 0..100;

TGlassy = class(TPaintBox)
private
FMoveable: Boolean;
FTranspColor: TColor;
FTransparency: THoundred;
ScreenShoot: TBitmap;
ParentForm: TForm;
PrevParentWndProc: Pointer;
ShiftX, ShiftY: Integer;
CanTakeScreen: Boolean;

procedure NewParentWndProc(var Msg: TMessage);
procedure TakeScreenShoot;

procedure SetTranspColor(Value: TColor);
procedure SetTransparency(Value: THoundred);
protected
procedure SetParent(Value: TWinControl); override;
public
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
procedure Loaded; override;

procedure Paint; override;
published
property Moveable: Boolean read FMoveable write FMoveable;
property TranspColor: TColor read FTranspColor write SetTranspColor;
property Transparency: THoundred read FTransparency write SetTransparency;
end;

procedure Register;

← →
Evgeny (2002-10-19 09:03) [18]

2. Часть.

implementation

type
PRGBArray = ^TRGBArray;
TRGBArray = Array[0..1000000] of TRGBTriple;

constructor TGlassy.Create(aOwner: TComponent);
var
p: Pointer;
begin
inherited Create(aOwner);
FMoveable := True;
FTransparency := 60;
FTranspColor := clBlack;
ParentForm := TForm(aOwner);
ScreenShoot := TBitmap.Create;

{ Setting hook on parent form }
PrevParentWndProc := Pointer(GetWindowLong(ParentForm.Handle, GWL_WNDPROC));
p := MakeObjectInstance(NewParentWndProc);
SetWindowLong(ParentForm.Handle, GWL_WNDPROC, LongInt(p));

CanTakeScreen := True;
end;

destructor TGlassy.Destroy;
begin
if ParentForm.HandleAllocated then
SetWindowLong(ParentForm.Handle, GWL_WNDPROC, LongInt(PrevParentWndProc));

if ScreenShoot <> nil then ScreenShoot.Destroy;
inherited Destroy;
end;

procedure TGlassy.Loaded;
begin
inherited Loaded;
TakeScreenShoot;
end;

procedure TGlassy.SetParent(Value: TWinControl);
begin
inherited SetParent(Value);
if Value <> nil then
begin
ShiftX := 0;
ShiftY := 0;
while not (Value is TForm) do
begin
inc(ShiftX, Value.Left);
inc(ShiftY, Value.Top);
Value := Value.Parent;
end;
end;
end;

procedure TGlassy.Paint;
var
X, Y: Integer;
begin
inherited Paint;
if (csDesigning in ComponentState) or (ScreenShoot = nil) then Exit;

X := ParentForm.Left + Left + ShiftX;
Y := ParentForm.Top + Top + ShiftY;

with ParentForm do
begin
if WindowState = wsNormal then
case BorderStyle of
bsSingle,
bsDialog: begin
inc(X, GetSystemMetrics(sm_CXDlgFrame));
inc(Y, GetSystemMetrics(sm_CYDlgFrame));
end;
bsSizeable: begin
inc(X, GetSystemMetrics(sm_CXFrame));
inc(Y, GetSystemMetrics(sm_CYFrame));
end;
bsToolWindow,
bsSizeToolWin: begin
inc(X, GetSystemMetrics(sm_CXBorder));
inc(Y, GetSystemMetrics(sm_CYBorder));
end;
end;
if BorderStyle <> bsNone then
inc(Y, GetSystemMetrics(sm_CYCaption));
end;

if ScreenShoot <> nil then
BitBlt(Canvas.Handle, 0, 0, ScreenShoot.Width, ScreenShoot.Height,
ScreenShoot.Canvas.Handle, X, Y, SrcCopy);
CanTakeScreen := True;
end;

procedure TGlassy.NewParentWndProc(var Msg: TMessage);
begin
Msg.Result := CallWindowProc(PrevParentWndProc, ParentForm.Handle, Msg.Msg,
Msg.WParam, Msg.LParam);
case Msg.Msg of
wm_Activate: if (Lo(Msg.wParam) <> wa_Inactive) and
CanTakeScreen then TakeScreenShoot;
wm_Move: Paint;
wm_NCHitTest: if not (csDesigning in ComponentState) and
FMoveable and (Msg.Result = htClient) then
Msg.Result := htCaption
end;
end;

procedure TGlassy.TakeScreenShoot;
var
DC: hDC;
ScreenWidth, ScreenHeight: Integer;
SL: PRGBArray;
X, Y: Integer;
begin
if (csDesigning in ComponentState) or (ScreenShoot = nil) then Exit;

CanTakeScreen := False;

ScreenWidth := GetSystemMetrics(sm_CXScreen);
ScreenHeight := GetSystemMetrics(sm_CYScreen);

ScreenShoot.Width := ScreenWidth;
ScreenShoot.Height := ScreenHeight;
ScreenShoot.PixelFormat := pf24bit;

ShowWindow(ParentForm.Handle, SW_Hide);

SetActiveWindow(0);

Sleep(100); // Waiting when all windows will be redrawn...

DC := GetDC(0);
BitBlt(ScreenShoot.Canvas.Handle, 0, 0,
ScreenWidth, ScreenHeight, DC, 0, 0, SrcCopy);
ReleaseDC(0, DC);

for Y := 0 to ScreenHeight - 1 do
begin
SL := ScreenShoot.ScanLine[Y];
for X := 0 to ScreenWidth - 1 do
begin
try
SL[X].rgbtRed := (FTransparency * SL[X].rgbtRed + (100 - FTransparency) * GetRValue(FTranspColor)) div 100;
SL[X].rgbtGreen := (FTransparency * SL[X].rgbtGreen + (100 - FTransparency)* GetGValue(FTranspColor)) div 100;
SL[X].rgbtBlue := (FTransparency * SL[X].rgbtBlue + (100 - FTransparency) * GetBValue(FTranspColor)) div 100;
except
end;
end
end;

ShowWindow(ParentForm.Handle, sw_Show);
end;

procedure TGlassy.SetTranspColor(Value: TColor);
begin
if FTranspColor <> Value then
begin
FTranspColor := Value;
if ScreenShoot <> nil then
begin
TakeScreenShoot;
Paint;
end;
end;
end;

procedure TGlassy.SetTransparency(Value: THoundred);
begin
if FTransparency <> Value then
begin
FTransparency := Value;
if ScreenShoot <> nil then
begin
TakeScreenShoot;
Paint;
end;
end;
end;

procedure Register;
begin
RegisterComponents("UtilMind", [TGlassy]);
end;

end.

← →
TankMan (2002-10-19 11:27) [19]

...ээ СПАСИБА Огромное...:) но вот вопрос, один маааленький - когда делаешь прозрачность равную 0 - то Компонент черного цвета, как сделать что бы он был например белого цвета? А то я чего-то менял менял, но так и не получилось...:(

← →
TankMan (2002-10-19 11:35) [20]

Да и еще... у меня вопрос... а можно как-то избежать перерисовки всего окна при изменении прозрачности... а то например трекбар ставишь... и при изменении, окно ужасно много раз перерисовывается :(.. а может я чего не так делаю.

← →
Evgeny (2002-10-19 13:24) [21]

>то Компонент черного цвета
procedure TGlassy.SetTranspColor(Value: TColor);
по умолчанию - при создании формы
TranspColor := clBlack;
поставь
TranspColor := clWhite;

>а можно как-то избежать перерисовки всего окна
А вот эту проблему решить практически невозможно. Так как в Win9.x нет возможности полупрозрачности приходится идти на ухищрения. На сайте имеется статья на эту тему, там это все очень подробно описано. Я эту статью могу поискать дома, но это будет не раньше вторника.
Sleep(100); // Waiting when all windows will be redrawn...
вот эта строчка отвечает за задержку перед перерисовкой, из-за этого и происходит мерцание, но как я уже говорил приходится мириться.

← →
TankMan (2002-10-19 20:31) [22]

... Извините за назойливость.. но еще один вопрос :) - Как с этим компонентом сделать полупрозрачную.. ну например обычную кнопку?

← →
MrAngel (2002-10-21 09:51) [23]

Ребята... TGlassy это самый глючный и медленно работающий компонент который я когда либо видел...
Помню я тоже интересовался этим вопросом...
Вот что я знаю:
1. в WIN9x поддержки полупрозрачности нет она есть только на 2000 и XP
2. в 98 полупрозрачность надо делать на ассемблере а точнее надо просчёты RGB компонент делать на нём...

Я такую ерунду уже делал и у меня на 600 Мгц было примерно 12 перерисовок в секунду на форме... при у словии полной загруженнности процессора...

← →
TankMan (2002-10-21 21:22) [24]

Ну раз так, почему ж тогда исходники никому не даешь?

← →
MrAngel (2002-10-22 17:48) [25]

Исходников уже давным давно нет... а всё заного делать нехочу... мне это ничего не даст...

← →
TankMan (2002-10-23 10:42) [26]

Ясно ясно.. а смысл было потоваться, все и так известно, что для того чтобы что-то работало быстро нужно писать самому ручками на ассемблере... странный ты вообще, пишешь, как у тебя все было круто... а зачем?

← →
MrAngel (2002-10-25 12:21) [27]

Ладно ладно признаюсь зря только писал а посему предложу вот что...
В Windows.PAS есть функции типа Blend/// как точно они называются я не знаю но вы можете их поиском найти (ключевое слово "Blend")...

Вот они как раз и рисуют полупрозрачные картинки...

← →
MrAngel (2002-10-25 12:30) [28]

А под WIN9x рисование полупрозрачной формы происходит следующим способом...
1. Сначала получаем то что находится под формой а точнее картинку
2. Затем решаем как мы её будем обрабатывать или будем обьединять с одним цветом или с другой картинкой (например с изображением формы).
3. Обьединяем и скидываем всё на форму...

Самое сложное в этом я вижу проблему получения картинки под формой... Есть для этого 2 пути...
1. Спрятать форму, получить картику на её месте, а затем показать форму - это замый медленный и "моргающий способ"
2. Есть функция которая требует у указанного HWND нарисовать на TargetHDC своё изображение... Эта функция ещё используется для печати отдельно взятых окон. Как называется эта функция не помню - надо искать...

Обновлять форму при этом надо постоянно, т.к. изображение под формой может меняться постоянно... Может быть кто знает есть ли такая функция которая позволяет определить перерисовалось ли чтонибудь под окном???

← →
TankMan (2002-10-26 15:25) [29]

Ну ты же говорил, что писал... и сам же спрашиваешь. Если бы кто занал, дугой способ отлчиный от того что сдесь привели, то наверное бы уж сказал.. а так это конечно все хорошо, идея конечно у тебя хорошая, но раз ты писал, значит тебе, как никому в этом форуме, будет легче найти эту функцию... но похоже у тебя только идеи...

← →
MrAngel (2002-10-29 17:24) [30]

Неа идеи уже давно стали реальностью....
Небыло реализована только вот эта часть, а именно :
определение что под окном что то изменилось...
Я лишь постоянно перерисовываю окно, а это как известно тормозит компьютер.
Если бы я знал, то тогда перерисовывал бы окно только в нужный момент, т.е. тогда когда под ним что то изменилось...

Прозрачная цветная форма Найти похожие ветки