Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Media";
Текущий архив: 2003.03.06;
Скачать: [xml.tar.bz2];

Вниз

обновление графики   Найти похожие ветки 

 
tomek2002   (2002-11-24 14:43) [0]

Здравствуйте, уважаемые профи программирования !
Вот никак не рашался задать вопрос, и все-таки доконало !
Итак... Представьте себе :
на форме есть image1. Закрашываем его в белый цвет. Затем,
в цикле (надо сказать, довольно-таки внушительных размеров) выводим
на канву image1 линии - каждая следующая начинается в конце предыдущей
(выйдет что-то напоминающее графику нек-рой функции).
При это пишем от руки функцию, обеспечивающую delay (в ней можно видеть
application.processmessages - ясно для чего).
Наблюдаем непримечательную картинку : все СТРАШНЕЙШИМ образом мигает !
Я лазил в архивах конференций. Нашел вот что :
image1.controlstyles:=image1.controlstyles+[csOpaque];
а затем после каждой прорисовки методом lineto делать то ли repaint
то ли update... ни хрена не получается естесна... У меня 6 дельфа.
Удалось перерыть много материала по графике в дельфи, но ничего конкретного
относительно моего случая найти не удалось. Есть идея динамически в памяти
формировать изображения, затем выводить на канву. Но не стоит тогда забывать,
что это аналогия того,как я рисую линии на той же канве..
- то же мигает (УЖАСНО !) - ведь все равно выводим затем на канву на image1.
Да, и мне не просто надо построить график. Надо моделировать некую систему в
реальном времени (то есть для того и delay..)
PLEASE ! HELP !!!!
ответьте пожалуйста по мылу !!!


 
KA_   (2002-11-24 14:54) [1]

Создай объект TBitmap. На нем отрисовывай все что необходимо, а затем просто копируй на канву Image. Еще лучше - рисуй прямо на канве формы в ее событии OnPaint. Я так почти мгновенно перерисовывал битмэпы по 100-150 мегов.


 
MBo   (2002-11-24 15:27) [2]

кроме того, Doublebuffered:=true


 
msts   (2002-11-24 16:16) [3]

unit Unit1;

interface

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

type
TForm1 = class(TForm)
PaintBox1: TPaintBox;
Timer1: TTimer;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
Buffer : TBitmap;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
Buffer := TBitmap.Create;
with Buffer do begin
PixelFormat := pf8bit;
Height := PaintBox1.Height;
Width := PaintBox1.Width;
Canvas.Brush.Color:=clBlack;
Canvas.FillRect(Canvas.ClipRect);
end;
Timer1.Enabled := false;
Timer1.Interval := 10;

end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
if Buffer.Canvas.LockCount=0 then
PaintBox1.Canvas.Draw(0,0,Buffer);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
if Buffer.Canvas.LockCount=0 then begin
Buffer.Canvas.Lock;

PaintBox1.Tag := PaintBox1.Tag +1;

with Buffer do begin
Canvas.Brush.Color:=clBlack;
Canvas.FillRect(Canvas.ClipRect);
Canvas.Font.Color := clWhite;
Canvas.TextOut(10,10, IntToStr(PaintBox1.Tag));
end;

PaintBox1.Canvas.Draw(0,0,Buffer);
Buffer.Canvas.Unlock;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Timer1.Enabled := not Timer1.Enabled;
end;

end.



Страницы: 1 вся ветка

Форум: "Media";
Текущий архив: 2003.03.06;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.56 MB
Время: 0.041 c
8-17212
GROL
2002-11-20 16:29
2003.03.06
Изменение изображения на экране


7-17421
ded
2003-01-09 22:41
2003.03.06
Содержимое произвольной ячейки памяти


14-17361
Ал
2003-02-18 12:47
2003.03.06
Подскажите, где найти бесплатные HELP-редакторы?


1-17129
Konstantin
2003-02-22 19:12
2003.03.06
Иконки в FileListBox


14-17303
Фикус
2003-02-20 08:06
2003.03.06
Прикольно :)





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский