VPF::отрисовка контура нижнего объекта

EDG_aka_Dima

Дата 22.12.2007, 00:51 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 7
Регистрация: 21.12.2007

Репутация: 1
Всего: 1

Задачка: Написать прогу в которой при установки компонента Shape один на другой отрисовывалась бы невидимая граница нижнего пункирной линией.

Ребят, помогите пожалуйста. С установкой шейпа на форму ничё сложного нет

Код


Shape[n]:= Tshape.Create(self);
Shape[n].Shape:=stsquare;
Shape[n].Width:=64;
Shape[n].Height:=64;
Shape[n].parent:=form1;
Shape[n].left:=x-32;
Shape[n].Top:=y-32;

далее делаем проверку по координатам есть ли наложение... вроде не сложно,
а вот как эту прорисовку делать на верхнем объекте? да ещё и пунктиром...

ivan219

Дата 22.12.2007, 02:01 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1121
Регистрация: 19.11.2005
Где: Планета земля

Репутация: 5
Всего: 12

С обычным TShape будет проблемотично:

Код


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TFShape = class(TShape)
  private
    FX, FY: Integer;
  protected
    procedure Paint; override;
  public
    procedure XYPos(X, Y: Integer);
    constructor Create(AOwner: TComponent); override;
  end;

var
  Form1: TForm1;
  Shape: TFShape;

implementation

{$R *.dfm}

{ TFShape }

constructor TFShape.Create(AOwner: TComponent);
begin
  inherited;
  FX := 0;
  FY := 0;
end;

procedure TFShape.Paint;
begin
  inherited;
  Canvas.Pen.Style := psDot;
  Canvas.Pen.Color := clRed;

  if FY > 0 then
   begin
    Canvas.MoveTo(FX, FY);
    Canvas.LineTo(Width, FY);
   end;

  if FX > 0 then
   begin
    Canvas.MoveTo(FX, FY);
    Canvas.LineTo(FX, Height);
   end;
end;

procedure TFShape.XYPos(X, Y: Integer);
begin
 FX := X;
 FY := Y;
 Invalidate;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 Shape := TFShape.Create(Self);
 Shape.Parent := Self;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 Shape.XYPos(20, 10);
end;
end.

--------------------

Мой первый сайт и моя первая программа!!!!!

EDG_aka_Dima

Дата 22.12.2007, 03:11 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 7
Регистрация: 21.12.2007

Репутация: 1
Всего: 1

хех, посидел ещё и наконец придумал! smile

Прекрасно работает! smile

Код


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  i,k,n: integer;
  Shape1: array [1..50] of TShape;
  Shape2: array [1..50] of TShape;
  ax,ay,bx,by,cx,cy:integer;

implementation

{$R *.dfm}

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin

  n:=n+1;
  Shape1[n]:= Tshape.Create(self);
  Shape1[n].Shape:=stsquare;
  Shape1[n].Width:=64;
  Shape1[n].Height:=64;
  Shape1[n].parent:=form1;
  Shape1[n].left:=x-32;
  Shape1[n].Top:=y-32;

  for i:=1 to n-1 do begin
    ax:=Shape1[i].Left;
    ay:=Shape1[i].Top;
    bx:=ax+64;
    by:=ay+64;
    ax:=ax-64;
    ay:=ay-64;
    cx:=shape1[n].Left;
    cy:=shape1[n].Top;
    if (ax<cx) and (ay<cy) and (bx>cx) and (by>cy) then begin
      memo1.Lines.Add('Shape('+ inttostr(n) +') накладывается на Shape('+ inttostr(i) +')');
      k:=k+1;
      shape2[k]:= Tshape.Create(self);
      Shape2[k].Shape:=stsquare;
      Shape2[k].Width:=64;
      Shape2[k].Height:=64;
      Shape2[k].parent:=form1;
      Shape2[k].left:=Shape1[i].Left;
      Shape2[k].Top:=Shape1[i].Top;
      Shape2[k].Pen.Style:=psDot;
      Shape2[k].Pen.Mode:=pmMask;
    end;
  end;

end;


procedure TForm1.FormCreate(Sender: TObject);
begin
n:=0;
k:=0;
i:=0;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
For i:=1 to n do
  Shape1[i].Destroy;
For i:=1 to k do
  Shape2[i].Destroy;
memo1.Clear;
n:=0;
k:=0;
i:=0;
end;

end.

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Для новичков \| Следующая тема »