Как сделать линию пунктиром у Rectangle в Delphi?

[Katerina1993]

Здравствуйте, нашла пример где создается Rectangle. Линия у квадрата обрывистые.
Вот пример:
https://1olgastorm.github.io/Example1/canvas1.html
Вот код на html.

Цитата

var canvas = document.getElementById("drawingCanvas");
var context = canvas.getContext("2d");
canvas.style.background = "#CCCCCC";
context.beginPath();
context.lineWidth="4";
context.setLineDash([12,12]);
context.strokeStyle="blue";
context.rect(20, 20, 120, 120);
context.stroke();

Как тоже самое нарисовать на форме Delphi, чтобы в квадрате линия тоже были пунктиром?

[MBo]

Canvas.Pen.Style := psDash;

[Katerina1993]

Спасибо, разобралась.

procedure TForm1.FormPaint(Sender: TObject);
begin
Canvas.Pen.Width := 1;
Canvas.Pen.Color := clBlue;
Canvas.Pen.Style := psDash;
Canvas.MoveTo(20, 20);
Canvas.LineTo(20, 200);
Canvas.LineTo(200, 200);
Canvas.LineTo(200, 20);
Canvas.LineTo(20, 20);
end;

[MBo]

Зачем рисовать линиями, если есть примитив TCanvas.Rectangle?

[Katerina1993]

Еще вопрос. Как сместить объект(фигуры) в delphi по оси координат?

При этом не меняя значения в MoveTo, Lineto, Rectangle. Например в той же javascript есть функция transform. Достаточно поставить перед отрисовкой фигуры transform.

Цитата

var canvas = document.getElementById("drawingCanvas");
var context = canvas.getContext("2d");
canvas.style.background = "#CCCCCC";
context.beginPath();
context.lineWidth="4";
context.setLineDash([12,12]);
context.strokeStyle="blue";
context.transform(1,0,0,1,20,20);
context.rect(0, 0, 120, 120);
context.stroke();

и объект сместиться по x=20 и по y=20.

Прикреплённый файлrect.jpg (6,58 Кбайт, скачиваний: 26)

Сообщение отредактировано: Katerina1993 - 21.03.24, 22:05

[macomics]

Есть API функция для установки ординат для контекста. Но в самом Canvas я не помню, чтобы такое можно было изменить на Delphi 7.

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    MoveLeftButton: TButton;
    MoveUpButton: TButton;
    MoveDownButton: TButton;
    MoveRightButton: TButton;
    procedure FormPaint(Sender: TObject);
    procedure MoveLeftButtonClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure MoveUpButtonClick(Sender: TObject);
    procedure MoveRightButtonClick(Sender: TObject);
    procedure MoveDownButtonClick(Sender: TObject);
  private
    newX, newY: Integer;
    oldP: TPoint;
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormPaint(Sender: TObject);
begin
  with Canvas do begin
    SetWindowOrgEx(Handle, newX, newY, @oldP);
    Rectangle(20, 20, 120, 120);
  end;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  newX := 0;
  newY := 0;
end;
 
procedure TForm1.MoveLeftButtonClick(Sender: TObject);
begin
  newX := newX + 10;
  Repaint;
end;
 
procedure TForm1.MoveUpButtonClick(Sender: TObject);
begin
  newY := newY + 10;
  Repaint;
end;
 
procedure TForm1.MoveRightButtonClick(Sender: TObject);
begin
  newX := newX - 10;
  Repaint;
end;
 
procedure TForm1.MoveDownButtonClick(Sender: TObject);
begin
  newY := newY - 10;
  Repaint;
end;
 
end.

[Katerina1993]

Смешение работает. Протестировала пример из предыдущего поста. Возможно ли получение RGBA у компонента Image?

Например в JavaScript с помощью getImageData можно вернуть одномерной массив Uint8ClampedArray, содержащий данные модели RGBA, с целыми значениями от 0 до 255. Пример на скриншоте. Вывод массива через консоль.
Прикреплённый файлrgba_example.jpg (77,98 Кбайт, скачиваний: 22)

Для этого я использую код.

Цитата

canvas = document.getElementById("drawingCanvas");
ctx = canvas.getContext("2d");


canvas.width = 100;
canvas.height = 100;

ctx.clearRect(0, 0, 100, 100)

ctx.drawImage(img, 0, 0, 100, 100)

const imageData = ctx.getImageData(0, 0, 100, 100);
console.log(ctx.getImageData(0, 0, 1, 1));
console.log(ctx.getImageData(0, 0, 2, 2));
console.log(ctx.getImageData(0, 0, 3, 3));
console.log(ctx.getImageData(0, 0, 4, 4));

Есть что-нибудь похожее в Delphi для компонента Image?

Сообщение отредактировано: Katerina1993 - 23.03.24, 09:23

[macomics]

Непосредственно на Dephi 7 есть массив TImage.Bitmap.Canvas.Pixels, но работает он крайне медленно. Гораздо лучше скопировать изображение в DIBsection и получить данные непосредственно из нее.

