Внезапно ! появилась версия 9.4.1Даже сам не ожидал ...
Архив содержит бинарник и сопутствующие файлы ...
Исходники будут чуть позже с комментарием .
Очередная версия технологического макета ...
Добавлено спустя 6 часов 2 минуты 43 секунды:
Продолжение истории «Я и мой загадочный виндовс »...
Раздел "Тайны Лазаруса" …
И так как я уже писал есть идеи использования полезного опыта из МА_RED в пакете WEB 2
Но как обычно выясняется что «гладко было на бумаге, да забыли про овраги... »
Первое с чем столкнулся при подъеме проекта из "глубоких архивов" проблемы с «белым квадратом Малевича » то есть с перерисовкой PaintBox в новой версии Лазаруса ну ладно я не гордый пару раз вызвать перерисовку рабочего поля не проблема …
Вот тут и начала появятся новая сборка !
Дальше потыкавшись помыкавшись отказался от «инструментального подхода» к смене цветов …
А чуть позже устроил переезд с древней DLL (еще с седьмого дельфи ) скриптового движка на встроенный в новые версии Лазаруса PascalScript …
И все бы замечательно но … Задумал я добавить новые инструмент...
первое что пришло в голову «Строго вертикальные» и «Строго горизонтальные линии»
Что может быть проще? Ага … Выкинул одну координату из скрипта прорисовки линии …
Но нормально НЕ РИСУЕТ !... вообще дурью маялся долго и довольно нудно (к тому же как выяснилось позабыл многие тонкости устройства программы ) но все же глюк победил …
И тут заметил что у меня вызов скрипта «сборки команды» случайно скопирован два раза …
Убираю …и в якобы «строго горизонтальные линии» вылезет «тень отца Гамлета» КОСАЯ линия причем именно на стадии генерации команды …
Пока так и не понял в чем дело и «лишний вызов» оставил «как есть».
Но какого черта это происходит вообще ?
Как может повторный вызов скрипта влиять на результат ?
Это прямо какой-то «призрак в опере»...
- Код: Выделить всё
//Реакция на нажатие кнопнок мыши
//на рабочие поле
procedure TRF1.Panel2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
Var
Ind:Longint;
SCR,S:String;
begin
IF CurPT<>Nil Then Begin
Ind:=TPanel(CurPt).HelpContext;
If (Button= mbLeft) or (Button= mbRight) then begin
If Fa=1 then begin Panel1.Enabled:=False; OPStr:=''; end
else Ft:=True;
if DrawList = Nil then DrawList:=TStringList.Create;
With ArTools[Ind] do begin
// Цвета в запись ...
CurC:=Shape1.Brush.Color;
CurB:=Shape2.Brush.Color;
SetParam('FA',IntToStr( FA ) );
SetParam('X',IntToStr( X ) );
SetParam('Y',IntToStr( Y ) );
SetParam('OPSTR',OPStr );
SetParam('CLR',IntToStr(CurC) );
SetParam('BCLR',IntToStr(CurB) );
SCR:=LoadStr(InputSCR);
// Непонятно ! Но почему-то нужно двухкратное выполенеие скриптов ...
rf1.PSScript1.Script.Clear;rf1.PSScript1.Script.Text:=SCR;
rf1.PSScript1.Compile ; rf1.PSScript1.Execute ;
rf1.PSScript1.Script.Clear;rf1.PSScript1.Script.Text:=SCR;
//Компилятция скрипта
If not rf1.PSScript1.Compile then begin
ShowMessage('Синтаксическая ошибка (ввод операции)');
exit;
end else
If not rf1.PSScript1.Execute then begin msg('Ошибка выполнения (ввод операции)');
exit;
end
else begin
OPSTR:=GetParam('OPSTR');
end
end;
fa:=0;
end ;
If Button= mbRight then
if FT then
begin
Fa:=1;
Ft:=false;
Panel1.Enabled:=True;
CurCanvas:=Self.PaintBox1.Canvas;
DRW_SETPenColor(CurC);
DRW_SETBrushColor(CurB);
DrawFig(-1,opstr);
DrawList.Add(Opstr);
if ul<>NIL then ul.Clear;
Opstr:='';
Listbox1.Clear;
Listbox1.Items.Text:=DrawList.Text;
end
end
end;
9.4.1.7z Обещанный исходник целикомЗы
Пока писал почти догадался в чем может быть дело ...
... SetParam('OPSTR',OPStr ); а в скрипте возврат идет точно также ...
...но откуда косая линия появляется и почему только при сборке команды «строго горизонтальной линии» ?
)
