// Quadratische
Matrix kippen/spiegeln.
// Getestet mit D2010 unter
Win7
//
Variante 1
// Lassen Sie sich nicht täuschen, die Belegung
der Matrix geschieht
// senkrecht. Deshalb der Zugriff auch als "alt[y, x]"
und nicht
// als
"alt[x,
y]"
!
const
max = 5; // beispielsweise
zahl = max - 1;
type
ar = array [0 .. zahl, 0 .. zahl] of byte;
var
alt: ar = ((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));
neu: ar;
procedure flipr; // 90° nach rechts kippen
var
i, j: integer;
begin
for i := 0 to zahl do
for j := 0 to zahl do
neu[i, j] := alt[zahl - j, i];
end;
procedure flipl; // 90° nach links kippen
var
i, j: integer;
begin
for i := 0 to zahl do
for j := 0 to zahl do
neu[i, j] := alt[j, zahl - i];
end;
procedure flipb; // 180° drehen
var
i, j: integer;
begin
for i := 0 to zahl do
for j := 0 to zahl do
neu[i, j] := alt[zahl - i, zahl - j];
end;
procedure flipws; // waagerecht zu senkrecht
var
i, j: integer;
begin
for i := 0 to zahl do
for j := 0 to zahl do
neu[i, j] := alt[j, i];
end;
procedure flips; // senkrecht spiegeln
var
i, j: integer;
begin
for i := 0 to zahl do
for j := 0 to zahl do
neu[i, j] := alt[zahl - i, j];
end;
procedure flipw; // waagerecht spiegeln
var
i, j: integer;
begin
for i := 0 to zahl do
for j := 0 to zahl do
neu[i, j] := alt[i, zahl - j];
end;
// Beispiel + Anzeige
procedure TForm2.Button1Click(Sender: TObject);
var
x, y: integer;
begin
for x := 0 to zahl do
for y := 0 to zahl do
canvas.textout(10 + x * 20, y * 20, inttostr(alt[y, x]));
flipb;
move(neu, alt, sizeof(alt));
for x := 0 to zahl do
for y := 0 to zahl do
canvas.textout(x * 20 + 150, y * 20, inttostr(alt[y, x]));
end;
// -----------------------------------------------------
// Variante 2
// Hier wird die Matrix tatsächlich waagerecht belegt.
// Bei Anwendung von flipr, flipl, flipw and flips geschieht
// genau das Gegenteil (statt nach rechts kippen - nach links usw).
// Der Zugriff erfolgt diesmal über "alt[x, y]" !
procedure TForm2.Button2Click(Sender: TObject);
var
x, y: integer;
begin
// --- belegen -----------------------
for y := 0 to zahl do
for x := 0 to zahl do
alt[x, y] := y * zahl + x + y + 1;
// -----------------------------------
for x := 0 to zahl do
for y := 0 to zahl do
canvas.textout(10 + x * 20, 10 + y * 20, inttostr(alt[x, y]));
flipl;
move(neu, alt, sizeof(alt));
for x := 0 to zahl do
for y := 0 to zahl do
canvas.textout(x * 20 + 150, 10 + y * 20, inttostr(alt[x, y]));
end;
// Mann kann auch
beispielsweise nur Zeilen kippen lassen. Dabei
// haben dann aber alle anderen Stellen indifferente Werte und dürfen
// nicht mehr beachtet werden:
procedure flipzu(z: byte); // Zeilen im Uhrzeigersinn
var
i, j: integer;
begin
for i := 0 to zahl do
for j := 0 to zahl do
neu[i, j] := alt[j, zahl - i - max + z];
end;
procedure TForm2.Button2Click(Sender: TObject);
var
x, y, z: integer;
begin
// --- belegen -----------------------
for y := 0 to zahl do
for x := 0 to zahl do
alt[x, y] := y * zahl + x + y + 1;
// -----------------------------------
z := 2; // z.B. zwei Zeilen
for x := 0 to zahl do
for y := 0 to zahl do
begin
if y < z then
begin
Canvas.Font.Color := clred;
Canvas.Font.Style := [fsBold];
end
else
begin
Canvas.Font.Color := clSilver;
Canvas.Font.Style := [];
end;
Canvas.textout(10 + x * 20, 10 + y * 20, inttostr(alt[x, y]));
end;
flipzu(z);
move(neu, alt, sizeof(alt));
for x := 0 to zahl do
begin
if x < z then
begin
Canvas.Font.Color := clred;
Canvas.Font.Style := [fsBold];
end
else
begin
Canvas.Font.Color := clSilver;
Canvas.Font.Style := [];
end;
for y := 0 to zahl do
Canvas.textout(x * 20 + 150, 10 + y * 20, inttostr(alt[x, y]));
end;
end;
|