Форум на Исходниках.RU

Форум на Исходниках.RU https://forum.sources.ru Форум на Исходниках.RU Форум на Исходниках.RU https://forum.sources.ru/index.php?showtopic=443691&view=findpost&p=3902093 Mon, 25 Mar 2024 14:58:16 +0000 Как сделать линию пунктиром у Rectangle в Delphi? https://forum.sources.ru/index.php?showtopic=443691&view=findpost&p=3902093
Пример использования на 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 (, : 85)
Пример использования на 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 (, : 83)

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

Вывод: Функция ModifyWorldTransform(Delphi) и Transform(HTML5) идентичны.]]> Katerina1993 Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=443691&view=findpost&p=3902092 Mon, 25 Mar 2024 14:36:36 +0000 Как сделать линию пунктиром у Rectangle в Delphi? https://forum.sources.ru/index.php?showtopic=443691&view=findpost&p=3902092 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 (, : 106)

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 (, : 92) ]]> Katerina1993 Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=443691&view=findpost&p=3902090 Mon, 25 Mar 2024 14:10:33 +0000 Как сделать линию пунктиром у Rectangle в Delphi? https://forum.sources.ru/index.php?showtopic=443691&view=findpost&p=3902090

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 (, : 98) ]]> Katerina1993 Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=443691&view=findpost&p=3902061 Mon, 25 Mar 2024 02:55:46 +0000 Как сделать линию пунктиром у Rectangle в Delphi? https://forum.sources.ru/index.php?showtopic=443691&view=findpost&p=3902061 MBo Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=443691&view=findpost&p=3902057 Sun, 24 Mar 2024 02:40:08 +0000 Как сделать линию пунктиром у Rectangle в Delphi? https://forum.sources.ru/index.php?showtopic=443691&view=findpost&p=3902057
Вот синтаксис, в 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 Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=443691&view=findpost&p=3902056 Sat, 23 Mar 2024 20:59:22 +0000 Как сделать линию пунктиром у Rectangle в Delphi? https://forum.sources.ru/index.php?showtopic=443691&view=findpost&p=3902056 Два вложенных цикла: внешний по строкам и внутренний по столбцам. Они проходят по всем пикселям 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).]]> macomics Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=443691&view=findpost&p=3902055 Sat, 23 Mar 2024 20:30:22 +0000 Как сделать линию пунктиром у Rectangle в Delphi? https://forum.sources.ru/index.php?showtopic=443691&view=findpost&p=3902055 https://1olgastorm.github.io/Example2/grafic.html
img1.jpg (, : 70)
Попытка на Delphi 7. Этот пример взяла с другого сайта поэтому не совсем понимаю как работает код. Но перекрасить картинку черный в красный, а белый в зеленный цвет не получается.

img2.jpg (, : 91)

Код:

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;

Image3.canvas.Draw(0,0,Bitmap);

end;

]]> Katerina1993 Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=443691&view=findpost&p=3902052 Sat, 23 Mar 2024 14:55:03 +0000 Как сделать линию пунктиром у Rectangle в Delphi? https://forum.sources.ru/index.php?showtopic=443691&view=findpost&p=3902052
Еще можно воспользоваться WinAPI функцией GetBitmapBits, указав её в третьем параметре массив в формате RGB достаточного размера.]]> macomics Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=443691&view=findpost&p=3902047 Sat, 23 Mar 2024 09:18:55 +0000 Как сделать линию пунктиром у Rectangle в Delphi? https://forum.sources.ru/index.php?showtopic=443691&view=findpost&p=3902047
Например в JavaScript с помощью getImageData можно вернуть одномерной массив Uint8ClampedArray, содержащий данные модели RGBA, с целыми значениями от 0 до 255. Пример на скриншоте. Вывод массива через консоль.
rgba_example.jpg (, : 81)

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

Цитата

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 Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=443691&view=findpost&p=3901983 Thu, 21 Mar 2024 23:30:18 +0000 Как сделать линию пунктиром у Rectangle в Delphi? https://forum.sources.ru/index.php?showtopic=443691&view=findpost&p=3901983

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;

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.

]]> macomics Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=443691&view=findpost&p=3901982 Thu, 21 Mar 2024 22:01:46 +0000 Как сделать линию пунктиром у Rectangle в Delphi? https://forum.sources.ru/index.php?showtopic=443691&view=findpost&p=3901982
При этом не меняя значения в 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 (, : 98) ]]> Katerina1993 Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=443691&view=findpost&p=3901948 Thu, 21 Mar 2024 09:36:58 +0000 Как сделать линию пунктиром у Rectangle в Delphi? https://forum.sources.ru/index.php?showtopic=443691&view=findpost&p=3901948 MBo Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=443691&view=findpost&p=3901920 Thu, 21 Mar 2024 06:04:51 +0000 Как сделать линию пунктиром у Rectangle в Delphi? https://forum.sources.ru/index.php?showtopic=443691&view=findpost&p=3901920

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;

]]> Katerina1993 Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=443691&view=findpost&p=3901919 Thu, 21 Mar 2024 04:10:48 +0000 Как сделать линию пунктиром у Rectangle в Delphi? https://forum.sources.ru/index.php?showtopic=443691&view=findpost&p=3901919

Canvas.Pen.Style := psDash;

]]> MBo Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=443691&view=findpost&p=3901886 Wed, 20 Mar 2024 10:10:48 +0000 Как сделать линию пунктиром у Rectangle в Delphi? https://forum.sources.ru/index.php?showtopic=443691&view=findpost&p=3901886 Вот пример:
https://1olgastorm.github.io/Example1/canvas1.html
Вот код на html.

Цитата

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