Задваивается изображение формы

← →
delhpiCasual (2012-07-13 06:56) [0]

создана форма tv. В один прекрасный момент вызывается команда tv.Show;

затем много раз по ходу выполнения вызывается процедура:

Procedure RefreshTV(tbmp: TBitmap);
begin
tv.Left := 0;
tv.Top := 0;
tv.Height := tbmp.Height + 100;
tv.Width := tbmp.Width + 100;
tv.Image1.Left := 0;
tv.Image1.Top := 0;
tv.Image1.Height := tbmp.Height;
tv.Image1.Width := tbmp.Width;
tv.Image1.Picture.Assign(tbmp);
tv.Refresh;
end;

после первой команды форма появляется примерно в центре экрана. Процедура же ее перемещает в верхний угол и меняет размеры. и рисует в ней картинку. В режиме отладки так все оно и происходит. Но если запускать exe файл непосредственно, или в режиме исполнения из делфи, то после первоначального появления формы на ней вдруг появляется надпись (не отвечает). А в верхнем углу появляется вторая такая же форма, а первая никуда не исчезает и ее размеры не меняются под размер картинки, но картинка исправно выводится в обе формы. основное окно программы и первую форму можно перетаскивать мышкой по рабочему столу, в то время как "правильная форма" никаким манипуляциям не поддается. Что за ужас?

← →
Омлет © (2012-07-13 07:51) [1]

> Что за ужас?

Ошибка в программе.

← →
delhpiCasual (2012-07-13 08:04) [2]

> Ошибка в программе.

какая?

кстати уменьшил в конструкторе форму до минимума, теперь второе окно не появляется. Но если появившуюся форму потаскать мышкой, то оно зависает и перестает работать. Тоже вверху пишется, что "не отвечает"

← →
Inovet © (2012-07-13 08:14) [3]

> [2] delhpiCasual (13.07.12 08:04)
> какая?

Миелофоны на подзарядке.

← →
AV © (2012-07-13 08:51) [4]

Ошибка в 17 строке - это когда не приведен код демонстрирующий ошибку, например вопрос "У меня программа вылетает по ошибке, помогите"

Код давай - то же самое, но для тех кто не понимает что такое "Ошибка в 17 строке"

Наверно у тебя ошибка в программе - юмористический вариант "Ошибка в 17 строке"

← →
Омлет © (2012-07-13 08:56) [5]

> AV © (13.07.12 08:51) [4]

Может ещё прийти Плохиш и предложить нанять программиста.

← →
delhpiCasual (2012-07-13 09:41) [6]

:facepalm: весь код касающейся этой формы я привел. Есть основная форма и есть эта, которая вызывается и все что с ней происходит описано в первом посте. Предлагаю вам нанять программиста, чтобы квалифицированно отвечать на форуме. :D

← →
AV © (2012-07-13 09:59) [7]

1.
Если RefreshTV дергается раз в пятилетку - одно, если несколько раз в секунду - другое.
Из приведенного это не ясно.
Я, например, подозреваю, что тупо не успевает процедура завершится, как вызывается снова.
Но не могу это сказать, т.к. из кода это не видно.

2.
отвечающим не нужен программист, т.к. им не нужно решить твою задачу.

← →
Омлет © (2012-07-13 10:09) [8]

> delhpiCasual (13.07.12 09:41) [6]

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

← →
Плохиш © (2012-07-13 10:30) [9]

> delhpiCasual (13.07.12 06:56)

В приведённом коде синтаксических ошибок нет

> delhpiCasual (13.07.12 09:41) [6]

> Предлагаю вам нанять программиста, чтобы квалифицированно
> отвечать на форуме.

Нам не нужен программист. Проблема у тебя и нам как-то до твоих проблем пофигу.

> AV © (13.07.12 09:59) [7]

> Я, например, подозреваю, что тупо не успевает процедура
> завершится, как вызывается снова.

На чём основано сие подозрение? Описание используемого языка не даёт поводов для таких подозрений.

> Омлет © (13.07.12 10:09) [8]

> либо тебя заклюют ненанятые программисты.

