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

Source/uPSC_extctrls.pas

@@ -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.

Source/uPSCompiler.pas

@@ -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

Source/uPSR_extctrls.pas

@@ -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}
@@ -215,20 +250,24 @@ begin
   RIRegisterTTIMER(Cl);
   {$ENDIF}
   RIRegisterTCUSTOMPANEL(Cl);
-{$IFNDEF CLX}
+  {$IFNDEF CLX}
   RIRegisterTPANEL(Cl);
-{$ENDIF}
+  {$ENDIF}
   {$IFNDEF PS_MINIVCL}
-{$IFNDEF CLX}
+  {$IFNDEF CLX}
   RIRegisterTPAGE(Cl);
 	RIRegisterTNOTEBOOK(Cl);
- {$IFNDEF FPC}
+  {$IFNDEF FPC}
 	RIRegisterTHEADER(Cl);
- {$ENDIF}{FPC}
+  {$ENDIF}{FPC}
-{$ENDIF}
+  {$ENDIF}
   RIRegisterTCUSTOMRADIOGROUP(Cl);
   RIRegisterTRADIOGROUP(Cl);
   {$ENDIF}
+  {$IFDEF DELPHI14UP}
+  RIRegisterTCUSTOMLINKLABEL(Cl);
+  RIRegisterTLINKLABEL(Cl);
+  {$ENDIF}
 end;
 
 end.