Delphi/pascalscript
Delphi/pascalscript
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge branch 'master' of github.com:remobjects/pascalscript

Browse Source
This commit is contained in:
evgeny-k 2024-05-14 10:39:38 +03:00
commit 098587c659
3 changed files with 108 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
Source/uPSC_extctrls.pas
View File

@ -30,7 +30,10 @@ procedure SIRegisterTHEADER(Cl: TPSPascalCompiler);
{$ENDIF}
procedure SIRegisterTCUSTOMRADIOGROUP(Cl: TPSPascalCompiler);
procedure SIRegisterTRADIOGROUP(Cl: TPSPascalCompiler);
{$IFDEF DELPHI14UP}
procedure SIRegisterTCUSTOMLINKLABEL(Cl: TPSPascalCompiler);
procedure SIRegisterTLINKLABEL(Cl: TPSPascalCompiler);
{$ENDIF}
procedure SIRegister_ExtCtrls(cl: TPSPascalCompiler);
implementation
@ -321,6 +324,45 @@ begin
end;
end;
{$IFDEF DELPHI14UP}
procedure SIRegisterTCUSTOMLINKLABEL(Cl: TPSPascalCompiler);
begin
with Cl.AddClassN(cl.FindClass('TWinControl'), 'TCustomLinkLabel') do
begin
RegisterProperty('Alignment', 'TAlignment', iptrw); //actual type: taLeftJustify..taRightJustify
RegisterProperty('AutoSize', 'Boolean', iptrw);
RegisterProperty('UseVisualStyle', 'Boolean', iptrw);
RegisterProperty('OnLinkClick', 'TSysLinkEvent', iptrw);
end;
end;
procedure SIRegisterTLINKLABEL(Cl: TPSPascalCompiler);
begin
with Cl.AddClassN(cl.FindClass('TCustomLinkLabel'), 'TLinkLabel') do
begin
RegisterProperty('Anchors', 'TAnchors', iptrw);
RegisterProperty('Caption', 'string', iptrw);
RegisterProperty('Color', 'TColor', iptrw);
RegisterProperty('Font', 'TFont', iptrw);
RegisterProperty('ParentColor', 'Boolean', iptrw);
RegisterProperty('ParentFont', 'Boolean', iptrw);
{$IFNDEF PS_MINIVCL}
RegisterProperty('DragCursor', 'LongInt', iptrw);
RegisterProperty('DragMode', 'TDragMode', iptrw);
RegisterProperty('ParentShowHint', 'Boolean', iptrw);
RegisterProperty('OnClick', 'TNotifyEvent', iptrw);
RegisterProperty('OnDragDrop', 'TDragDropEvent', iptrw);
RegisterProperty('OnDragOver', 'TDragOverEvent', iptrw);
RegisterProperty('OnEndDrag', 'TEndDragEvent', iptrw);
RegisterProperty('OnStartDrag', 'TStartDragEvent', iptrw);
{$ENDIF}
end;
end;
{$ENDIF}
procedure SIRegister_ExtCtrls_TypesAndConsts(cl: TPSPascalCompiler);
begin
cl.AddTypeS('TShapeType', '(stRectangle, stSquare, stRoundRect, stRoundSquare, stEllipse, stCircle)');
@ -330,6 +372,10 @@ begin
cl.AddTypeS('TBevelWidth', 'LongInt');
cl.AddTypeS('TBorderWidth', 'LongInt');
cl.AddTypeS('TSectionEvent', 'procedure(Sender: TObject; ASection, AWidth: Integer)');
{$IFDEF DELPHI14UP}
cl.AddTypeS('TSysLinkType', '(sltURL, sltID)');
cl.AddTypeS('TSysLinkEvent', 'procedure(Sender: TObject; const Link: string; LinkType: TSysLinkType)');
{$ENDIF}
end;
procedure SIRegister_ExtCtrls(cl: TPSPascalCompiler);
@ -356,6 +402,10 @@ begin
SIRegisterTCUSTOMRADIOGROUP(Cl);
SIRegisterTRADIOGROUP(Cl);
{$ENDIF}
{$IFDEF DELPHI14UP}
SIRegisterTCUSTOMLINKLABEL(Cl);
SIRegisterTLINKLABEL(Cl);
{$ENDIF}
end;
end.

13
Source/uPSCompiler.pas
View File

