мой единственынй совет - создать проект на любом хостинге проектов.
Там и доступ будет публичный всем в любой момент суток, ну и документацию с баг трекером можнно вести.
Модератор: Модераторы
скалогрыз » 16.06.2015 22:06:57
Alex2013 » 18.06.2015 00:14:41
// не помню точно в каком модуле нужные типы
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
ExtCtrls, Buttons, StdCtrls, Process, lazregions,
LCLIntf, LCLType, IntfGraphics,Math;
...
{SMARTLINK ON}
const
{ Graphics Modes }
GM_COMPATIBLE = 1;
GM_ADVANCED = 2;
GM_LAST = 2;
{ xform stuff }
MWT_IDENTITY = 1;
MWT_LEFTMULTIPLY = 2;
MWT_RIGHTMULTIPLY = 3;
MWT_MIN = MWT_IDENTITY;
MWT_MAX = MWT_RIGHTMULTIPLY;
msimg32lib = 'msimg32.dll';
user32lib = 'user32.dll';
shell32lib = 'shell32.dll';
gdi32lib = 'gdi32.dll';
comctl32lib = 'comctl32.dll';
type
PXForm = ^TXForm;
tagXFORM = packed record
eM11: Single;
eM12: Single;
eM21: Single;
eM22: Single;
eDx: Single;
eDy: Single;
end;
TXForm = tagXFORM;
XFORM = tagXFORM;
function SetGraphicsMode(hdc: HDC; iMode: Integer): Integer;stdcall;
external gdi32lib name 'SetGraphicsMode';
//function GetWorldTransform(DC: HDC; var p2: TXForm): BOOL; stdcall;
// external gdi32lib name 'GetWorldTransform';
function SetWorldTransform(DC: HDC; const p2: TXForm): BOOL; stdcall;
external gdi32lib name 'SetWorldTransform';
function ModifyWorldTransform(DC: HDC; const p2: TXForm; p3: DWORD): BOOL; stdcall;
external gdi32lib name 'ModifyWorldTransform';
// Пересчет размера
// входящие ---------------------
// degree угол
// W,H ширина исходной картинки
/ /исходящие -------------------
// topoverh, leftoverh точка оси поворота ?(Не уверен в "физическом смысле" этих координат)
// X,Y - Ширина и высота "повернутой" картинки
Procedure GetRSize (degree,W,H: integer; Var topoverh, leftoverh,X,Y: integer);
Var
cosA, sinA: real;
Begin
cosA := cos(degree*Pi/180);
sinA := sin(degree*Pi/180);
while degree >= 360 do degree := degree - 360;
while degree < 0 do degree := degree + 360;
if (degree <= 90) then
begin
topoverh := 0;
y := Round(W * sinA + H * cosA);
leftoverh := Round(- H * sinA);
x := Round(W * cosA) + Abs(leftoverh);
end
else if (degree <= 180) then
begin
topoverh := Round(H * cosA);
y := Round(W * sinA) + Abs(topoverh);
leftoverh := Round(W * cosA - H * sinA);
x := Abs(leftoverh);
end
else if (degree <= 270) then
begin
topoverh := Round(W * sinA + H * cosA);
y := Abs(topoverh);
leftoverh := Round(W * cosA);
x := Round(- H * sinA) + Abs(leftoverh);
end
else
begin
topoverh := Round(W * sinA);
y := Round(H * cosA) + Abs(topoverh);
leftoverh := 0;
x := Round(W * cosA - H * sinA) + Abs(leftoverh);
end;
end;
//Поворот картинки
procedure DrawRotatedBitmap(Bitmap: TBitmap; Dest: TCanvas; X_, Y_: Integer;
degree,topoverh, leftoverh: Integer);
var
Matrix: TXForm;
Angle: Double;
x, y, H, W: integer;
begin
H := Bitmap.Height;
W := Bitmap.Width;
Angle:= degree*Pi/180;
while degree >= 360 do degree := degree - 360;
while degree < 0 do degree := degree + 360;
// Разрешаем афинные преобразования
SetGraphicsMode(Dest.Handle, GM_ADVANCED);
// Устанавливаем матрицу для смещения на (X, Y)
Matrix.eM11 := 1;
Matrix.eM12 := 0;
Matrix.eM21 := 0;
Matrix.eM22 := 1;
Matrix.eDx := X_;
Matrix.eDy := Y_;
SetWorldTransform(Dest.Handle, Matrix);
// Устанавливаем матрицу поворота
Matrix.eM11 := Cos(Angle);
Matrix.eM12 := Sin(Angle);
Matrix.eM21 := -Sin(Angle);
Matrix.eM22 := Cos(Angle);
Matrix.eDx := -leftoverh;
Matrix.eDy := -topoverh;;
ModifyWorldTransform(Dest.Handle, Matrix, MWT_LEFTMULTIPLY);
// Выводим изображение
Dest.Draw(0, 0, Bitmap);
// Восстанавливаем систему координат
ModifyWorldTransform(Dest.Handle, Matrix, MWT_IDENTITY);
end;
GetRSize(i*10,40,40,tv,lv,wr,hr);
Br:=Tbitmap.Create; Br.SetSize(wr,hr);
With BR.Canvas do begin brush.Color:=clWhite;FillRect(ClipRect);end;
DrawRotatedBitmap(B0,BR.Canvas,0,0,i*10,tv,lv);
Image2.Picture.Bitmap.Assign(BR);
Br.free;
Sharfik » 18.06.2015 03:28:49
Alex2013 » 18.06.2015 20:56:05
«Доморощенный расширитель реальности »SV_MOD2
Инструкция
1 Нажать "START"
Если все в порядке сразу увидите изображение веб-камеры подключенной по умолчанию (Иначе выведет диалог выбора камеры)
Если в системе не все так хорошо как хочется фон окна просто изменится и все.
НО ЭТО НЕ ОБЯЗАТЕЛЬНО ПОМЕШАЕТ ...
2 Жмем >>BUF и BUF >> Если все ок сможете увидеть кадр в окошке превъю
3 Auto Start шевелим камеру видим изменения в "Риал Тайм"
4 Нажимаем ZOOM открывается окно "безграничного преувеличения"
6 + - регулируют увеличение галка Обновить включает "РТ-Режим"
7 Скролы позволяют работать в режиме "глаза воблы"
8 Если камера не обнаружена для проверки можно использовать DScaler
(http://deinterlace.sourceforge.net/russian/FAQ.htm )
9 Функция "супер зум" (в этой версии в отдельном модуле) включаете галку "ОБНОВЛЕНИЕ" отмечаете часть изображения мышкой нажимаете соответствующею кнопку..
10 Функция "Слежения" включается ответствующей галкой открывается чб визир можно повозится с настройкой ( Чувствительность , шаг сканера , сглаживание ) движение показывает зелеными точками ...
Да не забывайте включать галку "Обновление"
(Интересно отслеживать прохожих и машины на улице и по идее можно сделать например офисную охранную сигнализацию с отсылкой кадров по е-майлу или следилку за машиной под окнами ..)
RR.zip Alex2013 » 24.06.2015 03:38:21
RR_Full_01.zip
[MAIN]
// Шаг поворота
StepR=10
// Максимально допустимый шум %
MaxTresh=35
// Минимальное совпадение %
MinEQ=75
//Начальный угол
BeginAngle=0
//Конечный угол
EndAngle=360
// Минимальная демонстратция
MinView=1
// Выход после завершения сравнеиня
AutoExit=0
Впрочем "утро вечера мудреней " ! Alex2013 » 25.06.2015 23:28:10
RG_4_2
RG 4_2
Подключил выделенные в отдельный модуль этапы с 5-го по 7-мой .
(То есть собственно распознавание образов )
В исходных данных передается название файла образца(маски) и список контуров для распознавания. +
Обработка результатов распознавания (Не в полном объеме). +
Настройка параметров из основной программы. +
Pavia » 28.06.2015 09:17:46
// Гистерезисный порог
procedure HysteresisThreshold_approximate_Base(var r:TByteMap; bm:TByteMap; Tmin,TMax:Integer); Overload;
{14-20 тик на пиксель 1 канал}
var i,j:Integer;
LL:Integer;
p,p1,p2:PAByte;
// Реализация в 4 прохода с частичной потерью точности.
begin
p:=R.ScanLine[0];
p1:=bm.ScanLine[0];
for i:=1 to bm.Width-1 do
begin
if p1[i]> Tmin then p[i]:=80;
if (p1[i]> Tmax) or (p[i-1]=255) then p[i]:=255;
end;
for j:=1 to bm.Height-1 do
begin
p:=R.ScanLine[j];
p2:=R.ScanLine[j-1];
p1:=bm.ScanLine[j];
for i:=1 to bm.Width-1 do
begin
p[i]:=0;
if (p1[i]> Tmin) then
begin
p[i]:=$80;
if (p[i-1]=255) or (p2[i]=255) then p[i]:=255;
end;
if (p1[i]> Tmax) then p[i]:=255;
end;
end;
// Обратный проход
p:=R.ScanLine[bm.Height-1];
p1:=bm.ScanLine[bm.Height-1];
for i:=bm.Width-2 downto 0 do
begin
if (p[i]= $80) and (p[i+1]=255) then p[i]:=255;
end;
for j:=bm.Height-2 downto 0 do
begin
p:=R.ScanLine[j];
p2:=R.ScanLine[j+1];
p1:=bm.ScanLine[j];
for i:=bm.Width-2 downto 0 do
begin
if (p[i]= $80) and ((p[i+1]=255) or (p2[i]=255)) then p[i]:=255;
// if (p[i]= $80) then p[i]:=0;
end;
end;
// 3 проход
p:=R.ScanLine[0];
p1:=bm.ScanLine[0];
for i:=1 to bm.Width-1 do
begin
if (p[i]=$80) and (p[i-1]=255) then p[i]:=255;
end;
for j:=1 to bm.Height-1 do
begin
p:=R.ScanLine[j];
p2:=R.ScanLine[j-1];
p1:=bm.ScanLine[j];
for i:=1 to bm.Width-1 do
begin
if (p[i]=$80) and ((p[i-1]=255) or (p2[i]=255)) then p[i]:=255;
end;
end;
// 4 проход
// Обратный проход 2
p:=R.ScanLine[bm.Height-1];
p1:=bm.ScanLine[bm.Height-1];
for i:=bm.Width-2 downto 0 do
begin
if (p[i]= $80) and (p[i+1]=255) then p[i]:=255;
end;
for j:=bm.Height-2 downto 0 do
begin
p:=R.ScanLine[j];
p2:=R.ScanLine[j+1];
p1:=bm.ScanLine[j];
for i:=bm.Width-2 downto 0 do
begin
if (p[i]= $80) and ((p[i+1]=255) or (p2[i]=255)) then p[i]:=255;
if (p[i]= $80) then p[i]:=0;
end;
end;
end;
Alex2013 » 28.06.2015 17:45:26
Alex2013 » 08.07.2015 03:23:24
Alex2013 » 09.07.2015 21:00:50
Pavia » 10.07.2015 13:16:04
Alex2013 » 10.07.2015 15:34:37
(Ну максимум за две основные идеи были понятны еще за долго до появления этой темы ... ) Результат с 23-го мая воз и ныне там (и это уже третий вариант проекта )...Ну не совсем, локальные подвижки есть кое что наработано и опробовано кое отчего отказался . 
Nv_BETA002.zipСКАЧАТЬ Alex2013 » 15.07.2015 23:05:47
ПРИЛОЖЕНИЕ 1 Внешние Функции доступные из скрипта .
------------------------------------------------------
/// Основной набор
//Установить параметр или создать новый
Procedure SetParam(Name,Param:String);
//Получить параметр по имени
Function GetParam(Name:String):String;
//Получить ширину обрабатываемого изображения (пока одного из трех)
Function GetWidth(N:Integer):Integer;
// Получить высоту обрабатываемого изображения (пока одного из трех)
Function GetHeight(N:Integer):Integer;
// Изменить цвет точки (N(0..2) – номер изображения X Y Координаты точки )
Procedure SetPixel(N,X,Y,C:LongInt);
// Получить цвет точки (N(0..2) – номер изображения X Y Координаты точки)
Function GetPixel(N,X,Y:LongInt):LongInt);
// Записать строку для лога
Procedure SResult(S:String);
// Выдать сообщение
Procedure MSG (S:String);
// Выдать расширенное сообщение
Procedure WForm(M:String);
//Изменить состояние «полосы прогресса»
Procedure RunTime (M,T:Integer);
// Функции работы с цветом
function Red(rgb: LongInt): BYTE;
function Green(rgb: LongInt): BYTE;
function Blue(rgb: LongInt): BYTE;
function RGB(R, G, B: Byte):Longint;
// Яркость точки
// function BWColor(C: LongInt): BYTE;
// Функция копирования изображения
//(N1 -> N2)
// 0- Исходный кадр
// 1- Рабочий кадр (Обновляется после каждого этапа )
// 2- Запасной буфер
Procedure CopyImage(N1,N2:Integer);
// Функции работы со списком маркеров
function GetCountMarkerList:Longint;
Function MarkerWidth(N:Integer):Integer;
Function MarkerHeight(N:Integer):Integer;
Function GetMarkerPixel(N,X,Y:Integer):Integer;
Procedure SetMarkerPixel(N,X,Y,C:Integer);
//ДОПОЛНЕНИЕ Функции работы с рабочим списком
//1 Копировать область из осиновых изображений
//и добавить ее в рабочий список …
// (N 0-2 номер основного изображения )
Function ACopyIRToWork(N,X,Y,W,H:integer):integer;
//2 Добавить в рабочий список эталон маркера с масштабированием
// (N номер в списке маркеров )
Function MaskToWork(N,W,H:integer):integer;
//3 Изменить размер изображения в рабочем списке
// (N номер в списке маркеров )
Procedure WReSize(N,W,H:integer);
//4 Наложение изображения с логической операцией
// N1->N2 Mode – режим наложения
// Обычно нужно mode = cmSrcPaint = $00EE0086;
Procedure WLogicCopy(N1,N2,Mode:integer);
---------------- Полный список режимов ------------------
const
cmBlackness = BLACKNESS;
cmDstInvert = DSTINVERT;
cmMergeCopy = MERGECOPY;
cmMergePaint = MERGEPAINT;
cmNotSrcCopy = NOTSRCCOPY;
cmNotSrcErase = NOTSRCERASE;
cmPatCopy = PATCOPY;
cmPatInvert = PATINVERT;
cmPatPaint = PATPAINT;
cmSrcAnd = SRCAND;
cmSrcCopy = SRCCOPY;
cmSrcErase = SRCERASE;
cmSrcInvert = SRCINVERT;
cmSrcPaint = SRCPAINT;
cmWhiteness = WHITENESS;
SRCCOPY = $00CC0020; { dest = source }
SRCPAINT = $00EE0086; { dest = source OR dest }
SRCAND = $008800C6; { dest = source AND dest }
SRCINVERT = $00660046; { dest = source XOR dest }
SRCERASE = $00440328; { dest = source AND (NOT dest ) }
NOTSRCCOPY = $00330008; { dest = (NOT source) }
NOTSRCERASE = $001100A6; { dest = (NOT src) AND (NOT dest) }
MERGECOPY = $00C000CA; { dest = (source AND pattern) }
MERGEPAINT = $00BB0226; { dest = (NOT source) OR dest }
PATCOPY = $00F00021; { dest = pattern }
PATPAINT = $00FB0A09; { dest = DPSnoo }
PATINVERT = $005A0049; { dest = pattern XOR dest }
DSTINVERT = $00550009; { dest = (NOT dest) }
BLACKNESS = $00000042; { dest = BLACK }
WHITENESS = $00FF0062; { dest = WHITE }
//5 Количество изображений в рабочем списке
Function WCount:integer;
//6 Повернуть изображение (А -угол в градусах)
// N-номер изображения в рабочем списке
Procedure WRotate(N,A:integer);
//7 Получить цвет точки N-номер номер в рабочем списке X Y Координаты точки
Function WGetPixel(N,X,Y:Integer):Integer;
//8 Изменить цвет точки N-номер в рабочем списке X Y Координаты точки
Procedure WSetPixel(N,X,Y,C:Integer);
//9 Очистить рабочий список
Procedure WClear;
//10 Получить ширину изображения в рабочем списке
Function WWidth(N:Integer):Integer;
//11 Получить высоту изображения в рабочем списке
Function WHeight(N:Integer):Integer;
Alex2013 » 20.07.2015 01:58:48
Nv_BETA003.zip
... Особенность версии серии скриптов отвечающих за "рас-познание" в том что они требуют "одно контурных" маркеров .. То есть можно попытаться распознать хоть автограф Пушкина но... только если он будет слитным без отдельных деталей ... (Что значит что встроенный "по умолчанию" пример не работает и что нужно загрузить изображения ( в нулевой маркер и кадр ) самостоятельно ....) 
) и при наличии примеров и исходников не так уж трудно ... Pavia » 20.07.2015 11:36:19
Будут вопросы пишите постараюсь ответить. Сейчас скорее всего вас тормозят скрипты. Если у вас есть Delphi XE то неплохо прогнать код через него. И посмотреть какие ошибки и предупреждения он пишет. Статический анализ вещь хорошая читаешь и видишь ошибки. Но скорее всего у вас ошибки стандартного плана выход за границы массива."синдрома вертикального прогресса " (Это когда сложность программы скачком уходит за пределы моего скромного понимания ) ..
For Y:=0 to H do begin
For X:=0 to W do begin
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 1