Тут есть "ненанятые программисты"? :-)

← →
Плохиш © (2012-07-13 10:32) [10]

> delhpiCasual (13.07.12 09:41) [6]
>
> :facepalm: весь код касающейся этой формы я привел.

Ты ищешь там, где светло, а не где потерял. Попробуй поискать там, где потерял.

← →
delhpiCasual (2012-07-13 10:36) [11]

1)

Ну вызывается она действительно супер часто, сколько раз в секунду не засекал.

Procedure RefreshTV(tbmp: TBitmap);
begin
sleep(10000);
if (not(tv.Left = 0)) or (not(tv.Top = 0)) then
begin
tv.Left := 0;
tv.Top := 0;
end;
if (not((tv.Height = tbmp.Height + 100))) or
(not((tv.Width = tbmp.Width + 100))) then
begin
tv.Height := tbmp.Height + 100;
tv.Width := tbmp.Width + 100;
end;
if (not((tv.Image1.Left = 0))) or (not((tv.Image1.Top = 0))) then
begin
tv.Image1.Left := 0;
tv.Image1.Top := 0;
end;
if (not((tv.Image1.Height = tbmp.Height))) or
(not((tv.Image1.Width = tbmp.Width))) then
begin
tv.Image1.Height := tbmp.Height;
tv.Image1.Width := tbmp.Width;
end;
tv.Image1.Picture.Assign(tbmp);
tv.Refresh;
end;

лол, в таком виде конечно глюки исчезли, но только нафиг это не нужно никому в таком виде, т.к. скорость исполнения очень важна. причем условия в коде погоды не делают, а вот пауза. Все же глюк возникает при попытке сдвинуть окно. А с паузой оно не реагирует на эти попытки. и сдвинуть его не получается (хоть подвижность окна и не требуется).

2. Тогда какую же задачу решают отвечающие, отвечая? И почему им не нужен программист, чтобы нормально отвечать? )

← →
delhpiCasual (2012-07-13 10:38) [12]

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

программа 2000 строк по разным модулям, всю постить? )

← →
Плохиш © (2012-07-13 10:44) [13]

> 2. Тогда какую же задачу решают отвечающие, отвечая?

поговорить

> И почему им не нужен программист, чтобы нормально отвечать?

Что-такое "нормально"? На этом форуме все отвечают нормально.

> всю постить?

Это Ваши проблемы и никто Вам здесь либо ещё где-то ничего не должен и ничем не обязан.

PS. А для поплакать здесь есть конференция "Прочее". Там всегда найдуться защитники сирых и убогих. Правда решения ваших проблем они не предложат, ибо не в состоянии.

← →
Омлет © (2012-07-13 10:58) [14]

> delhpiCasual (13.07.12 10:36) [11]

1. sleep полностью замораживает поток, он тебе не нужен.
2. Не надо вызывать перерисовку супер часто. Надо по необходимости. Например, вызывай по таймеру или, просто, не чаще 30 кадров в секунду.
3. Не делай Assign - лишняя работы. Вообще не используй TImage, refresh тоже выкинь. Просто выводи картинку на форму через BitBlt, передавая ссылку на битмап.
4. Зачем менять размеры формы так часто? Неужели размеры картинки постоянно меняются?

Итого получаем:

// Там, где меняются размеры картинки, делаем tv.SetBounds(0, 0, bmp.widt0h, bmp.height); ... procedure RefreshTV(tbmp: TBitmap); begin // Тут нужен только вывод на форму BitBlt(tv.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, Bmp.Canvas.Handle, 0, 0, SRCCOPY); end;

В обработчике OnPaint для tv надо тоже отрисовку добавить.

← →
Омлет © (2012-07-13 11:11) [15]

> программа 2000 строк по разным модулям, всю постить? )

Если много кода, воспользуйся http://pastebin.com/ или файлообменником, чтобы весь проект (или только демонстрацию ошибки) выложить. А лучше подумай, какой код связан с ошибкой. Я почти уверен, что проблема в том месте, где вызывается RefreshTV, но ты этот код прячешь. Телепаты здесь, конечно, знатные, но имеют свои пределы.

