1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86:
| unit Unit1;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls;
type THaus=Class(TObject) Private FWidth, FHeight:Integer; FColor:TColor; FOrigin:TPoint; Public Constructor Create; Property Color:TColor read FColor Write FColor; Property Height:Integer read FHeight Write FHeight; Property Width:Integer read FWidth Write FWidth; Property Origin:TPoint read FOrigin write FOrigin; Procedure Paint(Canvas:TCanvas); End;
TForm1 = class(TForm) Image1: TImage; Button1: TButton; procedure Button1Click(Sender: TObject); private public end;
var Form1: TForm1;
implementation
{$R *.dfm}
constructor THaus.Create; begin Width := 100; Height := 100; Color := clBlue; end;
procedure THaus.Paint(Canvas:TCanvas); begin Canvas.Pen.Color := FColor; Canvas.Rectangle( FOrigin.X , FOrigin.Y + (Height div 2) , FOrigin.X + Width , FOrigin.Y + (Height div 2) + Height ); Canvas.MoveTo(FOrigin.X, FOrigin.Y + (Height div 2)); Canvas.LineTo( FOrigin.X + (Width div 2), FOrigin.Y); Canvas.LineTo( FOrigin.X + Width, FOrigin.Y + (Height div 2)); end;
procedure TForm1.Button1Click(Sender: TObject); var p:TPoint; begin With THaus.Create do begin Paint(image1.Canvas); p.X := 100; p.Y := 120; Origin:=p; Color := clRed; Width := 50; Paint(image1.Canvas); Free;
end; end;
end. |