Перейти к содержанию
Fire Monkey от А до Я
  • 0

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


denprox

Вопрос

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

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;

 

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

Ссылка на комментарий

Рекомендуемые сообщения

Ответов пока нет

Присоединяйтесь к обсуждению

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

Гость
Ответить на вопрос...

×   Вставлено с форматированием.   Вставить как обычный текст

  Разрешено использовать не более 75 эмодзи.

×   Ваша ссылка была автоматически встроена.   Отображать как обычную ссылку

×   Ваш предыдущий контент был восстановлен.   Очистить редактор

×   Вы не можете вставлять изображения напрямую. Загружайте или вставляйте изображения по ссылке.

  • Последние посетители   0 пользователей онлайн

    • Ни одного зарегистрированного пользователя не просматривает данную страницу
×
×
  • Создать...