Рисование на форме

Общие вопросы программирования, алгоритмы и т.п.

Модератор: Модераторы

Рисование на форме

Сообщение roman-info01 » 12.03.2013 14:07:13

Уважаемые коллеги, подскажите, кто знает, по следующему вопросу:

Моя задача заключается в создании программы - конструктора визуальных схем
То есть, заходит пользователь, добавляет компонент (квадратик), круг, соединяет стрелочками - и.т.д

Типа редактора блок-схем, но в моем случае - нужно больше изображения, пиктограммы.

Готового решения не прошу, не ленивый - но по данной теме, что по Delphi, что по Lazarus - почти ничего внятного нет. Опыта такой работы у меня нет - в основном, применял Lazarus для управления базами данных

В общем, меня интересует два вопроса:
1. как в lazarus создавать компоненты типа image и share во время выполнения
2. как перемещать по форме данные компоненты, созданные в real-time

Спасибо всем!
roman-info01
новенький
 
Сообщения: 13
Зарегистрирован: 20.11.2012 08:08:15

Re: Рисование на форме

Сообщение B4rr4cuda » 12.03.2013 22:22:57

1. гуглить по словам "динамическое создание компонентов"
2. смотреть тут, готовый класс для передвижения компонентов по форме..
Аватара пользователя
B4rr4cuda
энтузиаст
 
Сообщения: 693
Зарегистрирован: 28.12.2007 07:48:35

Re: Рисование на форме

Сообщение zub » 12.03.2013 23:13:07

Поднимите вот эту темку http://lazarus.freepascal.org/index.php ... #msg107718 там собирались портировать на лазаря чтото подобное
zub
долгожитель
 
Сообщения: 2886
Зарегистрирован: 14.11.2005 23:51:26

Re: Рисование на форме

Сообщение roman-info01 » 13.03.2013 07:10:58

Добился вот какого результата:
1. Создал компонент (по нажатию на кнопку формы):
procedure TForm1.Button1Click(Sender: TObject);
var
newLabel:TLabel;
begin
// Создать надпись
newLabel:=TLabel.Create(self);
newLabel.Parent:=Form1;
newLabel.Left:=10;
newLabel.Top:=10;
newLabel.AutoSize:=true;
newLabel.Caption:='Метка №1';
newLabel.Name:='newLabel1';
newLabel.Visible:=true;
newLabel.OnClick:=newLabelClick;
end;

При нажатии на данную метку срабатывает процедура:
procedure TForm1.newLabelClick(Sender: TObject);
begin
ident:='newLabel1';
ShowMessage(ident);
end;
В глобальную переменную ident - имя созданного компонента

Вопрос:
Как мне в run-time режиме редактировать свойства созданного компонента? Тут у меня вообще глухо, не знаю с какой стороны подступиться, помогите!
roman-info01
новенький
 
Сообщения: 13
Зарегистрирован: 20.11.2012 08:08:15

Re: Рисование на форме

Сообщение SSerge » 13.03.2013 07:58:26

roman-info01 писал(а):Как мне в run-time режиме редактировать свойства созданного компонента?


Ну так там, где вы его создаете (Button1Click) , вы _уже_ редактируете свойства компонента в рунтайме.
Точно так же и в других местах вашей программы, где доступен ваш компонент, они поддаются изменению.
SSerge
энтузиаст
 
Сообщения: 971
Зарегистрирован: 12.01.2012 05:34:14
Откуда: Барнаул

Re: Рисование на форме

Сообщение roman-info01 » 13.03.2013 08:38:10

Вы меня извините, я, видимо, не так выразился.
(Кстати, перемещать компоненты я вроде научился, сейчас выложу код...)

Мне нужно вот что: есть у меня, предположим, 3 созданных в run-time компонента Label - Label1, Label2, Label3

Я щелкаю мышкой по данному компоненту - появляется окно редактирования свойств, там выбираю новое имя и свойство Caption - применяю.

Вот щелкаю я мышью по форме, как мне опознать, на каком компоненте мышь? Вот здесь у меня проблема.
roman-info01
новенький
 
Сообщения: 13
Зарегистрирован: 20.11.2012 08:08:15

Re: Рисование на форме

Сообщение vada » 13.03.2013 10:35:35

Код: Выделить всё
begin
  Ac := ActiveControl;
  if (Ac.ClassName = 'Label')
  then begin
    case Ac.Name of
      'Label1': begin ... end;
      'Label2': begin ... end;
      .........................
      else begin ... end;
    end;
  end;

Ну где-то так
Аватара пользователя
vada
энтузиаст
 
Сообщения: 691
Зарегистрирован: 14.02.2006 13:43:17

Re: Рисование на форме

Сообщение roman-info01 » 13.03.2013 11:15:08

Решил задачу так:
procedure TmainForm.mainTimerTimer(Sender: TObject);
var
Control: TControl;
P: TPoint;
begin
P:=mouse.CursorPos;
Control := FindDragTarget(P, True);
if Assigned(Control) then mainForm.Caption := Control.Name;
end;

Таймер поставил на 500

Вроде работает...

Данный код определяет какой элемент находится под мышкой

Добавлено спустя 1 час 1 минуту 20 секунд:
В общем выкладываю, что получилось.
А получилось вот чего:
1. Создать компонент TLabel
2. Получать, какой компонент под мышкой
3. Перемещать компонент

unit main;

//{$mode objfpc}{$H+}
{$mode delphi}{$H+}

interface

uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus,
ExtCtrls, StdCtrls, ComCtrls, Buttons;

type

{ TmainForm }

TmainForm = class(TForm)
MenuItem1: TMenuItem;
MenuItem10: TMenuItem;
MenuItem11: TMenuItem;
MenuItem2: TMenuItem;
MenuItem3: TMenuItem;
MenuItem4: TMenuItem;
MenuItem5: TMenuItem;
MenuItem6: TMenuItem;
MenuItem7: TMenuItem;
MenuItem8: TMenuItem;
MenuItem9: TMenuItem;
nmMainMenu: TMainMenu;
mainTimer: TTimer;
mainToolBar: TToolBar;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
procedure mainTimerTimer(Sender: TObject);
procedure MenuItem6Click(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
procedure mnCreateLabel(nmLabelName:String); // Создать надпись
// Обработчики мыши для TLabel
procedure newLabelMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure newLabelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure newLabelMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
end;

var
mainForm: TmainForm;
comp_name:string; // Имя выбранного компонента
comp_class:string; // Класс выбранного компонента
dx,dy: integer;
Move: boolean;

implementation

{$R *.lfm}

{ TmainForm }

// ************** TLabel ************************
// Создать надпись
procedure TmainForm.mnCreateLabel(nmLabelName:String);
var
newLabel:TLabel;
begin
newLabel:=TLabel.Create(self); // Создать новый объект TLabel
newLabel.Parent:=mainForm; // Родительский объект
newLabel.Left:=50; // Первоначальное положение
newLabel.Top:=60;
newLabel.AutoSize:=true; // Авторазмер
newLabel.Caption:='Новая надпись'; // Надпись по умолчанию
newLabel.Name:=nmLabelName; // Присвоить имя
newLabel.Visible:=true; // Показать
// Обработчики событий мыши
newLabel.OnMouseDown:=newLabelMouseDown;
newLabel.OnMouseMove:=newLabelMouseMove;
newLabel.OnMouseUp:=newLabelMouseUp;
end;
// Обработчики мыши для TLabel
procedure TmainForm.newLabelMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Move := false;
end;
procedure TmainForm.newLabelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button <> mbLeft then exit;
dx := X;
dy := Y;
move := true;
(Sender as TControl).BringToFront;
end;
procedure TmainForm.newLabelMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
P:TPoint;
begin
if move then
begin
// Обработка перемещения
with (Sender as TControl)do
SetBounds(Left + X - dx, Top + Y - dy, Width, Height);
end;
end;

// *****************************************

procedure TmainForm.MenuItem6Click(Sender: TObject);
begin
// Создать надпись
mnCreateLabel('nmLabel1');
end;

procedure TmainForm.mainTimerTimer(Sender: TObject);
var
Control: TControl;
P: TPoint;
begin
try
P:=mouse.CursorPos;
Control := FindDragTarget(P, True);
if Assigned(Control) then
begin
comp_name := Control.Name;
comp_class :=Control.ClassName;
end;
except
// Если ошибка
end;
end;

end.
roman-info01
новенький
 
Сообщения: 13
Зарегистрирован: 20.11.2012 08:08:15

Re: Рисование на форме

Сообщение B4rr4cuda » 15.03.2013 03:23:57

*рукалицо*
А потом мы все удивляемся, почему комп тормозит, да почему программы бажные...
Аватара пользователя
B4rr4cuda
энтузиаст
 
Сообщения: 693
Зарегистрирован: 28.12.2007 07:48:35

Re: Рисование на форме

Сообщение roman-info01 » 20.03.2013 11:32:44

Re: Рисование на форме
B4rr4cuda » 15.03.2013 04:23:57

*рукалицо*
А потом мы все удивляемся, почему комп тормозит, да почему программы бажные...


А что не так, снизойдите с высот своей гениальности...
roman-info01
новенький
 
Сообщения: 13
Зарегистрирован: 20.11.2012 08:08:15

Re: Рисование на форме

Сообщение SeZuka » 20.03.2013 12:48:55

roman-info01 писал(а):В общем выкладываю, что получилось.

А ниче, прикольно получилось! Это коммерческий проект? :D
SeZuka
постоялец
 
Сообщения: 209
Зарегистрирован: 05.09.2012 14:58:05

Re: Рисование на форме

Сообщение B4rr4cuda » 21.03.2013 18:27:49

roman-info01 писал(а):А что не так, снизойдите с высот своей гениальности..

с высот моей гениальности, вот это:
Код: Выделить всё
procedure TmainForm.mainTimerTimer(Sender: TObject);
var
Control: TControl;
P: TPoint;
begin
try
P:=mouse.CursorPos;
Control := FindDragTarget(P, True);
if Assigned(Control) then
begin
comp_name := Control.Name;
comp_class :=Control.ClassName;
end;
except
// Если ошибка
end;
end;


заменяется двумя строчками кода в newLabelMouseDown
Код: Выделить всё
comp_name := TControl(Sender).Name;
comp_class :=TControl(Sender).ClassName;


НЕ ИСПОЛЬЗУЮТСЯ глобальные переменные, без лишней нужды.
Код на форуме оформляется в тег CODE.
Ну и еще много всякого другого... "гениального".
Аватара пользователя
B4rr4cuda
энтузиаст
 
Сообщения: 693
Зарегистрирован: 28.12.2007 07:48:35

Re: Рисование на форме

Сообщение roman-info01 » 26.03.2013 06:23:11

учту, спасибо!
roman-info01
новенький
 
Сообщения: 13
Зарегистрирован: 20.11.2012 08:08:15

Re: Рисование на форме

Сообщение eastorwest » 30.03.2013 21:52:10

Существует вариант редактора блок-схем, портированного в Lazarus
http://alexdrdev.narod2.ru/index.html
eastorwest
новенький
 
Сообщения: 57
Зарегистрирован: 23.07.2009 20:21:46
Откуда: Н-ск


Вернуться в Общее

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 10

Рейтинг@Mail.ru