Работа с формами

← →
staratel (2002-08-16 13:30) [0]

Народ, подскажите кто-нибудь можно ли сделать прозрачность формы в Win9x? Имеющаяся опция AlphaBlend в Delphi6 работает только с Win2000/NT/XP, а как это можно сделать в Win98?

← →
stany (2002-08-19 00:16) [1]

Есть два варианта.1)Рисуетюся только те части формы под которыми
есть компоненты:
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Panel1: TPanel;
Button2: TButton;
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormResize(Sender: TObject);
private
{ Private declarations }
procedure DoVisible;
procedure DoInvisible;
public
{ Public declarations }
end;

var
Form1: TForm1;
FullRgn, ClientRgn, CtlRgn : THandle;

implementation

{$R *.DFM}

procedure TForm1.DoInvisible;
var
AControl : TControl;
A, Margin, X, Y, CtlX, CtlY : Integer;
begin
Margin := ( Width - ClientWidth ) div 2;
//First, get form region
FullRgn := CreateRectRgn(0, 0, Width, Height);
//Find client area region
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;
//When the region is all ready, put it into effect:
SetWindowRgn(Handle, FullRgn, TRUE);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
//Clean up the regions we created
DeleteObject(ClientRgn);
DeleteObject(FullRgn);
DeleteObject(CtlRgn);
end;

procedure TForm1.DoVisible;
begin
FullRgn := CreateRectRgn(0, 0, Width, Height);
CombineRgn(FullRgn, FullRgn, FullRgn, RGN_COPY);
SetWindowRgn(Handle, FullRgn, TRUE);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
//We start out as a transparent form....
DoInvisible;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if Button1.Caption = "Show Form" then begin
DoVisible;
Button1.Caption := "Hide Form";
end
else begin
DoInvisible;
Button1.Caption := "Show Form";
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Application.Terminate;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
if Button1.Caption = "Show Form" then
DoInvisible
else
DoVisible;
end;

end.

← →
stany (2002-08-19 00:28) [2]

2)Настоящая прозрачность, но медленно и ненадёжно работает

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
ColorDialog1: TColorDialog;
SpinEdit1: TSpinEdit;
Label2: TLabel;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure SpinEdit1Change(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
BM:TBitmap;
BM2:TBitmap;
Moving:Boolean;
procedure WMEraseBkgnd(var Msg:TWMEraseBkgnd);message WM_EraseBkgnd;
procedure WMPaint(var Msg:TWMPaint);message WM_Paint;
procedure WMMove(var Msg:TMessage);message WM_Move;
procedure WMEnterSizeMove(var Msg:TMessage);message WM_EnterSizeMove;
procedure WMExitSizeMove(var Msg:TMessage);message WM_ExitSizeMove;
public
{ Public declarations }
end;

var
Form1: TForm1;

const Transparency:Integer=40; { Прозрачность в процентах. Должна быть от 0 до 100 }
TranspColor:TColor=clBlack; { Цвет окна }
DelayTime:Integer=400; { Время задержки в миллисекундах }

implementation

{$R *.DFM}

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

procedure Delay(DelayTime:Integer);
var TicksNow:Integer;
begin
TicksNow:=GetTickCount;
repeat
Application.ProcessMessages
until GetTickCount-TicksNow>=DelayTime
end;

procedure TForm1.WMEraseBkgnd;
begin
Msg.Result:=1
end;

procedure TForm1.WMPaint;
var DC:HDC;
PS:TPaintStruct;
CW,CH,CX,CY:Integer;
SL:PRGBArray;
X,Y:Integer;
begin
CW:=ClientWidth;
CH:=ClientHeight;
CX:=ClientOrigin.X;.
CY:=ClientOrigin.Y;

if not Moving then
begin
ShowWindow(Handle,SW_Hide);
SetActiveWindow(0);
Delay(400);
DC:=GetDC(0);

BitBlt(BM.Canvas.Handle,0,0,BM.Width,BM.Height,DC,0,0,SrcCopy);

ReleaseDC(0,DC);
end;

BM2.Width:=CW+1;
BM2.Height:=CH+1;
BM2.PixelFormat:=pf24bit;
BM2.Canvas.Draw(-CX,-CY,BM);
for Y:=0 to CH do // А в этих циклах на записанный нами кусок экрана
begin // Накладывается светофильтр
SL:=BM2.ScanLine[Y];
for X:=0 to CW do
begin
SL[X].rgbtRed:=(Transparency*SL[X].rgbtRed+(100-Transparency)*GetRValue(TranspColor)) div 100;
SL[X].rgbtGreen:=(Transparency*SL[X].rgbtGreen+(100-Transparency)*GetGValue(TranspColor)) div 100;
SL[X].rgbtBlue:=(Transparency*SL[X].rgbtBlue+(100-Transparency)*GetBValue(TranspColor)) div 100
end
end;

ShowWindow(Handle,SW_Show);
DC:=BeginPaint(Handle,PS);
BitBlt(DC,0,0,BM2.Width,BM2.Height,BM2.Canvas.Handle,0,0,SrcCopy);

Msg.DC:=DC;
inherited;
EndPaint(Handle,PS) // Ну, в общем-то и всё...
end;

procedure TForm1.WMMove;
begin
Invalidate;
inherited
end;

procedure TForm1.WMEnterSizeMove;
begin
Moving:=True;
inherited
end;

procedure TForm1.WMExitSizeMove;
begin
inherited;
Moving:=False
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
BM:=TBitmap.Create;
BM.Width:=GetSystemMetrics(SM_CXScreen);
BM.Height:=GetSystemMetrics(SM_CYScreen);

BM.PixelFormat:=pf24bit;
BM2:=TBitmap.Create;
Moving:=False
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if ColorDialog1.Execute then
begin
TranspColor:=ColorDialog1.Color;
Invalidate
end
end;

procedure TForm1.SpinEdit1Change(Sender: TObject);
begin
Transparency:=SpinEdit1.Value;
Invalidate
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
BM.Free;
BM2.Free
end;

end.

================================Удачи!=========================

Работа с формами Найти похожие ветки