freepascal.ru

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

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

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

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

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

Спасибо всем!

1. гуглить по словам "динамическое создание компонентов"
2. смотреть тут, готовый класс для передвижения компонентов по форме..

Поднимите вот эту темку http://lazarus.freepascal.org/index.php ... #msg107718 там собирались портировать на лазаря чтото подобное

Добился вот какого результата:
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 писал(а):Как мне в run-time режиме редактировать свойства созданного компонента?

Ну так там, где вы его создаете (Button1Click) , вы _уже_ редактируете свойства компонента в рунтайме.
Точно так же и в других местах вашей программы, где доступен ваш компонент, они поддаются изменению.

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

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

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

Вот щелкаю я мышью по форме, как мне опознать, на каком компоненте мышь? Вот здесь у меня проблема.

Код: Выделить всё

begin
  Ac := ActiveControl;
  if (Ac.ClassName = 'Label')
  then begin
    case Ac.Name of
      'Label1': begin ... end;
      'Label2': begin ... end;
      .........................
      else begin ... end;
    end;
  end;


Ну где-то так

Решил задачу так:
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.

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

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

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


А что не так, снизойдите с высот своей гениальности...

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

А ниче, прикольно получилось! Это коммерческий проект?

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.
Ну и еще много всякого другого... "гениального".

учту, спасибо!

Существует вариант редактора блок-схем, портированного в Lazarus
http://alexdrdev.narod2.ru/index.html