Графический редактор

Статьи » Графика и игры » Графический редактор

Приложение выполняет следующие функции: Установка основного и дополнительного цветов. Щелчок на панели цветов левой кнопкой мыши устанавливает основной цвет, а щелчок правой кнопкой – дополнительный.

Кисть – кнопка SBBrush. Закрашивает замкнутую область, ограниченныю цветом того пикселя, который указан щелчком мыши. При щелчке левой кнопкой закрашивание производится основным цветом, при щелчке правой кнопкой – вспомогательным.

Индикация цвета -кнопка SBColor. В этом режиме можно указать курсором мыши любой пиксель на изображении и, щелкнув левой кнопкой, установить цвет этого пикселя как основной, а щелкнув правой кнопкой мыши, установитьего как вспомогательный цвет.

Отмена операций, выполненных последним использованным инструментом – команда Правка|Отменить.

Открытие графического файла – команда Файл|Открыть (MOpenClick).

Вставка графического изображения типа битовой матрицы

SpeedButton: SBBrush, SBColor;
GroupIndex := 1;
AllowAllUp := true;
Glyph := ..ImagesButonsbrush.bmp;
Glyph := ..ImagesButonsone2one.bmp;
Последовательность проектирования: ;
1. Заполнить форму;
2. var

Bitmap: TBitMap; 3. Form OnCreate; 4. Form OnDestroy; 5. MOpenClick; 6. UndoClick; 7. SBBrushClick и SBColor(запоминает текущий вид изображения); 8. Image3MouseDown и копировать в Image4 MouseDown;

unit

UGraphEdit; interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Buttons, ExtCtrls, Menus, ExtDlgs; type

TForm1 = class

(TForm) Image1: TImage; Image2: TImage; Image3: TImage; Image4: TImage; SBBrush: TSpeedButton; SBColor: TSpeedButton; OpenPictureDialog1: TOpenPictureDialog; MainMenu1: TMainMenu; N1: TMenuItem; MOpen: TMenuItem; N2: TMenuItem; Undo: TMenuItem; procedure

FormCreate(Sender: TObject); procedure

FormDestroy(Sender: TObject); procedure

MOpenClick(Sender: TObject); procedure

UndoClick(Sender: TObject); procedure

SBBrushClick(Sender: TObject); procedure

Image3MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); private

{ Private declarations } public

{ Public declarations } end

; var

Form1: TForm1; implementation

{$R *.DFM} var

BitMap: TBitMap; //переменная для сохранения изображения, если его нужно будет востановить командой отменить procedure

TForm1.FormCreate(Sender: TObject); var

HW, I: integer; begin

BitMap := TBitMap.Create; {задание свойств кисти основного и вспомогательного цветов} Image1.Canvas.Brush.Color := clBlack; Image2.Canvas.Brush.Color := clWhite; {заполнение окон основного и вспомогательного цветов} with

Image1.Canvas do

FillRect(Rect(0, 0, Width, Height)); with

Image2.Canvas do

FillRect(Rect(0, 0, Width, Height)); {задание ширины элемента палитры цветов} HW := Image4.Width div

10; {закраска элементов палитры цветов} with

Image4.Canvas do

for

I := 1 to

10 do

begin

case

I of

1: Brush.Color := clBlack; 2: Brush.Color := clAqua; 3: Brush.Color := clBlue; 4: Brush.Color := clFuchsia; 5: Brush.Color := clGreen; 6: Brush.Color := clLime; 7: Brush.Color := clMaroon; 8: Brush.Color := clRed; 9: Brush.Color := clYellow; 10: Brush.Color := clWhite; end

; Rectangle((I - 1) * HW, 0, I * HW, Height); end

;

{рисование креста на холсте – только для
тестирования}
with

Image3 do

begin

Canvas.MoveTo(0, 0); Canvas.LineTo(Width, Height); Canvas.MoveTo(0, Height); Canvas.LineTo(Width, 0); end

