Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Общие вопросы > Как сделать свою функцию

Автор: Гость_alligator 5.7.2004, 01:12

Здравствуйте!
У меня сделана элементарная прога "Светофор"
Вот код :
var
Form1: TForm1;
Shp1,Shp2,Shp3:TShape;
Panel1,Panel2,Panel3,Panel4:TPanel;
d:real;
bs:TBrushStyle;
implementation

{$R *.dfm}

procedure TForm1.Shp1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var bs:TBrushStyle;
r,cX,cY:real;
begin
r:=Shp1.Width/2; // вычисляем радиус
cX:=Panel1.Left+Panel2.Left+r; // вычисляем центры круга
cY:=Panel1.Top+Panel2.Top+r;
d:=sqr(cX-X)+sqr(cY-Y); {вычисляем расстояние от центра круга
до произвольной точки наведения курсора}
if d<sqr® then { если до произвольной точки наведения курсора
меньше радиуса , то круг заполняется цветом}
bs:=bsSolid
else
bs:=bsClear; //иначе очищается

Shp1.Brush.Style:=bs;
Shp1.Brush.Color:=clRed ;
end;

procedure TForm1.Shp2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var bs:TBrushStyle;
r,cX,cY:real; A, B: Real;
begin
r:=Shp1.Width/2; // вычисляем радиус
cX:=Panel1.Left+Panel2.Left+r; // вычисляем центры круга
cY:=Panel1.Top+Panel3.Top+r;
d:=sqr(abs(cX-X))+sqr(abs(cY-Y));{вычисляем расстояние от центра круга
до произвольной точки наведения курсора}
if d<sqr® then { если до произвольной точки наведения курсора
меньше радиуса , то круг заполняется цветом}
bs:=bsSolid
else
bs:=bsClear;//иначе очищается

Shp2.Brush.Style:=bs;
Shp2.Brush.Color:=clYellow ;
end;

procedure TForm1.Shp3MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var r,cX,cY:real;
begin
r:=Shp1.Width/2; // вычисляем радиус
cX:=Panel1.Left+Panel2.Left+r; // вычисляем центры круга
cY:=Panel1.Top+Panel2.Top+r;
d:=sqr(cX-X)+sqr(cY-Y); {вычисляем расстояние от центра круга
до произвольной точки наведения курсора}
if d<sqr® then { если до произвольной точки наведения курсора
меньше радиуса , то круг заполняется цветом}
bs:=bsSolid
else
bs:=bsClear; //иначе очищается

Shp3.Brush.Style:=bs;
Shp3.Brush.Color:=clGreen ;
end;

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
Shp1.Brush.Style:=bsClear; // при выведении курсора из любого
Shp2.Brush.Style:=bsClear; //круга , его цвет должен
Shp3.Brush.Style:=bsClear; //очиститься,т.е. свет должен погаснуть
end;
end.

Мне, чтобы сократить код проги, там где вычисляются радиус, центры кругов и прочее,
нужно вставить свою функцию.
Делаю на примере одного круга, но ни черта не выходит :
function Polojenie (var r,d:real ):TBrushStyle;
begin
r:=Shp1.Width/2;
cX:=Panel1.Left+Panel2.Left+r;
cY:=Panel1.Top+Panel2.Top+r;
d:=sqr(cX-X)+sqr(cY-Y);
if d<sqr® then
Polojenie :=bsSolid
else
Polojenie :=bsClear;

end;
procedure TForm1.Shp1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var bs:TBrushStyle;
r:real;
v:TBrushStyle;
begin
v:=Polojenie(r,d);
Shp1.Brush.Style:=v;
Shp1.Brush.Color:=clRed ;
end;
При наведении на круг (который должен загореться красным светом) - ошибка
и завершении через Program Reset
Подскажите где моя ошибочка и как правильно сделать function??!!!

Автор: Albinos_x 5.7.2004, 01:46

По идее всё верно, но всё таки попробуй в функции

Цитата

function Polojenie (var r,d:real ):TBrushStyle;
begin
r:=Shp1.Width/2;
cX:=Panel1.Left+Panel2.Left+r;
cY:=Panel1.Top+Panel2.Top+r;
d:=sqr(cX-X)+sqr(cY-Y);
if d<sqr® then
Polojenie :=bsSolid
else
Polojenie :=bsClear;

поменять переменные r,d на какие-нибудь другие например r_f, d_f, так как если глобальные переменные объявлять ещё и в процедурах и функциях как локальные, то действие их прекращяется, что может в принципе вызвать такой эффект.

Автор: decoder 6.7.2004, 13:12

если функция не объявлена в разделе прайвэт, то все глобальные переменные доступны там только через self.переменная. попробуй написать ету функцию выше процедуры где она используеться, если ты этого не сделал, и ещё попробуй вместо polojenie:=... писать result:=... авось получиться!

Автор: p0s0l 9.7.2004, 14:40

(я так понял на Panel1 находятся 3 Shape'а ?):

Код

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Shp1: TShape;
    Shp2: TShape;
    Shp3: TShape;
    procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure Shp1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure Shp2MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure Shp3MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  private
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  Shp1.Brush.Style := bsClear; // при выведении курсора из любого
  Shp2.Brush.Style := bsClear; // круга , его цвет должен
  Shp3.Brush.Style := bsClear; // очиститься,т.е. свет должен погаснуть
end;

procedure MySuperFunction (shp : TShape; x, y : integer; Color : TColor);
var
  r : integer;
begin
  x := shp.Width div 2 - x;
  y := shp.Height div 2 - y;
  r := Round (Sqrt(x*x + y*y));
  if r <= shp.Width div 2 then shp.Brush.Color := Color
  else shp.Brush.Style:=bsClear;
end;

procedure TForm1.Shp1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  MySuperFunction (TShape(Sender), X, Y, clRed);
end;

procedure TForm1.Shp2MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  MySuperFunction (TShape(Sender), X, Y, clYellow);
end;

procedure TForm1.Shp3MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  MySuperFunction (TShape(Sender), X, Y, clGreen);
end;

end.