[jaguar16rus]

Сообщение от Страдалецъ

Выкладываю исходняк.

Код:

unit Unit27;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Buttons, StdCtrls, ToolWin, ActnMan, ActnCtrls, ActnList, PlatformDefaultStyleActnCtrls, ComCtrls;

type
  TBubble = class
   Size: TPoint;
   Pos: TPoint;
   constructor Create;
   procedure PullUp;
   procedure Paint;
   procedure Free;
  end;

  TForm27 = class(TForm)
    PaintBox1: TPaintBox;
    Button1: TButton;
    BubbleTimer: TTimer;
    Label1: TLabel;
    TrackBar1: TTrackBar;
    HotTimer: TTimer;
    Label2: TLabel;
    procedure PaintBox1Paint(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure BubbleTimerTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure HotTimerTimer(Sender: TObject);
  private
    ABubbles: Array of TBubble;
  end;

Const H = 400;
      W = 400;
      D = 10;
      PX = 50;
      PY = 50;
      T = 1;
      R = 25;
var
  Form27: TForm27;

implementation

{$R *.dfm}

procedure TForm27.Button1Click(Sender: TObject);
begin
 if Button1.Caption = 'Выкл.'
 then begin
      PaintBox1.Canvas.Brush.Color := clBlack;
      Button1.Caption := 'Вкл.';
      TrackBar1.Position := 20;
      end
 else begin
      PaintBox1.Canvas.Brush.Color := clRed;
      Button1.Caption := 'Выкл.';
      TrackBar1.Position := 100;
      end;
 PaintBox1.Canvas.Brush.Style := bsSolid;
 PaintBox1.Canvas.FillRect(Rect(PX,PY+H+3*D,PX+W+4*D,PY+H+4*D));
end;

procedure TForm27.FormCreate(Sender: TObject);
begin
 SetLength(ABubbles, 0);
end;

procedure TForm27.HotTimerTimer(Sender: TObject);
begin
 if TrackBar1.SelEnd > TrackBar1.Position
 then TrackBar1.SelEnd := TrackBar1.SelEnd - 1
 else TrackBar1.SelEnd := TrackBar1.SelEnd + 1;
 if TrackBar1.Position = TrackBar1.SelEnd
 then HotTimer.Enabled := False;
 Label2.Caption := IntToStr(TrackBar1.SelEnd)+#$B0;
end;

procedure TForm27.PaintBox1Paint(Sender: TObject);
begin
 // Кастрюлька
 PaintBox1.Canvas.Pen.Width := T;
 PaintBox1.Canvas.Pen.Color := clBlack;
 PaintBox1.Canvas.MoveTo(PX,PY);
 PaintBox1.Canvas.LineTo(PX+D,PY+D);
 PaintBox1.Canvas.LineTo(PX+D,PY+H+D);
 PaintBox1.Canvas.LineTo(PX+2*D,PY+H+2*D);
 PaintBox1.Canvas.LineTo(PX+2*D+W,PY+H+2*D);
 PaintBox1.Canvas.LineTo(PX+3*D+W,PY+H+D);
 PaintBox1.Canvas.LineTo(PX+3*D+W,PY+D);
 PaintBox1.Canvas.LineTo(PX+4*D+W,PY);

 PaintBox1.Canvas.LineTo(PX+3*D+W,PY);
 PaintBox1.Canvas.LineTo(PX+2*D+W,PY+D);
 PaintBox1.Canvas.LineTo(PX+2*D+W,PY+H+D);
 PaintBox1.Canvas.LineTo(PX+2*D,PY+H+D);
 PaintBox1.Canvas.LineTo(PX+2*D,PY+D);
 PaintBox1.Canvas.LineTo(PX+D,PY);
 PaintBox1.Canvas.LineTo(PX,PY);

 PaintBox1.Canvas.Brush.Style := bsBDiagonal;
 PaintBox1.Canvas.Brush.Color := clRed;
 PaintBox1.Canvas.FloodFill(PX+D+T+1,PY+D,clBlack,fsBorder);
 // Жидкость
 PaintBox1.Canvas.Brush.Style := bsSolid;
 PaintBox1.Canvas.Brush.Color := clAqua;
 PaintBox1.Canvas.FillRect(Rect(PX+2*D+T,PY+3*D-T,PX+W+2*D,PY+H+D));
 // Плитка
 PaintBox1.Canvas.Brush.Style := bsSolid;
 PaintBox1.Canvas.Brush.Color := clBlack;
 PaintBox1.Canvas.FillRect(Rect(PX,PY+H+3*D,PX+W+4*D,PY+H+4*D));
end;

procedure TForm27.TrackBar1Change(Sender: TObject);
begin
 HotTimer.Enabled := True;
end;

procedure TForm27.BubbleTimerTimer(Sender: TObject);
Var i,n: Integer;
begin
 Randomize;
 for i := 0 to Length(ABubbles)-1
 do ABubbles[i].PullUp;
 if TrackBar1.SelEnd > 40
 then case Random(TrackBar1.Max - TrackBar1.SelEnd)
      of 0: begin
            SetLength(ABubbles, Length(ABubbles)+1);
            ABubbles[High(ABubbles)] := TBubble.Create;
            ABubbles[High(ABubbles)].Pos := Point(PX+2*D+Random(W-R),PY+H+D);
            ABubbles[High(ABubbles)].Paint;
            end;
      end;

 i := 0;
 while i <= Length(ABubbles)-1
 do begin
    if ABubbles[i].Pos.Y < PX+2*D+T+R
    then begin
         ABubbles[i].Free;
         for n := i+1 to Length(ABubbles)-1
         do ABubbles[n-1] := ABubbles[n];
         SetLength(ABubbles,Length(ABubbles)-1);
         end;
    Inc(i);
    end;
 Label1.Caption := Format('Напузыряли: %d',[Length(ABubbles)]);
end;

constructor TBubble.Create;
begin
 Size := Point(0,0);
 inherited;
end;

procedure TBubble.Free;
begin
 Paint;
 inherited;
end;

procedure TBubble.Paint;
begin
 Form27.PaintBox1.Canvas.Pen.Width := 1;
 Form27.PaintBox1.Canvas.Pen.Mode := pmXor;
 Form27.PaintBox1.Canvas.Pen.Color := clRed;
 Form27.PaintBox1.Canvas.Brush.Style := bsClear;
 Form27.PaintBox1.Canvas.Ellipse(Pos.X,Pos.Y-Size.Y,Pos.X+Size.X,Pos.Y);
end;

procedure TBubble.PullUp;
begin
 Paint;
 Dec(Pos.Y,2);
 if Size.X < R then Inc(Size.X);
 if Size.Y < R then Inc(Size.Y);
 Paint;
end;

end.

и dfm-файл

Код:

object Form27: TForm27
  Left = 0
  Top = 0
  Caption = 'Form27'
  ClientHeight = 584
  ClientWidth = 649
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object PaintBox1: TPaintBox
    Left = 8
    Top = 8
    Width = 537
    Height = 497
    Color = clWhite
    ParentColor = False
    OnPaint = PaintBox1Paint
  end
  object Label1: TLabel
    Left = 551
    Top = 56
    Width = 75
    Height = 13
    Caption = #1053#1072#1087#1091#1079#1099#1088#1103#1083#1080': 0'
  end
  object Label2: TLabel
    Left = 546
    Top = 517
    Width = 17
    Height = 13
    Caption = '20'#176
  end
  object Button1: TButton
    Left = 240
    Top = 551
    Width = 75
    Height = 25
    Caption = #1042#1082#1083'.'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clHighlight
    Font.Height = -11
    Font.Name = 'Tahoma'
    Font.Style = []
    ParentFont = False
    TabOrder = 0
    OnClick = Button1Click
  end
  object TrackBar1: TTrackBar
    Left = 8
    Top = 505
    Width = 537
    Height = 45
    Max = 100
    Frequency = 5
    Position = 20
    SelEnd = 20
    TabOrder = 1
    TickMarks = tmBoth
    OnChange = TrackBar1Change
  end
  object BubbleTimer: TTimer
    Interval = 20
    OnTimer = BubbleTimerTimer
    Left = 560
    Top = 16
  end
  object HotTimer: TTimer
    Enabled = False
    Interval = 250
    OnTimer = HotTimerTimer
    Left = 560
    Top = 80
  end
end

Просьба выслать исходник программы на jaguar-16_rus@list.ru. заранее благодарю