|
2010/2/11 (木) 18:19:55 Mr.XRAY |
▼ KSCさん
> フォームファイルがあると、そんなに厄介なのですか？
厄介ですね (^^)
>変わった形のメインフォームを作りたくて、フォームをリージョンするコンポーネントを
>探しています。
簡単のでしたら，自分で作成してしまうのも手かも知れません．
// 逆三角形のフォーム
procedure TForm1.FormCreate(Sender: TObject);
var
Rgn1 : HRgn;
pntXY : array [0..3] of TPoint;
begin
{ 多角形の作成 }
pntXY[0].x := 0;
pntXY[0].y := 0;
pntXY[1].x := width div 2;
pntXY[1].y := height;
pntXY[2].x := width;
pntXY[2].y := 0;
pntXY[3].x := 0;
pntXY[3].y := 0;
{ リージョンの割り当て }
Rgn1 := CreatePolygonRgn(pntXY, 3, Winding);
SetWindowRgn(Handle, Rgn1, True);
end;
複雑な形のはパスを使うしかないです．
これは文字の輪郭を切り取っています．
http://mrxray.on.coocan.jp/Halbow/VCL01.html#VChap1-7
ウィンドウを四角以外の形にする
http://www.geocities.jp/asumaroyuumaro/program/tips/setwindowrgn.html
Bitmapから画像の形のリージョンを得る
http://www.geocities.jp/asumaroyuumaro/program/tips/createregionfrombitmap.html
丸いフォームとか...
unit SetWindowRegionU;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls;
type
TForm1 = class(TForm)
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
end;
var
Form1: TForm1;
OriginX, OriginY: Integer; // holds the center coordinates of the window
implementation
uses Math;
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
var
NewShape: HRGN; // holds the region
begin
{create a circular region}
NewShape := CreateEllipticRgn(GetSystemMetrics(SM_CXBORDER)+3,
GetSystemMetrics(SM_CYCAPTION)+3,
GetSystemMetrics(SM_CXBORDER)+103,
GetSystemMetrics(SM_CYCAPTION)+103);
{determine the center of the circle. this is used when drawing the numbers
of the clock}
OriginX := (GetSystemMetrics(SM_CXBORDER)+90) div 2;
OriginY := ((GetSystemMetrics(SM_CXBORDER)+90) div 2)-3;
{set the window region to the circular region. this will create
a round window}
SetWindowRgn(Handle, NewShape, TRUE);
end;
procedure TForm1.FormPaint(Sender: TObject);
var
iCount: Integer; // a general loop control variable
Hour, Minute, Second, MilSec: Word; // used to decode the time
begin
{set the background mode to transparent for drawing text}
SetBkMode(Canvas.Handle, TRANSPARENT);
{draw a highlighted bevel}
Canvas.Pen.Color := clWhite;
Canvas.Pen.Width := 2;
Arc(Canvas.Handle, 1, 1, 98, 98, 98, 1, 1, 98);
{draw a shadowed bevel}
Canvas.Pen.Color := clBtnShadow;
Arc(Canvas.Handle, 1, 1, 98, 98, 1, 98, 98, 1);
{for every hour of the day...}
for iCount := 1 to 12 do
begin
{...draw an hour measurement in a circular form around the window}
Canvas.TextOut(Trunc(Sin(((360/12)*iCount)*(PI/180))*40)+OriginX,
Trunc(-Cos(-((360/12)*iCount)*(PI/180))*40)+OriginY,
IntToStr(iCount));
end;
{retrieve the current time in a useable format}
DecodeTime(Now, Hour, Minute, Second, MilSec);
{translate military hours to civilian hours}
if Hour>12 then Hour := Hour-12;
{draw the hour hand}
Canvas.Pen.Color := clBlack;
Canvas.MoveTo(50, 50);
Canvas.LineTo(Trunc(Sin(((360/12)*Hour)*(PI/180))*30)+50,
Trunc(-Cos(-((360/12)*Hour)*(PI/180))*30)+50);
{draw the minutes hand}
Canvas.MoveTo(50, 50);
Canvas.LineTo(Trunc(Sin(((360/60)*Minute)*(PI/180))*40)+50,
Trunc(-Cos(-((360/60)*Minute)*(PI/180))*40)+50);
{draw the seconds hand}
Canvas.Pen.Color := clRed;
Canvas.MoveTo(50, 50);
Canvas.LineTo(Trunc(Sin(((360/60)*Second)*(PI/180))*40)+50,
Trunc(-Cos(-((360/60)*Second)*(PI/180))*40)+50);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
{repaint the form once per second}
Repaint;
end;
procedure TForm1.WMNCHitTest(var Msg: TWMNCHitTest);
begin
{this allows the user to drag the window by clicking anywhere on the form}
inherited;
Msg.Result := HTCAPTION;
end;
end.
 |
|