| 1.Ņ........ 2. ... 2.1) ..... 2.2) 2.3) . 2.4) .. 3.Ņ.......... 4. ۅ. 5.Ņ. |
- Delphi, Object Pascal. Delphi .
. , Windows. , , , . .
- . " ", . , . , . , , .
. .
.
-
.
. TCustomControl, .
, :
|
|
|
.
private, protected, public published . , :
Private. , , private, . , . , , .
Protected. , protected , . , . protected .
Public. , public - . .
Published. , , published, . . , , , real, .
.
2.4.1
1. .
2. .
3. .
4. .
.
.
, .
- . . , .
Delphi 7.
1. ., . Delphi. , : -, 2004. 233 .
2. . . Delphi 4. . .: , 1998.
3. . . Delphi, . .: , 2007. 720.: .
4. .., .. Delphi . : BHV--, 1996. 352 .
unit Pazle;
interface
uses
windows, SysUtils, Classes, Controls, graphics, Dialogs, forms, StdCtrls,
Messages, ExtCtrls;
type
TPazle = class(TCustomControl)
private
FColCount: integer;
FRowCount: integer;
FCut: boolean;
FBitmap:TBitmap;
procedure SetColCount(const Value: integer);
procedure SetRowCount(const Value: integer);
procedure SetCut(const Value: boolean);
|
|
|
procedure SetBitmap(const Value: TBitmap);
protected
procedure Paint; override;
procedure CheckRight;
public
Complete:boolean;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Bitmap: TBitmap read FBitmap write SetBitmap;
property ColCount: integer read FColCount write SetColCount;
property RowCount: integer read FRowCount write SetRowCount;
property Cut: boolean read FCut write SetCut;
end;
TPiece = class(TCustomControl)
private
FX: Integer;
FY: Integer;
protected
procedure WMNCHitTest(var Message:TMessage); message WM_NCHITTEST;
procedure Paint; override;
function IsOnPlace:Boolean;
procedure WMMOVE(var Message:TMessage); message WM_MOVE;
public
property X:Integer read FX write FX;
property Y:Integer read FY write FY;
published
end;
procedure Register;
implementation
uses Variants, Types;
procedure Register;
begin
RegisterComponents('Game', [TPazle, TPiece]);
end;
var
lPiece:TPiece;
{ TPazle }
procedure TPazle.CheckRight;
var
i:integer;
a:boolean;
begin
a:=true;
for i:= ComponentCount - 1 downto 0 do
begin
with Components[i] as TPiece do
begin
a:=a and IsOnPlace;
end;
end;
if a then
Complete:=true;
end;
constructor TPazle.Create(AOwner: TComponent);
begin
inherited;
width:= 300;
Height:= 300;
color:=clGray;
FBitmap:=TBitmap.Create;
FColCount:= 2;
FRowCount:= 2;
Cut:= False;
end;
destructor TPazle.Destroy;
begin
FBitmap.Free;
inherited;
end;
procedure TPazle.Paint;
begin
inherited;
if not FCut then
Canvas.StretchDraw(ClientRect, FBitmap);
canvas.Brush.Color:=clBlack;
Canvas.FrameRect(ClientRect);
if Complete and lPiece.IsOnPlace then
ShowMessage(' !');
Complete:=false;
end;
procedure TPazle.SetBitmap(const Value: TBitmap);
begin
FBitMap.Assign(Value);
Invalidate;
end;
procedure TPazle.SetColCount(const Value: integer);
begin
FColCount:= Value;
end;
procedure TPazle.SetCut(const Value: boolean);
var
c, r: integer;
dx,dy:Integer;
begin
FCut:= Value;
if Cut then
begin //
dx:=ClientWidth div ColCount;
dy:=ClientHeight div RowCount;
for c:= 0 to ColCount - 1 do
for r:= 0 to RowCount - 1 do
begin
lPiece:= TPiece.Create(self);
lPiece.Parent:= self;
lPiece.Width:=dx;
lPiece.Height:=dy;
lPiece.X:=C;
lPiece.Y:=R;
lPiece.Left:= Random(ClientWidth);
lPiece.Top:= Random(ClientHeight);
end;
end
else
begin
for c:= ComponentCount - 1 downto 0 do
Components[c].Free;
end;
Invalidate;
end;
procedure TPazle.SetRowCount(const Value: integer);
begin
FRowCount:= Value;
end;
{ TPiece }
function TPiece.IsOnPlace: Boolean;
begin
Result:=(Left=(X*ClientWidth)) and (top=(Y*ClientHeight));
end;
procedure TPiece.Paint;
var dx, dy:Integer;
begin
inherited;
Canvas.Brush.Color:=clBlack;
dx:=TPazle(Owner).FBitmap.Width div TPazle(Owner).ColCount;
dy:=TPazle(Owner).FBitmap.Height div TPazle(Owner).RowCount;
Canvas.CopyRect(ClientRect,TPazle(Owner).FBitmap.Canvas, Rect(dx*x,dy*y, dx*(x+1), dy*(y+1)));
Canvas.FrameRect(ClientRect);
end;
procedure TPiece.WMMOVE(var Message: TMessage);
var
xx,yy:integer;
begin
xx:=X*ClientWidth;
yy:=Y*ClientHeight;
if abs(Message.LParamLo-xx)<=8 then Left:=xx; //
if abs(Message.LParamHi-yy)<=8 then top:=yy; //
IsOnPlace;
TPazle(owner).CheckRight;
end;
procedure TPiece.WMNCHitTest(var Message: TMessage);
begin
Message.Result:=
DefWindowProc(Handle, Message.Msg, Message.WParam, Message.LParam);
if Message.Result=HTCLIENT then Message.Result:=HTCaption;
|
|
|
end;
end.
