Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 24.10.2013, 17:04   #1
soso1
 
Регистрация: 26.03.2013
Сообщений: 4
По умолчанию создать графический редактор в лазарусе!половину сделал а дальше никак не могу( кнопки все всё правильно сделал,а все равно не раб

Код:
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
  Classes, SysUtils, FileUtil, PrintersDlgs, Forms, Controls, Graphics, Dialogs,
  ExtCtrls, Menus, Buttons, ExtDlgs;
type
{ TMainForm }
TMainForm = class(TForm)
ColorDialog: TColorDialog;
Image: TImage;
MainMenu1: TMainMenu;
MenuItem1: TMenuItem;
MenuItem10: TMenuItem;
MenuItem2: TMenuItem;
MenuItem3: TMenuItem;
MenuItem4: TMenuItem;
MenuItem5: TMenuItem;
MenuItem6: TMenuItem;
OpenPictureDialog: TOpenPictureDialog;
Panel1: TPanel;
PrintDialog1: TPrintDialog;
SavePictureDialog: TSavePictureDialog;
PenColorShape: TShape;
BrushColorShape: TShape;
SpeedButton_Select: TSpeedButton;
SpeedButton_Eraser: TSpeedButton;
SpeedButton_Pen: TSpeedButton;
SpeedButton_Line: TSpeedButton;
SpeedButton_Rectangle: TSpeedButton;
SpeedButton_Ellipse: TSpeedButton;
SpeedButton_FillRectangle: TSpeedButton;
SpeedButton_FillEllipse: TSpeedButton;
SpeedButton_Fill: TSpeedButton;
procedure BrushColorShapeMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ImageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure ImageMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure MenuItem10Click(Sender: TObject);
procedure MenuItem4Click(Sender: TObject);
procedure MenuItem6Click(Sender: TObject);
procedure PenColorShapeMouseDown(Sender: TObject; Button: TMouseButton;  Shift: TShiftState; X, Y: Integer);
private
{ private declarations }
public
{ public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.lfm}
{ TMainForm }
const
RBegin: boolean = false; //флаг начала выделения фрагмента
REnd: boolean = false; //
RDrag: boolean = false; //флаг перетаскивания
Var
x0,y0, x1,y1: integer;
MDown: boolean;
R, R0: TRect;
BitMap, BMCopy: TBitMap;
Mode: TPenMode;// структура «точка»
// Файл - Открыть
procedure TMainForm.MenuItem4Click(Sender: TObject);
begin
if OpenPictureDialog.Execute then
Image.Picture.LoadFromFile(OpenPictureDialog.FileName);
end;
 //файл-выход
procedure TMainForm.MenuItem10Click(Sender: TObject);
begin
close;
end;
// изменение цвета кисти
procedure TMainForm.BrushColorShapeMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if ColorDialog.Execute then
begin
BrushColorShape.Brush.Color:= ColorDialog.Color;
Image.Canvas.Brush.Color:= ColorDialog.Color;
end;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
// создание объекта bitmap для хранения фрагмента изображения
BitMap := TBitMap.Create;
// установка цвета поля для рисования
with Image.Canvas do
begin
Brush.Color := clWhite;
 FillRect(Rect(0, 0, ClipRect.Right, ClipRect.Bottom));
end;
// установка начального цвета пера - "черный"
 PenColorShape.Brush.Color:= clBlack;
 Image.Canvas.Pen.Color:= clBlack;
// установка начального цвета кисти (заливки) - "белый"
 BrushColorShape.Brush.Color:= clWhite;
 Image.Canvas.Brush.Color:= clWhite;
 BitMap.Assign(Image.Picture);
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  BitMap.Free;
end;
soso1 вне форума Ответить с цитированием
Старый 24.10.2013, 17:05   #2
soso1
 
Регистрация: 26.03.2013
Сообщений: 4
По умолчанию и продолжение

Код:
 // --------------- нажата кнопка мыши ------------------------
procedure TMainForm.ImageMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
X0 := X;
Y0 := Y;
MDown:= true;
if SpeedButton_Select.Down or SpeedButton_Rectangle.Down //*********** используем инструмент "выделение" или
or SpeedButton_FillRectangle.Down then // "прямоугольникбез заливки" или "прямоугольник с заливкой"
begin
{режим работы с фрагментом}
// Image.Canvas.Pen.Color:= PenColorShape.Brush.Color;
if REnd then
begin
{стирание прежней рамки}
Image.Canvas.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(Image.Picture);
{установка цвета кисти}
Image.Canvas.Brush.Color :=
BrushColorShape.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);
Image.Canvas.DrawFocusRect(R);
end;
end else
if SpeedButton_Eraser.Down then // *********** используеминструмент "ластик"
begin

