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

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

Кисть – кнопка 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
.

 

Часть 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
.

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

• Быстрая работы с графикой в среде Windows
• Delphi и Flash. Совмещение несовместимого!
• Перемещение Image'a по форме во время работы программы