Перейти к содержанию
  • Регистрация
  • 0
rareMax

Как нарисовать точку на канве в FireMonkey?

Вопрос

Добрый вечер. Помогите  с таким вопросом. Пытаюсь сделать эффект "Падающих звезд" для Android. Но не получается даже нарисовать точку на канве. Взял ваш пример с форума:

procedure TForm9.Panel1Click(Sender: TObject);
var
  M: TBitmapData;
  i, j: integer;
begin
  if Panel1.Canvas.Bitmap.Map(TMapAccess.maWrite, M) then
    try
      for i := 0 to Panel1.Canvas.Bitmap.Width - 1 do
        for j := 0 to Panel1.Canvas.Bitmap.Height - 1 do
          M.SetPixel(i, j, TAlphaColorRec.Red);
    finally
      Panel1.Canvas.Bitmap.Unmap(M);
    end;
  // Stars1.Stars := not Stars1.Stars;
end;

Но даже при его запуске получаю ошибку: 

 

First chance exception at $005537A3. Exception class $C0000005 with message 'access violation at 0x005537a3: read of address 0x00000040'. Process Project10.exe (3228)

Если нажать на Break то кидает на функцию 

function TBitmap.GetCanvasClass: TCanvasClass;
begin
  if not Assigned(FCanvasClass) then
    FCanvasClass := TCanvasManager.GetDefaultCanvas;
  Result := FCanvasClass;
end;

Собственно вопрос: Как нарисовать точку на канве в FMX?

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


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

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

  • 0

Добрый вечер

 

В моей статье, я описывал способ работы с TBitmap. В вашем же случае, вы работаете с канвой. У канвы формы нету Bitmap. Поэтому ваш код падает при попытке вызывать Map у не существующего объекта.

 

Для решения вашей задачи, нужно:

  1. Помнить о самое главной вещи при работе с канвой в FMX. Это то, что выполнять отрисовку можно только в определенный моменты времени (в отличии от VCL). Непосредственно, когда получен системный запрос на отрисовку сцены (формы), а именно в событиях OnPaint, OnPainting (в вашем случае у панели). 
  2. Знать, что канва существует в единственном экземпляре в рамках одной формы (опять же в отличии от VCL, где свою канву имеет каждый оконный контрол).

Резюмирую, все выше сказанное.

procedure TForm4.Panel1Paint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
var
  X, Y: Integer;
  PixelRegion: TRectF;
begin
  Canvas.Stroke.Color := TAlphaColorRec.Red;
  for X := 0 to Floor(Panel1.Width) - 1 do
    for Y := 0 to Floor(Panel1.Height) - 1 do
    begin
      PixelRegion := TRectF.Create(TPointF.Create(X, Y), 1, 1);
      Canvas.DrawRect(PixelRegion, 0, 0, AllCorners, 1);
    end;
end;

Задаем обработчик на событие TPanel.OnPaint. Используя канву переданную через параметры, задаем цвет кисти и отрисовываем логические пиксели. Для закраски пикселей, я воспользовался обычной отрисовкой квадрата с шириной в 1 логический пиксель.

 

Если речь идет об андроиде, то из-за возможного наличия экрана с повышенной плотностью пикселей (Screen Scale) это код для экранов со Scale отличных от 1 и не кратных 2, будет рисовать сдвоенные/размазанные линии. Чтобы этого избежать, нужно перед отрисовкой выполнить округление региона до физических пикселей при помощи метода TCanvas.AlignToPixel.

procedure TForm4.Panel1Paint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
var
  X, Y: Integer;
  PixelRegion: TRectF;
  PixelPos: TPointF;
begin
  Canvas.Stroke.Color := TAlphaColorRec.Red;
  for X := 0 to Floor(Panel1.Width) - 1 do
    for Y := 0 to Floor(Panel1.Height) - 1 do
    begin
      PixelPos := Canvas.AlignToPixel(TPointF.Create(X, Y));
      PixelRegion := TRectF.Create(PixelPos, 1, 1);
      Canvas.DrawRect(PixelRegion, 0, 0, AllCorners, 1);
    end;
end;

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


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

хмм, последний вопрос по этой теме: А в каком юните описана функция Floor  Floor(Panel1.Width)  ??

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


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

А почему когда пишу так:

Image14.Canvas.Stroke.Color := TAlphaColorRec.Red;
PixelRegion := TRectF.Create(TPointF.Create(100, 100), 20, 20);
Image14.Canvas.DrawEllipse(PixelRegion, 1);
То в Win всё видно, а на девайсе не видно?

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


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

 

А почему когда пишу так:

Image14.Canvas.Stroke.Color := TAlphaColorRec.Red;
PixelRegion := TRectF.Create(TPointF.Create(100,100),20,20);
Image14.Canvas.DrawEllipse(PixelRegion,1);
То в Win всё видно, а на девайсе не видно?

 

 

У меня просьба. На форуме пока негласное правило. Одна тема - один вопрос. В этой теме ответ уже был дан. Если вас интересует ответ на вашу ситуацию, оформите это отдельным вопросом. Так же нужно подробно описать вашу ситуацию. Чем подробнее и полнее будет описание вопроса, тем вероятнее на него и точнее будет ответ. Например в вашей ситуации нужно обязательно указать место, где вы пытаетесь выполнить отрисовку. А так же приложить скриншоты, подтверждающие, что на Windows и устройстве результат отрисовки разный.

 

Спасибо за понимание.

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


Ссылка на сообщение
Поделиться на другие сайты
Гость
Эта тема закрыта для публикации ответов.

  • Похожий контент

    • От Павел Блажеев
      Добрый день. Очень нужна Ваша помощь. 
      Мне необходимо сделать координатную сетку в виде точек. При масштабировании панели количество точек должно изменяться . 
      Хочу все это сделать на канве панели. Унаследовал класс и переопределил procedure   Paint; override;
        Tfield = class(TPanel)
            Constructor Create( parent: TFmxObject);
              procedure   Paint; override;
              Procedure   OnMyClick (Sender: TObject);
          end;

      В теле метода я пробовал рисовать. Экспериментировал и столкнулся с такой проблемой. Ничего не отображается. Нет никаких изменений.
      Если я наследую не от Tpanel а от Timage то часть кода работает а часть работает очень криво. Очень хочу разобраться почему .
      {Отображается сразу}
      for a:=1 to 1000 do
            begin
              self.Canvas.Fill.Color:=  TAlphaColors.Crimson;
               self.Canvas.FillEllipse(rect(1,1,10,10),self.AbsoluteOpacity);
               self.Canvas.FillEllipse(rect(round(self.Width-9),round(self.Height-9),round(self.Width), round(self.Height)),self.AbsoluteOpacity);
               self.Canvas.FillEllipse(rect(round(self.Width-9),1,round(self.Width), 9),self.AbsoluteOpacity);
               self.Canvas.FillEllipse(rect(1,round(self.Height-9),10, round(self.Height)),self.AbsoluteOpacity);
            end;
       
      {Отображается только после того как я проскролю Scrollbox на котором лежит панель в крайнее нижнее правое положение}
            self.Canvas.Stroke.Color:=  TAlphaColors.Crimson;
            self.Canvas.Stroke.Thickness:=7;
             Canvas.BeginScene;
            self.Canvas.DrawLine(PointF(20, 20), PointF(100, 50), self.AbsoluteOpacity);
             Canvas.EndScene;
      Подскажите пожалуйста, почему не работает такое с панелью?  Как правильно рисовать на панели? 
      Почему в случае с имейджем все работает так некорректно?  Почему работает только после скрола? 
      Каким способом мне лучше сделать координатную сетку? состоящую из точек как в режиме Design?

       


    • От Zyablik3000
      Здравствуйте!
      Есть самописный компонент - индикатор загрузки написанныый под VCL с использованием Direct2D.
      TD2DProgressBar = class(TCustomControl) FRenderTarget: ID2D1RenderTarget; FD2DFactory.CreateWicBitmapRenderTarget(FWicBitmap, RenderTargetProp, FRenderTarget); FInteropTarget := FRenderTarget as ID2D1GdiInteropRenderTarget; Вся отрисовка происходит на FRenderTarget.
      Затем беру
      FInteropTarget.GetDC(D2D1_DC_INITIALIZE_MODE_COPY, FRenderDC); и вывожу на поверхность функцией
       
      procedure TD2DProgressBar.UpdateWindow(sourceDC : HDC); var info : TUpdateLayeredWindowInfo; begin ZeroMemory(@info, sizeof(info)); with info do begin cbSize := sizeof(TUpdateLayeredWindowInfo); pptSrc := @FSourcePosition; pptDst := @FWindowPosition; psize := @FWndSize; pblend := @FBlend; dwFlags := ULW_ALPHA; end; info.hdcSrc := SourceDC; if not UpdateLayeredWindowIndirect(handle, @info) then begin RaiseLastOSError(); end end; Но это только под VCL.
      В Firemonkey не нашел способа комбинировать градиенты и/или нарисовать арку градиентом (саму линию арки а не залить сектор) или комбинацией градиентов.
       
      Как вывести этот FRenderTarget на канву Firemonkey-контрола?
      Самая большая проблема в том, что компонент полупрозрачный, и вариант с переливом через Vcl.Graphics.TBitmap и MemoryStream не дает нужного результата.
       
      MS:=TMemoryStream.Create; Blend.BlendOp := AC_SRC_OVER; Blend.BlendFlags := 0; Blend.AlphaFormat := AC_SRC_NO_PREMULT_ALPHA; Blend.SourceConstantAlpha:= 255; // // Уровень прозрачности Res:=Winapi.Windows.AlphaBlend(VCLBitmap.Canvas.Handle, 0, 0, VCLBitmap.Width, VCLBitmap.Height, FRenderDC, 0, 0, VCLBitmap.Width, VCLBitmap.Height, Blend); {или эта функция StretchBlt(bm.Canvas.Handle, 0, 0, VCLBitmap.Width, VCLBitmap.Height, FRenderDC, 0, 0, VCLBitmap.Width, VCLBitmap.Height, SRCCOPY); } VCLBitmap.SaveToStream(MS); FFMXBitmap.SetSize(TSize.Create(VCLBitmap.Width, VCLBitmap.Height)); FFMXBitmap.LoadFromStream(MS); FreeAndNil(MS);  
      В Blend пробовал разные комбинации BlendOp и AlphaFormat.
      Хелп плизз!
      Во вложении компонент под VCL. ( Может кому пригодится)) )
      D2DProgressbar.zip

    • От Денис Демин
      Здравствуйте, есть такая задача:
      1) Необходимо вставить карту от Яндекса на форму.
      2) Необходимо вставить информацию текстовую (информация о доставке или оплате), это можно также вставить HTML кодом, а лучше просто отформатированным содержанием. 
      Заранее спасибо всем за ответы.
    • От Ильдар
      Добрый день, идеология такая:
      - создать битмап, рисовать на нем, не делая его видимым.
      - нашлепать на канву панели подготовленный битмап.
       
      На деле не получается нарисовать линию на битмапе. Т.е после процедуры Draw2 прожимаю процедуру Draw - получаю на панели красный прямоугольник битмапа без нарисованной линии...
      Посоветуйте чего-нибуть, спасибо!
       
      //BITMAP Bm:= TBitmap.Create; bm.Width:= round (Panel.Width/2); bm.Height:= round (Panel.Height/2); bm.Canvas.BeginScene(); bm.Canvas.Clear(TAlphacolorrec.Red); //($FF484848); bm.Canvas.EndScene; procedure TChart.Draw2; var A,B:TPointF; begin A:=TPointF.Create(0,0); B:=TPointF.Create(200, 200); bm.Canvas.BeginScene(); bm.Canvas.DrawLine(A,B,1); bm.Canvas.EndScene; end; procedure TChart.Draw; var A: TPointF; R: TRectF; begin A.X:= Panel.Position.X+3; A.Y:= Panel.Position.Y+3; R:= TRectF.Create(A, bm.Width , bm.Height); panel.Canvas.BeginScene(); Panel.Canvas.DrawBitmap(bm,r,r, 20); panel.Canvas.EndScene; end;  
    • От Julia
      Загружаю через opendialog картинку  формата bmp в image
      Есть переменные с:TColor, c1:Tcolor
      Необходимо  вначале узнать цвет определенного пикселя на загруженной картинке и записать в  c1, а затем изменить цвет определенного пикселя на загруженной картинке на цвет, хранящийся в переменной c.
      Ищу очень давно, но внятного объяснения нигде не нашла(
       
       
    • От Maximus
      Доброго всем времени суток. Хочу снова поднять вопрос про отрисовку линий на канве, обсуждавшейся здесь
      С горизонтальными и вертикальными линиями проблем нет, при смещении на половину от толщины линии всё прекрасно выглядит. Однако при отрисовке линий под различными углами такой финт не проходит: слева VCL, справа FMX

      Линия всё так же размазывается, в итоге визуально утолщается и становится не такой чёткой.
      Как всё же добиться такого же результата как на VCL? Интересует только Windows.
      const OFFSET_LINE = 0.5; ... Image.Bitmap.Canvas.BeginScene; Image.Bitmap.Canvas.Stroke.Kind := TBrushKind.Solid; Image.Bitmap.Canvas.Stroke.Thickness := 1.0; Image.Bitmap.Canvas.DrawLine( PointF(10.0 - OFFSET_LINE, 10.0 - OFFSET_LINE), PointF(500.0 - OFFSET_LINE, 10.0 - OFFSET_LINE), 1.0); Image.Bitmap.Canvas.DrawLine( PointF(10.0 - OFFSET_LINE, 10.0 - OFFSET_LINE), PointF(10.0 - OFFSET_LINE, 500.0 - OFFSET_LINE), 1.0); Image.Bitmap.Canvas.DrawLine( PointF(10.0 - OFFSET_LINE, 10.0 - OFFSET_LINE), PointF(500.0 - OFFSET_LINE, 500.0 - OFFSET_LINE), 1.0); Image.Bitmap.Canvas.EndScene;  
    • От ODmitrijS
      Подскажите алгоритм или готовый пример заливки замкнутой области рисунка произвольной формы определенным цветом?
      Моё решение часто приводит к переполнению стека.
    • От Vizit0r
      Delphi Seattle, Android 5.0.1
      Формирую картинку через ScanLine. На выходе полученный битмап рисуется на полотне TImage, на котором перед этим был нарисован Rect.
      GlobalBitmap - формированный tbitmap.
                 with ObjectPreviewImage.Bitmap.Canvas do             begin               BeginScene;               Clear(TAlphaColorRec.White);               DRect := TRectF.Create(0, 0, GlobalBitmap.Width + 8, GlobalBitmap.Height + 8);               DrawRect(DRect, 0, 0, AllCorners,                        StealthForm.ObjectPreviewImage.AbsoluteOpacity);               DRect := TRectF.Create(0, 0, GlobalBitmap.Width, GlobalBitmap.Height);               DrawBitmap(GlobalBitmap,DRect,                  TRectF.Create(2, 2, GlobalBitmap.Width + 2, GlobalBitmap.Height + 2), 1);               EndScene;             end;  
      Проблема собственно в чем - в андроидной версии слева и внизу рамка "съедается". В Win32 версии все отлично. На прилагаемых скриншотах это четко видно.
      Документацию читал, гугл гуглил.
       
      Что я делаю не так? Или это неизвестные подводные камни андроидного рисования на полотне?
       
      P.S. Картинка одинаковая, цвет к определенной области применяется не верно. Походу тоже андроидные приколы. Но с этим я уже разберусь.
      P.P.S. Уже разобрался с цветом - под андроидом Blue и Red в пикселе надо поменять местами. А насчет канвы - не получается никак.
      P

    • От Error
      *** Небольшой обмен опытом ***
      Вижу что вопросы о размере текста довольно частые, поделюсь своими наработками.
      function CalcTextSize(Text: string; Font: TFont; Size: Single = 0): TSizeF;
      Функция для расчета размера прямоугольника, занимаемого однострочным текстом.
      Параметры:
      Text - Текст Font - Шрифт с которым будет выводиться текст Size - если 0, то Font.Size будет использоваться из Font, иначе из данного параметра Исходный код:
      uses System.Types, FMX.Types, FMX.Graphics, FMX.TextLayout, System.Math, System.SysUtils; function CalcTextSize(Text: string; Font: TFont; Size: Single = 0): TSizeF; var TextLayout: TTextLayout; begin TextLayout := TTextLayoutManager.DefaultTextLayout.Create; try TextLayout.BeginUpdate; try TextLayout.Text := Text; TextLayout.MaxSize := TPointF.Create(9999, 9999); TextLayout.Font.Assign(Font); if not SameValue(0, Size) then begin TextLayout.Font.Size := Size; end; TextLayout.WordWrap := False; TextLayout.Trimming := TTextTrimming.None; TextLayout.HorizontalAlign := TTextAlign.Leading; TextLayout.VerticalAlign := TTextAlign.Leading; finally TextLayout.EndUpdate; end; Result.Width := TextLayout.Width; Result.Height := TextLayout.Height; finally TextLayout.Free; end; end;   function FontSizeForBox(Text: string; Font: TFont; Width, Height: Single; MaxFontSize: Single = cMaxFontSize): Integer;
      Функция возвращающая максимально возможный размер шрифта, для текста вписанного в заданный прямоугольник.
      Параметры:
      Text - Текст Font - Шрифт с которым будет выводиться текст Width, Height - Ширина и высота прямоугольника MaxFontSize - Максимально возможный размер шрифта Исходный код:
      uses System.Types, FMX.Types, FMX.Graphics, FMX.TextLayout, System.Math, System.SysUtils; const cMaxFontSize = 512; function FontSizeForBox(Text: string; Font: TFont; Width, Height: Single; MaxFontSize: Single = cMaxFontSize): Integer; var Size, Max, Min, MaxIterations: Integer; Current: TSizeF; begin Max := Trunc(MaxFontSize); Min := 0; MaxIterations := 20; repeat Size := (Max + Min) div 2; Current := CalcTextSize(Text, Font, Size); if ((Abs(Width - Current.Width) < 1) and (Width >= Current.Width)) and ((Abs(Height - Current.Height) < 1) and (Height >= Current.Height)) then break else if (Width < Current.Width) or (Height < Current.Height) then Max := Size else Min := Size; Dec(MaxIterations); until MaxIterations = 0; Result := Size; end; ---
      Также данные функции можно найти в этом юните
  • Последние посетители   0 пользователей онлайн

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

×
×
  • Создать...