Отправляет email-рассылки с помощью сервиса Sendsay

Советы по Delphi

Рассылка закрыта

При закрытии подписчики были переданы в рассылку "Delphi - проблемы и решения" на которую и рекомендуем вам подписаться.

Вы можете найти рассылки сходной тематики в Каталоге рассылок.

←   Ноябрь 2001   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Автор
Сергей

Статистика

13.545 подписчиков
-22 за неделю
←   Все выпуски   →

Советы по Delphi - WindowRgn and Balls


Служба Рассылок Subscribe.Ru

Здравствуйте, уважаемые подписчики! Прошу прощения: до четверга (22.11.2001) опрос о версии Delphi был неверно настроен, и результаты не сохранялись. Сейчас все настроено и проверено. Вы можете указать версию Delphi, которую Вы используете, по адресу program.dax.ru/delver.htm.

Сегодня поговорим об изменении формы окна. Подобный совет можно найти на большинстве сайтов по Delphi, поэтому форма окна будет не статическая. В прямоугольном окне будут вырезаны круги. Эти круги будут перемещаться, отскакивать от стенок и друг от друга (по всем правилам). При этом будет не проверка на каждом шагу, столкнулись ли уже круги, а точный метод.

Для изменения формы окна используется функция SetWindowRgn. Перед ее вызовом нужно при помощи функций CombineRgn, CreateEllipticRgn, CreateEllipticRgnIndirect, CreatePolygonRgn, CreatePolyPolygonRgn, CreateRectRgn, CreateRectRgnIndirect, CreateRoundRectRgn, ExtCreateRegion, InvertRgn и OffsetRgn создать саму форму. Вам требуется только handle региона, а полная информация о нем хранится в недрах Windows.

При перемещении кругов становятся видными разные части чужих окон. Им приходится перерисовываться. Поскольку процесс этот не всегда быстр, перемещение отверстий может оказаться не очень красивым.

И еще. По непонятной мне причине, круги иногда сцепляются. Если кто-нибудь поймет, в чем дело, напишите мне, пожалуйста, на subscribe@program.dax.ru.

Скачать необходимые для компиляции файлы проекта можно на program.dax.ru 

uses math;

const
  r = 60;
  maxx = 400;
  maxy = 300;
  BallCount = 3;
  OneStep = 1;

var
  xo, yo, vx, vy: array [0..BallCount-1] of double;

function GetBumTime(var n: integer; var t: double): boolean;
  function GetOneBumTime(index: integer): double;
  begin
    result := min(
      max((maxx - r - xo[index]) / vx[index],
      -(xo[index] - r) / vx[index]),
      max((maxy - r - yo[index]) / vy[index],
      -(yo[index] - r) / vy[index]));
  end;
var
  i: integer;
  OneTime: double;
begin
  OneTime := GetOneBumTime(0);
  result := OneTime < t;
  n := 0;
  for i := 1 to BallCount - 1 do begin
    OneTime := GetOneBumTime(i);
    if OneTime < t then begin
      t := OneTime;
      n := i;
      result := true;
    end;
  end;
end;

function GetCrashTime(var t: double; var n1, n2: integer): boolean;
var
  i, j: integer;
  D: double;
  dx, dy, dvx, dvy: double;
  t1, t2: double;
begin
  result := false;
  for i := 0 to BallCount - 2 do
    for j := i + 1 to BallCount - 1 do begin
      dvx := vx[i] - vx[j];
      dvy := vy[i] - vy[j];
      dx := xo[i] - xo[j];
      dy := yo[i] - yo[j];

      D := 2*dx*dvx*dy*dvy - sqr(dvx*dy) - sqr(dvy*dx) +
        4*r*r*(dvx*dvx + dvy*dvy);
      if D < 0 then continue;
      if D > 1E-20 then D := sqrt(D);
      t1 := -(dvx*dx + dvy*dy + D) / (sqr(dvx) + sqr(dvy));
      t2 := -(dvx*dx + dvy*dy - D) / (sqr(dvx) + sqr(dvy));
      if (t1 <= 1E-5) and (t2 <= 1E-5) then continue;
      if (t1 > 0) and (t2 > 0)
        then t1 := min(t1, t2)
        else t1 := max(t1, t2);
      if t1 < t then begin
        t := t1;
        n1 := i;
        n2 := j;
        result := true;
      end;
    end;