; BitMap.Assign(Image3.Picture); end

; procedure

TForm1.FormDestroy(Sender: TObject); begin

BitMap.Free; end

; procedure

TForm1.MOpenClick(Sender: TObject); begin

if

OpenPictureDialog1.Execute then

begin

Image3.Picture.LoadFromFile(OpenPictureDialog1.FileName); BitMap.Assign(Image3.Picture); end

; end

; procedure

TForm1.UndoClick(Sender: TObject); begin

Image3.Picture.Assign(BitMap); end

; procedure

TForm1.SBBrushClick(Sender: TObject); begin

if

(Sender as

TSpeedButton).Down then

BitMap.Assign(Image3.Picture); end

; procedure

TForm1.Image3MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin

if

(Sender = Image4) or

SBColor.Down then

{режим установки основного и вспомогательного цветов} begin

if

(Button = mbLeft) then

with

Image1.Canvas do

begin

{установка основного цвета} Brush.Color := (Sender as

TImage).Canvas.Pixels[X, Y]; FillRect(Rect(0, 0, Width, Height)); end

else

with

Image2.Canvas do

begin

{установка вспомогательного цвета} Brush.Color := (Sender as

TImage).Canvas.Pixels[X, Y]; FillRect(Rect(0, 0, Width, Height)); end

; end

else

if

SBBrush.Down then

with

Image3.Canvas do

begin

{режим закраски указанной области холста} if

Button = mbLeft then

Brush.Color := Image1.Canvas.Brush.Color else

Brush.Color := Image2.Canvas.Brush.Color; FloodFill(X, Y, Pixels[X, Y], fsSurface); end

; end

; end

.

8. OnMouseDown – это основной код, осуществляющий как установку основного и вспомогательных цветов, так и функцию инструмента графического редактора – кисти.

Если кнопка мыши нажата на палитре цветов, Image4, или если кнопка SBColor – кнопка указателя цвета утоплена

, то приложение находится в режиме установки цветов. При нажатой левой кнопки мыши цвет пикселя под курсором мыши передается в окно основного цвета, а при нажатой правой кнопки – в окно вспомогательного цвета.

Если кнопка мыши нажата на холсте, Image3, или если кнопка SBColor – кнопка указателя цвета утоплена

, то приложение находится в режиме закраски указанной области рисунка. В этом случае в зависимости от нажатой кнопки мыши выбирается основной или вспомогательный цвет и функцией FloodFill

производится закраска области, координаты внутренней точки которой указаны курсором мыши, а цвет – цветом пикселя, на который указывает мышь.

 

Часть 2.

Дополнительные функции графического редактора:

Функция выделения фрагмента осуществляется методом DrawFocusRect.В этом режиме
при событии onMouseDown холста – компонента Image3, выполняются операторы:
{запоминание начального положения курсора мыши}

X0 := X;
//запоминание координаты мыши X,Y в переменных X0,Y0;
Y0 := Y; //начальные координаты прямоугольной области – переменной R типа TRect;
{формирование начального положения области фрагмента};

R.TopLeft := Point(X, Y);
R.BottomRight := Point(X, Y); {рисование рамки}

Image3.DrawFocusRect(R);
  //рисуется рамка пока нулевого размера методом DrawFocusRect;
RBegin := true;
{утанавливается флаг начала выделения фрагмента RBegin;При событии onMouseMove компонента Image3, 
если установлен флаг RBegin, выпол-няются операторы:}

Выделение фрагмента – кнопка SBRect

. Фрагмент выделяется точечной рамкой. Выделенный фрагмент можно в дальнейшем перетащить мышью на другое место. Если в процессе перетаскивания нажата клавиша Ctrl, то производится копирование фрагмента, в противном случае вырезание, при котором область первоначального размещения фрагмента закрашивается вспомогательным цветом. Выделенный фрагмент может быть также скопирован или вырезан в буфер обмена Clipboard соответствующими командами меню.

 

