Создать аккаунт
Войти





27.1 MB

Twitter Facebook Google Livejournal Pinterest

Графический редактор delphi скачать презентация


Описание: Графический редактор delphi скачать презентация
Имя файла: graficheskiy-redaktor-delphi-prezentaciya

Часть 1.

Приложение выполняет следующие функции:

Установка основного и дополнительного цветов. Щелчок на панели цветов левой кнопкой мыши устанавливает основной цвет, а щелчок правой кнопкой – дополнительный. Кисть – кнопка SBBrush. Закрашивает замкнутую область, ограниченныю цветом того пикселя, который указан щелчком мыши. При щелчке левой кнопкой закрашивание производится основным цветом, при щелчке правой кнопкой – вспомогательным. Индикация цвета -кнопка SBColor. В этом режиме можно указать курсором мыши любой пиксель на изображении и, щелкнув левой кнопкой, установить цвет этого пикселя как основной, а щелкнув правой кнопкой мыши, установитьего как вспомогательный цвет. Отмена операций, выполненных последним использованным инструментом – команда Правка|Отменить. Открытие графического файла – команда Файл|Открыть (MOpenClick). Вставка графического изображения типа битовой матрицы
SpeedButton: SBBrush, SBColor; GroupIndex := 1; AllowAllUp := true; Glyph := ..\Images\Butons\brush.bmp; Glyph := ..\Images\Butons\one2one.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 – кнопка указателя цвета утоплена, то приложение находится в режиме установки цветов. При нажатой левой кнопки мыши цвет пикселя под курсором мыши передается в окно основного цвета, а при нажатой правой кнопки – в окно вспомогательного цвета.

Часть 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:=..\Images\Butons\pencil.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.

Cсылка для сайта (HTML):

Cсылка для форума (BBCode):