@ -2746,6 +2746,15 @@ begin
end;
end;
function IsCharType(b: TPSBaseType): Boolean;
begin
case b of
btChar{$IFNDEF PS_NOWIDESTRING}, btWideChar{$ENDIF}: Result := True;
else
Result := False;
end;
end;
function IsRealType(b: TPSBaseType): Boolean;
begin
case b of
@ -6102,7 +6111,9 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean;
for i := 0 to arr.count -1 do
begin
mType := GetTypeNo(BlockInfo, arr.Item[i]);
if (mType <> SetType.SetType) and not (IsIntType(mType.FBaseType) and IsIntType(SetType.SetType.BaseType)) then
if (mType <> SetType.SetType) and
not (IsIntType(mType.FBaseType) and IsIntType(SetType.SetType.BaseType)) and
not (IsCharType(mType.FBaseType) and IsCharType(SetType.SetType.BaseType)) then
begin
with MakeError('', ecTypeMismatch, '') do
begin

39
Source/uPSR_extctrls.pas
View File

@ -23,6 +23,10 @@ procedure RIRegisterTNOTEBOOK(Cl: TPSRuntimeClassImporter);
{$ENDIF}
procedure RIRegisterTCUSTOMRADIOGROUP(Cl: TPSRuntimeClassImporter);
procedure RIRegisterTRADIOGROUP(Cl: TPSRuntimeClassImporter);
{$IFDEF DELPHI14UP}
procedure RIRegisterTCUSTOMLINKLABEL(Cl: TPSRuntimeClassImporter);
procedure RIRegisterTLINKLABEL(Cl: TPSRuntimeClassImporter);
{$ENDIF}
implementation
@ -203,6 +207,37 @@ begin
end;
{$IFDEF DELPHI10UP}{$ENDREGION}{$ENDIF}
{$IFDEF DELPHI14UP}
procedure TCUSTOMLINKLABELALIGNMENT_R(Self: TCUSTOMLINKLABEL; var T: TCustomLinkLabel.TLinkAlignment); begin T := Self.ALIGNMENT; end;
procedure TCUSTOMLINKLABELALIGNMENT_W(Self: TCUSTOMLINKLABEL; T: TCustomLinkLabel.TLinkAlignment); begin
Self.ALIGNMENT := T;
end;
procedure TCUSTOMLINKLABELAUTOSIZE_R(Self: TCUSTOMLINKLABEL; var T: Boolean); begin T := Self.AUTOSIZE; end;
procedure TCUSTOMLINKLABELAUTOSIZE_W(Self: TCUSTOMLINKLABEL; T: Boolean); begin Self.AUTOSIZE := T; end;
procedure TCUSTOMLINKLABELUSEVISUALSTYLE_R(Self: TCUSTOMLINKLABEL; var T: Boolean); begin T := Self.USEVISUALSTYLE; end;
procedure TCUSTOMLINKLABELUSEVISUALSTYLE_W(Self: TCUSTOMLINKLABEL; T: Boolean); begin Self.USEVISUALSTYLE := T; end;
procedure TCUSTOMLINKLABELONLINKCLICK_R(Self: TCUSTOMLINKLABEL; var T: TSysLinkEvent); begin T := Self.ONLINKCLICK; end;
procedure TCUSTOMLINKLABELONLINKCLICK_W(Self: TCUSTOMLINKLABEL; T: TSysLinkEvent); begin Self.ONLINKCLICK := T; end;
procedure RIRegisterTCUSTOMLINKLABEL(Cl: TPSRuntimeClassImporter);
begin
with Cl.Add(TCUSTOMLINKLABEL) do
begin
RegisterPropertyHelper(@TCUSTOMLINKLABELALIGNMENT_R, @TCUSTOMLINKLABELALIGNMENT_W, 'Alignment');
RegisterPropertyHelper(@TCUSTOMLINKLABELAUTOSIZE_R, @TCUSTOMLINKLABELAUTOSIZE_W, 'AutoSize');
RegisterPropertyHelper(@TCUSTOMLINKLABELUSEVISUALSTYLE_R, @TCUSTOMLINKLABELUSEVISUALSTYLE_W, 'UseVisualStyle');
RegisterPropertyHelper(@TCUSTOMLINKLABELONLINKCLICK_R, @TCUSTOMLINKLABELONLINKCLICK_W, 'OnLinkClick');
end;
end;
procedure RIRegisterTLINKLABEL(Cl: TPSRuntimeClassImporter);
begin
Cl.Add(TLINKLABEL);
end;
{$ENDIF}
procedure RIRegister_ExtCtrls(cl: TPSRuntimeClassImporter);
begin
{$IFNDEF PS_MINIVCL}
@ -229,6 +264,10 @@ begin
RIRegisterTCUSTOMRADIOGROUP(Cl);
RIRegisterTRADIOGROUP(Cl);
{$ENDIF}
{$IFDEF DELPHI14UP}
RIRegisterTCUSTOMLINKLABEL(Cl);
RIRegisterTLINKLABEL(Cl);
{$ENDIF}
end;
end.