Skip to content

Commit 098587c

Browse files
committed
Merge branch 'master' of github.com:remobjects/pascalscript
2 parents 2962298 + f5638ff commit 098587c

File tree

3 files changed

+108
-8
lines changed

3 files changed

+108
-8
lines changed

Source/uPSC_extctrls.pas

Lines changed: 51 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -30,7 +30,10 @@ procedure SIRegisterTHEADER(Cl: TPSPascalCompiler);
3030
{$ENDIF}
3131
procedure SIRegisterTCUSTOMRADIOGROUP(Cl: TPSPascalCompiler);
3232
procedure SIRegisterTRADIOGROUP(Cl: TPSPascalCompiler);
33-
33+
{$IFDEF DELPHI14UP}
34+
procedure SIRegisterTCUSTOMLINKLABEL(Cl: TPSPascalCompiler);
35+
procedure SIRegisterTLINKLABEL(Cl: TPSPascalCompiler);
36+
{$ENDIF}
3437
procedure SIRegister_ExtCtrls(cl: TPSPascalCompiler);
3538

3639
implementation
@@ -321,6 +324,45 @@ procedure SIRegisterTRADIOGROUP(Cl: TPSPascalCompiler);
321324
end;
322325
end;
323326

327+
{$IFDEF DELPHI14UP}
328+
329+
procedure SIRegisterTCUSTOMLINKLABEL(Cl: TPSPascalCompiler);
330+
begin
331+
with Cl.AddClassN(cl.FindClass('TWinControl'), 'TCustomLinkLabel') do
332+
begin
333+
RegisterProperty('Alignment', 'TAlignment', iptrw); //actual type: taLeftJustify..taRightJustify
334+
RegisterProperty('AutoSize', 'Boolean', iptrw);
335+
RegisterProperty('UseVisualStyle', 'Boolean', iptrw);
336+
RegisterProperty('OnLinkClick', 'TSysLinkEvent', iptrw);
337+
end;
338+
end;
339+
340+
procedure SIRegisterTLINKLABEL(Cl: TPSPascalCompiler);
341+
begin
342+
with Cl.AddClassN(cl.FindClass('TCustomLinkLabel'), 'TLinkLabel') do
343+
begin
344+
RegisterProperty('Anchors', 'TAnchors', iptrw);
345+
RegisterProperty('Caption', 'string', iptrw);
346+
RegisterProperty('Color', 'TColor', iptrw);
347+
RegisterProperty('Font', 'TFont', iptrw);
348+
RegisterProperty('ParentColor', 'Boolean', iptrw);
349+
RegisterProperty('ParentFont', 'Boolean', iptrw);
350+
351+
{$IFNDEF PS_MINIVCL}
352+
RegisterProperty('DragCursor', 'LongInt', iptrw);
353+
RegisterProperty('DragMode', 'TDragMode', iptrw);
354+
RegisterProperty('ParentShowHint', 'Boolean', iptrw);
355+
RegisterProperty('OnClick', 'TNotifyEvent', iptrw);
356+
RegisterProperty('OnDragDrop', 'TDragDropEvent', iptrw);
357+
RegisterProperty('OnDragOver', 'TDragOverEvent', iptrw);
358+
RegisterProperty('OnEndDrag', 'TEndDragEvent', iptrw);
359+
RegisterProperty('OnStartDrag', 'TStartDragEvent', iptrw);
360+
{$ENDIF}
361+
end;
362+
end;
363+
364+
{$ENDIF}
365+
324366
procedure SIRegister_ExtCtrls_TypesAndConsts(cl: TPSPascalCompiler);
325367
begin
326368
cl.AddTypeS('TShapeType', '(stRectangle, stSquare, stRoundRect, stRoundSquare, stEllipse, stCircle)');
@@ -330,6 +372,10 @@ procedure SIRegister_ExtCtrls_TypesAndConsts(cl: TPSPascalCompiler);
330372
cl.AddTypeS('TBevelWidth', 'LongInt');
331373
cl.AddTypeS('TBorderWidth', 'LongInt');
332374
cl.AddTypeS('TSectionEvent', 'procedure(Sender: TObject; ASection, AWidth: Integer)');
375+
{$IFDEF DELPHI14UP}
376+
cl.AddTypeS('TSysLinkType', '(sltURL, sltID)');
377+
cl.AddTypeS('TSysLinkEvent', 'procedure(Sender: TObject; const Link: string; LinkType: TSysLinkType)');
378+
{$ENDIF}
333379
end;
334380

