VPF::проблема с рисованием на канве

Archmk

Дата 19.12.2006, 14:16 (ссылка)

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

Загрузка ...

Новичок

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

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

Здравствуйте.
Подскажите, плз, почему на канве TPanel с измененной формой (SetWindowRgn) не получается рисовать?

Код


procedure TPanel.Proc;
var
  R : HRGN;
begin
  R:= Create...Rgn(...);
  SetWindowRgn(Self.Handle, R, True);
  with Self.Canvas do
  begin
    Pen.Color:= clRed;
    MoveTo(P1.X, P1.Y);
    LineTo(P2.X, P2.Y); // линия не появляется, хотя точки P1 и P2 находятся внутри региона 
  end;
end;

Если точнее, то линия появляется, но затем тут же затирается цветом панели (clBtnFace).

Snowy

Дата 19.12.2006, 14:42 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

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

Потому что рисовать нужно в OnPaint

Archmk

Дата 19.12.2006, 14:59 (ссылка)

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

Загрузка ...

Новичок

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

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

Цитата(Snowy @ 19.12.2006, 14:42)

Потому что рисовать нужно в OnPaint

Тот же эффект. Выкладываю модуль целиком:

Код


unit UMain;

interface

uses
  Windows, Classes, Graphics, Controls, Forms, ExtCtrls, Math, StdCtrls;

type
  TArrow = class(TPanel)
    private
      P1, P2 : TPoint;
      LC : TColor;
      FOnPaint : TNotifyEvent;
      procedure OPaint(Sender: TObject);
    public
      procedure ProcessIt;
      property OnPaint : TNotifyEvent read FOnPaint write FOnPaint;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    A : TArrow;
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TArrow }

procedure TArrow.OPaint(Sender: TObject);
begin
  if Sender is TArrow then
  with Sender as TArrow do
  begin
    Canvas.Pen.Color:= clRed;
    Canvas.MoveTo(P1.X, P1.Y);
    Canvas.LineTo(P2.X, P2.Y);
  end;
end;

procedure TArrow.ProcessIt;
var
  R : HRGN;
  P : array[0..3] of TPoint;
  L : Single;
  A1, A2 : Integer;
begin
  R:= CreateEllipticRgn(P1.X-5, P1.Y-5, P1.X+5, P1.Y+5);
  CombineRgn(R, R, CreateEllipticRgn(P2.X-5, P2.Y-5, P2.X+5, P2.Y+5), RGN_OR);
  L:= Hypot(P1.X-P2.X, P1.Y-P2.Y);
  A1:= Trunc((P2.Y-P1.Y)*5/L);
  A2:= Trunc((P2.X-P1.X)*5/L);
  P[0].X:= P1.X-A1;
  P[0].Y:= P1.Y+A2;
  P[1].X:= P1.X+A1;
  P[1].Y:= P1.Y-A2;
  P[2].X:= P2.X+A1;
  P[2].Y:= P2.Y-A2;
  P[3].X:= P2.X-A1;
  P[3].Y:= P2.Y+A2;
  CombineRgn(R, R, CreatePolygonRgn(P, 4, WINDING), RGN_OR);
  SetWindowRgn(Self.Handle, R, True);
  Visible:= True;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  A.ProcessIt;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  A:= TArrow.Create(Form1);
  A.Parent:= Form1;
  A.Align:= alClient;
  A.LC:= LC;
  A.P1.X:= 10;
  A.P1.Y:= 10;
  A.P2.X:= 300;
  A.P2.Y:= 100;
  A.Visible:= False;
  A.OnPaint:= A.OPaint;
end;


end.

Это сообщение отредактировал(а) Archmk - 19.12.2006, 15:00

Snowy

Дата 19.12.2006, 15:17 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

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

Код


type
  TArrow = class(TPanel)
    private
      P1, P2 : TPoint;
      LC : TColor;
    protected
      procedure Paint; override; // наследуем виртуальный рисовальщик
    public
      procedure ProcessIt;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    A : TArrow;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TArrow }

procedure TArrow.Paint; // рисуем ся
begin
  inherited;
  Canvas.Pen.Color:= clRed;
  Canvas.MoveTo(P1.X, P1.Y);
  Canvas.LineTo(P2.X, P2.Y);
end;

procedure TArrow.ProcessIt;
var
  R : HRGN;
  P : array[0..3] of TPoint;
  L : Single;
  A1, A2 : Integer;
begin
  R:= CreateEllipticRgn(P1.X-5, P1.Y-5, P1.X+5, P1.Y+5);
  CombineRgn(R, R, CreateEllipticRgn(P2.X-5, P2.Y-5, P2.X+5, P2.Y+5), RGN_OR);
  L:= Hypot(P1.X-P2.X, P1.Y-P2.Y);
  A1:= Trunc((P2.Y-P1.Y)*5/L);
  A2:= Trunc((P2.X-P1.X)*5/L);
  P[0].X:= P1.X-A1;
  P[0].Y:= P1.Y+A2;
  P[1].X:= P1.X+A1;
  P[1].Y:= P1.Y-A2;
  P[2].X:= P2.X+A1;
  P[2].Y:= P2.Y-A2;
  P[3].X:= P2.X-A1;
  P[3].Y:= P2.Y+A2;
  CombineRgn(R, R, CreatePolygonRgn(P, 4, WINDING), RGN_OR);
  SetWindowRgn(Handle, R, True);
  Show;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  A.ProcessIt;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  A:= TArrow.Create(Self);
  A.Parent:= Self;
  A.Align:= alClient;
  A.LC:= LC;
  A.P1.X:= 10;
  A.P1.Y:= 10;
  A.P2.X:= 300;
  A.P2.Y:= 100;
  A.Visible:= False;
  A.Color := clNavy; // как-то нужно себя выделять, иначе сливается с фоном
end;

end.

Archmk

Дата 19.12.2006, 15:37 (ссылка)

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

Загрузка ...

Новичок

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

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

Спасибо

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