VPF::наложение компонентов - Форум программистов

gonzales

Дата 31.1.2012, 16:36 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 241
Регистрация: 13.3.2006

Репутация: 1
Всего: 2

Приветствую, уважаемые форумчане!!!!

Возникла интересная задача, уже все мозги сломал. smile

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

Сначала я хотел использовать регионы для обрезки прозрачной части компонента, но у TImage нет хэндла. Тогда я пробывал создать наследника TCustomControl, но он не поддерживает прозрачность. Все попытки прикрутить к нему прозрачность не увенчались успехом.

Единственным вариантом вижу обрабатывать onclick и передавать его в случае "тыкания" в прозрачную область компоненту под ним. Отсюда пара вопросов, кроме как перебирать все компоненты на форме и сравнивать clientrect с позицией мышки если ли другие идеи? Например использовать подобные функции

function FindDragTarget(const Pos: TPoint; AllowDisabled: Boolean): TControl;
function ControlAtPos(const Pos: TPoint; AllowDisabled: Boolean; AllowWinControls: Boolean = False; AllLevels: Boolean = False): TControl;

но вопрос, как найти все контролы под мышкой??

--------------------

- мастер, мастер, запорол..., все четыре запорол!!!- я ж тебе только три давал!!!???- да я и образец запорол!!!!

Illusion Dolphin

Дата 4.2.2012, 23:04 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1198
Регистрация: 3.5.2003

Репутация: 13
Всего: 63

Допустим что на форме лежит N компонентов TImage и у них у всех загрежены полупрозначные TPngImage. У каждого компонента на OnMouseDown установлен следующий обработчик:

Код


procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  P, PI: TPoint;
  IM: TImage;
  PNG: TPngImage;
  I: Integer;
begin
  Caption := '';
  P := Point(X, Y);
  P := TControl(Sender).ClientToScreen(P);
  for I := 0 to ControlCount - 1 do
  begin
    if Controls[I] is TImage then
    begin
      IM := TImage(Controls[I]);
      PI := IM.ScreenToClient(P);
      PNG := TPngImage(IM.Picture.Graphic);
      if (PI.X > 0) and (PI.Y > 0) and (PI.X < PNG.Width) and (PI.Y < PNG.Height) then
      begin
        if PNG.AlphaScanline[PI.Y - 1][PI.X - 1] > 10 then
          Caption := IM.Name;
      end;
    end;
  end;
end;

В Caption пишется имя найденного компонента.
Число 10 - это значит что при прозрачности менее 10 изображение считается непрозрачной. Можно заменить на другу константу на вкус. Главное чтобы азображение не масштабировалось в TImage иначе это надо учитывать в алоритме. В строчке "Caption := IM.Name;" можно сделать "IM.OnClick(IM);" что вызовет клик по непрозначному Image.

--------------------

В мире всего две бесконечности: вселенная и человеческая глупость... На счёт вселенной я не уверен.
Шифрование и организация фотографий - Photo Database 4.5

gonzales

Дата 7.2.2012, 09:52 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 241
Регистрация: 13.3.2006

Репутация: 1
Всего: 2

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

Код


procedure TForm1.FrameMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
var
i:integer;
sendername:string;
p:tpoint;
begin
 begin
  with sender as TFrameImage do
   begin
    FrameImageMouseDown(sender as TFrameImage,Button,Shift,X, Y);
     begin
      if MouseInRegion=true then //флаг отвечающий за нахождение мыши в видимой области
       begin
         //обычные действия
       end
      else
       begin
        p.X:=x;
        p.Y:=y;
        p:=(sender as TFrameImage).ClientToParent(p);
        form1.findframe:=true;
        sendername:=(sender as TFrameImage).Name;
        //  showmessage(inttostr(p.X));
        for i:=0 to form1.ComponentCount-1 do
         if form1.Components[i] is TFrameImage then
          with form1.Components[i] as TFrameImage do
           begin
            p:=ParentToClient(p);
            FrameImageMouseDown(form1.Components[i] as TFrameImage,Button,Shift,p.X, p.Y);
            if MouseInRegion=true then
             begin
              ReleaseCapture;
              //  showmessage((form1.FindComponent(sendername)as TFrameImage).Name);
             // form1.FrameMouseUp((form1.FindComponent(sendername)as TFrameImage),Button,Shift,X, Y);
               Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTUP, x, y, 0, 0);
               ReleaseCapture;
              Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTDOWN, p.x, p.y, 0, 0);
            //  sender:=(form1.Components[i] as TFrameImage);
              form1.FrameMouseDown((form1.Components[i] as TFrameImage),button,shift,p.X,p.y);

            //  form1.FrameMouseMove((form1.Components[i] as TFrameImage),shift,p.x,p.y);
             end;
           end;



     // showmessage('2');
     end;
     end;
   end;
 end;
end;

ReleaseCapture не помогает

--------------------

- мастер, мастер, запорол..., все четыре запорол!!!- я ж тебе только три давал!!!???- да я и образец запорол!!!!

Illusion Dolphin

Дата 13.2.2012, 20:47 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1198
Регистрация: 3.5.2003

Репутация: 13
Всего: 63

Дополняем предыдущий код:

Код


  private
    FIM: TImage;
    FX, FY: Integer;
    FTop, FLeft: Integer;

Код



procedure TForm1.FormCreate(Sender: TObject);
begin
  FIM := nil;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  P, PI: TPoint;
  IM: TImage;
  PNG: TPngImage;
  I: Integer;
begin
  Caption := '';
  P := Point(X, Y);
  P := TControl(Sender).ClientToScreen(P);
  FX := P.X;
  FY := P.Y;
  for I := 0 to ControlCount - 1 do
  begin
    if Controls[I] is TImage then
    begin
      IM := TImage(Controls[I]);
      PI := IM.ScreenToClient(P);
      PNG := TPngImage(IM.Picture.Graphic);
      if (PI.X > 0) and (PI.Y > 0) and (PI.X < PNG.Width) and (PI.Y < PNG.Height) then
      begin
        if PNG.AlphaScanline[PI.Y - 1][PI.X - 1] > 10 then
        begin
          FTop := IM.Top;
          FLeft := IM.Left;
          FIM := IM;
        end;
      end;
    end;
  end;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  P: TPoint;
begin
  P := Point(X, Y);
  P := TControl(Sender).ClientToScreen(P);
  if FIM <> nil then
  begin
    FIM.Left := FLeft + P.X - FX;
    FIM.Top := FTop + P.Y - FY;
  end;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FIM := nil;
end;

и у формы не забываем DoubleBuffered = True

--------------------

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Звук, графика и видео \| Следующая тема »