end;

procedure Step(dt: double);
var i: integer;
begin
  for i := 0 to BallCount - 1 do begin
    xo[i] := xo[i] + vx[i] * dt;
    yo[i] := yo[i] + vy[i] * dt;
  end;
end;

procedure Draw;
var
  i: integer;
  rgn, ball: hRgn;
begin
  rgn := CreateRectRgn(0, 0, maxx - 1, maxy - 1);
  ball := CreateEllipticRgn(0, 0, r*2 - 1, r*2 - 1);
  for i := 0 to BallCount - 1 do begin
    OffsetRgn(ball, round(xo[i] - r), round(yo[i] - r));
    CombineRgn(rgn, rgn, ball, RGN_XOR);
    OffsetRgn(ball, round(r - xo[i]), round(r - yo[i]));
  end;
  DeleteObject(ball);
  SetWindowRgn(Form1.Handle, rgn, true);
end;

procedure FillBalls;
var
  i, j: integer;
  x, y: double;
  allright: boolean;
begin
  randomize;
  for i := 0 to BallCount - 1 do begin
    repeat
      x := random(maxx - 2 * r) + r;
      y := random(maxy - 2 * r) + r;
      allright := true;
      for j := 0 to i - 1 do begin
        if sqr(x - xo[j]) + sqr(y - yo[j]) <= 5 * r * r
        then begin
          allright := false;
          break;
        end;
      end;
    until allright;
    xo[i] := x;
    yo[i] := y;
    vx[i] := random - 0.5;
    vy[i] := random - 0.5;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  F, Fx, Fy, t, BumT, CrashT, a: double;
  BumN, Crash1, Crash2: integer;
begin
  Button1.Visible := false;
  Form1.Width := maxx; Form1.Height := maxy;
  Form1.Color := clBlack;
  FillBalls;
  repeat
    t := 0;
    repeat
      BumT := OneStep - t;
      CrashT := OneStep - t;
      if (not GetBumTime(BumN, BumT)) and
        (not GetCrashTime(CrashT, Crash1, Crash2)) then break;
      if (CrashT < BumT) then begin
        Step(CrashT);
        a := arctan2(yo[Crash1] - yo[Crash2], xo[Crash1] - xo[Crash2]);
        F := cos(a) * (vx[Crash2] - vx[Crash1]) +
          (vy[Crash2] - vy[Crash1]) * sin(a);
        Fx := F * cos(a);
        vx[Crash1] := vx[Crash1] + Fx;
        vx[Crash2] := vx[Crash2] - Fx;
        Fy := F * sin(a);
        vy[Crash1] := vy[Crash1] + Fy;
        vy[Crash2] := vy[Crash2] - Fy;
        t := t + CrashT;
      end else begin
        Step(BumT);
        if max((maxx - r - xo[BumN]) / vx[BumN],
          -(xo[BumN] - r) / vx[BumN]) <
          max((maxy - r - yo[BumN]) / vy[BumN],
          -(yo[BumN] - r) / vy[BumN])
          then vx[BumN] := -vx[BumN]
          else vy[BumN] := -vy[BumN];
        t := t + BumT;
      end;
    until false;
    Step(OneStep - t);
    Draw;
    Application.ProcessMessages;
  until Application.Terminated;
end;


Полезные мелочи
Чтобы инициализировать переменную на стадии ее создания, нужно объявить ее, как типизированную константу. Таким способом можно инициализировать переменные простых типов, а также записи, массивы, множества. Пример:
procedure TForm1.FormCreate(Sender: TObject);
const
  a: integer = 0;
  p: TPoint = (x: 10; y: 20);
  BoolStr: array [boolean] of string = ('false', 'true');
  figures: set of char = ['0'..'9'];
begin
  p := Form1.ClientToScreen(p);
  SetCursorPos(p.x, p.y);
  Form1.Caption := BoolStr[GetKeyState(VK_NUMLOCK) and 1 > 0];
end;


Все советы и замечания, пожалуйста, присылайте на subscribe@program.dax.ru

Всего доброго,
Даниил Карапетян.




http://subscribe.ru/
E-mail: ask@subscribe.ru 		Отписаться
Убрать рекламу
В избранное