16番会議室「玉石混淆みんなで作るSample蔵」に寄せられたサンプル
"RE^2:グラデーション文字2"
この発言は #00438 Fermion さんのRE:グラデーション文字2 に対するコメントです
クリップリージョンの廃棄に問題がありそうなので、、(((^^;)
m(_"_)m
■サンプルコード
//=====================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
Rect, GRect : TRect;
W, H,
i : Integer;
Txt : String;
StartColor, EndColor : TColor;
RStep, GStep, BStep : Extended;
R, G, B : Byte;
Rgn : HRGN;
begin
Txt := '★ぐらで〜しょん???★';
Rect := ClientRect;
with Canvas do begin
with Font do begin
Name := 'MS P明朝'; Size := 32;
Style := Style + [fsBold];
end;
W := TextWidth( Txt ); H := TextHeight( Txt );
with Rect do begin
TopLeft := Point((Right - Left - W ) div 2,
( Bottom - Top - H ) div 2 );
BottomRight := Point( Left + W, Top + H );
end;
StartColor := clYellow;//$00FF0080;
EndColor := clBlack;//$004080FF;
R := GetRValue( StartColor );
G := GetGValue( StartColor );
B := GetBValue( StartColor );
RStep := ( GetRValue( EndColor ) - R ) / H;
GStep := ( GetGValue( EndColor ) - G ) / H;
BStep := ( GetBValue( EndColor ) - B ) / H;
SetBkMode( Handle, TRANSPARENT );
BeginPath( Handle );
DrawText( Handle, PChar( Txt ), -1, Rect,
DT_SINGLELINE or DT_VCENTER or DT_CENTER );
EndPath( Handle );
Rgn := PathToRegion( Handle );
try
if SelectClipRgn( Handle, Rgn ) <= NULLREGION then Exit;
GRect.TopLeft := Rect.TopLeft;
GRect.BottomRight := Point( Rect.Right, GRect.Top + 1 );
for i := 0 to H do begin
Brush.Color := TColor( RGB( R + Trunc( RStep * i ),
G + Trunc( GStep * i ),
B + Trunc( BStep * i ) ) );
FillRect( GRect );
Inc( GRect.Top );
Inc( GRect.Bottom );
end;
SelectClipRgn( Handle, 0 );
finally
DeleteObject( Rgn );
end;
end;
end;
//=====================================================================
98/03/13(金) 00:41 Fermion [KHF03264]
Original document by Fermion 氏 ID:(KHF03264)
ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。
Copyright 1996-2002 Delphi Users' Forum
|