{Стирание прежней рамки фрагмента}
Image3.Canvas.DrawFocusRect(R);
  //метод DrawFocusRect рисует рамку с помощью операции XOR;
{формирование области R};
if

X0 < X then

//область, передаваемая в функцию DrawFocusRect begin

R.Left := X0; R.Right := X end

// должна быть сформирована так, что R.Left<R.Right и else

begin

R.Left := X; R.Right := X0 end

; // R.Top<R.Buttom if

Y0 < Y then

begin

R.Top := Y0; R.Bottom := Y end

else

begin

R.Top := Y; R.Bottom := Y0 end

; {Рисования новой рамки фрагмента} Image3.Canvas.DrawFocusRect(R); {Рамка,ограничивающая фрагмент нарисована. Если пользовательпомещает курсор внутрь выделенной области и нажимает кнопку мыши (onMouseDown), выполняют-ся операторы:} with

Image3.Canvas do

begin

; X0 := X; //запоминание начального положения курсора мыши Y0 := Y; DrawFocusRect(R); {стирание прежней рамки} ; RDrag := true; //устанавливает флаг перетаскивания RDrag; REnd := false; {запоминание начального положения перетаскиваемого фрагмента в переменной R0 типа TRect}; R0.TopLeft := R.TopLeft; R0.BottomRight := R.BottomRight; {запоминание методом Assign изображения в момент начала перетаскивания в переменно BitMap, чтобы в процессе перетаскивания можно было восстанавливать испорченные места изображения и чтобы при желании пользователя можно было в дальнейшем отменить результат перетаскивания}; BitMap.Assign(Image3.Picture); {установка цвета кисти равным вспомогательному цвету, хранящемуся в компоненте Image2}; Brush.Color := Image2.Canvas.Brush.Color; end

; {При событии onMouseMove компонента Image3, если установлен флаг RDrag, выпол-няются операторы: восстановление изображения под перетаскиваемым фрагментом в его прежней позиции, (т.е. стирает фрагмент) копируя соответствующую область методом CopyRect из компо-нента BitMap }; CopyRect(R, BitMap.Canvas, R); {если не нажата клавиша Ctrl - стирание изображения в R0(осуществляется вырезание) ме-тодом FillRect }; if

not

(ssCtrl in

Shift) then

FillRect(R0); {формирование нового положения фрагмента } R.Left := R.Left + X - X0; R.Right := R.Right + X - X0; R.Top := R.Top + Y - Y0; R.Bottom := R.Bottom + Y - Y0; {запоминание положения курсора мыши}; X0 := X; Y0 := Y; {рисование фрагмента в новом положении}; CopyRect(R, BitMap.Canvas, R0); {рисование рамки} DrawFocusRect(R); {Таким образом проводится операция выделения фрагрента и его перетаскивания.}

Рисование прямоугольника – кнопка SBRectang

. Рисуется прямоугольная рамка основным цветом.

 

Начало режимов рисования заполненного и незаполненного прямоугольников про-исходит по событию onMouseDown и их продолжение по событиям onMouseMove и не отличаются от рассмотренного режима выделения фрагмента.;При завершении формирования пользователем прямоугольной рамки, т.е. при собы-тии MouseUp, надо нарисовать прямоугольник. ;Рисование заполненного прямоугольника осуществляется операторами:

with

Image3.Canvas do

begin

Brush.Color := Image2.Canvas.Brush.Color; //задается цвет кисти; Pen.Color := Image1.Canvas.Brush.Color; //задается цвет пера; Rectangle(R.Left, R.Top, R.Right, R.Bottom); end

;

Рисование незакрашенного прямоугольника осуществляется операторами:

with

Image3.Canvas do

begin

Brush.Color := Image1.Canvas.Brush.Color; FrameRect(R); //метод FrameRect рисует цветом кисти; end

;

Рисование заполненного прямоугольника – кнопка SBFillRec

. Рисуется прямоугольная рамка основным цветом и прямоугольник внутри закрашивается вспомогательным цветом.

Возможные значения свойства Mode пера Pen

pmCopy – линии проводятся цветом, заданным в свойстве Color
pmBlack Always black
pmWhiteAlways white
pmNopUnchanged
pmNot Inverse of

canvas background color pmCopy Pen color specified in

Color property

pmNotCopyInverse of

pen color pmMergePenNot Combination of

pen color and

inverse of

canvas background pmMaskPenNotCombination of

colors common to

both pen and

inverse of

canvas background. pmMergeNotPen Combination of

canvas background color and

inverse of

pen color pmMaskNotPenCombination of

colors common to

both canvas background and

inverse of

pen pmMerge Combination of

pen color and

canvas background color pmNotMergeInverse of

pmMerge: combination of

pen color and

canvas background color pmMask Combination of

colors common to

both pen and

canvas background pmNotMaskInverse of

pmMask: combination of

colors common to

both pen and

canvas background pmXorСложение с фоном по исключающему {ИЛИ (линия появляется только в момент отпускания мыши) pmNotXorСложение с фоном по инверсному исключающему ИЛИ}

Начало рисования прямой линии осуществляется по событию onMouseDown:

X0 := X;
Y0 := Y;
X1 := X;
Y1 := Y;
Image3.Canvas.Pen.Color := Image1.Canvas.Brush.Color;
  //устанавливается цвет пера;
Image3.Canvas.Pen.Mode := pmNotXor;
  //режим pmNotXor позволяет при движении мыши стирать изображение линии;


Рисование прямой линии – кнопка SBLine

.Рисуется прямая линия основным цветом.

 

Продолжение рисования прямой линии осуществляется по событию onMouseMove:

with

Image3.Canvas do

begin

{стирание прежней линии} MoveTo(X0, Y0); //стирается линия в прежнем положении (это необходимо, т.к. метод LineTo LineTo(X1, Y1); //рисует линию,начинающуюся в текущей позиции пера и заканчивающуюся {рисование новой линии}//в указанной точке, исключая эту конечную точку. MoveTo(X0, Y0); //рисуется новая линия; LineTo(X, Y); X1 := X; {запоминание новых координат конца линии} Y1 := Y; end

;

Заключительные операции при событии MouseUp аналогичны рассмотренным выше, но дополняются переводом пера в режим pmCopy, при котором рисуется окончатель-ная линия:

with

Image3.Canvas do

begin

MoveTo(X0, Y0); //стирание прежней линии; LineTo(X1, Y1); Pen.Mode := pmCopy; //рисование новой линии; MoveTo(X0, Y0); LineTo(X, Y); end

;

Карандаш – кнопка SBPen

. Можно рисовать произвольную кривую основным цветом. Glyph:=..ImagesButonspencil.bmp

 

При реализации этого инструмента в виде:

Image3.Canvas.Pixels[X, Y] := Image3.Canvas.Brush.Color;

линия распадется на отдельные точки, так как курсор мыши перемещаетяс быстро и события onMouseMove происходят вовсе не при перемещении на соседний пик-сель. Линию,оставляемую курсором тоже нужно рисовать методом LineTo, помес-тив в обработчик события onMouseMove оператор:

Image3.Canvas.LineTo(X, Y);

Стирание изображения (ластик) – кнопка SBErase. Перемещение ластика закрашивает область под ним во вспомогательный цвет.

 

Ластик реализуется методом FillRect

, очищающим изображение под его рамкой.

Сохранение файла осуществляется с использованием компонента SavePictureDialog оператором:

procedure

TForm1.MSaveClick(Sender: TObject); begin

if

SavePictureDialog1.Execute then

begin