335381
procedure SIRegister_ExtCtrls(cl: TPSPascalCompiler);
@@ -356,6 +402,10 @@ procedure SIRegister_ExtCtrls(cl: TPSPascalCompiler);
356402
SIRegisterTCUSTOMRADIOGROUP(Cl);
357403
SIRegisterTRADIOGROUP(Cl);
358404
{$ENDIF}
405+
{$IFDEF DELPHI14UP}
406+
SIRegisterTCUSTOMLINKLABEL(Cl);
407+
SIRegisterTLINKLABEL(Cl);
408+
{$ENDIF}
359409
end;
360410

361411
end.

Source/uPSCompiler.pas

Lines changed: 12 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2746,6 +2746,15 @@ function IsIntType(b: TPSBaseType): Boolean;
27462746
end;
27472747
end;
27482748

2749+
function IsCharType(b: TPSBaseType): Boolean;
2750+
begin
2751+
case b of
2752+
btChar{$IFNDEF PS_NOWIDESTRING}, btWideChar{$ENDIF}: Result := True;
2753+
else
2754+
Result := False;
2755+
end;
2756+
end;
2757+
27492758
function IsRealType(b: TPSBaseType): Boolean;
27502759
begin
27512760
case b of
@@ -6102,7 +6111,9 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean;
61026111
for i := 0 to arr.count -1 do
61036112
begin
61046113
mType := GetTypeNo(BlockInfo, arr.Item[i]);
6105-
if (mType <> SetType.SetType) and not (IsIntType(mType.FBaseType) and IsIntType(SetType.SetType.BaseType)) then
6114+
if (mType <> SetType.SetType) and
6115+
not (IsIntType(mType.FBaseType) and IsIntType(SetType.SetType.BaseType)) and
6116+
not (IsCharType(mType.FBaseType) and IsCharType(SetType.SetType.BaseType)) then
61066117
begin
61076118
with MakeError('', ecTypeMismatch, '') do
61086119
begin

Source/uPSR_extctrls.pas

Lines changed: 45 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,10 @@ procedure RIRegisterTNOTEBOOK(Cl: TPSRuntimeClassImporter);
2323
{$ENDIF}
2424
procedure RIRegisterTCUSTOMRADIOGROUP(Cl: TPSRuntimeClassImporter);
2525
procedure RIRegisterTRADIOGROUP(Cl: TPSRuntimeClassImporter);
26+
{$IFDEF DELPHI14UP}
27+
procedure RIRegisterTCUSTOMLINKLABEL(Cl: TPSRuntimeClassImporter);
28+
procedure RIRegisterTLINKLABEL(Cl: TPSRuntimeClassImporter);
29+
{$ENDIF}
2630

2731
implementation
2832

@@ -203,6 +207,37 @@ procedure RIRegisterTRADIOGROUP(Cl: TPSRuntimeClassImporter);
203207
end;
204208
{$IFDEF DELPHI10UP}{$ENDREGION}{$ENDIF}
205209

