文字だけ表示するフォーム
解決仕様は以下の通り
1)タイトルの通り、文字しか見えない
2)文字をクリックしてフォーム移動する
3)表示する文字は、数秒から十数秒単位で変更される
あるホームページからテキストを読んで表示します
付箋紙２１（http://www.roto21.net/pukiwiki/index.php）を使っていますが、
これの「プロパティ」−「透明」みたいなことをやりたいわけです。
このようなものを作る場合、リージョン（PathToRegion, CombineRgnとか）で、やってるんでしょうか？
それとも、他にテクニックありますか？
ラベルなどを貼ったフォームのBorderStyleをbsNoneにする
というのではダメなのでしょうか？
それとも文字の形のフォームを作成したいということでしょうか？
http://blog.livedoor.jp/junki560/archives/30287059.html
こちらの[３分で出来る非矩形フォーム]で
指定色を透明にしてしまえばいいのではないでしょうか？
非矩形なフォーム
というところでは、リージョンが使われているので
とても勉強になると思います。
> ラベルなどを貼ったフォームのBorderStyleをbsNoneにする
> というのではダメなのでしょうか？
なんか推敲しまくっているうちに、肝心なとこを消してしまったようです。
誤 1)タイトルの通り、文字しか見えない
正 1)タイトルの通り、文字しか見えない、背景を透過したフォーム
なので、BorderStyle = bsNone では、フォームの色が見えてしまうのでだめなのです。
> それとも文字の形のフォームを作成したいということでしょうか？
そうですね。
win2000以降でよければalphaブレンドで半透明までサポートしてます。
これによってアンチエイリアス対応の文字だけ表示が可能になりました。
これを希望するなら以前作ったサンプルうｐしますよ。
ちなみにネットを調べても見つかると思います。
> win2000以降でよければalphaブレンドで半透明までサポートしてます。
自分用ＰＣのＸＰ限定なのでＯＫです。
それで、ちょっと探してみました.
SetLayeredWindowAttributesを使ってAlphablendしてみたことはあったので、
ちょっと気になる「UpdateLayeredWindow」あたりで検索したところ
このページがヒット
http://www.geocities.jp/asumaroyuumaro/program/winapi/window.html#56
ここを読んだだけですが、カラーキーを透明色にして実行しておけばいいのでしょうか？
フォームの色をカラーキーにしておけば、それ以外の文字で透明化されると？
もにゃさん、よければサンプルお願いします。
Fusa さん
> http://blog.livedoor.jp/junki560/archives/30287059.html
ありがとうございます。
参考になります。
今まで、レスあったことに気がついていませんでした。
今更ながら、Delphi 5 を使っております・・・と報告（＾＾；）
これやったの４年前ですが
情報源がちゃんと書いてありました、えらいぞおれ！
リンク先は健在です。
//FDelphiより
//"不定形なフォーム(Windows2000専用)"
//http://delfusa.main.jp/delfusafloor/archive/www.nifty.ne.jp_forum_fdelphi/samples/01218.html
//
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormDblClick(Sender: TObject);
private
{ Private 宣言 }
BMP32:TBitmap;
public
{ Public 宣言 }
end;
function UpdateLayeredWindow(_hwnd:HWND; dstHDC:HDC; pptDst:PPoint;
ASize:PSize; srcHDC:HDC; pptSrc:PPoint; crKey:COLORREF;
var bf : BLENDFUNCTION; dwFlag:DWORD):BOOL; stdcall;
const
WS_EX_LAYERED = $80000;
LWA_COLORKEY = 1;
LWA_ALPHA = 2;
ULW_COLORKEY = 1;
ULW_ALPHA = 2;
ULW_OPAQUE = 4;
AC_SRC_ALPHA = 1;
function UpdateLayeredWindow;
external 'user32.dll' name 'UpdateLayeredWindow';
var
Form1: TForm1;
implementation
{$R *.dfm}
function MakeLayer(wHandle:HWND; LayerBmp:TBitmap):boolean;
var
bf : TBlendFunction;
zerop : TPoint;
formsz : TSize;
begin
result:=false;
with bf do begin
BlendOp:=AC_SRC_OVER;
BlendFlags:=0;
SourceConstantAlpha:=255; // 完全にALPHAをBITMAPに依存する場合
AlphaFormat:=AC_SRC_ALPHA;
end;
//２度め以降は不要？
SetWindowLong(wHandle, GWL_EXSTYLE, GetWindowLong(wHandle, GWL_EXSTYLE) or
WS_EX_LAYERED);
zerop.x:=0; zerop.y:=0;
formsz.cx:=LayerBmp.Width; formsz.cy:=LayerBmp.Height;
if not UpdateLayeredWindow(
wHandle, 0,
nil, // palleteを気にしないならnilでよろし
@formsz, // フォームの大きさの指定 : 必須！
LayerBmp.canvas.handle, // サーフェイスを定義するDC
@zerop, // サーフェイスを定義する画像の開始点
0, bf, ULW_ALPHA) then begin
ShowMessage(SysErrorMessage(GetLastError));
Exit;
end;
result:=true;
end;
procedure TForm1.Button1Click(Sender: TObject);
var x,y:integer;
P1,P2:PByteArray;
Alpha:Integer;
MaskBMP:TBitmap;
deg,i,p:Integer;
begin
deg:=30;
BMP32.Canvas.Font:=Label1.Font;
BMP32.Height:=BMP32.Canvas.TextHeight(Label1.Caption)+deg;
BMP32.Width :=BMP32.Canvas.TextWidth(Label1.Caption)+deg;
BMP32.Canvas.Brush.Style:=bsSolid;
BMP32.Canvas.Pen.Color:=clBlack;
BMP32.Canvas.Brush.Color:=clBlack;
BMP32.Canvas.Rectangle(0,0,BMP32.Width,BMP32.Height);
BMP32.Canvas.TextOut(0,0,Label1.Caption);
//マスクは32bitである必要ありません。(分かり易く今回は32bitです)
MaskBMP:=TBitmap.Create;
MaskBMP.Canvas.Font:=Label1.Font;
MaskBMP.Assign(BMP32);
MaskBMP.Canvas.Pen.Color:=clBlack;
MaskBMP.Canvas.Brush.Color:=clBlack;
MaskBMP.Canvas.Rectangle(0,0,MaskBMP.Width,MaskBMP.Height);
MaskBMP.Canvas.Brush.Style:=bsClear;
for i:=deg-1 downto 1 do
begin
p:= 255-round(255/deg)*i;
MaskBMP.Canvas.Font.Color:=RGB(p,p,p) ;
MaskBMP.Canvas.TextOut(i,i,Label1.Caption);
end;
MaskBMP.Canvas.Font.Color:=clWhite;
MaskBMP.Canvas.TextOut(0,0,Label1.Caption);
{形の元となるビットマップは、以下のことに気をつけてください。
R=255, G=127, B=63 の点を ALPHA=100(0なら透明、255なら不透明)
で抜きたいときは、32BIT BITMAPのその点のデータを
R = 255 * 100 div 255 = 100
G = 127 * 100 div 255 = 49
B = 63 * 100 div 255 = 24
Alpha = 100
にしてください。}
for Y:=0 to BMP32.Height-1 do
begin
P1 :=BMP32.ScanLine[y];
P2 :=MaskBMP.ScanLine[y];
for X:=0 to BMP32.Width -1 do
begin
//もっと美しく処理した方がいいと思いますが
//分かりやすいようにしてあります。
Alpha:=(P2[x*4+0 ] +
P2[x*4+1 ] +
P2[x*4+2 ]) div 3;
P1[x*4+0 ]:= P1[x*4+0 ] * Alpha div 255;
P1[x*4+1 ]:= P1[x*4+1 ] * Alpha div 255;
P1[x*4+2 ]:= P1[x*4+2 ] * Alpha div 255;
P1[x*4+3 ]:= Alpha;
end;
end;
MakeLayer(Handle, BMP32);
ClientHeight:=BMP32.Height;
ClientWidth :=BMP32.Width;
MaskBMP.Free;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
BMP32:=TBitmap.Create;
BMP32.PixelFormat:=pf32bit;
FormStyle:=fsStayOnTop;
BorderStyle:=bsNone;
Label1.Font.Size:=22;
Label1.Font.Color:=clRed;
Label1.Caption:='東京都特許許可局';
Label1.OnDblClick:=FormDblClick;
OnDblClick :=FormDblClick;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
BMP32.Free;
end;
procedure TForm1.FormDblClick(Sender: TObject);
begin
Close;
end;
end.
もにゃさんありがとうございます。
ちょっと試してみましたが、UpdateLayeredWindowで
「ハンドルが無効です(GetLastError = 6)」とか
「パラメータが間違っています(GetLastError=87)」とか出て、
思った動作になりません。
もにゃさんが参考にしたリンク先では、画像ファイルをロードしてやっている
ことから、単純に画像にTextOutしたものを作成し、MakeLayerに渡しました。
だから、この程度のコードです
bmp := TBitmap.Create;
bmp.PixelFormat := pf32bit;
bmp.Width := ClientWidth;
bmp.Height := ClientHeight;
bmp.Canvas.TextOut(Label1.Left, Label1.Top, Label1.Caption);
MakeBitmapLayer(Handle, bmp);
1)GetLastError=87 が出るのは、SetLayeredWindowAttributesを使ってしまっていたとき。
2)GetLastError = 6 が出るのは、使わなかったとき。
今は、じっくり腰を落ち着けてやる時間がないので、また後日試してみます。
何か報告できることがあれば報告しますが、とりあえず解決にして、がんばります。
ありがとうございました。
うそ書いた(^^;)
> 2)GetLastError = 6 が出るのは、使わなかったとき。
これは、勘違いでした。
エラーじゃないときにもGetLastErrorしてました。
エラーにならずにできていました。
ホントに解決とします。
Formのプロパティを設定するだけで・・・・
BorderStyle := bsNone
TransparentColor := True;
TransparentColorValue := フォームの色
D5では、TransparentColor はなかった気がするのと
切り抜かれた文字部分を、タイトルバーみたいに
ドラッグしてFormが動かせるように、
WM_NCHITTEST を処理するコードを
書く必要がありそうですね。
KHE00221さん、Fusaさんレスありがとうございます。
D5にTransparentColorはありません。
ちょっとしたプログラムなので、D6Personalとか、TurboDelphiExplorerなら、
簡単に済ませることができそう・・・と、思ったので、試しにD6Personalでやってみたところ、
なんとも簡単にできてしまいましたorz
UpdateLayeredWindowの使い方も勉強になったし、今は満足しています。
そして、どうも、複雑に考えすぎていたようです。
今回フォームには、TLabelしかないのですが、以下の６行で済みました。
const
WS_EX_LAYERED = $80000;
LWA_COLORKEY = 1;
exStyle := GetWindowLong(aHandle, GWL_EXSTYLE);
SetWindowLong(Handle, GWL_EXSTYLE, exStyle or WS_EX_LAYERED);
SetLayeredWindowAttributes(Handle, 透過する色, 255, LWA_COLORKEY);
もっと高度な処理をする場合に、UpdateLayeredWindowが必要になるようですね。
UpdateLayeredWindowでは半透明を表現できます。
これは単に文字に影をつけるのにも有効ですし、
アンチエイリアス処理された文字の場合、
背景と文字の中間色を表現できます。
日本語だとメイリオしかサポートされてませんが、
MSゴシックを必要以上に大きく描画して、バイキュービック法等で縮小してやると仮想アンチエイリアスが可能です。
ちなみに、サンプルコピペで動かなかったのですかね？
環境を教えていただければできる限り対応してみます。
もにゃさん、再度のレスありがとうございます。
# 後日と言いつつ、しっかりここに張り付いている俺(^^;)
> ちなみに、サンプルコピペで動かなかったのですかね？
> 環境を教えていただければできる限り対応してみます。
サンプルはコピペしていないです。
理解不十分のままでしたが、もにゃさんのサンプルはじめ、ネットに転がっている
各種サンプルを参考にしながら、適当なBitmapを使ってテストしたり、
自分でBitmapを動的に作成してやったり、いろいろテストしました。
使い方とか勘違いとかいろいろありましたが、最終的に、文字まで
半透明にする必要ないかな？ということで、解決としました。
また今度、このあたりでこだわりをみせたいときがあり、わからないことがあれば、
別で質問あげるので、よければおつきあいください。
# 「仮想アンチエイリアス」とか、おもしろそうだけど、
# そこまで遊んでる時間がなくて・・・
| ツイート |  |