Tips (1541)

Tip Bewertung (3):

function TileImage(const FileName: TFileName; Sender: TObject): Boolean;
var
  x, y: Integer;
  Bmp:  TBitmap;
begin
  if FileExists(FileName) then
  begin
    bmp := TBitmap.Create;
    try
      bmp.LoadFromFile(FileName);
      with (Sender as TImage) do
      begin
        for x := 0 to (Width div bmp.Width) do
          for y := 0 to (Height div bmp.Height) do
            Canvas.Draw(x * bmp.Width, y * bmp.Height, bmp);
      end;
    finally
      bmp.Free;
    end;
    Result := True;
  end
  else
    Result := False;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if Opendialog1.Execute then
    TileImage(OpenDialog1.FileName, Image1);
end;