Еще можно воспользоваться WinAPI функцией GetBitmapBits, указав её в третьем параметре массив в формате RGB достаточного размера.

[Katerina1993]

Попробовала заменить текстуры на Delphi 7, вот пример на html5.
https://1olgastorm.github.io/Example2/grafic.html
Прикреплённый файлimg1.jpg (6,83 Кбайт, скачиваний: 20)
Попытка на Delphi 7. Этот пример взяла с другого сайта поэтому не совсем понимаю как работает код. Но перекрасить картинку черный в красный, а белый в зеленный цвет не получается.

Прикреплённый файлimg2.jpg (11,58 Кбайт, скачиваний: 22)

Код:

  bmp1,bmp2 : TBitmap;
....
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  bmp1 := TBitmap.Create;
  bmp1.LoadFromFile('.\bitmap\main.bmp');  // chargement du niveau
  Form1.Image1.Canvas.Brush.Color:=clWhite;
  Form1.Image1.Canvas.FillRect(Form1.Image1.ClientRect);
  Image1.Canvas.Draw(0,0,bmp1);
 // bmp2 := TBitmap.Create;
  //bmp2.LoadFromFile('.\bitmap\main.bmp');  // chargement du niveau
  //Form1.Image1.Canvas.Brush.Color:=clWhite;
  //Form1.Image1.Canvas.FillRect(Form1.Image1.ClientRect);
  //Image1.Canvas.Draw(0,0,bmp2);
 
end;
.....
 
procedure TForm1.Mixer( Bitmap: TBitmap; Value: Byte; Color: TColor );
 
  function BLimit( B: Integer ): Byte;
  begin
     if B < 0 then
        Result := 0
     else if B > 255 then
        Result := 255
     else
        Result := B;
  end;
 
type
  pRGB = ^TRGB;
  TRGB = record
    B, G, R: Byte;
  end;
var
  x, y: Word;
  Dest: pRGB;
  DR, DG, DB, D: Double;
begin
   DR := Lo( Color );
   DG := Lo( Color shr 8 );
   DB := Lo( ( Color shr 8 ) shr 8 );
   for y := 0 to Bitmap.Height - 1 do begin
      Dest := Bitmap.ScanLine[y];
      for x := 0 to Bitmap.Width - 1 do begin
         with Dest^ do begin
            R := BLimit( Round( ( R/100 * Value + DR/100 * ( 255-Value ) ) / 2 ) );
            G := BLimit( Round( ( G/100 * Value + DG/100 * ( 255-Value ) ) / 2 ) );
            B := BLimit( Round( ( B/100 * Value + DB/100 * ( 255-Value ) ) / 2 ) );
         end;
         Inc( Dest );
       end;
    end;
  Image3.canvas.Draw(0,0,Bitmap);
end;

[macomics]

Процедура Mixer использует объявленную внутри структуру (TRGB) и указатель на данные этой структуры (pRGB) для обращения к данным в объекте Bitmap
Два вложенных цикла: внешний по строкам и внутренний по столбцам. Они проходят по всем пикселям Bitmap и изменяют дынные в памяти по указателю.
Во внешнем цикле получается указатель на пиксели строки изображения и сохраняется в переменной Dest (типа pRGB).
В внутреннем цикле стоит блок with, чтобы сократить в его операторах доступ к полям структуры TRGB, на которую указывает Dest. После with указатель Dest увеличивается на 3 (байта - длину структуры TRGB).
В блоке with последовательно по отдельности к каждому цветовому компоненту применяется функция смешивания значений: (X / 100 * Value + DX / 100 * (255 - Value)) / 2. По сути Value и 255 - Value это обратные величины: если одна максимальная, то другая минимальная. X / 100 и DX / 100 это компоненты цвета текущего пикселя и заданного в параметрах цвета.

А вот код в методе FormCreate не имеет смысла кроме первых двух строк. Рисовать на экране до его обновления нельзя (точнее все эти изменения будут отброшены и стерты при OnErase и OnPaint).

[Katerina1993]

Инетересно, а аналог setTransform в delphi 7 есть?

Вот синтаксис, в html canvas.

Цитата

ctx.setTransform(m11, m12, m21, m22, dx, dy);

А вот пояснение c habr

Цитата

dx, dy — повторяют метод translate, смещая картинку на соответствующие значения.
m11, m22 — повторяют метод scale, изменяя размер отрысовываемых пикселей.
m12, m21 — более интересные. Каждый пиксель (x,y) смещается на y*m21 пикселей вправо и на x*m12 пикселей вниз.Это значит, что при m21=1 каждая следующая строчка будет смещена на 1 пиксель вправо, относительно предыдущей.

Сообщение отредактировано: Katerina1993 - 24.03.24, 02:41

[MBo]

SetWorldTransform

[Katerina1993]

Разобралась как работает SetWorldTransform.

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;
 