BitMap.Assign(Image3.Picture); //сохранение изображения; BitMap.SaveToFile(SavePictureDialog1.FileName); //запись в файл изображения; end

; end

;

Сохранение изображения в графическом файле – команда Файл/Сохранить как…
Копированию или вырезанию подлежит ранее выделенный пользователем объект, местоположение и размеры которого определяются переменной R. Поэтому сначала создается временный объект типа TBitMap, в который переносится копируемый фрагмент. Затем объект копируется в ClipBoard.

procedure

TForm1.MCopyClick(Sender: TObject); var

BMCopy: TBitMap; begin

Image3.Canvas.DrawFocusRect(R); {стирание рамки} BMCopy := BitMap.Create; {создание временного объекта BMCopy } BMCopy.Width := R.Right - R.Left; BMCopy.Height := R.Bottom - R.Top; try

{копирование объекта в BMCopy } BMCopy.Canvas.Copyrect(Rect(0, 0, BMCopy.Width, BMCopy.Height), Image3.Canvas, R); Image3.Canvas.DrawFocusRect(R); {восстановление рамки} ClipBoard.Assign(BMCopy); {копирование в Clipboard} if

(Sender as

TMenuItem).Name = 'MCut' then

begin

Image3.Canvas.Brush.Color := clWhite; {вырезание} Image3.Canvas.FillRect(R); end

; finally

{благодаря разделу finally память освобождается от временного объекта при любом исходе копирования: удачном или аварийном} BMCopy.Free; {освобождение памяти} end

; end

;

Копирование или вырезание выделенного фрагмента изображения в буфер обмена Clipboard – команды Правка|Копировать или Правка|Вырезать
Чтение из ClipBoard осуществляется методом LoadFromClipBoardFormat. Предусмотрен перехват исключения EInvalidGraphic, если в ClipBoard содержится не битовая матрица:

procedure

TForm1.MPasteClick(Sender: TObject); var

BMCopy: TBitMap; begin

BMCopy := BitMap.Create; try

try

BMCopy.LoadFromClipBoardFormat(cf_BitMap, ClipBoard.GetAsHandle(cf_Bitmap), 0); Image3.Canvas.CopyRect(Rect(0, 0, BMCopy.Width, BMCopy.Height); BMCopy.Canvas, Rect(0, 0, BMCopy.Width, BMCopy.Height)); finally

BMCopy.Free; end

; except

on

EInvalidGraphic do

ShowMessage('Ошибочный формат графики'); end

; end

;

Вставка графического изображения типа битовой матрицы из буфера обмена Clipboard – команды Правка|Вставить.
 

Попробуйте усовершенствовать редактор, добавив в него, например, выбор ширины линий, рисование эллипсов и т.д.

Далее приведен полный текст дополнений к редактору представленному в части 1:

В класс TForm1

добавить:

TForm1 = class

(TForm) MFile: TMenuItem; SBRect: TSpeedButton; SBRectang: TSpeedButton; SBFillRec: TSpeedButton; SBErase: TSpeedButton; SBPen: TSpeedButton; SBLine: TSpeedButton; MSave: TMenuItem; MCut: TMenuItem; MCopy: TMenuItem; MPaste: TMenuItem; SavePictureDialog1: TSavePictureDialog; procedure

Image3MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); //доб. procedure

SBBrushClick(Sender: TObject); procedure

Image3MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

procedure

Image3MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure

MOpenClick(Sender: TObject); procedure

MCopyClick(Sender: TObject); procedure

MPasteClick(Sender: TObject); procedure

MSaveClick(Sender: TObject); ……………………………………………. end

; implementation

{$R *.DFM} var

BitMap, BMCopy: TBitMap; R, R0: TRect; X0, Y0, X1, Y1: longint; const

RBegin: boolean = false; //флаг начала выделения фрагмента REnd: boolean = false; // RDrag: boolean = false; //флаг перетаскивания procedure

