unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TPlatzrecord=Record
x:Integer;
y:Integer;
b:Double;
h:Double;
farbe:TColor;
Nr:Integer;
End;
TPlatzrecordArray=Array
of TPlatzrecord;
TForm1 =
class(TForm)
Button1: TButton;
PaintBox1: TPaintBox;
procedure Button1Click(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
private
{ Private-Deklarationen }
public
FPlatzrecordArray:TPlatzrecordArray;
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
const
cColor:
Array [0..9]
of TColor=(clred,clBlue,cllime,clYellow,clmaroon,clSilver,clGray,clNavy,clBlack,clWhite);
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
x,y:Integer;
begin
SetLength(FPlatzrecordArray,200);
for x := 0
to 9
do
for y := 0
to 19
do
begin
FPlatzrecordArray[y*10 + x].x := x;
FPlatzrecordArray[y*10 + x].y := y;
FPlatzrecordArray[y*10 + x].nr := y*10 + x;
FPlatzrecordArray[y*10 + x].h := 0.8;
FPlatzrecordArray[y*10 + x].b := 0.7;
FPlatzrecordArray[y*10 + x].Farbe := cColor[y
div 2];
end;
PaintBox1.Invalidate;
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
var
scale:Double;
x,y:Integer;
c:TCanvas;
r:TRect;
begin
if High(FPlatzrecordArray)<>199
then Exit;
Scale := paintBox1.Width / 20;
if paintBox1.height / 20 < Scale
then Scale := paintBox1.height / 20;
c := PaintBox1.Canvas;
for x := 0
to 9
do
for y := 0
to 19
do
begin
r.Left := round(FPlatzrecordArray[y*10 + x].x * scale);
r.Top := round(FPlatzrecordArray[y*10 + x].y * scale);
r.Right := r.Left + round(FPlatzrecordArray[y*10 + x].b * scale);
r.Bottom := r.Top + round(FPlatzrecordArray[y*10 + x].h * scale);
c.Brush.Color := FPlatzrecordArray[y*10 + x].Farbe;
c.FillRect(r);
c.Rectangle(r.Left,r.Top,r.Right,r.Bottom);
c.TextOut(r.Left + (r.Right - r.Left - c.TextWidth(IntToStr(FPlatzrecordArray[y*10 + x].nr)))
div 2,
r.top + (r.bottom - r.top - c.TextHeight(IntToStr(FPlatzrecordArray[y*10 + x].nr)))
div 2,
IntToStr(FPlatzrecordArray[y*10 + x].nr));
end;
end;
end.