|
|
|
|
#1
17.04.2014, 03:00
|
|||
|
|||
БД и ГИС
Всем доброго времени суток, господа.
Может мой вопрос уже озвучивался где-то, но я не нашел ответ на него.... Если что приношу свои извинения...  Но переходу к делу: есть БД к которой находятся координаты зданий на карте (поля таблицы-Xmin, Xmax, Ymin, Ymax, Image, About).Нужно при наведении мышки на определенное здание выводить фото и описание этого здания. Код:
function TForm1.GetImageName(const X, Xmin, Xmax, Y, Ymin, Ymax: Integer): string;
begin
with ADOTable1 do
begin First;
while not EOF do begin
if (X > Xmin) and (X < Xmax) and (Y > Ymin) and (Y < Ymax) then
begin
Result:= ADOTable1Foto.AsString ;
end
else
Result:= '';
next;
end;
end;
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var x2,y2: integer;
NewImageName: string;
begin
if ssleft in shift then // если нажата левая кнопка мыши, то...
begin
x1:=x; //запоминаем конечные координаты
y1:=y; //запоминаем конечные координаты
Scrollbox1.VertScrollBar.Position := Scrollbox1.VertScrollBar.Position + y0-y1;
Scrollbox1.HorzScrollBar.Position := Scrollbox1.HorzScrollBar.Position +x0-x1;
end;
Label1.Caption := IntToStr(x);
Label2.Caption := IntToStr(y);
//ПЕРЕБОРКА СТРОК ТАБЛИЦЫ
NewImageName:= GetImageName(X,StrToInt(ADOTable1Xmin.AsString),StrToInt(ADOTable1Xmax.AsString),
Y,StrToInt(ADOTable1Ymin.AsString),StrToInt(ADOTable1Ymax.AsString));
if NewImageName = '' then
begin
Image5.Visible:= False;
LoadImage:='';
end
else
if NewImageName <> LoadImage then
begin
Image5.Visible:= True;
Image5.Picture.LoadFromFile(NewImageName);
LoadImage:= NewImageName;
end;
Label3.Caption := NewImageName;
end;Создал данный код, но работает некорректно. Реагирует только на перые координаты, а фото выводит последнее... Подскажите в чем ошибка. |
| Этот пользователь сказал Спасибо Alegun за это полезное сообщение: | ||
Demlan (17.04.2014)
| ||
|
#3
17.04.2014, 04:18
|
|||
|
|||
|
Может и правильней, только вот результат все равно нулевой. Проблема в цикле по ходу. Не могу ее решить..
С этим Код:
if (X > Xmin) and (X < Xmax) and (Y > Ymin) and (Y < Ymax) А с этим Код:
if (X in [Xmin..Xmax]) and (Y in [Ymin..Ymax]) then Изменил код функции на Код:
function TForm1.GetImageName(const X, Xmin, Xmax, Y, Ymin, Ymax: Integer): string;
begin
if Result = '' then
if (X > Xmin) and (X < Xmax) and (Y > Ymin) and (Y < Ymax)
then begin
Result:= ADOTable1Foto.AsString;
end
else
Result:= '';
end;Все заработало как надо. Если кому пригодится, то вот: Код:
function TForm1.GetImageName(const X, Xmin, Xmax, Y, Ymin, Ymax: Integer): string;
begin
if Result = '' then
if (X > Xmin) and (X < Xmax) and (Y > Ymin) and (Y < Ymax)
then begin
Result:= ADOTable1Foto.AsString;
end
else
Result:= '';
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
NewImageName: string;
begin
if ssleft in shift then // если нажата левая кнопка мыши, то...
begin
x1:=x; //запоминаем конечные координаты
y1:=y; //запоминаем конечные координаты
Scrollbox1.VertScrollBar.Position := Scrollbox1.VertScrollBar.Position + y0-y1;
Scrollbox1.HorzScrollBar.Position := Scrollbox1.HorzScrollBar.Position +x0-x1;
end;
Label1.Caption := IntToStr(x);
Label2.Caption := IntToStr(y);
//ПЕРЕБОРКА СТРОК ТАБЛИЦЫ
with ADOTable1 do
begin First;
while not EOF do begin
NewImageName:= GetImageName(X,StrToInt(ADOTable1Xmin.Text),StrToInt(ADOTable1Xmax.Text),
Y,StrToInt(ADOTable1Ymin.Text),StrToInt(ADOTable1Ymax.Text));
if Label3.Caption=NewImageName then
begin
if NewImageName = '' then
begin
Image5.Visible:= False;
LoadImage:='';
end
else
if NewImageName <> LoadImage then
begin
Image5.Visible:= True;
Image5.Picture.LoadFromFile(NewImageName);
LoadImage:= NewImageName;
end;
end;
next;
end;
end;
Label3.Caption := NewImageName;
end;Дорогу осилит идущий. Пойду дальше... Всем удачи. Последний раз редактировалось M.A.D.M.A.N., 17.04.2014 в 08:26. |
|
#4
17.04.2014, 07:50
|
||||
|
||||
|
Цитата:
Смотрите что происходит в MouseMove - вероятно что-то тяжёлое повесили на перемещение, если высчитываете координаты или пытаетесь найти что-то в базе, то это слишком затратный процесс и его лучше выполнять на MouseDown, а на перемещении оставить только локацию (определение) возможного региона для обработки З.Ы. Пока набирал текст - увидел последний пост, так оно и есть, на движухе всё самое тяжёлое висит, так могут быть глюки что не есть хорошо, пересмотрите вариант, будет ещё лучше |
|
#5
17.04.2014, 15:39
|
||||
|
||||
|
Цитата:
Например вот такой код: Код:
procedure TForm1.Button1Click(Sender: TObject);
var
a, b, c: Integer;
begin
a := 1;
b := 256;
c := 300;
if a in [b..c] then
ShowMessageFmt('Число %d ВХОДИТ в диапазон %d..%d', [a, b, c])
else
ShowMessageFmt('Число %d НЕ ВХОДИТ в диапазон %d..%d', [a, b, c]);
end; |
|
#6
17.04.2014, 17:28
|
||||
|
||||
|
Точно, я просто на маленьком рисунке так края рамки отслеживаю чтоб её двигать, там работает (обидно, это ж теперь придётся код наново переписывать, а там его уже прилично накопилось), а здесь по всей видимости размеры рисунка намного больше чем 255, вот и глючит, виноват, у ТС прошу прощения, поленился и не проверил на "тяжёлых" режимах данное решение. Спасибо за науку bro poli-smen! ^)
|
|
#7
17.04.2014, 20:43
|
||||
|
||||
|
Извините, я здесь допустил небольшую неточность.
У типа-диапазона конечно же нет никакого ограничения, например статический массив можно объявлять довольно больших размеров, а указанное ограничение имеется у типа-множества и оператор in работает именно с типом-множеством, хотя на вид кажется что это неограниченный тип-диапазон - вот такая пакость вшита в сам язык...  Я тоже выяснил это только через пару лет после того как начал изучать Delphi и потом лихорадочно пересматривал все свои проекты на наличие этого бага... |
Линейный вид
