Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

Вернуться   Форум программистов > Delphi > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Ответ
 
Опции темы
Старый 24.06.2013, 10:33   #1
acheron1757
 
Регистрация: 16.05.2013
Адрес: Кострома
Сообщений: 6
Репутация: 10
Восклицание исправить хвост

помочь убрать хвост у объекта и изменить его на звезду.
Вложения
Тип файла: rar Новая папка.rar (204.1 Кб, 4 просмотров)
acheron1757 вне форума   Ответить с цитированием
Старый 24.06.2013, 11:07   #2
Serge_Bliznykov
МегаМодератор
СуперМодератор
 
Регистрация: 09.01.2008
Сообщений: 24,613
Репутация: 5352
По умолчанию

примерно так:
Код:

unit Unit4;

interface

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

type
  TForm4 = class(TForm)
    Button1: TButton;
    Timer1: TTimer;
    procedure Zvezda(x0,y0,r: integer; ZvezdaColor : TColor);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form4: TForm4;
  x,y: Integer;

implementation

const RazmahZvezdy = 120;

{$R *.dfm}

procedure TForm4.Zvezda(x0,y0,r: integer; ZvezdaColor : TColor);
    // x0,y0 - координаты центра звезды
    // r - радиус звезды
var
    p : array[1..11] of TPoint; // массив координат лучей и впадин
    a: integer;   // угол между осью ОХ и прямой, соединяющей
                  // центр звезды и конец луча или впадину
    i: integer;
begin
    Canvas.Pen.Color := ZvezdaColor;
    Canvas.Brush.Color := ZvezdaColor;
    a := 18; // строим от правого гор. луча
    for i:=1 to 10 do
       begin
          if (i mod 2 = 0) then
             begin // впадина
               p[i].x := x0+Round(r/3*cos(a*2*pi/360));
               p[i].y:=y0-Round(r/3*sin(a*2*pi/360));
             end
          else
             begin // луч
               p[i].x:=x0+Round(r*cos(a*2*pi/360));
               p[i].y:=y0-Round(r*sin(a*2*pi/360));
             end;
          a := a+36;
       end;

    p[11].X := p[1].X; // чтобы замкнуть контур звезды
    p[11].Y := p[1].Y;

    Canvas.Polyline(p); // начертить контур звезды
end;

procedure TForm4.FormCreate(Sender: TObject);
begin
  // поместили в левый нижний угол формы (примерно )
  x:= RazmahZvezdy;
  y:= Height - RazmahZvezdy - 50;

  DoubleBuffered := true; // сглаживание мерцания при перерисовке формы

  Timer1.Interval := 80; // интервал перерисовки
  Timer1.Enabled := true;
end;

procedure TForm4.Timer1Timer(Sender: TObject);
begin
  Zvezda(x,y, RazmahZvezdy, clBtnFace);
  x:=x+2;
  y:=y-2;
  Zvezda(x,y, RazmahZvezdy, clRed);

  if (x>Width-RazmahZvezdy) or ((y-RazmahZvezdy)<0) then
      Timer1.Enabled := false;  // если дошли до края формы, остановили

end;

end.

форма целиком во вложенном архиве...
Вложения
Тип файла: rar Unit4.rar (1.4 Кб, 4 просмотров)
Serge_Bliznykov вне форума   Ответить с цитированием
Ответ

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Рисуется хвост за текстом (TextOut) artemavd Общие вопросы Delphi 19 17.05.2012 10:29
Pascal хвост змейки zhenka619 Помощь студентам 1 30.12.2011 14:01
Хвост для кометы X@OC JavaScript, Ajax 0 29.07.2011 10:34
очередь с указателем на хвост и голову Anny_Apple Паскаль 0 02.05.2011 21:04
Пеpенести в хвост одномеpного массива пеpвый отpицательный элемент. Irisk Помощь студентам 17 27.12.2010 18:35


09:05.


Powered by vBulletin® Version 3.8.8 Beta 2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.

RusProfile.ru


Справочник российских юридических лиц и организаций.
Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru