|
Вопрос # 5 514/ вопрос открыт / |
|
Здравствуйте, уважаемые эксперты!
Как в делфи сделать рисование многоугольника (компонент многоугольник такой же как и в стандартном Paint, рисовать должно также) по нажатию на клавишу мышки? Какая функция служит для такого рисования, с какими параметрами задается?
 |
Вопрос задал: buldoger (статус: Посетитель)
Вопрос отправлен: 20 июля 2011, 15:08
Состояние вопроса: открыт, ответов: 1.
|
Ответ #1. Отвечает эксперт: firstvirus
Принцип я объяснял в комментах. Это рабочий код, но там есть косяк с координатами. Это ты уже сам разбирайся, я показал как делать :)
Приложение: Переключить в обычный режим- unit Unit1;
-
- interface
-
- uses
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, Buttons, ExtCtrls;
-
- type
- TForm1 = class(TForm)
- SB_Arroy: TSpeedButton;
- SB_Poly: TSpeedButton;
- PB_Work: TPaintBox;
- procedure PB_WorkMouseDown(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- private
- NowDrawPoly : boolean;
- { Private declarations }
- public
- { Public declarations }
- end;
-
- var
- Form1: TForm1;
-
- implementation
-
- {$R *.dfm}
-
- procedure TForm1.PB_WorkMouseDown(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- var
- RClick,LClick : boolean;
- begin
- LClick := Button = mbLeft;
- RClick := Button = mbRight;
- if LClick then
- begin
- if SB_Poly.Down then
- if NowDrawPoly then PB_Work.Canvas.LineTo(Mouse.CursorPos.X,Mouse.CursorPos.Y)
- else
- begin
- NowDrawPoly := true;
- PB_Work.Canvas.MoveTo(Mouse.CursorPos.X,Mouse.CursorPos.Y);
- end;
- end
- else if RClick then
- begin
- SB_Poly.Down := False;
- SB_Arroy.Down := True;
- NowDrawPoly := False;
- end;
- end;
-
- end.
 |
Ответ отправил: firstvirus (статус: 1-ый класс)
Время отправки: 21 июля 2011, 09:59
|
Мини-форум вопроса
Всего сообщений: 18; последнее сообщение — 22 июля 2011, 08:11; участников в обсуждении: 3.
|
min@y™ (статус: Доктор наук), 20 июля 2011, 15:10 [#1]:
Цитата (buldoger):
Какая функция служит для такого рисования, с какими параметрами задается?
Ну, если ты будешь рисовать с помощью TCanvas, то это методы MoveTo(), LineTo() плюс варьирование свойствами таких дочерних объектов TCanvas, как Pen и Brush.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
|
buldoger (статус: Посетитель), 20 июля 2011, 15:15 [#2]:
Забыл уточнить, рисование происходит с помощью PaintBox.
|
|
|
min@y™ (статус: Доктор наук), 20 июля 2011, 15:18 [#3]:
Цитата (buldoger):
Забыл уточнить, рисование происходит с помощью PaintBox.
Ну у TPaintBox такие есть Canvas. Вот и пользуйся.
Что конкретно не получается-то?
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
|
buldoger (статус: Посетитель), 20 июля 2011, 15:27 [#4]:
не рисуется многоугольник... карандаш, заливку и прочую ерунду сделал, а многоугольник не знаю как
|
|
|
min@y™ (статус: Доктор наук), 20 июля 2011, 15:50 [#5]:
Ну запоминай в памяти массив вершин многоугольника и отрисовывай его методами TCanvas.PolyLine() и TCanvas.Polygon(). Как-то так.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
|
firstvirus (статус: 1-ый класс), 20 июля 2011, 16:14 [#6]:
при нажатии кнопки отрисовки многоугольника ставь флаг что сейчас ты будешь рисовать многоугольник а не линию. далее на событие OnClick пеинт бокса проверь этот самый флаг. потом идет проверка какой клавишей мыши нажато по пеинтбоксу, если левой, то проверка флага начато ли рисование. если не начато, то выставить флаг начала рисования и выполнить процедуру MoveTo(MouseX,MouseY), иначе выполнять процедуру LineTo(MouseX,MouseY). Если нажата правая клавиша мыши то сбросить флаг начала рисования и флаг рисования многоугольника.
В общем как-то так. Сейчас пока нет времени написать код. Завтра мб будет время.
Кодер второго поколения.
|
|
|
buldoger (статус: Посетитель), 20 июля 2011, 19:40 [#7]:
Ок, жду код...
|
|
|
buldoger (статус: Посетитель), 21 июля 2011, 09:24 [#8]:
Как сделать пункты меню: копировать, вырезать, вставить из PaintBox?
|
|
|
min@y™ (статус: Доктор наук), 21 июля 2011, 09:36 [#9]:
Цитата (buldoger):
Как сделать пункты меню: копировать, вырезать, вставить из PaintBox?
С помощью компонентов TMainMenu и TPopupMenu.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
|
buldoger (статус: Посетитель), 21 июля 2011, 09:42 [#10]:
а какой код для этих операций?
|
|
|
min@y™ (статус: Доктор наук), 21 июля 2011, 09:49 [#11]:
Цитата (buldoger):
а какой код для этих операций?
Предлагаю тебе скачать какую-нибудь книжку по delphi и почитать в ней про объект Clipboard.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
|
min@y™ (статус: Доктор наук), 21 июля 2011, 09:52 [#12]:
Вот тебе пару функций из моей древней программы.
// ------------- Копирование изображения канвы в буфер обмена ------------------
procedure CopyCanvasToClipboard(Canvas:TCanvas;ARect:TRect);
var
bmp:TBitmap; // Временный битмэп
begin
bmp:=TBitmap.Create; // Создаём его
try
bmp.Width:=ARect.Right-ARect.Left; // Устанавливаем его размеры
bmp.Height:=ARect.Bottom-ARect.Top;
bmp.Canvas.CopyRect(Rect(0,0,bmp.Width,bmp.Height), // Копируем канву на
Canvas,ARect); // канву битмэпа
ClipBoard.Assign(bmp); // Копируем битмэп в буфер обмена
finally
FreeAndNil(bmp); // Уничтожаем ненужный битмэп
end;
end;
// ---- Извлечение картинки из буфера обмена. Возвращат True в случае удачи ----
function PasteCanvasFromClipboard(Picture:TPicture;var ARect:TRect):Boolean;
begin
Result:=False; // Значение функции по умолчанию
if not ClipBoard.HasFormat(CF_Bitmap) // Если в буфере обмена нет изображения,
then Exit; // то выходим с результатом False
Picture.Assign(Clipboard); // Загружаем картинку из буфера обмена
ARect:=Rect(1,1,Picture.Width,Picture.Height); // Передаём через параметр ARect габариты картинки
Result:=True; // Выходим с положительным результатом (True)
end;
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
|
buldoger (статус: Посетитель), 21 июля 2011, 11:06 [#13]:
почему пишет Undeclared Identifier ClipBoard и ARect?
|
|
|
min@y™ (статус: Доктор наук), 21 июля 2011, 11:49 [#14]:
Цитата (buldoger):
почему пишет Undeclared Identifier ClipBoard и ARect TRect?
Потому что достаточно залезть в хэлп и узнать, в каких модулях эти типы находятся и прицепить эти модули в uses.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
|
buldoger (статус: Посетитель), 21 июля 2011, 19:43 [#15]:
подскажите пожалуйста какие модули нужно подключить
|
|
|
min@y™ (статус: Доктор наук), 21 июля 2011, 19:51 [#16]:
Цитата (buldoger):
подскажите пожалуйста какие модули нужно подключить
Ну ваще народ обленился! Неужели проще ждать сутками ответов на форумах, чем просто нажать F1 и за 3 минуты решить свой же вопрос?
Ладно, это модули Clipbrd и Types.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
|
buldoger (статус: Посетитель), 21 июля 2011, 22:12 [#17]:
Спасибо огромное за ответы!
А как сделать "вырезать" из PaintBox???
|
|
|
min@y™ (статус: Доктор наук), 22 июля 2011, 08:11 [#18]:
Цитата (buldoger):
А как сделать "вырезать" из PaintBox???
1. Скопировать выделенный фрагмент.
2. Очистить выделенный фрагмент.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
|
