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

Вниз

Замостить Timage   Найти похожие ветки 

 
Шакал   (2009-01-16 10:24) [0]

Доброго времени суток!
Создал форму, с верху и слева панели - нужно всю остальную область замостить (из небольшого .bmp) т.е. сделать фон.
Пишу следующий код:

procedure TForm1.FormPaint(Sender: TObject);
var
x,y: integer;
pic: tbitmap;
pic1: timage;
begin
pic1:=timage.Create(form1);
pic1.Align:=alClient;
pic1.Parent:=form1;
pic:=tbitmap.Create;
pic.LoadFromFile("img\pole.bmp");
for x:=0 to round(pic1.width/120) do
for y:=0 to round(pic1.height/150) do
pic1.Canvas.Draw( X*120, Y*150, pic);

end;
Изоброжение появляется, но постоянно мигает (похоже постоянно прорисовывается заново).
Подскажите плиз...


 
Ega23 ©   (2009-01-16 10:42) [1]

Form1.DoubleBuffered := True?


 
Шакал   (2009-01-16 10:49) [2]


> Form1.DoubleBuffered := True?

Хм...добавил, картинка стабилизировалась, но когда мышкой водишь, курсор притормаживает с такойже переодичностью как картинка мигала(((


 
Шакал   (2009-01-16 10:51) [3]

и проц почти на 100% приложение грузит....


 
Медвежонок Пятачок ©   (2009-01-16 11:01) [4]

procedure TForm1.FormPaint(Sender: TObject);
var
....
pic.LoadFromFile("img\pole.bmp");
.....

А не слишком ли ты суров?


 
Плохиш ©   (2009-01-16 11:02) [5]


> Шакал   (16.01.09 10:51) [3]
>
> и проц почти на 100% приложение грузит....
>

Ты полчасика поводи, потом придёшь, ещё и про нехватку памяти спросишь.


 
Ega23 ©   (2009-01-16 11:04) [6]

Ну всё правильно, у тебя на каждую перерисовку такая фигня идёт.

Алгоритм такой:
1. Заводишь в памяти Bitmap, выставляешь ему размеры.
2. ОДИН РАЗ его мостишь.
3. При перерисовке формы назначаешь этот битмап канвасу формы.


 
Ega23 ©   (2009-01-16 11:05) [7]


> А не слишком ли ты суров?


Это цветочки. Он ещё по экземпляру TImage создаёт на каждую перерисовку.


 
Шакал   (2009-01-16 11:10) [8]


> Алгоритм такой:
> 1. Заводишь в памяти Bitmap, выставляешь ему размеры.
> 2. ОДИН РАЗ его мостишь.
> 3. При перерисовке формы назначаешь этот битмап канвасу
> формы.

а пример кода мона-_О

>
> Ты полчасика поводи, потом придёшь, ещё и про нехватку памяти
> спросишь.

через две минуты выдает)))))


 
Ega23 ©   (2009-01-16 11:21) [9]


> а пример кода мона-_О


Сам подумай. Учись учиться.


 
Шакал   (2009-01-16 11:29) [10]


> А не слишком ли ты суров?

в чем суровость? объясните плиз...


 
Медвежонок Пятачок ©   (2009-01-16 11:42) [11]

procedure TForm1.FormPaint(Sender: TObject);
.....
Caption := Format("Я закаким-то хреном загрузил этот файл уже %d раз"#13#10"А пофик, потому как я суров",[Tag]);
Tag := Succ(Tag);
......


 
Шакал   (2009-01-16 11:47) [12]


> > 2. ОДИН РАЗ его мостишь.

а как ограничить?


 
Медвежонок Пятачок ©   (2009-01-16 11:55) [13]

Надо использовать компонент TZamostitelRestrictor


 
Ega23 ©   (2009-01-16 11:55) [14]


> а как ограничить?
>


TForm.ClientWidth, TForm.ClientHeight + F1.


 
Шакал   (2009-01-16 12:12) [15]


> Надо использовать компонент TZamostitelRestrictor

напишешь, скинь на мыло)))


 
Шакал   (2009-01-16 12:17) [16]


> TForm.ClientWidth, TForm.ClientHeight + F1.

я имел ввиду количество раз мощения)))


 
Ega23 ©   (2009-01-16 12:30) [17]


> я имел ввиду количество раз мощения)))


Тебе незнакомы операции деления, вычитания, сложения и умножения?
Может ну его нафиг, программирование? В армии люди нужны... Да и с дворниками как-то тоже не очень...


 
KSergey ©   (2009-01-16 12:30) [18]

> Шакал   (16.01.09 12:17) [16]
> я имел ввиду количество раз мощения)))

Их не надо искусственно ограничивать. Достаточно разместить этот код в обработчике, срабатывающем 1 раз за время жизни программы (или формы), а не каждый раз при отрисовке.
Например, в TForm.OnCreate


 
Ega23 ©   (2009-01-16 12:45) [19]


> Например, в TForm.OnCreate


Это для старта. И в OnResize


 
{RASkov} ©   (2009-01-16 12:57) [20]

unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs;

type
 TForm1 = class(TForm)
   procedure FormCreate(Sender: TObject);
   procedure FormPaint(Sender: TObject);
 private { Private declarations }
 public  { Public declarations }
   BMP: TBitmap;
 end;

var Form1: TForm1;

implementation
{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
 BMP:=TBitmap.Create;
 BMP.LoadFromFile(<name.bmp>);
end;

procedure TForm1.FormPaint(Sender: TObject);
var X, Y: Integer;
begin
 for X:=0 to ClientWidth div BMP.Width do
  for Y:=0 to ClientHeight div BMP.Height do
   Canvas.Draw(X*BMP.Width, Y*BMP.Height, BMP);
end;

end.


 
Шакал   (2009-01-16 13:36) [21]


> {RASkov} ©

В принципе работает без тормозов, НО проц грузит на 99% и каждую 1 секунду жрет по 16 кб памяти....


 
Шакал   (2009-01-16 13:41) [22]

а не все ок....просто timage забыл удалить.....
ОГРОМНОЕ СПАСИБО {RASkov}
И Всем огромное человеческое спасибо за помощь...



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

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

Наверх





Память: 0.49 MB
Время: 0.007 c
2-1229513809
vegarulez
2008-12-17 14:36
2009.03.01
вопрос про XML


2-1232345049
Ruslan777
2009-01-19 09:04
2009.03.01
Проверка нажатия кнопки во цикле?


15-1230877089
desc
2009-01-02 09:18
2009.03.01
Как позвонить с Mail Agent- а на сервисный номер МТС ?


2-1232132953
programmer90
2009-01-16 22:09
2009.03.01
Ссылка...


6-1199800507
Biver
2008-01-08 16:55
2009.03.01
E-mail





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский