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

Поиск сообщества

Показаны результаты для тегов 'Canvas'.

  • Поиск по тегам

    Введите теги через запятую.
  • Поиск по автору

Тип контента


Форумы

  • Общие вопросы
    • Анимация
    • Графика
    • Стили
    • Базы данных и REST
    • Компоненты
    • Положение, размеры, выравнивание
    • Работа с текстом
    • Приложение и формы
    • Отладка
    • Развертывание приложений
    • Вопросы по языку Object Pascal и RTL
    • Общая информация о TControl
    • События
    • Прочие вопросы
  • Вопросы по платформам
    • Android
    • iOS
    • OSX
    • Windows
    • Windows Phone
    • Linux
  • Вопросы по использованию RAD Studio
    • Лицензирование
    • Сборка проектов
    • Multi-Device Designer
    • Редактор кода
    • Вопросы
  • Обучение
    • Основная информация
    • Вопросы
    • Отзывы
  • Поиск специалистов по FireMonkey
    • Консультации
    • Ищу подрядчика
  • Дополнительные ресурсы по FireMonkey
    • Сторонние компоненты
    • Приложения, написанные с использованием FireMonkey
    • Примеры
    • Руководства
    • Шаблоны
    • Статьи и заметки
    • Информация о версиях RAD Studio
    • Новости
  • Организация работы данного форума

Поиск результатов в...

Поиск контента, содержащего...


Дата создания

  • Начало

    Конец


Дата обновления

  • Начало

    Конец


Фильтр по количеству...

Регистрация

  • Начало

    Конец


Группа


AIM


MSN


Сайт


ICQ


Yahoo


Jabber


Skype


StackOverflow


Защита от ботов


Город


Интересы

Найдено: 20 результатов

  1. Здравствуйте! Подскажите пожалуйста в чем причина смещения изображения при печати по горизонтали относительно листа? procedure ThePrint(day : arraySheet; prn : TPrintDialog); var DestRect, Rect_cell, Rect_Size:TRectF; i,pageall:integer; textFill: tFillTextFlags; poses : TPoses; Col1 : boolean; COLROW : integer; sizeRow : Single; Image : TImage; begin textFill := []; COLROW := 63; Printer.ActivePrinter := Printer.Printers[1]; Printer.ActivePrinter.SelectDPI(Printer.ActivePrinter.DPI[Printer.ActivePrinter.DPICount-1]); Printer.BeginDoc; sizeRow := Printer.PageHeight / COLROW; poses := getPosY(day, sizeRow); Printer.Canvas.BeginScene; Printer.Canvas.Font.Size := sizeRow * 0.8; Printer.Canvas.Font.Family := 'Times New Roman'; Printer.Canvas.Fill.Color := TAlphaColorRec.Black; Printer.Canvas.Fill.Kind := TBrushKind.Solid; Col1 := true; var WCol := Printer.PageWidth / 2 - 10; var WColW := WCol / 3; for var s := 0 to Length(poses)-1 do begin if Col1 then DestRect := RectF(0, poses[s], WCol, poses[s] + sizeRow) else DestRect := RectF(WCol, poses[s], Printer.Canvas.Width, poses[s] + sizeRow); Printer.Canvas.Font.Style:= Printer.Canvas.Font.Style + [TFontStyle.fsBold]; Printer.Canvas.FillText(DestRect,day[0].listSheme[s].name,True,1,textFill,TTextAlign.Center,TTextAlign.Center); Printer.Canvas.Font.Style:= Printer.Canvas.Font.Style - [TFontStyle.fsBold]; for var p := 0 to Length(day[0].listSheme[s].listPosition) - 1 do begin var nameSize := day[0].listSheme[s].listPosition[p].t + 'x' + day[0].listSheme[s].listPosition[p].w + 'x' + day[0].listSheme[s].listPosition[p].l + '='; if day[0].listSheme[s].listPosition[p].c.ToInteger > 1 then nameSize := nameSize + day[0].listSheme[s].listPosition[p].c + 'л'; Rect_cell := RectF(10, poses[s] + (sizeRow * (p+1)), WCol-30, poses[s] + (sizeRow * (p+2))); Rect_Size := RectF(0, poses[s] + (sizeRow * (p+1)), WCol - WColW, poses[s] + (sizeRow * (p+2))); if not Col1 then begin Rect_cell.Left := Rect_cell.Left + WCol + 20; Rect_cell.Right := Rect_cell.Right + WCol + 10; Rect_Size.Left := Rect_Size.Left + WCol + 20; Rect_Size.Right := Rect_Size.Right + WCol + 10; end; Printer.Canvas.FillText(Rect_cell, day[0].listSheme[s].listPosition[p].pn + ')' + day[0].listSheme[s].listPosition[p].s, True,1,textFill,TTextAlign.Leading,TTextAlign.Center); Printer.Canvas.FillText(Rect_Size, nameSize, True,1,textFill,TTextAlign.Trailing,TTextAlign.Center); end; Col1 := not(Col1); end; for var row := 1 to COLROW do begin Printer.Canvas.DrawLine(TPointF.Create(0, sizeRow * row), TPointF.Create(WCol, sizeRow * row), 0.5); Printer.Canvas.DrawLine(TPointF.Create(WCol + 20, sizeRow * row), TPointF.Create(Printer.Canvas.Width, sizeRow * row), 0.5); end; DestRect := RectF(0, 0, Printer.Canvas.Width, sizeRow); Printer.Canvas.FillText(DestRect, day[0].name, True, 1, textFill, TTextAlign.Center,TTextAlign.Center); Printer.Canvas.DrawLine(TPointF.Create(WCol, sizeRow), TPointF.Create(WCol, Printer.Canvas.Height), 1); Printer.Canvas.DrawLine(TPointF.Create(WCol + 20, sizeRow), TPointF.Create(WCol + 20, Printer.Canvas.Height), 1); Printer.Canvas.DrawLine(TPointF.Create(0, sizeRow), TPointF.Create(500, Printer.Canvas.Height), 1); Printer.Canvas.DrawLine(TPointF.Create(Printer.Canvas.Width, sizeRow), TPointF.Create(Printer.Canvas.Width, Printer.Canvas.Height), 1); Printer.Canvas.DrawLine(TPointF.Create(WCol-WColW+20, sizeRow), TPointF.Create(WCol-WColW+20, Printer.Canvas.Height), 1); Printer.Canvas.DrawLine(TPointF.Create(Printer.Canvas.Width-WColW+20, sizeRow), TPointF.Create(Printer.Canvas.Width-WColW+20, Printer.Canvas.Height), 1); Printer.Canvas.EndScene; Printer.EndDoc; end; ВОТ ЧТО ПОЛУЧАЕТСЯ: Линия спецом под угол, что бы понять само смещение в лево относительно листа. Соответственно текст тоже видно на половину Написано на Delphi 11, FMX.Printer Заранее спасибо!
  2. Здравствуйте! Подскажите пожалуйста почему такая в масштабе разница отрисовки в Bitmap.Canvas в Windows и Android, и как ее настроить? Windows: Android: Дано: 1. Массив с координатами прямоугольников и их габаритами (миллиметры) 2. Поле для расположения этих прямоугольников ширина 2000мм длина 6000мм (ширину и длину может менять пользователь но не более этих размеров) Задача: Вывести в Bitmap на экран это поле с расположенными прямоугольниками на картинках "Лист" - это Image Не могу понять как подогнать Bitmap.size под все экраны вот мой код: Спасибо за внимание!
  3. Botov Nikita

    "Ластик" для TImage

    Добрый день Уважаемые! Подскажите каким образом можно реализовать функцию ластика в XE 10.3? Например на форме лежит 2 TImage один над другим, и когда мышкой проводим по верхней картинке, остается "след" и видно нижнюю картинку? С Уважением!
  4. Добрый день. Очень нужна Ваша помощь. Мне необходимо сделать координатную сетку в виде точек. При масштабировании панели количество точек должно изменяться . Хочу все это сделать на канве панели. Унаследовал класс и переопределил 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?
  5. Здравствуйте! Есть самописный компонент - индикатор загрузки написанныый под 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
  6. Ильдар

    Bitmap DrawLine

    Добрый день, идеология такая: - создать битмап, рисовать на нем, не делая его видимым. - нашлепать на канву панели подготовленный битмап. На деле не получается нарисовать линию на битмапе. Т.е после процедуры 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;
  7. Загружаю через opendialog картинку формата bmp в image Есть переменные с:TColor, c1:Tcolor Необходимо вначале узнать цвет определенного пикселя на загруженной картинке и записать в c1, а затем изменить цвет определенного пикселя на загруженной картинке на цвет, хранящийся в переменной c. Ищу очень давно, но внятного объяснения нигде не нашла(
  8. Доброго всем времени суток. Хочу снова поднять вопрос про отрисовку линий на канве, обсуждавшейся здесь С горизонтальными и вертикальными линиями проблем нет, при смещении на половину от толщины линии всё прекрасно выглядит. Однако при отрисовке линий под различными углами такой финт не проходит: слева 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;
  9. Подскажите алгоритм или готовый пример заливки замкнутой области рисунка произвольной формы определенным цветом? Моё решение часто приводит к переполнению стека.
  10. В DrawColumnCell провожу зарисовку некоторых строк, необходима подсветка цветом. И тут возникла неожиданная проблема на ровном месте: ячейка, где текстом записано время, почему-то меняет местами время и дату, хотя передаётся в функцию FillText как надо. TabbedForm->StringGrid1->Canvas->Fill->Color = background_color; TabbedForm->StringGrid1->Canvas->FillRect(Bounds, 0, 0, AllCorners, 100); TabbedForm->StringGrid1->Canvas->Fill->Color = font_color; TabbedForm->StringGrid1->Canvas->Font->Style << fsBold; TabbedForm->StringGrid1->Canvas->FillText(Bounds,TabbedForm->StringGrid1->Cells[Column->Index][Row], false, 100,TFillTextFlags() << TFillTextFlag::ftRightToLeft, TTextAlign::taTrailing, TTextAlign::taTrailing); Подскажите пожалуйста, как развернуть время обратно? Ну и параллельно вопрос: как строку сплошным цветом заливать? Без белых границ?
  11. В этой теме я уже задавал вопрос, но, наверное, я просто ошибся разделом. Аккумулирую вопрос: 10.1 Berlin, C++, Win8, FMX. Интересует особенность работы Canvas->FillText(), вот код: void __fastcall TTabbedForm::StringGrid1DrawColumnCell(TObject *Sender, TCanvas * const Canvas, TColumn * const Column, const TRectF &Bounds, const int Row, const TValue &Value, const TGridDrawStates State) { // код... UnicodeString CT = TabbedForm->StringGrid1->Cells[Column->Index][Row]; Canvas->FillText(Bounds, CT, false, 100,TFillTextFlags() << TFillTextFlag::ftRightToLeft, TTextAlign::taTrailing, TTextAlign::taTrailing); } В итоге наблюдаются совсем странные "фишки": 1. Разворот времени, хотя в FillText() текст передаётся правильный. 2. Если текст заканчивается на скобку, то скобка разворачивается и переносится в начало текста. 3. И, если есть и кириллица, и латиница, то текст просто не выводится)) (хотя есть подозрение, что это кавычки виноваты). Кто сталкивался? Что делать? Есть альтернативы?
  12. *** Небольшой обмен опытом *** Вижу что вопросы о размере текста довольно частые, поделюсь своими наработками. 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; --- Также данные функции можно найти в этом юните
  13. Под Windows 32 приложение собирается и работает отлично, под Android при запуске из RAD-среды сразу говорит: Project project1.apk raised exception class ECanvasException with message 'Handle not allocated' и отказывается работать. В чем может быть причина?
  14. Привет. Как можно узнать сколько кадров в секунду рисует мой компонент? Пытался сделать так: procedure TCoordinatePlane.Paint; var aBM: TStopwatch; begin aBM := TStopwatch.Create; try aBM.Start; inherited Paint; FCells.DrawShape(Self); PaintXY; PaintAllShapes; PaintDebugInfo; aBM.Stop; Canvas.TextOut(0, 20, (1 / aBM.Elapsed.TotalSeconds).ToString); finally // aBM.Free; end; end; Выдает значения довольно разные(В зависимости от масштаба) от 30 .. >1000. Как то не доверяю этим значениям. Можете подсказать как правильно сделать замер FPS?
  15. Как вывести текст на изображение так, чтобы его можно было сохранить в .jpg формате. P.S. Нет метода TextOut у Image.
  16. Krug1: TCircle лежащий на TabItem4, TabControl1 лежащим на Form1 Проблема в том, что текст кажется рисуется по координатам формы, а не Krug1, или TabItem4, или TabControl1 (заменял в коде krug1.Canvas на TabControl1.Tabs[3].Canvas всё равно по координатам формы рисует). В теории представляю, что если по координатам круга то TRectF.Create(0, 0, krug1.Width, krug1.Height) должен работать, но нет. В коде (кусок из события Click объекта krug1) ниже по логике в TRectF.Create с опорой на координаты Tab'а, хотя канва krug1, в итоге рисует над TabControl1: with krug1.Canvas do begin BeginScene; try Fill.Color := TAlphaColorRec.Red; Fill.Kind := TBrushKind.Solid; Font.Size := 10; FillText(TRectF.Create(krug1.Position.X, krug1.Position.Y, krug1.Position.X+krug1.Width, krug1.Position.Y+krug1.Height), 'Текст', False, 1, [], TTextAlign.Center, TTextAlign.Center); finally EndScene; end; end;
  17. Как определить, какая канва используется в текущий момент?
  18. Возможно ли рисовать анимацию на других компонентах? Вот например как MediaPlayer (VCL) - в свойстве можно выбрать было разные компоненты для отображения видео. В случае с ФМ - можно рисовать только на специальном компоненте MediaPlayerControl. Это случайность, или теперь не получится рисовать на разных компонентах? Если же возможно - поделитесь техникой, как это сделать.
  19. Пробую нарисовать окружность в заданном регионе на мобильной платформе следующим способом: procedure TForm1.Image14Paint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF); begin Image14.Canvas.Stroke.Color := TAlphaColorRec.Red; PixelRegion := TRectF.Create(TPointF.Create(100, 100), 20, 20); Image14.Canvas.DrawEllipse(PixelRegion, 1); end; В Windows всё отображается, а на мобильных платформах окружность не отображается. Подскажите, с чем может быть связано такое поведение.
  20. Добрый вечер. Помогите с таким вопросом. Пытаюсь сделать эффект "Падающих звезд" для 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; Но даже при его запуске получаю ошибку: Если нажать на Break то кидает на функцию function TBitmap.GetCanvasClass: TCanvasClass; begin if not Assigned(FCanvasClass) then FCanvasClass := TCanvasManager.GetDefaultCanvas; Result := FCanvasClass; end; Собственно вопрос: Как нарисовать точку на канве в FMX?
×
×
  • Создать...