← →
delhpiCasual (2012-07-13 11:23) [16]

function findPicture(tBmpContainer: TBitmap; searchArray: TsearchArray;
size: Integer; x: cardinal = 0; y: cardinal = 0; x1: cardinal = 0;
y1: cardinal = 0; k: extended = 0.6): TCoord;
// Поиск в области скриншота
var
QP1: TQuickPixels;
Pixel1: cardinal;
i: Integer;
x2: cardinal;
y2: cardinal;
sovpadenij: Integer;
Intensity1: byte;
kSov: extended;
Coord: TCoord;
xmax: Integer;
ymax: Integer;
xmin: Integer;
ymin: Integer;
xmaxMass: Integer;
ymaxMass: Integer;
xminMass: Integer;
yminMass: Integer;

begin
Coord := form3.InitCoordStruct();

kSov := 0;
xmax := 0;
ymax := 0;

if not((tBmpContainer.Height < y1) or (tBmpContainer.Width < x1)) then
begin
QP1 := TQuickPixels.Create;
QP1.Attach(tBmpContainer);
for y2 := y to y1 do
begin
for x2 := x to x1 do
begin
sovpadenij := 0;

xmaxMass := 0;
ymaxMass := 0;
xminMass := high(xminMass);
yminMass := high(yminMass);
for i := 0 to size - 1 do
begin
if ((x2 + searchArray[i].x) < 0) or ((y2 + searchArray[i].y) < 0) or
((x2 + searchArray[i].x) > x1) or ((y2 + searchArray[i].y) > y1) or
((x2 + searchArray[i].x) > QP1.Width) or
((y2 + searchArray[i].y) > QP1.Height) then
else
begin

Pixel1 := QP1.GetPixels24(x2 + searchArray[i].x,
y2 + searchArray[i].y);
Intensity1 := getIntensity(Pixel1);
if Intensity1 < 255 then
begin
if xmaxMass < (x2 + searchArray[i].x) then
xmaxMass := (x2 + searchArray[i].x);
if ymaxMass < (y2 + searchArray[i].y) then
ymaxMass := (y2 + searchArray[i].y);
if xminMass > (x2 + searchArray[i].x) then
xminMass := (x2 + searchArray[i].x);
if yminMass > (y2 + searchArray[i].y) then
yminMass := (y2 + searchArray[i].y);
inc(sovpadenij);
end;

end;
end;

if kSov < (sovpadenij / size) then
begin
kSov := (sovpadenij / size);
xmax := xmaxMass;
ymax := ymaxMass;
xmin := xminMass;
ymin := yminMass;
end; // конец проверки на то что существующий коэффициент совпадения меньше текущего
end; // конец первого цикла по Y
end; // Конец первого цикла по Х

if kSov > k then // Будем считать что совпало
begin
Coord.x1search := xmin;
Coord.y1search := ymin;
Coord.x2search := xmax;
// (xmax + searchArray[(size - 1)].x);
Coord.y2search := ymax;
// (ymax + searchArray[(size - 1)].y);

Coord.x1work := xmin + 1;
Coord.y1work := ymin + 1;
Coord.x2work := xmax - 1;
Coord.y2work := ymax - 1;

if not(x = Coord.x1search) or not(Coord.y1search = y) or
not(x1 = Coord.x2search) or not(Coord.y2search = y1) then
Coord.coordCh := true
else
Coord.coordCh := false;

Coord.PicFound := true;
Drawsquare(tBmpContainer, xmax, ymax, ymin, xmin);
RefreshTV(tBmpContainer);
end; // Конец проверки на то, что коэффициент удовлетворяет условию по которому понимаем что нашли картинку.
QP1.Free;
end;
result := Coord;
end;

← →
app © (2012-07-13 11:23) [17]

> программа 2000 строк по разным модулям, всю постить? )

Только попробуй.

← →
AV © (2012-07-13 11:25) [18]

