end;
function SyvKanjiToSymbol(c: Char): TSYV;
begin
SyvKanjiToSymbol := Byte(c) or $30000;
end;
function FIsStdGesture(syv: Longint): Boolean;
begin
FIsStdGesture := (syv = syv_Clear) or (syv = syv_ExtendSelect) or
(syv = syv_Undo) or (syv = syv_Copy) or (syv = syv_Cut) or
(syv = syv_Paste) or (syv = syv_ClearWord) or (syv = syv_KKConvert) or
(syv = syv_User) or (syv = syv_Correct);
end;
function FIsAnsiGesture(syv: TSYV): Boolean;
begin
FIsAnsiGesture := (syv = syv_Backspace) or (syv = syv_Tab) or
(syv = syv_Return) or (syv = syv_Space);
end;
{ Gesture macros }
function FIsLoAppGesture(syv: Longint): Boolean;
begin
FIsLoAppGesture := (syv >= syv_CircleLoA) and (syv <= syv_CircleLoZ);
end;
function FIsUpAppGesture(syv: Longint): Boolean;
begin
FIsUpAppGesture := (syv >= syv_CircleUpA) and (syv <= syv_CircleUpZ);
end;
function FIsAppGesture(syv: Longint): Boolean;
begin
FIsAppGesture := (syv >= syv_CircleUpA) and (syv <= syv_CircleLoZ);
end;
function SyvAppGestureFromLoAnsi(Ansi: Char): TSYV;
begin
SyvAppGestureFromLoAnsi := Byte( (Ord(Ansi) – Ord('a')) + syv_CircleLoA );
end;
function SyvAppGestureFromUpAnsi(Ansi: Char): TSYV;
begin
SyvAppGestureFromUpAnsi := Byte( (Ord(Ansi) – Ord('A')) + syv_CircleUpA );
end;
function AnsiFromSyvAppGesture(syv: TSYV): Byte;
begin
if FIsUpAppGesture(syv) then syv := syv_CircleUpA – TSYV('A')
else syv := syv_CircleLoA – TSYV('a');
AnsiFromSyvAppGesture := ChSyvToAnsi(syv);
end;
function FIsSpecial(syv: TSYV): Boolean;
begin
FIsSpecial := LongRec(syv).Hi = syvhi_Special;
end;
function FIsAnsi(syv: TSYV): Boolean;
begin
FIsAnsi := LongRec(syv).Hi = syvhi_ANSI;
end;
function FIsGesture(syv: TSYV): Boolean;
begin
FIsGesture := LongRec(syv).Hi = syvhi_Gesture;
end;
function FIsKanji(syv: TSYV): Boolean;
begin
FIsKanji := LongRec(syv).Hi = syvhi_Kanji;
end;
function FIsShape(syv: TSYV): Boolean;
begin
FIsShape := LongRec(syv).Hi = syvhi_Shape;
end;
function FIsUniCode(syv: TSYV): Boolean;
begin
FIsUniCode := LongRec(syv).Hi = syvhi_UniCode;
end;
function FIsVKey(syv: TSYV): Boolean;
begin
FIsVKey := LongRec(syv).Hi = syvhi_VKey;
end;
function GetWEventRef: Word;
var
Result: Longint;
begin
Result := GetMessageExtraInfo;
GetWEventRef := LongRec(Result).Lo;
end;
function MpAlcB(lprc: PRC; i: Word): PByte;
begin
MpAlcB := @lprc^.rgbfAlc[ (i and $FF) shr 3 ];
end;
function MpIbf(i: Word): Byte;
begin
MpIbf := 1 shl (i and 7);
end;
procedure SetAlcBitAnsi(lprc: PRC; i: Word);
var
P: PByte;
begin
P := MpAlcB(lprc, i);
P^ := P^ or MpIbf(i);
end;
procedure ResetAlcBitAnsi(lprc: PRC; i: Word);
var
P: PByte;
begin
P := MpAlcB(lprc, i);
P^ := P^ and not MpIbf(i);
end;
function IsAlcBitAnsi(lprc: PRC; i: Word): Boolean;
begin
IsAlcBitAnsi := MpAlcB(lprc,i)^ and MpIbf(i) <> 0;
end;
function IsGestureToGesture(lprcresult: PRCResult): Boolean;
begin
IsGestureToGesture :=
(lprcresult^.wResultsType and map_GestOGES) = map_GestOGES;
end;
function IsGestureToVkeys(lprcresult: PRCResult): Boolean;
begin
IsGestureToVkeys :=
(lprcresult^.wResultsType and map_GestOVKeys) = map_GestOVKeys;
end;
procedure SetAlreadyProcessed(lprcresult: PRCResult);
begin
lprcresult^.wResultsType :=
(lprcresult^.wResultsType and (not rcrt_GestureToKeys)) or rcrt_AlreadyProcessed;
end;
function DestroyPenData(hPenData: THPenData): Boolean;
begin
DestroyPenData := GlobalFree(hPenData) = 0;
end;
procedure EndEnumStrokes(hPenData: THPenData);
begin
GlobalUnlock(hPenData);
end;
procedure UpdatePenInfo; external 'PENWIN' index 207;
function EndPenCollection; external 'PENWIN' index 137;
function GetPenHwData; external 'PENWIN' index 138;
function GetPenHwEventData; external 'PENWIN' index 139;
function SetPenHook; external 'PENWIN' index 115;
procedure PostVirtualKeyEvent; external 'PENWIN' index 102;
procedure PostVirtualMouseEvent; external 'PENWIN' index 101;
procedure AtomicVirtualEvent; external 'PENWIN' index 104;
function InstallRecognizer; external 'PENWIN' index 14;
procedure UninstallRecognizer; external 'PENWIN' index 15;
function GetGlobalRC; external 'PENWIN' index 151;
function SetGlobalRC; external 'PENWIN' index 150;
procedure RegisterPenApp; external 'PENWIN' index 111;
function IsPenAware; external 'PENWIN' index 110;
function SetRecogHook; external 'PENWIN' index 114;
procedure InitRC; external 'PENWIN' index 10;
function Recognize; external 'PENWIN' index 11;
function RecognizeData; external 'PENWIN' index 12;
function TrainInk; external 'PENWIN' index 16;
function TrainContext; external 'PENWIN' index 17;
function ProcessWriting; external 'PENWIN' index 170;
function CorrectWriting; external 'PENWIN' index 172;
procedure EmulatePen; external 'PENWIN' index 173;
function GetSymbolMaxLength; external 'PENWIN' index 121;
function GetSymbolCount; external 'PENWIN' index 122;
procedure FirstSymbolFromGraph; external 'PENWIN' index 123;
function EnumSymbols; external 'PENWIN' index 124;
function TPtoDP; external 'PENWIN' index 132;
function DPtoTP; external 'PENWIN' index 131;
procedure BoundingRectFromPoints; external 'PENWIN' index 13;
function SymbolToCharacter; external 'PENWIN' index 125;
function CharacterToSymbol; external 'PENWIN' index 126;
function GetVersionPenWin; external 'PENWIN' index 402;
function ExecuteGesture; external 'PENWIN' index 418;
function IsPenEvent; external 'PENWIN' index 135;
function GetPenAsyncState; external 'PENWIN' index 144;
function GetPenDataInfo; external 'PENWIN' index 211;
function GetPenDataStroke; external 'PENWIN' index 219;
function GetPointsFromPenData; external 'PENWIN' index 221;
procedure DrawPenData; external 'PENWIN' index 214;
function MetricScalePenData; external 'PENWIN' index 215;
function ResizePenData; external 'PENWIN' index 222;
function OffsetPenData; external 'PENWIN' index 216;
function RedisplayPenData; external 'PENWIN' index 242;
function CompactPenData; external 'PENWIN' index 223;
function DuplicatePenData; external 'PENWIN' index 218;
function CreatePenData; external 'PENWIN' index 210;
function AddPointsPenData; external 'PENWIN' index 212;
function BeginEnumStrokes; external 'PENWIN' index 213;
function DictionarySearch; external 'PENWIN' index 420;
function ShowKeyboard; external 'PENWIN' index 250;
{$R *.DFM}
const
id_FName = 100;
id_FPath = 101;
id_FList = 102;
id_DList = 103;
const
fsFileSpec = fsFileName + fsExtension;
type
TDWord = record
Lo, Hi: Word;
end;
var
GCaption: PChar;
GFilePath: PChar;
GPathName: array[0..fsPathName] of Char;
GExtension: array[0..fsExtension] of Char;
GFileSpec: array[0..fsFileSpec] of Char;
function GetFileName(FilePath: PChar): PChar;
var
P: PChar;
begin
P := StrRScan(FilePath, '\');
if P = nil then P := StrRScan(FilePath, ':');
if P = nil then GetFileName := FilePath else GetFileName := P + 1;
end;
function GetExtension(FilePath: PChar): PChar;
var
P: PChar;
begin
P := StrScan(GetFileName(FilePath), '.');
if P = nil then GetExtension := StrEnd(FilePath) else GetExtension := P;
end;
function FileDialog(Dialog: HWnd; Message, WParam: Word;
LParam: TDWord): Bool; export;
var
PathLen: Word;
P: PChar;
procedure UpdateFileName;
begin
SetDlgItemText(Dialog, id_FName, StrLower(GPathName));
SendDlgItemMessage(Dialog, id_FName, em_SetSel, 0, $7FFF0000);
end;
procedure SelectFileName;
begin
SendDlgItemMessage(Dialog, id_FName, em_SetSel, 0, $7FFF0000);
SetFocus(GetDlgItem(Dialog, id_FName));
end;
function UpdateListBoxes: Boolean;
var
Result: Integer;
Path: array[0..fsPathName] of Char;
begin
UpdateListBoxes := False;
if GetDlgItem(Dialog, id_FList) <> 0 then
begin
StrCopy(Path, GPathName);
Result := DlgDirList(Dialog, Path, id_FList, id_FPath, 0);
if Result <> 0 then DlgDirList(Dialog, '*.*', id_DList, 0, $C010);
end else
begin
StrLCopy(Path, GPathName, GetFileName(GPathName) – GPathName);
StrLCat(Path, '*.*', fsPathName);
Result := DlgDirList(Dialog, Path, id_DList, id_FPath, $C010);
end;
if Result <> 0 then
begin
StrLCopy(GFileSpec, GetFileName(GPathName), fsFileSpec);
StrCopy(GPathName, GFileSpec);
UpdateFileName;
UpdateListBoxes := True;
end;
end;
begin
FileDialog := True;
case Message of
wm_InitDialog:
begin
SendDlgItemMessage(Dialog, id_FName, em_LimitText, fsPathName, 0);
if GCaption <> nil then SetWindowText(Dialog, GCaption);
StrLCopy(GPathName, GFilePath, fsPathName);
StrLCopy(GExtension, GetExtension(GPathName), fsExtension);
if not UpdateListBoxes then
begin
StrCopy(GPathName, '*.*');
UpdateListBoxes;
end;
SelectFileName;
Exit;
end;
wm_Command:
case WParam of
id_FName:
begin
if LParam.Hi = en_Change then
EnableWindow(GetDlgItem(Dialog, id_Ok),
SendMessage(LParam.lo, wm_GetTextLength, 0, 0) <> 0);
Exit;
end;
id_FList:
if (LParam.Hi = lbn_SelChange) or (LParam.Hi = lbn_DblClk) then
begin
DlgDirSelect(Dialog, GPathName, id_FList);
UpdateFileName;
if LParam.Hi = lbn_DblClk then
SendMessage(Dialog, wm_Command, id_Ok, 0);
Exit;
end;
id_DList:
if (LParam.Hi = lbn_SelChange) or (LParam.Hi = lbn_DblClk) then
begin
DlgDirSelect(Dialog, GPathName, id_DList);
StrCat(GPathName, GFileSpec);
if LParam.Hi = lbn_DblClk then
UpdateListBoxes else
UpdateFileName;
Exit;
end;
id_Ok:
begin
GetDlgItemText(Dialog, id_FName, GPathName, fsPathName + 1);
FileExpand(GPathName, GPathName);
PathLen := StrLen(GPathName);
if (GPathName[PathLen – 1] = '\') or
(StrScan(GPathName, '*') <> nil) or
(StrScan(GPathName, '?') <> nil) or
(GetFocus = GetDlgItem(Dialog, id_DList)) then
begin
if GPathName[PathLen – 1] = '\' then
StrLCat(GPathName, GFileSpec, fsPathName);
if not UpdateListBoxes then
begin
MessageBeep(0);
SelectFileName;
end;
Exit;
end;
StrLCat(StrLCat(GPathName, '\', fsPathName),
GFileSpec, fsPathName);
if UpdateListBoxes then Exit;
GPathName[PathLen] := #0;
if GetExtension(GPathName)[0] = #0 then
StrLCat(GPathName, GExtension, fsPathName);
StrLower(StrCopy(GFilePath, GPathName));
EndDialog(Dialog, 1);
Exit;
end;
id_Cancel:
begin
EndDialog(Dialog, 0);
Exit;
end;
end;
end;
FileDialog := False;
end;
function DoFileDialog(Window: HWnd;
FilePath, DialogName, Caption: PChar): Boolean;
var
DialogProc: TFarProc;
begin
GFilePath := FilePath;
GCaption := Caption;
DialogProc := MakeProcInstance(@FileDialog, HInstance);
DoFileDialog := DialogBox(HInstance, DialogName, Window, DialogProc) = 1;
FreeProcInstance(DialogProc);
end;
function DoFileOpen(Window: HWnd; FilePath: PChar): Boolean;
begin
DoFileOpen := DoFileDialog(Window, FilePath, 'FileOpen', nil);
end;
function DoFileSave(Window: HWnd; FilePath: PChar): Boolean;
begin
DoFileSave := DoFileDialog(Window, FilePath, 'FileSave', nil);
end;
procedure TForm1.Button2Click(Sender: TObject); {ВЫХОД}
begin
close;
end;
procedure TForm1.Button1Click(Sender: TObject); {СПЕКТР. АНАЛ.}
var
i,j,k,n: integer;
sred,otkl:real;
sign:textfile;
mass:array[0..5] of real;
massx,massy:array[1..5,0..5]of real;
s,m:byte;
p,min:real;
mass1: array [1..20,1..20] of word;
mass2: array [1..20,1..20,1..20] of word;
begin
n:= 27;
ind:=0;
assignfile(sign,'sign01.txt');
reset(sign);
progressbar1.StepIt;progressbar1.StepIt;progressbar1.StepIt;progressbar1.StepIt;progressbar1.StepIt;
progressbar1.StepIt;progressbar1.StepIt;progressbar1.StepIt;progressbar1.StepIt;progressbar1.StepIt;
{Весь файл}
for k:=1 to 5 do
begin
{Объект}
for j:=0 to 5 do
begin
{Выборка}
sred:=0;otkl:=0;
for i:=0 to 5 do
begin
read(sign,mass[i]);
sred:=sred+mass[i];
end;
sred:=sred/6;
for i:=0 to 5 do otkl:=otkl+abs(mass[i]–sred);
otkl:=otkl/100+i*0.01;
massx[k,j]:=sred;
massy[k,j]:=otkl;
end;end;close(sign);reset(sign);
for i:=1 to 5 do
for j:=0 to 5 do
begin
read(sign,p)
mass[i,j]:=p*ln(sqrt(otkl)/(1.325113*p/16)–exp(p));
otkl:=1.3*arctg(mass[i,j])+sqr(i–p);
sred:=ln(sqr(p+sred)*456/otkl–mass[i,j]);
mass[i,j]:=mass[i,j]/otkl+ sred;
end;
{cоздание образа}
inc(ind,1);
if ind = 1 then
begin
for i:=0 to 5 do chart1.SeriesList[0].AddXY(massx[1,i],massy[1,i],'',clred);
for i:=0 to 5 do chart1.SeriesList[1].AddXY(massx[2,i],massy[2,i],'',clred);
for i:=0 to 5 do chart1.SeriesList[2].AddXY(massx[3,i],massy[3,i],'',clred);
for i:=0 to 5 do chart1.SeriesList[3].AddXY(massx[4,i],massy[4,i],'',clred);
for i:=0 to 5 do chart1.SeriesList[4].AddXY(massx[5,i],massy[5,i],'',clred);
for i:=0 to 5 do begin
chart1.SeriesList[5].AddXY(massx[1,i],massy[1,i],'',clred);
chart1.SeriesList[5].AddXY(massx[2,i],massy[2,i],'',clred);
end;
for i:=0 to 5 do begin
chart1.SeriesList[6].AddXY(massx[1,i],massy[1,i],'',clred);
chart1.SeriesList[6].AddXY(massx[3,i],massy[3,i],'',clred);
end;
for i:=0 to 5 do begin
chart1.SeriesList[7].AddXY(massx[1,i],massy[1,i],'',clred);
chart1.SeriesList[7].AddXY(massx[4,i],massy[4,i],'',clred);
end;
for i:=0 to 5 do begin
chart1.SeriesList[8].AddXY(massx[1,i],massy[1,i],'',clred);
chart1.SeriesList[8].AddXY(massx[5,i],massy[5,i],'',clred);
end;
for i:=0 to 5 do begin
chart1.SeriesList[9].AddXY(massx[2,i],massy[2,i],'',clred);
chart1.SeriesList[9].AddXY(massx[3,i],massy[3,i],'',clred);
end;
for i:=0 to 5 do begin
chart1.SeriesList[10].AddXY(massx[2,i],massy[2,i],'',clred);
chart1.SeriesList[10].AddXY(massx[4,i],massy[4,i],'',clred);
end;
for i:=0 to 5 do begin
chart1.SeriesList[11].AddXY(massx[2,i],massy[2,i],'',clred);
chart1.SeriesList[11].AddXY(massx[5,i],massy[5,i],'',clred);
end;
for i:=0 to 5 do begin
chart1.SeriesList[12].AddXY(massx[3,i],massy[3,i],'',clred);
chart1.SeriesList[12].AddXY(massx[4,i],massy[4,i],'',clred);
end;
for i:=0 to 5 do begin
chart1.SeriesList[13].AddXY(massx[3,i],massy[3,i],'',clred);
chart1.SeriesList[13].AddXY(massx[5,i],massy[5,i],'',clred);
end;
for i:=0 to 5 do begin
chart1.SeriesList[14].AddXY(massx[4,i],massy[4,i],'',clred);
chart1.SeriesList[14].AddXY(massx[5,i],massy[5,i],'',clred);
end;
for i:=0 to 5 do begin
chart1.SeriesList[15].AddXY(massx[1,i],massy[1,i],'',clred);