приложение 'Песочные часы"

[Anya13]

Помогите,пожалуйста,переделать код программы без помещения кнопок на форму(с использованием конструктора)

{$R *.dfm}
const PauseTime = 200;    {длительность паузы при прорисовке изображения}
      Count     = 50;    {количество песка в часах,  60 < Count < 125}
 
procedure Chasy(x,y:integer;cv:TCanvas);
var  i,j,k : integer; {переменные циклов}
begin
with cv do
 begin
  moveto(x+50, y+50);lineto(x+150,y+200);
  moveto(x+150,y+50);lineto(x+50,y+200);
  moveto(x+50,y+50);lineto(x+150,y+50);
  moveto(x+50,y+200);lineto(x+150,y+200);
  brush.Color:=clGray;
  rectangle(x+45, y+45, x+155, y+49);
  rectangle(x+45, y+201,x+155, y+206);
 {цикл рисования часов, каждый новый круг часы "переворачиваются"}
  {J = Count - верхняя граница линии песка, 125 - нижняя}
  for j := Count to 125 do
  for i := Round((2*j+50)/3)+1 to Round((2*j-550)/(-3))-1 do
  Pixels[x+i, y+j]:=clYellow; {рисуем песок}
  for k := 199 downto 199-Count do
  for i := Round((2*k-550)/(-3))+1 to Round((2*k+50)/3)-1 do
  Pixels[x+i, y+k]:=clBtnFace;         {стираем песок в нижнем конусе}
  j := 199;  {т.к. нижний конус кончается при y=200, чтобы не затереть его}
  k := Count;   {уменьшаем начальное значение J}
  while (j > 199-(125-Count)) and (k < 125) do
   begin
    {рисуем струю песка}
    for i := j downto 125 do
    if Random(10) < 6 then         {имитируем песчинки в струе песка}
    Pixels[x+100, y+i]:=clBtnFace else Pixels[x+100, y+i]:=clYellow;
   {рисуем полоску песка в нижнем конусе}
    for i := Round((2*j-550)/(-3))+1 to Round((2*j+50)/3)-1 do
    Pixels[x+i, y+j]:=clYellow;
   {стираем полоску песка в верхнем конусе (1)}
    for i := Round((2*k+50)/3)+1 to Round((2*k-550)/(-3))-1 do
    Pixels[x+i, y+k]:=clBtnFace;
   {стираем полоску песка в верхнем конусе (2)}
    for i := Round((2*(k+1)+50)/3)+1 to Round((2*(k+1)-550)/(-3))-1 do
    Pixels[x+i, y+k+1]:=clBtnFace;
    sleep(PauseTime);               {пауза и изменение переменных цикла}
    {уровень песка в верхнем конусе уменьшается быстрее, чем повышается}
    {его количество в нижнем}
    dec(j);
    inc(k, 2);
   end; {while}
 {завершение работы}
  for i := j downto 125 do         {cтираем струю песка}
  Pixels[x+100, y+i]:=clBtnFace;
 end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var x,y,i:integer;
BEGIN
 i:=0;
 repeat
 x:=clientwidth div 2-100;{координаты с учетом  размера экрана и размера часов}
 y:=clientheight div 2-155;
 Chasy(x,y,Form1.Canvas);{рисуем}
 i:=i+1;
 sleep(1000);
 until i=5;
end;

[D-mon]

Ну как-то так. Но есть одно но. Метод Start нужно вызывать асинхронно, а то все виснет, пока цикл не закончится.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TClock = class
  private
    FPauseTime: Integer;  {длительность паузы при прорисовке изображения}
    FCount: Integer;      {количество песка в часах,  60 < Count < 125}
    FOwner: TWinControl;
    procedure Chasy(x,y:integer;cv:TCanvas);
  public
    constructor Create(AOwner: TWinControl);
    procedure Start;
    property Count: Integer read FCount write FCount;
    property PauseTime: Integer read FPauseTime write FPauseTime;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
 
procedure TClock.Chasy(x,y:integer;cv:TCanvas);
var  i,j,k : integer; {переменные циклов}
begin
with cv do
 begin
  moveto(x+50, y+50);lineto(x+150,y+200);
  moveto(x+150,y+50);lineto(x+50,y+200);
  moveto(x+50,y+50);lineto(x+150,y+50);
  moveto(x+50,y+200);lineto(x+150,y+200);
  brush.Color:=clGray;
  rectangle(x+45, y+45, x+155, y+49);
  rectangle(x+45, y+201,x+155, y+206);
 {цикл рисования часов, каждый новый круг часы "переворачиваются"}
  {J = Count - верхняя граница линии песка, 125 - нижняя}
  for j := Count to 125 do
  for i := Round((2*j+50)/3)+1 to Round((2*j-550)/(-3))-1 do
  Pixels[x+i, y+j]:=clYellow; {рисуем песок}
  for k := 199 downto 199-Count do
  for i := Round((2*k-550)/(-3))+1 to Round((2*k+50)/3)-1 do
  Pixels[x+i, y+k]:=clBtnFace;         {стираем песок в нижнем конусе}
  j := 199;  {т.к. нижний конус кончается при y=200, чтобы не затереть его}
  k := Count;   {уменьшаем начальное значение J}
  while (j > 199-(125-Count)) and (k < 125) do
   begin
    {рисуем струю песка}
    for i := j downto 125 do
    if Random(10) < 6 then         {имитируем песчинки в струе песка}
    Pixels[x+100, y+i]:=clBtnFace else Pixels[x+100, y+i]:=clYellow;
   {рисуем полоску песка в нижнем конусе}
    for i := Round((2*j-550)/(-3))+1 to Round((2*j+50)/3)-1 do
    Pixels[x+i, y+j]:=clYellow;
   {стираем полоску песка в верхнем конусе (1)}
    for i := Round((2*k+50)/3)+1 to Round((2*k-550)/(-3))-1 do
    Pixels[x+i, y+k]:=clBtnFace;
   {стираем полоску песка в верхнем конусе (2)}
    for i := Round((2*(k+1)+50)/3)+1 to Round((2*(k+1)-550)/(-3))-1 do
    Pixels[x+i, y+k+1]:=clBtnFace;
    sleep(PauseTime);               {пауза и изменение переменных цикла}
    {уровень песка в верхнем конусе уменьшается быстрее, чем повышается}
    {его количество в нижнем}
    dec(j);
    inc(k, 2);
   end; {while}
 {завершение работы}
  for i := j downto 125 do         {cтираем струю песка}
  Pixels[x+100, y+i]:=clBtnFace;
 end;
end;
constructor TClock.Create(AOwner: TWinControl);
begin
  FOwner := AOwner;
  FPauseTime := 200;
  FCount := 50;
end;

procedure TClock.Start;
var x,y,i:integer;
begin
 i:=0;
 repeat
   x:=FOwner.clientwidth div 2-100;{координаты с учетом  размера экрана и размера часов}
   y:=FOwner.clientheight div 2-155;
   Chasy(x,y,Form1.Canvas);{рисуем}
   i:=i+1;
   sleep(1000);
 until i=5;
end;

procedure TForm1.Button1Click(Sender: TObject);
var clock: TClock;
begin
  clock := TClock.Create(Form1);
  try
    clock.Start;
  finally
    clock.Free;
  end;
end;

end.

[Anya13]

Огромное спасибо!!!! а раздела published не будет разве?

[D-mon]

А зачем? Просто что бы было? Почитайте про этот раздел и поймёте нужен ли он в данном случае.