см
Омлет © (13.07.12 10:58) [14]
+
при входе в RefreshTV
1. проверяется флаг, который если взведен, то выход.
2. флаг взводится.
Это исключит неконтролируемый второй вход (поможет его выявить, если дописать ахтунг какой)

И флаг сбрасывается, когда реально нужно перерисовать форму
по таймеру, или явно

> Плохиш ©
> На чём основано сие подозрение?

на

> вдруг появляется надпись (не отвечает)

значит, занята чем-то
а так - не знаю, интуиция :)
+ так угадал же :)
(почти)

← →
Омлет © (2012-07-13 11:36) [19]

> delhpiCasual (13.07.12 11:23) [16]

Где вызывается findPicture? Если у тебя бесконечно вызывается findPicture, понятно, что все будет висеть. Даже если закомментировать RefreshTV.
Опиши задачу, что, где, когда и зачем ищется и рисуется.

← →
delhpiCasual (2012-07-13 11:48) [20]

> Где вызывается findPicture? Если у тебя бесконечно вызывается
> findPicture, понятно, что все будет висеть. Даже если закомментировать
> RefreshTV.
> Опиши задачу, что, где, когда и зачем ищется и рисуется.
>

делается скрин окна сторонней программы и в ней ищутся определенные картинки. Скрины делаются настолько быстро насколько это возможно и поиск картинок соответственно тоже. при успешном поиске выполняются определенные действия(в том числе поиск в найденом куске другой картинки). Точную скорость поиска картинки не знаю, но 1-2 раза в секунду есть точно. Далее в целях понимания что происходит (потому что иногда ничего не понятно чего он там нашел, но понятно что ничего не работает) на вот эту форму выводится результат ее поисков, т.е. обработаный скрин с выделенным объектом.

Без формы ничего не висит. С формой висит только форма, все остальное продолжает исправно работать. По сути форма нужна для отладки. Вообщем я уже понял, что в таком виде, оно просто не тянет... Городить мега огород желания нет, т.к. эта форма по большому счету для отладки.

← →
Омлет © (2012-07-13 12:07) [21]

> но 1-2 раза в секунду есть точно

С такой скоростью ничего не должно висеть. Опять что-то скрываешь.

← →
delhpiCasual (2012-07-13 12:09) [22]

хм, даже со слипом. в первый заход в рефреш форма не перерисовалась, а нарисовалась новая, а основная и первая остались висеть поверх новой. Причем ту что появилась при tv.Show можно таскать мышкой, а новую нельзя и при этом картинки нормально рисуются. И глюк этот никогда не появляется в режиме отладки, и гораздо реже в режиме исполнения если вставить паузу. вообщем дурдом.

← →
delhpiCasual (2012-07-13 12:12) [23]

> С такой скоростью ничего не должно висеть. Опять что-то
> скрываешь.

ну так она и не висит, она конкретно глючит )

← →
Омлет © (2012-07-13 12:16) [24]

Нужно больше кода.

← →
delhpiCasual (2012-07-13 16:51) [25]

больше кода не поможет. Упростил ситуацию до предела. Закоментировал рефреш вообще. Результат - второе окно не появляется. Но если передать фокус tv то оно переходит в состояние "не отвечает". Подозреваю что я неправильно создаю эту форму, только вот не знаю как правильно.

При этом на главная форма (на которой расположена кнопка запускающая программу) занята и соответственно не перемещается. А ТВ можно возить по экрану, только вот она становится неотвечающей и ничего не показывается в ней.

Если же рефреш вызывать, то еcли tv.show вызывается прямо перед вызовом tvrefresh то обновляется показаное окно, расширяется и переносится в заданные координаты. Если же после tv.show программа долго пытается получить скрин, т.е. несколько секунд не вызывается ни поиск картинки ни рефрешь, то когда таки рефрешь делается. показанное окно остается на месте, а под всеми окнами появляется еще одно окно tv уже нормальной формы, т.е. вместо одного окна тv у меня их 2 ) и в обоих меняется картинка.

Procedure RefreshTV(tbmp: TBitmap);
begin

if not tv.Visible then
tv.Show;

