Форум: "Основная";
Текущий архив: 2004.05.02;
Скачать: [xml.tar.bz2];
ВнизПолупрозрачные окна Найти похожие ветки
← →
fatal © (2004-04-09 12:28) [0]Подскажите пожалуйста как в Delphi реализовать полупрозрачный стиль окна. У кого нибудь получалось?
Спасибо.
← →
tpa (2004-04-09 12:38) [1]Кажется в RX есть компонент TTransparentForm. Кладешь на форму рискунок с transparent краями - получаешь не прямоугольную форму. Делаешь в русунке transparent дырочки - получаешь полупрозрачную форму.
← →
fatal © (2004-04-09 12:44) [2]Где раздобыть этот RX?
← →
tpa (2004-04-09 12:50) [3]Стыдно батенька :) ищи RxLib в инете.
← →
serge © (2004-04-09 12:52) [4]In the big garbage heap named Internet :o))))
← →
fatal © (2004-04-09 12:53) [5]Спасибо найду.
Но вопрос остается открытым, еще есть у кого предложения?
← →
serge © (2004-04-09 12:54) [6]Есть - поискать по разным преразным факам разбросанных по Инетрнету :)
← →
alless © (2004-04-09 12:59) [7]procedure TForm1.FormCreate(Sender: TObject);
begin
form1.AlphaBlend:=true;
form1.AlphaBlendValue:=100;
end;
← →
fatal © (2004-04-09 13:01) [8]У меня этих факов на локали до ...., результат=0.
← →
tpa (2004-04-09 13:11) [9]Извини fatal :( Нет этого компонента в RxLib. Вот он:
unit TrForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TtrRegion = class;
TTransparentForm = class(TComponent)
private
FMask: TBitmap;
FOwner: TCustomForm;
FRgn: TtpRegion;
FRegion: HRGN;
FAutoSize: Boolean;
FEnable: Boolean;
procedure SetEnable(Value: Boolean);
procedure SetMask(Value: TBitmap);
procedure SetAutoSize(Value: Boolean);
protected
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Mask: TBitmap read FMask write SetMask;
property Enable: Boolean read FEnable write SetEnable;
property AutoSize: Boolean read FAutoSize write SetAutoSize;
end;
TtrRegion = class(TComponent)
published
function RegionFromBitmap(Image: TBitmap): HRGN;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents("Add", [TTransparentForm]);
end;
constructor TTransparentForm.Create(AOwner: TComponent);
begin
inherited;
FOwner := GetParentForm(TControl(AOwner));
FMask := TBitmap.Create;
FRgn := TtpRegion.Create(Self);
end;
destructor TTransparentForm.Destroy;
begin
if not (csDestroying in FOwner.ComponentState) then
begin
SetWindowLong(FOwner.Handle, GWL_STYLE,
GetWindowLong(FOwner.Handle, GWL_STYLE) or WS_CAPTION);
SetWindowRgn(FOwner.Handle, 0, True);
end;
FRgn.Free;
FMask.Free;
inherited;
end;
procedure TTransparentForm.SetMask(Value: TBitmap);
begin
FMask.Assign(Value);
FRegion := FRgn.RegionFromBitmap(Value);
if FEnable then
SetWindowRgn(FOwner.Handle, FRegion, True)
else
SetWindowRgn(FOwner.Handle, 0, True);
if FEnable and FAutoSize then
begin
FOwner.Width := FMask.Width;
FOwner.Height := FMask.Height;
end;
end;
procedure TTransparentForm.SetEnable(Value: Boolean);
begin
FEnable := Value;
if Value then
begin
SetWindowLong(FOwner.Handle, GWL_style,
GetWindowLong(FOwner.Handle, GWL_style) and not WS_CAPTION);
FRegion := FRgn.RegionFromBitmap(FMask);
SetWindowRgn(FOwner.Handle, FRegion, True);
if FAutoSize then
begin
FOwner.Width := FMask.Width;
FOwner.Height := FMask.Height;
end;
end
else
begin
SetWindowLong(FOwner.Handle, GWL_STYLE,
GetWindowLong(FOwner.Handle, GWL_STYLE) or WS_CAPTION);
SetWindowRgn(FOwner.Handle, 0, True);
end;
end;
procedure TTransparentForm.SetAutoSize(Value: Boolean);
begin
FAutoSize := Value;
if Value and FEnable then
begin
FOwner.Width := FMask.Width;
FOwner.Height := FMask.Height;
end;
end;
const
MaxPixelCount = 32768;
type
PRGBArray = ^TRGBArray;
TRGBArray = array [0..MaxPixelCount - 1] of TRGBTriple;
function TtrRegion.RegionFromBitmap(Image: TBitmap): HRGN;
var
rgn1, rgn2: HRGN;
startx, endx, x, y: Integer;
TransparentColor: TRGBTriple;
bmp: TBitmap;
p: PRGBArray;
begin
rgn1 := 0;
bmp := TBitmap.Create;
bmp.Assign(Image);
bmp.PixelFormat := pf24Bit;
if (bmp.Height > 0) and (bmp.Width > 0) then
begin
p := bmp.ScanLine[0];
TransparentColor := p[0];
end;
for y := 0 to bmp.Height - 1 do
begin
x := 0;
p := bmp.ScanLine[y];
repeat
while (x < bmp.Width) and (CompareMem(@p[x], @TransparentColor, 3)) do
Inc(x);
Inc(x);
startx := x;
while (x < bmp.Width) and (not (CompareMem(@p[x], @TransparentColor, 3))) do
Inc(x);
endx := x;
if startx < bmp.Width then
begin
if rgn1 = 0 then
rgn1 := CreateRectRgn(startx + 1, y, endx, y + 1)
else
begin
rgn2 := CreateRectRgn(startx + 1, y, endx, y + 1);
if rgn2 <> 0 then
CombineRgn(rgn1, rgn1, rgn2, RGN_OR);
DeleteObject(rgn2);
end;
end;
until x >= Image.Width;
end;
bmp.Free;
Result := rgn1;
end;
end.
← →
alless © (2004-04-09 13:12) [10]a tot kod kotorii ia tebe dal ne rabotaiet? On ne budet rabotati tolico v win98,95
← →
sir John © (2004-04-09 13:19) [11]предложения есть. Можно вот так сделать:
private
FullRgn, ClientRgn, CtlRgn: THandle;
procedure MakeTransparent;
procedure UndoTransparent;
procedure TForm1.MakeTransparent;
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.UndoTransparent;
begin
FullRgn := CreateRectRgn(0, 0, Width, Height);
CombineRgn(FullRgn, FullRgn, FullRgn, RGN_COPY);
SetWindowRgn(Handle, FullRgn, True);
end;
тест. Две кнопки на форме
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
MakeTransparent;
end;
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
UndoTransparent;
end;
вот собственно и все...
← →
Ann © (2004-04-09 13:20) [12]А зачем компонент, если то что привел alless прекрасно работает?
← →
tpa (2004-04-09 13:32) [13]Речь кажется идет о форме , а у alles полупрозрачными становятся все контролы. В варианте sir John идея таже самая, что и в TTransparentForm. Дело вкуса.
← →
fatal © (2004-04-09 14:09) [14]to alless
Ооо большое спасибо.
Получилось просто супер.
← →
Amoeba © (2004-04-12 16:19) [15]Смотрим:
http://www.delphikingdom.com/asp/viewitem.asp?catalogid=30
← →
Боян Георгиев (2004-04-12 21:04) [16]Прозрачная форма:
Form1.AlphaBlend := true;
Form1.AlphaBlendValue := 50;
Полупрозрачная форма:Form1.AlphaBlend := true;
Form1.AlphaBlendValue := 100;
Работает только для XP.
← →
Боян Георгиев (2004-04-12 21:06) [17]Ошибался.
Прозрачная форма:
Form1.AlphaBlend := true;
Form1.AlphaBlendValue := 100;
Полупрозрачная форма:
Form1.AlphaBlend := true;
Form1.AlphaBlendValue := 50;
← →
Мишка Кулясов © (2004-04-12 21:08) [18]Вместе с FormRgn поставляется пример с настоящей полупрозрачностью в любых версиях Windows.
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2004.05.02;
Скачать: [xml.tar.bz2];
Память: 0.5 MB
Время: 0.034 c