Подскажите, как создать форму, чтоб она была прозрачной, и с заданным интервалом появлялся на ней текст, при этом надо чтоб этот текст появлялся поверх всех окон и это не мешало основной работе на компутере. То есть эта форма при отобржении не должна получать фокус. Как это можно реализовать?
Уважаемые авторы вопросов! Большая просьба сообщить о результатах решения проблемы на этой странице. Иначе, следящие за обсуждением, возможно имеющие аналогичные проблемы, не получают ясного представления об их решении. А авторы ответов не получают обратной связи. Что можно расценивать, как проявление неуважения к отвечающим от автора вопроса.
31-01-2007 04:45 | Комментарий к предыдущим ответам
что за модуль JwaWinGDI
Это из JEDI WinAPI, тут он не нужен, просто забыл его убрать.
У меня ничего не получилось, форма прозрачная вся...
Ну не знаю, у меня всё работает, вот ещё разок PAS:
unit Unit1;
interface
uses
Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms;
type
TForm1=class(TForm)
procedure FormCreate(Sender:TObject);
end;
var
Form1:TForm1;
implementation
{$R *.dfm}
procedure UpdateLayerWnd(Wnd:HWND;Canvas:TCanvas;R:TRect);
var
P:TPoint;
Blend:TBlendFunction;
Pos:TPoint;
Size:TSize;
begin
Blend.BlendOp:=AC_SRC_OVER;
Blend.BlendFlags:=0;
Blend.SourceConstantAlpha:=255;
Blend.AlphaFormat:=AC_SRC_ALPHA;
P:=Point(0,0);
Size.cx:=R.Right-R.Left;
Size.cy:=R.Bottom-R.Top;
Pos:=R.TopLeft;
UpdateLayeredWindow(Form1.Handle,0,@Pos,@Size,Canvas.Handle,@P,0,@Blend,ULW_ALPHA);
end;
procedure DrawAlphaText(Canvas:TCanvas;X,Y:Integer;const Text:string);
var
S:TSize;
Bmp:TBitmap;
Table:array[0..255] of TRGBQuad;
Pix:PRGBQuad;
R,G,B:Byte;
Color:DWORD;
A:Integer;
begin
S:=Canvas.TextExtent(Text);
Bmp:=TBitmap.Create;
try
Bmp.PixelFormat:=pf32bit;
Bmp.Width:=S.cx;
Bmp.Height:=S.cy;
Bmp.Canvas.Brush.Color:=clWhite;
Bmp.Canvas.FillRect(Rect(0,0,S.cx,S.cy));
Bmp.Canvas.Font:=Canvas.Font;
Color:=Bmp.Canvas.Font.Color;
Bmp.Canvas.Font.Color:=clBlack;
Bmp.Canvas.Brush.Style:=bsClear;
Bmp.Canvas.TextOut(0,0,Text);
B:=Color and $FF;
G:=(Color shr 8)and $FF;
R:=(Color shr 16)and $FF;
for A:=0 to 255 do
with Table[255-A] do begin
rgbReserved:=A;
rgbBlue:=B*A div 255;
rgbGreen:=G*A div 255;
rgbRed:=R*A div 255;
end;
Pix:=Bmp.ScanLine[S.cy-1];
for A:=0 to S.cx*S.cy-1 do begin
Pix^:=Table[Pix.rgbBlue];
Inc(Pix);
end;
UpdateLayerWnd(Form1.Handle,Bmp.Canvas,Bounds(100,100,S.cx,S.cy));
finally
Bmp.Free;
end;
end;
procedure TForm1.FormCreate(Sender:TObject);
begin
Font.Color:=clWhite;
SetWindowLong(Handle,GWL_EXSTYLE,GetWindowLong(Handle,GWL_EXSTYLE)or WS_EX_LAYERED or WS_EX_TRANSPARENT);
SetWindowPos(Handle,HWND_TOPMOST,0,0,0,0,SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);
DrawAlphaText(Canvas,0,0,'Test QWOBDGOB');
end;
unit Unit1;
interface
uses
JwaWinGDI,Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,
Dialogs,StdCtrls;
type
TForm1=class(TForm)
procedure FormCreate(Sender:TObject);
private
{ Private declarations }
protected
procedure WndProc(var Msg:TMessage); override;
public
{ Public declarations }
end;
var
Form1:TForm1;
implementation
{$R *.dfm}
procedure UpdateLayerWnd(Wnd:HWnd;Canvas:TCanvas;R:TRect);
var
P:TPoint;
Blend:TBlendFunction;
Pos:TPoint;
Size:TSize;
begin
Blend.BlendOp:=AC_SRC_OVER;
Blend.BlendFlags:=0;
Blend.SourceConstantAlpha:=100;
Blend.AlphaFormat:=AC_SRC_ALPHA;
P:=Point(0,0);
Size.cx:=R.Right-R.Left;
Size.cy:=R.Bottom-R.Top;
Pos:=R.TopLeft;
UpdateLayeredWindow(Form1.Handle,0,@Pos,@Size,Canvas.Handle,@P,0,@Blend,ULW_ALPHA);
end;
procedure DrawAlphaText(Canvas:TCanvas;X,Y:Integer;const Text:string);
var
S:TSize;
Bmp:TBitmap;
Table:array[0..255] of TRGBQuad;
R,G,B:Byte;
Color:DWORD;
A:Integer;
procedure ProcessAlpha(ImageBits,Table:Pointer;Count:Integer); register;
asm
push edi
push esi
test eax,eax
jz @End
test edx,edx
jz @End
test ecx,ecx
jz @End
mov edi,eax
mov esi,edx
xor edx,edx
@1:
mov dl,[edi]
mov eax,[esi+edx*4]
mov [edi],eax
add edi,4
dec ecx
jnz @1
@End:
pop esi
pop edi
end;
begin
S:=Canvas.TextExtent(Text);
Bmp:=TBitmap.Create;
try
Bmp.PixelFormat:=pf32bit;
Bmp.Width:=S.cx;
Bmp.Height:=S.cy;
Bmp.Canvas.Brush.Color:=clWhite;
Bmp.Canvas.FillRect(Rect(0,0,S.cx,S.cy));
Bmp.Canvas.Font:=Canvas.Font;
Color:=Bmp.Canvas.Font.Color;
Bmp.Canvas.Font.Color:=clBlack;
Bmp.Canvas.Brush.Style:=bsClear;
Bmp.Canvas.TextOut(0,0,Text);
B:=Color and $FF;
G:=(Color shr 8)and $FF;
R:=(Color shr 16)and $FF;
for A:=0 to 255 do
with Table[255-A] do begin
rgbReserved:=A;
rgbBlue:=B*A div 255;
rgbGreen:=G*A div 255;
rgbRed:=R*A div 255;
end;
ProcessAlpha(Bmp.ScanLine[S.cy-1],@Table,S.cx*S.cy);
UpdateLayerWnd(Form1.Handle,Bmp.Canvas,Bounds(100,100,S.cx,S.cy));
finally
Bmp.Free;
end;
end;
procedure TForm1.FormCreate(Sender:TObject);
begin
// Font.Color:=clWhite;
SetWindowLong(Handle,GWL_EXSTYLE,GetWindowLong(Handle,GWL_EXSTYLE)or WS_EX_LAYERED or WS_EX_TRANSPARENT);
SetWindowPos(Handle,HWND_TOPMOST,0,0,0,0,SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);
DrawAlphaText(Canvas,0,0,'Test QWOBDGOB');
// UpdateLayerWnd(Handle,TiledImage1.Picture.Bitmap.Canvas,Bounds(100,100,TiledImage1.Width,TiledImage1.Height));
end;
procedure TForm1.WndProc(var Msg:TMessage);
begin
case Msg.Msg of
WM_NCHITTEST:Msg.Result:=HTCAPTION;
else
inherited;
end;
end;
end.
Основная проблема была получить полупрозрачный Antialising текста, без него можно было и на "регионах" всё это сделать.
Если вы заметили орфографическую ошибку на этой странице, просто выделите ошибку мышью и нажмите Ctrl+Enter. Функция может не работать в некоторых версиях броузеров.