if (not(tv.Left = 0)) or (not(tv.Top = 0)) then
begin
tv.Left := 0;
tv.Top := 0;
end;
if (not((tv.Height = tbmp.Height + 100))) or
(not((tv.Width = tbmp.Width + 100))) then
begin
tv.Height := tbmp.Height + 100;
tv.Width := tbmp.Width + 100;
end;
BitBlt(tv.Canvas.Handle, 0, 0, tbmp.Width, tbmp.Height, tbmp.Canvas.Handle, 0, 0, SRCCOPY);

end;

т.е. если сделать так, то ситуация не меняется.

← →
Inovet © (2012-07-13 17:15) [26]

> [25] delhpiCasual (13.07.12 16:51)
> При этом на главная форма (на которой расположена кнопка
> запускающая программу) занята и соответственно не перемещается.
> А ТВ можно возить по экрану, только вот она становится неотвечающей
> и ничего не показывается в ней.

ProcessMessage() вызываешь в цикле поиска картинки?

← →
Омлет © (2012-07-13 18:32) [27]

> delhpiCasual (13.07.12 16:51) [25]

У тебя банально виснет приложение. Слишком часто(читай непрерывно) вызывается findPicture.

← →
delhpiCasual (2012-07-13 19:50) [28]

> ProcessMessage() вызываешь в цикле поиска картинки?

нет

← →
delhpiCasual (2012-07-13 19:52) [29]

> У тебя банально виснет приложение. Слишком часто(читай непрерывно)
> вызывается findPicture.

а почему оно "виснет" только если окно попытаться пошевелить, и не виснет если нет? а без окна так вообще все шикарно...

> а почему оно "виснет" только если окно попытаться пошевелить,
> и не виснет если нет?

Да всегда виснет. Просто винда пишет, что не отвечает, если ты что-то пытаешься сделать с окном зависшего приложения. Посмотри загрузку процессора в диспетчере задач.

← →
delhpiCasual (2012-07-14 05:25) [31]

> Да всегда виснет. Просто винда пишет, что не отвечает, если
> ты что-то пытаешься сделать с окном зависшего приложения.
> Посмотри загрузку процессора в диспетчере задач.

ну в моем понимании "виснет", значит ничего не делает. Но я вижу что на самом деле процесс идет и она выдает сообщения о том что она делает, и выполняет действия, которые должна выполнять. Т.е. она идет по алгоритму. Такую же фигню можно наблюдать в 1с 7.7 когда выполняется обработка большая, если пытаться кантовать программу во время ее исполнения или выходить по альт. таб, то форма приложения перестает обновляться и выглядит так будто зависло, а потом обработка заканчивается и она "отвисает", может 7.7 тоже писали на делфи? )))

← →
delhpiCasual (2012-07-14 05:26) [32]

12% загрузка проца. 15 мб памяти занимает в озу.

В начале ветки ты спрашивал, что за ужас. А теперь для тебя это стало нормально? Т.е. тема закрыта?
1с 7.7 - плохой пример для подражания.

← →
delhpiCasual (2012-07-14 12:13) [34]

Нет естественно это не стало нормально. Но ведь никто не знает как это лечить, даж не понятно с чем это связано и что курить. Видимо остается только терпеть.

> [34] delhpiCasual (14.07.12 12:13)
> Но ведь никто не знает как это лечить, даж не понятно с чем это связано

Так сказали уже.

> Но ведь никто не знает как это лечить, даж не понятно с
> чем это связано и что курить.

По-простому, лечится вызовом Application.ProcessMessages в теле цикла вычислений.
Но лучше вынести долгие операции в отдельный поток.

← →
delhpiCasual (2012-07-14 12:29) [37]

> Так сказали уже.

где?

← →
delhpiCasual (2012-07-14 12:45) [38]

> По-простому, лечится вызовом Application.ProcessMessages
> в теле цикла вычислений.
> Но лучше вынести долгие операции в отдельный поток.

помогло

> [38] delhpiCasual (14.07.12 12:45)
> помогло

Что из двух?

> Application.ProcessMessages

думаю :)

Задваивается изображение формы Найти похожие ветки