Рисование процесса кипения

Sevas · #16 19.06.2009, 00:07

спасибо огромное!!!
буду разбираться.

jaguar16rus · #17 15.10.2009, 08:03

Цитата:

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

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

Код:

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. заранее благодарю

AleD · #18 15.10.2009, 10:04

я бы вместо массивов использовал класс TList, удобное управление содержимым, да и скорость не особо падает (на глаз в такой программе точно не заметно будет). всегда этим классом пользуюсь и автору темы советую (юнит Classes)

Страдалецъ · #19 15.10.2009, 12:55

Код:

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

А чем вас не устраивает исходняк который выложен здесь?

jaguar16rus · #20 27.10.2009, 21:15

Цитата:

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

Код:

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

А чем вас не устраивает исходняк который выложен здесь?

не работает... Выделяет PlatformDefaultStyleActnCtrls. А ссылка выложенная тут на депозит - битая.

Страдалецъ · #21 27.10.2009, 23:46

Да зачем вам депозит? Тут http://www.delphisources.ru/forum/sh...3&postcount=17 полный исходняк.

Цитата:

не работает... Выделяет PlatformDefaultStyleActnCtrls.

Это на какой версии Дельфи такое вылазит, пробовал на D2009 и D7 - без проблем работает.

jaguar16rus · #22 28.10.2009, 08:16

Цитата:

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

Да зачем вам депозит? Тут http://www.delphisources.ru/forum/sh...3&postcount=17 полный исходняк.

Это на какой версии Дельфи такое вылазит, пробовал на D2009 и D7 - без проблем работает.

Все, "догнал".

Теперь бьюсь над "совершенствованием" данной проги. Пытаюсь реализовать слияние пузырьков при соприкосновении. С центром в точке соприкосновения

Страдалецъ · #23 28.10.2009, 19:59

Так там не только слияние, но и увеличение радиуса нового пузыря согласно добавленного объема должно быть, и возможно и ускорение всплытия засчет повышения плавучести, но тут могу и ошибаться.

Страдалецъ · #24 28.10.2009, 21:45

В общем сам процесс слияния и увеличения радиуса пузыря засчет слияния площадей я вроде сделал, но теперь надо артефакты устранять.
Добавил еще плавный разогрев/остывание плитки.

Код:

unit Unit27;

interface

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

type
  TBubble = class
   Size,MaxSize: Integer;
   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;
    HotColor: Byte;
  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;
      HotColor := 150;
      end
 else begin
      Button1.Caption := 'Выкл.';
      TrackBar1.Position := 100;
      end;
end;

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

procedure TForm27.HotTimerTimer(Sender: TObject);
begin
 if TrackBar1.SelEnd > TrackBar1.Position
 then begin
      TrackBar1.SelEnd := TrackBar1.SelEnd - 1;
      Dec(HotColor,1);
      end
 else begin
      TrackBar1.SelEnd := TrackBar1.SelEnd + 1;
      Inc(HotColor,3);
      end;
 PaintBox1.Canvas.Brush.Color := RGB(HotColor,0,0);
 PaintBox1.Canvas.Brush.Style := bsSolid;
 PaintBox1.Canvas.FillRect(Rect(PX,PY+H+3*D,PX+W+4*D,PY+H+4*D));
 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,j,n,m: Integer;
    B0,B1,B2: TRect;
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;

    n := 0;
    while n <= Length(ABubbles)-2
    do begin
       with ABubbles[n]
       do B1 := Rect(Pos.X-1,Pos.Y-Size-1,Pos.X+Size+1,Pos.Y+1);
       m := n+1;
       while m <= Length(ABubbles)-1
       do begin
          with ABubbles[m]
          do B2 := Rect(Pos.X-1,Pos.Y-Size-1,Pos.X+Size+1,Pos.Y+1);
          if IntersectRect(B0,B1,B2)
          then begin
               if ABubbles[n].Size >= ABubbles[m].Size
               then begin
                    ABubbles[m].Free;
                    for j := m+1 to Length(ABubbles)-1
                    do ABubbles[j-1] := ABubbles[j];
                    SetLength(ABubbles,Length(ABubbles)-1);
                    ABubbles[n].MaxSize := Round(Sqrt((Pi*Sqr(ABubbles[n].Size)+Pi*Sqr(ABubbles[m].Size))/Pi));
                    end
               else begin
                    ABubbles[n].Free;
                    for j := n+1 to Length(ABubbles)-1
                    do ABubbles[j-1] := ABubbles[j];
                    SetLength(ABubbles,Length(ABubbles)-1);
                    ABubbles[m].MaxSize := Round(Sqrt((Pi*Sqr(ABubbles[n].Size)+Pi*Sqr(ABubbles[m].Size))/Pi));
                    end;
               end;
          Inc(m);
          end;
       Inc(n);
       end;
    Inc(i);
    end;
 Label1.Caption := Format('Напузыряли: %d',[Length(ABubbles)]);
end;

constructor TBubble.Create;
begin
 Size := 0;
 MaxSize := R;
 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,Pos.X+Size,Pos.Y);
end;

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

end.

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	RSS лента	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Новости сайта Новости форума	Ссылки и Баннеры Donate О сайте Реклама Контакты