Einzelnen Beitrag anzeigen

Hamsterpower

Registriert seit: 17. Jun 2007
17 Beiträge
 
#26

Re: Gleiches Image in Array speichern

  Alt 20. Jun 2007, 20:19
Hier ^^

Delphi-Quellcode:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus, ExtCtrls;

const
  x=400;
  y=246;

type
  MyImage = record
    Zahl:Integer;
    Bild:TImage;
  end;

  TForm1 = class(TForm)
    Label1: TLabel;
    Button1: TButton;
    Image2: TImage;
    Image3: TImage;
    Image4: TImage;
    Image5: TImage;
    Image6: TImage;
    Bevel1: TBevel;
    Image1: TImage;
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Button1Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Richtung:integer=0;
  i:integer=0;
  xk:integer=1;
  yk:integer=1;
  run:boolean;
  start:boolean=false;
  Bmpfeld: array[0..30,0..50] of MyImage;
 // self:Tform1;

implementation

{$R *.dfm}


procedure Kopfposrunter(x,y:integer);
var i,j:shortint;
begin
for i:=0 to 6 do
  for j:=0 to 6 do
    with form1.Image1.Picture.Bitmap.Canvas do
      begin
        Pixels[x+i,y+j] :=form1.Image5.Picture.Bitmap.Canvas.Pixels[i,j];
      end;
end;


procedure Kopfposhoch(x,y:integer);
var i,j:shortint;
begin
for i:=0 to 6 do
  for j:=0 to 6 do
    with form1.Image1.Picture.Bitmap.Canvas do
      begin
        Pixels[x+i,y+j] :=form1.Image4.Picture.Bitmap.Canvas.Pixels[i,j];
      end;
end;


procedure Kopfposrechts(x,y:integer);
var i,j:shortint;
begin
for i:=0 to 6 do
  for j:=0 to 6 do
    with form1.Image1.Picture.Bitmap.Canvas do
      begin
        Pixels[x+i,y+j] :=form1.Image2.Picture.Bitmap.Canvas.Pixels[i,j];
      end;
end;

procedure Kopfposlinks(x,y:integer);
var i,j:shortint;
begin
for i:=0 to 6 do
  for j:=0 to 6 do
    with form1.Image1.Picture.Bitmap.Canvas do
      begin
        Pixels[x+i,y+j] :=form1.Image3.Picture.Bitmap.Canvas.Pixels[i,j];
      end;
end;

procedure Weiter;
var x_,y_:integer;
begin
bmpfeld[1,4].bild := TImage.Create(self);
bmpfeld[1,4].Bild.Assign(form1.Image4);
            bmpfeld[1,4].Bild.Top:=(21);
            bmpfeld[1,4].Bild.Left:=(81);
            bmpfeld[1,4].Bild.BringToFront;
            bmpfeld[1,4].Bild.Visible:=true;


  while run=true do
  begin
    if (xk<x-7) and (richtung=3) then xk:=xk+7;
    if (yk<y-7) and (richtung=2) then yk:=yk+7;
    if (xk>1) and (richtung=1) then xk:=xk-7;
    if (yk>1) and (richtung=4) then yk:=yk-7;
    case richtung of
      1: kopfposlinks(xk,yk);
      2: kopfposrunter(xk,yk);
      3: kopfposrechts(xk,yk);
      4: kopfposhoch(xk,yk);
    end;
    sleep(10);


    Application.ProcessMessages;
  end;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if chr(Key) = 'Athen
    Richtung := 1;
  if chr(Key) = 'Sthen
    Richtung := 2;
  if chr(Key) = 'Dthen
    Richtung := 3;
  if chr(Key) = 'Wthen
    Richtung := 4;
  if chr(Key) = 'Qthen
    run:=false;
  if Key = VK_ESCAPE then
    begin
      run:=false;
      form1.close;
    end;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
x_,y_:integer;
begin
  Image1.Width := x;
  Image1.Height := y;
  Image1.Picture.Bitmap.PixelFormat := pf24bit;
  Image1.Picture.Bitmap.Width := x;
  Image1.Picture.Bitmap.Height := y;

  if start=false then
    begin
      start:=true;
      form1.Bevel1.Width:=x+2;
      form1.Bevel1.Height:=y+2;
{      for x_:=0 to 30 do
        for y_:=0 to 50 do
          begin
            bmpfeld[x_,y_].Bild:=form1.Image3;
            bmpfeld[x_,y_].Bild.Top:=(y_*7+10);
            bmpfeld[x_,y_].Bild.Left:=(x_*7+10);
            bmpfeld[x_,y_].Bild.BringToFront;
            bmpfeld[x_,y_].Bild.Visible:=true;
          end;      }

      form1.Bevel1.Visible:=true;
    end;
  run:=true;
  weiter;

end;

end.
  Mit Zitat antworten Zitat