type
  TForm1 = class(TForm)
    Image1: TImage;
    Image2: TImage;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  bmp1: TBitmap;
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
var HDC:THandle;
M:TXFORM;
a:Double;
begin
  bmp1 := TBitmap.Create;
  bmp1.LoadFromFile('.\bitmap\main.bmp');  // chargement du niveau
  Form1.Image1.Canvas.Brush.Color:=clWhite;
  Form1.Image1.Canvas.FillRect(Form1.Image1.ClientRect);
  Image1.Canvas.Draw(0,0,bmp1);
 
   hDc := Image2.Canvas.Handle;
   SetGraphicsMode(hDc, GM_ADVANCED);
 
   M.eM11 := 1;
   M.eM12 := 0;
   M.eM21 := 0;
   M.eM22 := 1;
   M.eDx := -bmp1.Width div 2;
   M.eDy := -bmp1.Height div 2;
   SetWorldTransform(hDc, M);
 
   a := PI/6;
   fillChar(M, sizeOf(M), 0);
   M.eM11 := Cos(a);
   M.eM12 := Sin(a);
   M.eM21 := -Sin(a);
   M.eM22 := Cos(a);
   M.eDx := 0;
   M.eDy := 0;
   ModifyWorldTransform(hDc, M, MWT_RIGHTMULTIPLY);
 
   M.eM11 := 1;
   M.eM12 := 0;
   M.eM21 := 0;
   M.eM22 := 1;
   M.eDx := bmp1.Width div 2;
   M.eDy := bmp1.Height div 2;
   ModifyWorldTransform(hDc, M, MWT_RIGHTMULTIPLY);
 
   Image2.Canvas.Draw(0, 0, bmp1);
end;
 
end.

Результат:

Прикреплённый файлimg1.jpg (23,28 Кбайт, скачиваний: 19)

[Katerina1993]

Я убедилась, что SetWorldTransform это та функция, которая является аналогом setTransform в html5. Запустила два примера.
1. Delphi.

 bmp1 := TBitmap.Create;
  bmp1.LoadFromFile('.\bitmap\main.bmp');  // chargement du niveau
  Form1.Image1.Canvas.Brush.Color:=clWhite;
  Form1.Image1.Canvas.FillRect(Form1.Image1.ClientRect);
  Image1.Canvas.Draw(0,0,bmp1);
 
   hDc := Image2.Canvas.Handle;
   SetGraphicsMode(hDc, GM_ADVANCED);
 
   a := PI/6;
 
   M.eM11 := Cos(a);
   M.eM12 := Sin(a);
   M.eM21 := -Sin(a);
   M.eM22 := Cos(a);
   M.eDx := 0;
   M.eDy := 0;
   SetWorldTransform(hDc, M);
 
   Image2.Canvas.Draw(0, 0, bmp1);

Результат:

Прикреплённый файлimg2.jpg (7,62 Кбайт, скачиваний: 21)

2. HTML5.

Цитата

var a,eM11,eM12,eM21,eM22,eDx,eDy;

var c=document.getElementById("drawingCanvas");
var ctx=c.getContext("2d");
var c=document.getElementById("drawingCanvas1");
var ctx1=c.getContext("2d");

const img = new Image()
img.src = 'main.jpg';
img.onload = function()
{
ctx.drawImage(img,0,0);




a = Math.PI/6;

eM11 = Math.cos(a);
eM12 = Math.sin(a);
eM21 = -Math.sin(a);
eM22 = Math.cos(a);
eDx = 0;
eDy = 0;

ctx1.setTransform(eM11,eM12,eM21,eM22,eDx,eDy);
ctx1.drawImage(img,0,0);
}

Результат (c помощью стилей я изменила задний фон, чтобы соотвествовал Delphi).
Прикреплённый файлimg3.jpg (7,76 Кбайт, скачиваний: 22)

Сообщение отредактировано: Katerina1993 - 25.03.24, 14:37

[Katerina1993]

А вот нашелся и аналог transform, который я так искала, это ModifyWorldTransform. Последний параметр нужно обязательно передавать MWT_LEFTMULTIPLY.

Пример использования на dephi 7.

  M.eM11 := 1;
   M.eM12 := 0;
   M.eM21 := 0;
   M.eM22 := 1;
   M.eDx := 0;
   M.eDy := 100;
   ModifyWorldTransform(hDc, M, MWT_LEFTMULTIPLY);

Результат.
Прикреплённый файлimg4.jpg (8,01 Кбайт, скачиваний: 24)
Пример использования на html 5.

Цитата

a = Math.PI/6;

eM11 = Math.cos(a);
eM12 = Math.sin(a);
eM21 = -Math.sin(a);
eM22 = Math.cos(a);
eDx = 0;
eDy = 0;

ctx1.setTransform(eM11,eM12,eM21,eM22,eDx,eDy);
ctx1.transform(1, 0, 0, 1, 0, 100);
ctx1.drawImage(img,0,0);

Результат.
Прикреплённый файлimg5.jpg (12,69 Кбайт, скачиваний: 27)

Добавлено 25.03.24, 15:01
Обе картинки одинаково выглядывают из угла что на Delphi, что на HTML5.

Вывод: Функция ModifyWorldTransform(Delphi) и Transform(HTML5) идентичны.

Сообщение отредактировано: Katerina1993 - 25.03.24, 15:06