Динамическое создание Paintbox Опции

[Atos]

Ну вот и меня проблемы с динамическим созданием. Сразу твёрдо скажу, чтобы не было лишних споров - в данном случае это оправдано, т.к. в программе, которую хочу насписать, их будет переменное количество. Приведенный код - пока пробный пример.

Тут происходят странные вещи. С PaintBox1 всё нормально. А P при первом нажатии на SpeedButton не выводит графическую информацию. Вернее, выводит и тут же стирает. Даже можно заметить промелькивание. При последующих нажатиях выводит нормально :o
В чём тут может быть дело??

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    SpeedButton1: TSpeedButton;
    PaintBox1: TPaintBox;
    procedure SpeedButton1Click(Sender: TObject);
    procedure Create(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  P:TPaintBox;

implementation

{$R *.dfm}

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
PaintBox1.Canvas.TextOut(10,10,'1000');
PaintBox1.Canvas.Ellipse(10,10,20,20);


  With P do
    begin

    Height:=100;
    Width:=100;
    Left:=20;
    Top:=20;

    Cursor:=crHandPoint;
    Color:=clYellow;

    ParentColor:=false;
    ParentFont:=false;

    Font.Color:=clBlack;
    Font.Size:=8;

    Canvas.Pen.Color:=clRed;
    Canvas.Pen.Style:=psSolid;

    Canvas.Brush.Style:=bsSolid;
    Canvas.Brush.Color:=clYellow;

    Canvas.Rectangle(0,0,Height,Width);
    Canvas.TextOut(10,10,'1000');
    Canvas.Ellipse(10,10,20,20);   {здесь при отлаживании текст в прямоугольнике виден на экране}
    end;

end;  //а на выходе из процедуры исчезает   

procedure TForm1.Create(Sender: TObject);
begin
P:=TPaintBox.Create(Form1);
P.Parent:=Form1;
end;

end.

[Digitalator]

Посмотри мои исходники, в проге используеться динамическое создание картинок на форме. Разобраться будет несложно
Скачать ~200кб

[Atos]

Спасибо!
Долго смотрел на оба кода, пытаясь понять, что у меня не так. Потом поменял TPaintBox на TImage - помогло!
Но все равно интересно, в чем природа глюка?

[Digitalator]

Скорее всего в MSG Paint, т.е. скорее всего TPaintBox рисует один раз, и чтобы изображение сохранилось необходимо его перерисовывать (в событии onPaint например). Хотя может быть и не так.... надо проверить

[hiv]

Все именно так!
TPaintBox рисует прямо в канву (Canvas), в справке так и написано, что нужно все время перерисовывать по событию onPaint. Поэтому функцию отрисовки нужно связать с событием onPaint.
Я вот так переписал:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    SpeedButton1: TSpeedButton;
    procedure SpeedButton1Click(Sender: TObject);
  private
    { Private declarations }
    constructor Create(AOwner: TComponent); override;
  public
    { Public declarations }
    P:TPaintBox;
  end;

var
  Form1: TForm1;


implementation

{$R *.dfm}

constructor TForm1.Create(AOwner: TComponent);
begin
  inherited;

  P:=TPaintBox.Create(Form1);
  P.Parent:=Form1;
  P.OnPaint:=Form1.SpeedButton1Click;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  With P do
    begin
    Canvas.TextOut(10,10,'1000');
    Canvas.Ellipse(10,10,20,20);

    Height:=100;
    Width:=100;
    Left:=20;
    Top:=20;

    Cursor:=crHandPoint;
    Color:=clYellow;

    ParentColor:=false;
    ParentFont:=false;

    Font.Color:=clBlack;
    Font.Size:=8;

    Canvas.Pen.Color:=clRed;
    Canvas.Pen.Style:=psSolid;

    Canvas.Brush.Style:=bsSolid;
    Canvas.Brush.Color:=clYellow;

    Canvas.Rectangle(0,0,Height,Width);
    Canvas.TextOut(10,10,'1000');
    Canvas.Ellipse(10,10,20,20);   {здесь при отлаживании текст в прямоугольнике виден на экране}
    end;
end; 

end.

Сообщение отредактировано: hiv - 6.05.2005 13:46