• 0
denprox

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

Вопрос

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

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;

 

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

Евгений Корепов понравилось это

Поделиться сообщением


Ссылка на сообщение
Поделиться на других сайтах

0 ответов на этот вопрос

Нет ответов на вопрос

Создайте аккаунт или войдите для комментирования

Вы должны быть пользователем, чтобы оставить комментарий

Создать аккаунт

Зарегистрируйтесь для получения аккаунта. Это просто!


Зарегистрировать аккаунт

Войти

Уже зарегистрированы? Войдите здесь.


Войти сейчас

  • Сейчас на странице   0 пользователей

    Нет пользователей, просматривающих эту страницу