Вверх ↑
Этот топик читают: Гость
Ответов: 1307
Рейтинг: 29
#541: 2021-01-23 01:38:10 ЛС | профиль | цитата
Add(MainForm,2953706,91,161)
{
}
Add(StrMask,2673112,273,210)
{
Mask="1122*"
Point(doMask)
link(onFalse,6933876:doOff,[])
link(onTrue,6933876:doOn,[])
link(Str,7057069:Var3,[(279,187)])
}
Add(Edit,13856812,168,84)
{
Left=20
Top=15
Width=295
Text="1122*"
link(onChange,2673112:doMask,[(236,90)(236,223)])
}
Add(Edit,10757444,168,140)
{
Left=20
Top=55
Width=295
Text="112233"
}
Add(Button,12446957,91,210)
{
Left=20
Top=120
link(onClick,4799450:doData,[])
}
Add(LED,6933876,364,203)
{
Left=145
Top=130
}
Add(DoData,4799450,168,210)
{
link(onEventData,2673112:doCompare,[])
link(Data,7057069:Var2,[])
}
Add(GetDataEx,7057069,168,182)
{
link(Data,10757444:Text,[])
}

все версии: 32, 64, 32U, 64U



Редактировалось 2 раз(а), последний 2021-01-23 01:39:33
карма: 2

0
Ответов: 192
Рейтинг: 12
#542: 2021-01-23 01:48:54 ЛС | профиль | цитата
Rysik, И что не так
карма: 1

0
Ответов: 1307
Рейтинг: 29
#543: 2021-01-23 01:57:18 ЛС | профиль | цитата
Joiner писал(а):
Rysik, И что не так



был уже такой вопрос, нашёл решение, взяв компонент из поста https://forum.hiasm.com/post/304292 , НО не компилилось, ругань на параметры ToString, заменил THIStrMask._work_doMask на ту что старая, в итоге всё заработало


не работало по маске 123*, там где неизвестные, отбор не проходил,......

вобщем итоговый код вышел такой


unit hiStrMask;

interface

uses Windows,Share,Debug;

type
THIStrMask = class(TDebug)
private
FMask:string;
procedure SetMask(msk:string);
public
_prop_CaseSensitive:byte;

_data_Str:THI_Event;
_event_onTrue:THI_Event;
_event_onFalse:THI_Event;

property _prop_Mask:string write SetMask;
procedure _work_doCompare(var _Data:TData; Index:word);
procedure _work_doMask(var _Data:TData; Index:word);
end;

function StrCmp(Str,Msk:string):boolean;

implementation

function _StrCmp(Str,Msk:PChar):boolean;
begin
while (Str^<>#0)and(Msk^<>#0) do begin
if Msk^='*' then begin
Result := _StrCmp(Str,Msk+1);
if Result then exit;
end else begin
if Msk^='#' then Result := Str^in['0'..'9']
else Result := (Msk^='?')or(Msk^=Str^);
if Result then Inc(Msk)
else exit;
end;
Inc(Str);
end;
while Msk^ = '*' do inc(Msk);
Result := (Str^=#0)and(Msk^=#0);
end;

function StrCmp(Str,Msk:string):boolean;
begin
Result := _StrCmp(Pchar(Str),Pchar(Msk));
end;

procedure THIStrMask._work_doCompare;
var str:string;
begin
str := ReadString(_Data,_data_Str);
_hi_CreateEvent(_Data,@_event_onFalse,str);
if (_prop_CaseSensitive = 1) then begin
UniqueString(str);
CharLower(pointer(str));
end;
if _StrCmp(PChar(str),PChar(FMask)) then
_Data.Next := @_event_onTrue;
end;

procedure THIStrMask._work_doMask;
begin
_prop_Mask := Share.ToString(_Data);
end;

procedure THIStrMask.SetMask;
begin
FMask := msk;
if (_prop_CaseSensitive = 1) then begin
UniqueString(FMask);
CharLower(pointer(FMask));
end;
end;

end.
карма: 2

0
Ответов: 192
Рейтинг: 12
#544: 2021-01-23 02:06:44 ЛС | профиль | цитата
Rysik, Проблемы были в предыдущей версии. В FPC 3.2.0 все норм уже.
Вот hiStrMask.pas

unit hiStrMask;

interface

uses
Windows, KOL, Share, Debug;

type
THIStrMask = class(TDebug)
private
FMask: string;
procedure SetMask(Value: string);
public
_prop_CaseSensitive: Byte;

_data_Str: THI_Event;
_event_onTrue: THI_Event;
_event_onFalse: THI_Event;

property _prop_Mask: string write SetMask; // —войство Mask должно сто¤ть последним в ini!

procedure _work_doCompare(var _Data: TData; Index: Word);
procedure _work_doMask(var _Data: TData; Index: Word);
end;

function StrCmp(Str, Msk: string): Boolean;

implementation

function _StrCmp(Str, Msk: PChar): Boolean;
begin
while (Str^ <> #0) and (Msk^ <> #0) do
begin
if Msk^ = '*' then
begin
Result := _StrCmp(Str, Msk + 1);
if Result then Exit;
end
else
begin
if Msk^ = '#' then
Result := Str^ in ['0'..'9']
else
Result := (Msk^ = '?') or (Msk^ = Str^);

if Result then
Inc(Msk)
else
Exit;
end;

Inc(Str);
end;

while Msk^ = '*' do Inc(Msk);

Result := (Str^ = #0) and (Msk^ = #0);
end;

function StrCmp(Str, Msk: string): Boolean;
begin
Result := _StrCmp(PChar(Str), PChar(Msk));
end;

procedure THIStrMask._work_doCompare;
var
Str: string;
begin
Str := ReadString(_Data, _data_Str);
_hi_CreateEvent(_Data, @_event_onFalse, Str);

if (_prop_CaseSensitive = 1) then
begin
Str := AnsiLowerCase(Str);
end;

if _StrCmp(PChar(Str), PChar(FMask)) then
_Data.Next := @_event_onTrue;
end;

procedure THIStrMask._work_doMask;
begin
SetMask(Share.ToString(_Data));
end;

procedure THIStrMask.SetMask(Value: string);
begin
FMask := Value;
if (_prop_CaseSensitive = 1) then
FMask := AnsiLowerCase(FMask);
end;

end.

карма: 1

0
Ответов: 1307
Рейтинг: 29
#545: 2021-01-23 12:58:50 ЛС | профиль | цитата
Joiner писал(а):
В FPC 3.2.0 все норм уже.



а SVN работает?, или как что обновлять нормально, или файл на обменнике постоянно под обновлением?

Редактировалось 1 раз(а), последний 2021-01-23 13:04:09
карма: 2

0
Ответов: 4476
Рейтинг: 716
#546: 2021-01-25 13:03:27 ЛС | профиль | цитата
Новый FPC и пакет к нему никак не наличествуют на SVN.
карма: 26

0
Ответов: 4476
Рейтинг: 716
#547: 2021-01-26 11:38:47 ЛС | профиль | цитата
Для исправления ошибки компиляции компонента PNG поправить файл code\KOLPng.pas.
После строки 59 добавить пустую строку, в которой написать слово "type". Окончательно фрагмент будет выглядеть так:

{$IFNDEF FPC}
type
{$ifdef win64}
NativeInt = Int64;
NativeUInt = UInt64;
{$else}
NativeInt = Integer;
NativeUInt = Cardinal;
{$endif}
{$ENDIF}
карма: 26

0
Ответов: 192
Рейтинг: 12
#548: 2021-01-26 12:34:04 ЛС | профиль | цитата
Netspirit, Странно, но у меня без исправления схема из примера работает без ошибок. 32, 64, 32U, 64U

Add(MainForm,9775816,294,175)
{
Width=404
Height=351
Color=10789024
}
Add(Image,15497265,539,126)
{
Left=5
Top=5
Width=385
Height=275
}
Add(Button,10549840,294,133)
{
Left=135
Top=290
Width=120
TabOrder=-1
Caption="Загрузить png"
link(onClick,8644631:doEvent1,[])
}
Add(PNG,14345186,476,154)
{
Point(doBitmap)
link(onBitmap,15497265:doLoad,[(520,160)(520,132)])
}
Add(Hub,8644631,357,133)
{
link(onEvent1,15497265:doClear,[])
link(onEvent2,13387288:doExecute,[(381,146)(381,160)])
}
Add(Hub,11952692,441,154)
{
link(onEvent1,14345186:doLoad,[])
link(onEvent2,14345186:doBitmap,[(465,167)(465,174)])
}
Add(ODialog,13387288,392,154)
{
Filter="Файлы *.png|*.png"
link(onExecute,11952692:doEvent1,[])
}
карма: 1

0
Ответов: 4476
Рейтинг: 716
#549: 2021-01-26 12:46:41 ЛС | профиль | цитата
А там была ошибка компиляции, если компилировать компилятором Delphi (в FPC - нет).
карма: 26

0
Ответов: 192
Рейтинг: 12
#550: 2021-01-26 12:55:46 ЛС | профиль | цитата
Да, на Delphi с ошибками. Поправил на всякий случай
карма: 1

0
Ответов: 4476
Рейтинг: 716
#551: 2021-02-22 13:23:03 ЛС | профиль | цитата
Для исправления atan компонента Math для 64 бит в файле Share.pas нужно заменить функцию ArcTan2() со строки 3142 на эту:

function ArcTan2(const Y, X: Extended): Extended;
begin
if X = 0 then
begin
if Y = 0 then
Result := 0.0
else if Y > 0 then
Result := Pi/2
else if Y < 0 then
Result := -Pi/2;
end
else
Result := ArcTan(Y/X);
if X < 0.0 then
Result := Result + Pi;
if Result > Pi then
Result := Result - 2*Pi;
end;
карма: 26

0
Ответов: 1307
Рейтинг: 29
#552: 2021-02-23 20:18:42 ЛС | профиль | цитата
Netspirit писал(а):
Для исправления atan компонента Math для 64 бит



работает, только не понятно куда это девать нужно в Share.pas, столько строк там нету

--- Добавлено в 2021-02-23 20:23:49

бывает ещё крашит при округлении чисел высокой точности, причём краши с любыми компонентами где есть Round, Trunc итд

Редактировалось 1 раз(а), последний 2021-02-23 20:23:49
карма: 2

0
Ответов: 4476
Рейтинг: 716
#553: 2021-02-24 15:00:53 ЛС | профиль | цитата
В Share.pas пакета, идущего в комплекте с этим компилятором. Про официальный пакет речи не идёт, потому что там нету проблем с atan(), поскольку нету и 64 бит. Да и тема соответствующая.

Rysik писал(а):
краши с любыми компонентами где есть Round, Trunc
Пример с нужным числом?

Редактировалось 1 раз(а), последний 2021-02-24 15:02:14
карма: 26

0
Ответов: 1307
Рейтинг: 29
#554: 2021-02-25 09:49:15 ЛС | профиль | цитата
Netspirit писал(а):
Пример с нужным числом?


Не удалось поймать(оно то было то не было), но после как убрал округление, обрезание float, краши исчезли(в некоторых случаях просто пришлось округлять строкой, разделив число до и после точки)
карма: 2

0
Ответов: 33
Рейтинг: 0
#555: 2021-02-28 22:07:07 ЛС | профиль | цитата
А в чем разница между 32-битной версией компилятора и 64?
Пустая форма у х32 выдает 15+ обнаружений на вирустотал а х64 - всего одно

Может на х32 подключается что-то что можно убрать для корректной работы программы? (в коде)

--- Добавлено в 2021-02-28 22:07:41

Или может быть можно как-то перекомпилировать программу (или обфусцировать)?

Редактировалось 1 раз(а), последний 2021-02-28 22:07:41
карма: 0

0
Сообщение
...
Прикрепленные файлы
(файлы не залиты)