denprox

23 мая, 2017

Мне кажется идея с регионами, звучит попроще. К примеру, если использовать такую функцию:

function BitmapToRgn(Image: TBitmap): HRGN;
var
  TmpRgn: HRGN;
  x, y: integer;
  ConsecutivePixels: integer;
  CurrentPixel: TColor;
  CreatedRgns: integer;
  CurrentColor: TColor;

  tmpImage:TBitmapData;
begin
  Image.Map(TMapAccess.ReadWrite, tmpImage);

  CreatedRgns := 0;
  Result := CreateRectRgn(0, 0, Image.Width, Image.Height);
  inc(CreatedRgns);

  if (Image.Width = 0) or (Image.Height = 0) then
    exit;

  for y := 0 to Image.Height - 1 do
  begin
    CurrentColor := tmpImage.GetPixel(0,y);

    ConsecutivePixels := 1;
    for x := 0 to Image.Width - 1 do
    begin
      CurrentColor := tmpImage.GetPixel(x,y);

      if CurrentColor = CurrentPixel then
        inc(ConsecutivePixels)
      else
      begin
        // Входим в новую зону
        if CurrentColor = TColorRec.White then
        begin
          TmpRgn := CreateRectRgn(x - ConsecutivePixels, y, x, y + 1);
          CombineRgn(Result, Result, TmpRgn, RGN_DIFF);
          inc(CreatedRgns);
          DeleteObject(TmpRgn);
        end;
        CurrentColor := CurrentPixel;
        ConsecutivePixels := 1;
      end;
    end;

    if (CurrentColor = TColorRec.White) and (ConsecutivePixels > 0) then
    begin
      TmpRgn := CreateRectRgn(x-ConsecutivePixels, y, x, y+1);
      CombineRgn(Result, Result, TmpRgn, RGN_DIFF);
      inc(CreatedRgns);
      DeleteObject(TmpRgn);
    end;
  end;
end;

Только мне пока не ясно, как применить регион к Bitmap'у или, как писал dnekrasov сопоставить Битмап и регион

23 мая, 2017

Mars M

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

Ingalime · 22 мая, 2017

krapotkin

Предполагается, что пользователь сам должен создать свой "тренировочный полигон", установить фон, выбрать мишени и укрытия. Для упрощения предлагается нарисовать в Paint мишени/укрытия, как на картинках ниже. По большому большой роли не играет Image это или Bitmap. Для Укрытия красный цвет означает стену, белый (или отсутствие цвета, если это png с альфа каналом) - соответственно окно. Для мишени, у маски несколько цветов, каждый из которых отвечает за определенный балл.

dnekrasov

На счет регионов, думаю этот вариант подошел бы как нельзя кстати. Но как я уже писал ранее, к примеру для функции SetWindowRgn - нужен хэндл окна (объекта). В VCL к примеру без проблем можно для TPanel применить эту функцию.

22 мая, 2017

Каким образом ?

22 мая, 2017

Доброго времени суток! Пытаюсь сделать небольшое приложение в виде игры на тему "Стрелковый тир". Столкнулся с основной проблемой, решение которой обеспечит решение всей задачи, а именно Определение объекта попадания. Проблема в том, что кроме мишеней, могут присутствовать еще укрытия, а в укрытиях могут быть окна. Визуально мы видим как мишень появляется в "окне" и стреляем в нее, но по скольку программно это TImage один за другим, то событие ОнКлик срабатывает для Укрытия (TImage на переднем плане).

Были такие идеи:

1. Воспользоваться функционалом, который используют для придания окну программы произвольной формы (функция SetWindowRgn() ), но для этого нужно знать Handle объекта

2. При клике определять позицию курсора, определять какие объекты в этой позиции находятся, и послойно определять точку попадания для каждого объекта по маске. - но боюсь, что этот метод будет не очень быстро работать.

Буду признателен, если предложите свои идеи, как можно решить такую задачу. Если есть примеры - еще лучше!

19 мая, 2017

16 минут назад, krapotkin сказал:

а откуда у TImage HWND ? - это же не WinControl

Пардон) допустим не Image а TPanel ? В VCL можно было написать просто Panel1.handle, а как в FMX это реализуется?

Евгений Корепов · 19 мая, 2017

Доброго времени суток! Пытаюсь сделать форму программы произвольной формы. Нагуглил такой пример:

function BitmapToRgn(Image: TBitmap): HRGN;
var
  TmpRgn: HRGN;
  x, y: integer;
  ConsecutivePixels: integer;
  CurrentPixel: TColor;
  CreatedRgns: integer;
  CurrentColor: TColor;

  tmpImage:TBitmapData; //добавлено мной
begin
  Image.Map(TMapAccess.ReadWrite, tmpImage); //Добавлено мой для совместимости

  CreatedRgns := 0;
  Result := CreateRectRgn(0, 0, Image.Width, Image.Height);
  inc(CreatedRgns);

  if (Image.Width = 0) or (Image.Height = 0) then
    exit;

  for y := 0 to Image.Height - 1 do
  begin
    //CurrentColor := Image.Canvas.Pixels[0,y];  -- было
    CurrentColor := tmpImage.GetPixel(0,y);      //стало

    ConsecutivePixels := 1;
    for x := 0 to Image.Width - 1 do
    begin
      //CurrentPixel := Image.Canvas.Pixels[x, y]; -- было
      CurrentColor := tmpImage.GetPixel(x,y);      //стало

      if CurrentColor = CurrentPixel then
        inc(ConsecutivePixels)
      else
      begin
        // Входим в новую зону
        if CurrentColor = TColorRec.White then
        begin
          TmpRgn := CreateRectRgn(x - ConsecutivePixels, y, x, y + 1);
          CombineRgn(Result, Result, TmpRgn, RGN_DIFF);
          inc(CreatedRgns);
          DeleteObject(TmpRgn);
        end;
        CurrentColor := CurrentPixel;
        ConsecutivePixels := 1;
      end;
    end;

    if (CurrentColor = TColorRec.White) and (ConsecutivePixels > 0) then
    begin
      TmpRgn := CreateRectRgn(x-ConsecutivePixels, y, x, y+1);
      CombineRgn(Result, Result, TmpRgn, RGN_DIFF);
      inc(CreatedRgns);
      DeleteObject(TmpRgn);
    end;
  end;
end;

По скольку пример был для VCL, немного изменил/добавил код

Затем по нажатию кнопки применяем:

procedure TForm1.Button1Click(Sender: TObject);
var
  MaskBmp: TBitmap;

begin
  MaskBmp := TBitmap.Create;
  try
    MaskBmp.LoadFromFile(ExtractFileDir(ParamStr(0))+ '\rgn.png');
    Height := MaskBmp.Height;
    Width := MaskBmp.Width;
    // ОС владеет регионом, после вызова SetWindowRgn

    SetWindowRgn(FmxHandleToHWND(Handle), BitmapToRgn(MaskBmp), True);
  finally
    MaskBmp.Free;
  end;
end;

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

p.s.

Если использовать не Bitmap а к примеру:

var
  Rgn : HRGN;
begin
  Rgn := CreateEllipticRgn(0, 0, 200, 200);
  SetWindowRgn(FmxHandleToHWND(Self.Handle), Rgn, TRUE);
end;

То окно программы становится круглым, как и задумано.

19 мая, 2017

Всем привет! Возник такой вопрос, как можно получить список всех контролов под курсором ? К примеру несколько TImage лежат друг над другом, при нажатии на самый "верхний", необходимо узнать какие контролы есть под этим TImage.

19 мая, 2017

Доброго времени суток! Подскажите, как получить хендл (HWND) контрола, например TImage расположенного на форме ?

17 мая, 2017

11 минуту назад, Brovin Yaroslav сказал:

Нужно делать свой компонент отнаследованный от TImage. И в нем переопределить процедуру проверки попадания точки в область PointInObject. В этом методе делать свой анализ попала ли точка в маске или нет.

Спасибо, подумаю над этим.

17 мая, 2017

Вот примерно так это могло бы выглядеть.

17 мая, 2017

Доброго времени суток! Столкнулся с такой задачей: допустим на форме лежит кнопка (или любой другой объект), поверх него лежит Image, у которого есть определенная маска (Альфа). Необходимо, чтобы в местах где прозрачность, была возможность нажать на объект, который под Image находится. При этом Image так же должен быть кликабелен.

Mars M · 17 мая, 2017

Спасибо! То что нужно!

Вот рабочий пример:

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
var
   AbsoluteMousePos: TPointF;
   LocalMousePos: TPointF;
begin
Label1.Text := 'X: '+FloatToStr(X); //Координаты в пределах объекта
Label2.Text := 'Y: '+FloatToStr(Y);

LocalMousePos := TPointF.Create(X, Y);
AbsoluteMousePos := Panel1.LocalToAbsolute(LocalMousePos);

Label3.Text := 'gX: '+ FloatToStr(AbsoluteMousePos.X); //Координаты относительно формы
Label4.Text := 'gY: '+ FloatToStr(AbsoluteMousePos.Y);

16 мая, 2017

Доброго времени суток! Подскажите, каким образом можно узнать глобальные координаты курсора в момент нажатия по TImage (например). К примеру на форме лежит TImage, при нажатии (OnMouseDown) можно узнать координаты X,Y в пределах этого Image (локальные), а как узнать X,Y относительно главной формы ?

20 апреля, 2017

Про Position объекта как то не подумал ... спасибо за наводку ))

20 апреля, 2017

Всем привет! Подскажите, как узнать текущую позицию Point.X и Point.Y в момент проигрывания ? Т.е. мне нужно, после запуска TPathAnimation.Start, показать текущее значение TPathAnimation.PathData

20 апреля, 2017

Доброго времени суток! Подскажите, как можно реализовать изменение скорости движения объекта по заданному пути в разный момент времени? К примеру нарисовали прямую линию, по которой движется TImage, необходимо, чтобы сначала картинка передвигалась с одной скоростью, затем ускорилась и снова вернулась к исходной скорости.

19 апреля, 2017

Я знаю что есть 3D, но мне нужно именно в 2D )) Пока мысль была такая: изменять высоту Timage и одновременно смещать позицию вниз (т.к. координаты начинаются от верхнего левого угла), таким образом будет что-то похожее на падение назад.

19 апреля, 2017

Доброго времени суток! Подскажите пожалуйста, возможно ли реализовать имитацию падения картинки, такого плана:

Brovin Yaroslav · 11 апреля, 2017

Пришлось набирать весь код по видео. Если кому будет полезно, вот исходник

PathAnim2.rar

11 апреля, 2017

Доброго времени суток! Есть у кого ни будь пример того, как в RunTime нарисовать путь, по которому потом сможет двигаться объект ?

Я смог найти только видео:

Tutorial: TPathAnimation in FireMonkey XE6

6 апреля, 2017

Решение найдено:

procedure SetTransparent(oBmp: TBitmap);
var
  bmpData: TBitmapData;
  colorToMakeTransparent: TAlphaColor;
  transparentColor: TAlphaColor;
  color: TAlphaColor;
  x,y: Integer;
begin
  oBmp.Map(TMapAccess.ReadWrite, bmpData);
 
  colorToMakeTransparent := bmpData.GetPixel(0,0);
  transparentColor := $00000000;
 
  for x := 0 to bmpData.Width do
  begin
    for y := 0 to bmpData.Height do
    begin
      color := bmpData.GetPixel(x,y);
      if (color = colorToMakeTransparent) then
        bmpData.SetPixel(x,y,transparentColor);
    end;
  end;
 
  oBmp.Unmap(bmpData);
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  img: TImage;
begin
  img := TImage.Create(Self);
  with img do
  begin
    Parent := Self;
    Position.X := 136;
    Position.Y := 16;
    Width := 257;
    Height := 321;
    Bitmap.LoadFromFile(ExtractFilePath(ParamStr(0))+'123.png');
   SetTransparent(Bitmap);
  end;
end;

5 апреля, 2017

Всем привет! Подскажите, как программно применить TransparentColor для TImage которые динамически создаются.

Пишу так, но эффекта ноль...

MultiResBitmap.TransparentColor := TColorRec.White;

p.s. фотошоп не предлагать, нужно именно указать цвет прозрачности

5 апреля, 2017

Есть еще такое решение: Если поместить объект в TSelection, который в свою очередь потомок необходимого родителя, то автоматически будут созданы границы, за которые объект(потомок) нельзя вывести.

5 апреля, 2017

  maxW := Image1.Bitmap.Width;
  maxH := Image1.Bitmap.Height;
  if Selection1.Height > maxH then
    Selection1.Height := maxH;
  if Selection1.Width > maxW then
    Selection1.Width := maxW;
  Selection1.Width:=Image1.Bitmap.Width*(Selection1.Height/Image1.Bitmap.Height);

Для Selection событие onResize.

Войти

denprox

Постов

Зарегистрирован

Посещение

Тип контента

Профили

Форумы

Сообщения, опубликованные denprox

Стрелковый тир (игра)

Стрелковый тир (игра)

Mars M

Стрелковый тир (игра)

krapotkin

dnekrasov

Стрелковый тир (игра)

Стрелковый тир (игра)

Как получить hwnd контрола ?

Окно программы по заданному Bitmap'у

Получить список контрлов под курсором

Как получить hwnd контрола ?

Физический альфа канал для Image

Физический альфа канал для Image

Физический альфа канал для Image

Глобальные и локальные координаты позиции курсора

Глобальные и локальные координаты позиции курсора

Узнать текущую позицию

Узнать текущую позицию

Изменить скорость в разный момент времени

Имитация падения TImage в 2D

Имитация падения TImage в 2D

TPath - нарисовать путь для объекта

TPath - нарисовать путь для объекта

Программно применить TransparentColor

Программно применить TransparentColor

Запретить выходить за пределы родителя

TSelection - Размер по картинке

Сайт

FGX

Активность