Помощь - Поиск - Пользователи - Календарь
Полная версия: Динамическое создание Paintbox
Форум «Всё о Паскале» > Современный Паскаль и другие языки > Делфи
Atos
Ну вот и меня проблемы с динамическим созданием. sad.gif Сразу твёрдо скажу, чтобы не было лишних споров - в данном случае это оправдано, т.к. в программе, которую хочу насписать, их будет переменное количество. Приведенный код - пока пробный пример.

Тут происходят странные вещи. С PaintBox1 всё нормально. А P при первом нажатии на SpeedButton не выводит графическую информацию. Вернее, выводит и тут же стирает. blink.gif Даже можно заметить промелькивание. При последующих нажатиях выводит нормально :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; //а на выходе из процедуры исчезает sad.gif

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

end.

Digitalator
Посмотри мои исходники, в проге используеться динамическое создание картинок на форме. Разобраться будет несложно smile.gif
Скачать ~200кб
Atos
Спасибо!
Долго смотрел на оба кода, пытаясь понять, что у меня не так. Потом поменял TPaintBox на TImage - помогло!
Но все равно интересно, в чем природа глюка? unsure.gif
Digitalator
Скорее всего в MSG Paint, т.е. скорее всего TPaintBox рисует один раз, и чтобы изображение сохранилось необходимо его перерисовывать (в событии onPaint например). Хотя может быть и не так.... надо проверить smile.gif
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.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.