R := Rect(X - 6, Y - 6, X + 6, Y + 6);
Image.Canvas.DrawFocusRect(R);
// Image.Canvas.Brush.Color := BrushColorShape.Brush.Color;
Image.Canvas.FillRect(Rect(X - 5, Y - 5, X + 5, Y + 5));
end else
if SpeedButton_Pen.Down then // *********** используем инст-румент "карандаш"
begin
Image.Canvas.MoveTo(X, Y);
Image.Canvas.Pen.Color := PenColorShape.Brush.Color;
end else
if SpeedButton_Line.Down then // *********** используем ин-струмент "линия"
begin
X1 := X;
Y1 := Y;
//режим pmNotXor позволяет при движении мыши стирать изо-бражение линии;
Image.Canvas.Pen.Mode := pmNotXor;
Image.Canvas.Pen.Color := PenColorShape.Brush.Color;
end else
if SpeedButton_FillEllipse.Down then // *********** исполь-зуем инструмент "эллипс с заливкой"
begin
end else
if SpeedButton_Fill.Down then // *********** используем ин-струмент "заливка"
begin
if Button = mbLeft then
Image.Canvas.Brush.Color:= PenColorShape.Brush.Color
else
Image.Canvas.Brush.Color:= BrushColorShape.Brush.Color;
Image.Canvas.FloodFill(X,Y, Image.Canvas.Pixels[X, Y],
fsSurface);
end;
end;
  // мышь передвигается
procedure TMainForm.ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 if MDown then
 begin
 if (SpeedButton_Select.Down and (RBegin or RDrag)) or
SpeedButton_Rectangle.Down or
SpeedButton_FillRectangle.Down then
 with Image.Canvas do
 begin
// Pen.Color:= PenColorShape.Brush.Color;
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 SpeedButton_Select.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 else
 if SpeedButton_Eraser.Down then // *********** используеминструмент "ластик"
begin
Image.Canvas.DrawFocusRect(R);
 R := Rect(X - 6, Y - 6, X + 6, Y + 6);
 Image.Canvas.DrawFocusRect(R);
 Image.Canvas.FillRect(Rect(X - 5, Y - 5, X + 5, Y + 5));
end else
 if SpeedButton_Pen.Down then // *********** используем ин-струмент "карандаш"
 Image.Canvas.LineTo(X, Y) else
 if SpeedButton_Line.Down then // *********** рисуем времен-ную линию
with Image.Canvas do
 begin
{стирание прежней линии}
 MoveTo(X0, Y0);
 //стирается линия в прежнем положении (это необходимо,т.к. метод LineTo
 LineTo(X1, Y1);
 //рисует линию,начинающуюся в текущей позиции пера и за-канчивающуюся
 {рисование новой линии}//в указанной точке, исключая эту ко-нечную точку.
 MoveTo(X0, Y0); //рисуется новая линия;
 LineTo(X, Y);
 X1 := X; {запоминание новых координат конца линии}
 Y1 := Y;
end else
 if SpeedButton_FillEllipse.Down then // *********** рисуемвременный эллипс
begin
 end;
end;
end;
soso1 вне форума Ответить с цитированием
Старый 24.10.2013, 17:05   #3
soso1
 
Регистрация: 26.03.2013
Сообщений: 4
По умолчанию

Код:
  // кнопка мыши отпущена, окончательно рисуем фигуру
procedure TMainForm.ImageMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
MDown:= false;
if SpeedButton_Line.Down then // *********** рисуем линию
with Image.Canvas do
begin
MoveTo(X0, Y0); //стирание прежней линии;
LineTo(X1, Y1);
Pen.Mode := pmCopy; //рисование новой линии;
Pen.Color:= PenColorShape.Brush.Color; // устанавливаем цветлинии
MoveTo(X0, Y0);
LineTo(X, Y);
end else
if SpeedButton_Select.Down then
begin
if RDrag then
Image.Canvas.DrawFocusRect(R);
if RBegin and not REnd then
begin
REnd := true;
//MCopy.Enabled := true;
//MCut.Enabled := true;
end
end else
if SpeedButton_Eraser.Down then
begin
Image.Canvas.DrawFocusRect(R);
end else
if SpeedButton_Rectangle.Down then
begin
Image.Canvas.Brush.Color := PenColorShape.Brush.Color;
Image.Canvas.FrameRect(R);
end else
if SpeedButton_FillRectangle.Down then
with Image.Canvas do
begin
Brush.Color := BrushColorShape.Brush.Color;
Pen.Color := PenColorShape.Brush.Color;
Rectangle(R.Left, R.Top, R.Right, R.Bottom);
end;
RBegin := false;
RDrag := false;

end;


 // Файл - Cохранить
procedure TMainForm.MenuItem6Click(Sender: TObject);
begin
  if SavePictureDialog.Execute then
Image.Picture.SaveToFile(SavePictureDialog.FileName);
end;




// изменение цвета пера
procedure TMainForm.PenColorShapeMouseDown(Sender: TObject;
 Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 if ColorDialog.Execute then
 begin
PenColorShape.Brush.Color:= ColorDialog.Color;
 Image.Canvas.Pen.Color:= ColorDialog.Color;
end; end;
initialization
 MDown:= false;

end.
soso1 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Правильно ли сделал? cargo29 PHP 6 06.10.2011 17:09
Сделал задачу, а она все равно не выполняет задания ВДПУ Помощь студентам 2 17.05.2011 20:27
сайт сделан в CSS, почему в експлолере он у меня глючит, а в мозиле все показывается как я сделал? -=Ламер=- HTML и CSS 16 11.09.2008 18:12
Сделал WAP сайт, а что дальше? Maybe HTML и CSS 10 20.07.2008 13:48