TForm1.Image3MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin

if

(Sender = Image4) or

SBColor.Down then

{режим установки основного и вспомогательного цветов} begin

if

(Button = mbLeft) then

with

Image1.Canvas do

begin

{установка основного цвета} Brush.Color := (Sender as

TImage).Canvas.Pixels[X, Y]; FillRect(Rect(0, 0, Width, Height)); end

else

with

Image2.Canvas do

begin

{установка вспомогательного цвета} Brush.Color := (Sender as

TI //mage).Canvas.Pixels[X,Y]; FillRect(Rect(0, 0, Width, Height)); end

; end

else

with

Image3.Canvas do

begin

X0 := X; Y0 := Y; if

SBPen.Down then

begin

{режим карандаша} MoveTo(X, Y); Pen.Color := Image1.Canvas.Brush.Color; end

else

if

SBLine.Down then

begin

{режим линии} X1 := X; Y1 := Y; Pen.Mode := pmNotXor; Pen.Color := Image1.Canvas.Brush.Color; end

else

if

SBBrush.Down then

begin

{режим закраски указанной области холста} if

Button = mbLeft then

Brush.Color := Image1.Canvas.Brush.Color else

Brush.Color := Image2.Canvas.Brush.Color; FloodFill(X, Y, Pixels[X, Y], fsSurface); end

else

if

SBErase.Down then

begin

{режим ластика} R := Rect(X - 6, Y - 6, X + 6, Y + 6); DrawFocusRect(R); Brush.Color := Image2.Canvas.Brush.Color; FillRect(Rect(X - 5, Y - 5, X + 5, Y + 5)); end

else

if

SBRect.Down or

SBRectang.Down or

SBFillRec.Downthen begin

{режим работы с фрагментом} if

REnd then

begin

{стирание прежней рамки} DrawFocusRect(R); if

(X < R.Right) and

(X > R.Left) and

(Y > R.Top) and

(Y < R.Bottom) {режим начала перетаскивания фрагмента} then

begin

{установка флагов} RDrag := true; REnd := false; {запоминание начального положения перетаскиваемого фрагмента} R0.TopLeft := R.TopLeft; R0.BottomRight := R.BottomRight; {запоминание изображения} BitMap.Assign(Image3.Picture); {установка цвета кисти} Brush.Color := Image2.Canvas.Brush.Color; MCopy.Enabled := false; MCut.Enabled := false; end

; end

else

begin

{режим начала рисования рамки фрагмента} RBegin := true; REnd := false; R.TopLeft := Point(X, Y); R.BottomRight := Point(X, Y); DrawFocusRect(R); end

; end

; end

; end

; procedure

TForm1.SBBrushClick(Sender: TObject); begin

if

(Sender as

TSpeedButton).Down then

BitMap.Assign(Image3.Picture); RBegin := false; RDrag := false; REnd := false; end

; procedure

TForm1.Image3MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin

if

not

(ssLeft in

Shift) then

exit; {режим линии} if

SBLine.Down then

with

Image3.Canvas do

begin

{стирание прежней линии} MoveTo(X0, Y0); LineTo(X1, Y1); {рисование новой линии} MoveTo(X0, Y0); LineTo(X, Y); {запоминание новых координат конца линии} X1 := X; Y1 := Y; end

else

if

SBPen.Down then

Image3.Canvas.LineTo(X, Y) else

if

SBErase.Down then

with

Image3.Canvas do

begin

{режим ластика} DrawFocusRect(R); R := Rect(X - 6, Y - 6, X + 6, Y + 6); DrawFocusRect(R); FillRect(Rect(X - 5, Y - 5, X + 5, Y + 5)); end

else

if

(SBRect.Down and

(RBegin or

RDrag)) or

SBRectang.Down or

SBFillRec.Down then

with

Image3.Canvas do

begin

if

RBegin then

begin

{Режим рисования рамки фрагмента} DrawFocusRect(R); if

X0 < X then

begin

R.Left := X0; R.Right := X end

else

begin

R.Left := X; R.Right := X0 end

; if

Y0 < Y then

begin

R.Top := Y0; R.Bottom := Y end

else

begin

R.Top := Y; R.Bottom := Y0 end

; DrawFocusRect(R); end

else

if

SBRect.Down then

begin

{Режим перетаскивания фрагмента} {восстановление изображения под перетаскиваемым фрагментом} CopyRect(R, BitMap.Canvas, R); {если не нажата клавиша Ctrl - стирание изображения в R0} if

not

(ssCtrl in

Shift) then

FillRect(R0); {формирование нового положения фрагмента } R.Left := R.Left + X - X0; R.Right := R.Right + X - X0; R.Top := R.Top + Y - Y0; R.Bottom := R.Bottom + Y - Y0; {запоминание положения курсора мыши} X0 := X; Y0 := Y; {рисование фрагмента в новом положении} CopyRect(R, BitMap.Canvas, R0); {рисование рамки} DrawFocusRect(R); end

; end

; end

; procedure

TForm1.Image3MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin

with

Image3.Canvas do

begin

if

SBLine.Down then

begin

MoveTo(X0, Y0); LineTo(X1, Y1); Pen.Mode := pmCopy; MoveTo(X0, Y0); LineTo(X, Y); end

else

if

SBRect.Down then

begin

if

RDrag then

DrawFocusRect(R); if

RBegin and

not

REndthen begin

REnd := true; MCopy.Enabled := true; MCut.Enabled := true; end

end

else

if

SBRectang.Down then

begin

Brush.Color := Image1.Canvas.Brush.Color; FrameRect(R); end

else

if

SBFillRec.Down then

begin

Brush.Color := Image2.Canvas.Brush.Color; Pen.Color := Image1.Canvas.Brush.Color; Rectangle(R.Left, R.Top, R.Right, R.Bottom); end

else

if

SBErase.Downthen Image3.Canvas.DrawFocusRect(R); RBegin := false; RDrag := false; end

; end

; procedure

TForm1.MCopyClick(Sender: TObject); {var MyFormat: Word; AData: THandle; APalette: HPALETTE;} begin

Image3.Canvas.DrawFocusRect(R); BMCopy := BitMap.Create; BMCopy.Width := R.Right - R.Left; BMCopy.Height := R.Bottom - R.Top; try

BMCopy.Canvas.Copyrect(Rect(0, 0, BMCopy.Width, BMCopy.Height), Image3.Canvas, R); Image3.Canvas.DrawFocusRect(R); {BMCopy.SaveToClipBoardFormat(MyFormat,AData,APalette); ClipBoard.SetAsHandle(MyFormat,AData);} ClipBoard.Assign(BMCopy); if

(Sender as

TMenuItem).Name = 'MCut' then

begin

Image3.Canvas.Brush.Color := clWhite; Image3.Canvas.FillRect(R); end

; finally

BMCopy.Free; end

; end

; procedure

TForm1.MPasteClick(Sender: TObject); begin

BMCopy := BitMap.Create; try

try

BMCopy.LoadFromClipBoardFormat(cf_BitMap, ClipBoard.GetAsHandle(cf_Bitmap), 0); Image3.Canvas.CopyRect(Rect(0, 0, BMCopy.Width, BMCopy.Height), BMCopy.Canvas, Rect(0, 0, BMCopy.Width, BMCopy.Height)); finally

BMCopy.Free; end

; except

on

EInvalidGraphic do

ShowMessage('Ошибочный формат графики'); end

; end

; procedure

TForm1.MSaveClick(Sender: TObject); begin

if

SavePictureDialog1.Execute then

begin

BitMap.Assign(Image3.Picture); BitMap.SaveToFile(SavePictureDialog1.FileName); end

; end

; end

.

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com