210+
{$IFDEF DELPHI14UP}
211+
212+
procedure TCUSTOMLINKLABELALIGNMENT_R(Self: TCUSTOMLINKLABEL; var T: TCustomLinkLabel.TLinkAlignment); begin T := Self.ALIGNMENT; end;
213+
procedure TCUSTOMLINKLABELALIGNMENT_W(Self: TCUSTOMLINKLABEL; T: TCustomLinkLabel.TLinkAlignment); begin
214+
Self.ALIGNMENT := T;
215+
end;
216+
procedure TCUSTOMLINKLABELAUTOSIZE_R(Self: TCUSTOMLINKLABEL; var T: Boolean); begin T := Self.AUTOSIZE; end;
217+
procedure TCUSTOMLINKLABELAUTOSIZE_W(Self: TCUSTOMLINKLABEL; T: Boolean); begin Self.AUTOSIZE := T; end;
218+
procedure TCUSTOMLINKLABELUSEVISUALSTYLE_R(Self: TCUSTOMLINKLABEL; var T: Boolean); begin T := Self.USEVISUALSTYLE; end;
219+
procedure TCUSTOMLINKLABELUSEVISUALSTYLE_W(Self: TCUSTOMLINKLABEL; T: Boolean); begin Self.USEVISUALSTYLE := T; end;
220+
procedure TCUSTOMLINKLABELONLINKCLICK_R(Self: TCUSTOMLINKLABEL; var T: TSysLinkEvent); begin T := Self.ONLINKCLICK; end;
221+
procedure TCUSTOMLINKLABELONLINKCLICK_W(Self: TCUSTOMLINKLABEL; T: TSysLinkEvent); begin Self.ONLINKCLICK := T; end;
222+
223+
procedure RIRegisterTCUSTOMLINKLABEL(Cl: TPSRuntimeClassImporter);
224+
begin
225+
with Cl.Add(TCUSTOMLINKLABEL) do
226+
begin
227+
RegisterPropertyHelper(@TCUSTOMLINKLABELALIGNMENT_R, @TCUSTOMLINKLABELALIGNMENT_W, 'Alignment');
228+
RegisterPropertyHelper(@TCUSTOMLINKLABELAUTOSIZE_R, @TCUSTOMLINKLABELAUTOSIZE_W, 'AutoSize');
229+
RegisterPropertyHelper(@TCUSTOMLINKLABELUSEVISUALSTYLE_R, @TCUSTOMLINKLABELUSEVISUALSTYLE_W, 'UseVisualStyle');
230+
RegisterPropertyHelper(@TCUSTOMLINKLABELONLINKCLICK_R, @TCUSTOMLINKLABELONLINKCLICK_W, 'OnLinkClick');
231+
end;
232+
end;
233+
234+
procedure RIRegisterTLINKLABEL(Cl: TPSRuntimeClassImporter);
235+
begin
236+
Cl.Add(TLINKLABEL);
237+
end;
238+
239+
{$ENDIF}
240+
206241
procedure RIRegister_ExtCtrls(cl: TPSRuntimeClassImporter);
207242
begin
208243
{$IFNDEF PS_MINIVCL}
@@ -215,20 +250,24 @@ procedure RIRegister_ExtCtrls(cl: TPSRuntimeClassImporter);
215250
RIRegisterTTIMER(Cl);
216251
{$ENDIF}
217252
RIRegisterTCUSTOMPANEL(Cl);
218-
{$IFNDEF CLX}
253+
{$IFNDEF CLX}
219254
RIRegisterTPANEL(Cl);
220-
{$ENDIF}
255+
{$ENDIF}
221256
{$IFNDEF PS_MINIVCL}
222-
{$IFNDEF CLX}
257+
{$IFNDEF CLX}
223258
RIRegisterTPAGE(Cl);
224259
RIRegisterTNOTEBOOK(Cl);
225-
{$IFNDEF FPC}
260+
{$IFNDEF FPC}
226261
RIRegisterTHEADER(Cl);
227-
{$ENDIF}{FPC}
228-
{$ENDIF}
262+
{$ENDIF}{FPC}
263+
{$ENDIF}
229264
RIRegisterTCUSTOMRADIOGROUP(Cl);
230265
RIRegisterTRADIOGROUP(Cl);
231266
{$ENDIF}
267+
{$IFDEF DELPHI14UP}
268+
RIRegisterTCUSTOMLINKLABEL(Cl);
269+
RIRegisterTLINKLABEL(Cl);
270+
{$ENDIF}
232271
end;
233272

234273
end.

0 commit comments

Comments
 (0)