pascal/kolmck
1
0
Fork 0
Code Issues Releases Activity

3.20 version + some changes

Browse Source 
git-svn-id: https://svn.code.sf.net/p/kolmck/code@133 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07
This commit is contained in:
dkolmck
2014-12-03 09:26:29 +00:00
parent 8a2cf167f6
commit 0f41e320b2
1 changed files with 146 additions and 34 deletions
Download Patch File Download Diff File Expand all files Collapse all files

150
mirror.pas
View File

@ -19,7 +19,7 @@ mmmmm mmmmm mmmmm cccccccccccc kkkkk kkkkk
Key Objects Library (C) 1999 by Kladov Vladimir. Key Objects Library (C) 1999 by Kladov Vladimir.
KOL Mirror Classes Kit (C) 2000 by Kladov Vladimir. KOL Mirror Classes Kit (C) 2000 by Kladov Vladimir.
******************************************************** ********************************************************
* VERSION 3.1415926535897 * VERSION 3.20
******************************************************** ********************************************************
} }
unit mirror; unit mirror;
@ -247,6 +247,7 @@ type
FGeneratePCode: Boolean; FGeneratePCode: Boolean;
FDefaultFont: TKOLFont; FDefaultFont: TKOLFont;
FFormCompactDisabled: Boolean; FFormCompactDisabled: Boolean;
FAutoCreateForms: String;
function GetProjectName: String; function GetProjectName: String;
procedure SetProjectDest(const Value: String); procedure SetProjectDest(const Value: String);
@ -282,6 +283,7 @@ type
procedure setNewIf(const Value: Boolean); procedure setNewIf(const Value: Boolean);
procedure SetDefaultFont(const Value: TKOLFont); procedure SetDefaultFont(const Value: TKOLFont);
procedure SetFormCompactDisabled(const Value: Boolean); procedure SetFormCompactDisabled(const Value: Boolean);
procedure SetAutoCreateForms(const Value: String);
protected protected
FLocked: Boolean; FLocked: Boolean;
FNewIF: Boolean; FNewIF: Boolean;
@ -386,6 +388,7 @@ type
property NewIF: Boolean read getNewIf write setNewIf; property NewIF: Boolean read getNewIf write setNewIf;
property DefaultFont: TKOLFont read FDefaultFont write SetDefaultFont; property DefaultFont: TKOLFont read FDefaultFont write SetDefaultFont;
property FormCompactDisabled: Boolean read FFormCompactDisabled write SetFormCompactDisabled; property FormCompactDisabled: Boolean read FFormCompactDisabled write SetFormCompactDisabled;
property AutoCreateForms: String read FAutoCreateForms write SetAutoCreateForms;
end; end;
TKOLProjectBuilder = class( TComponentEditor ) TKOLProjectBuilder = class( TComponentEditor )
@ -774,6 +777,7 @@ type
fAssignTextToControls: Boolean; fAssignTextToControls: Boolean;
FAssignTabOrders: Boolean; FAssignTabOrders: Boolean;
fFormCurrentParent: String; fFormCurrentParent: String;
fCenterOnCurScrn: Boolean;
function GetFormUnit: KOLString; function GetFormUnit: KOLString;
procedure SetFormMain(const Value: Boolean); procedure SetFormMain(const Value: Boolean);
procedure SetFormUnit(const Value: KOLString); procedure SetFormUnit(const Value: KOLString);
@ -870,6 +874,7 @@ type
procedure SetAssignTabOrders(const Value: Boolean); procedure SetAssignTabOrders(const Value: Boolean);
function GetFormCompact: Boolean; function GetFormCompact: Boolean;
procedure SetFormCurrentParent(const Value: String); procedure SetFormCurrentParent(const Value: String);
procedure SetCenterOnCurScrn(const Value: Boolean);
protected protected
fUniqueID: Integer; fUniqueID: Integer;
FLocked: Boolean; FLocked: Boolean;
@ -1045,6 +1050,7 @@ type
property StayOnTop: Boolean read FStayOnTop write SetStayOnTop; property StayOnTop: Boolean read FStayOnTop write SetStayOnTop;
property CanResize: Boolean read fCanResize write SetCanResize; property CanResize: Boolean read fCanResize write SetCanResize;
property CenterOnScreen: Boolean read fCenterOnScr write SetCenterOnScr; property CenterOnScreen: Boolean read fCenterOnScr write SetCenterOnScr;
property CenterOnCurrentScreen: Boolean read fCenterOnCurScrn write SetCenterOnCurScrn;
property Ctl3D: Boolean read FCtl3D write SetCtl3D; property Ctl3D: Boolean read FCtl3D write SetCtl3D;
property WindowState: KOL.TWindowState read FWindowState write SetWindowState; property WindowState: KOL.TWindowState read FWindowState write SetWindowState;
@ -2999,8 +3005,8 @@ function Color2Str( Color: TColor ): String;
procedure Log( const S: String ); procedure Log( const S: String );
procedure LogOK ; procedure LogOK ;
procedure Rpt( const S: String; Color: Integer ); procedure Rpt( const S: KOLString; Color: Integer );
procedure RptDetailed( const S: String; Color: Integer ); procedure RptDetailed( const S: KOLString; Color: Integer );
procedure Rpt_Stack; procedure Rpt_Stack;
function ProjectSourcePath: String; function ProjectSourcePath: String;
@ -3151,7 +3157,7 @@ end;
{$STACKFRAMES ON} {$STACKFRAMES ON}
function GetCallStack: TStringList; function GetCallStack: TStringList;
var RegEBP: PDWORD; var RegEBP: PDWORD;
RetAddr, MinSearchAddr, SrchPtr: PChar; RetAddr, MinSearchAddr, SrchPtr: PAnsiChar;
Found: Boolean; Found: Boolean;
begin begin
Result := TStringList.Create; Result := TStringList.Create;
@ -3362,7 +3368,7 @@ begin
{$ENDIF} {$ENDIF}
end; end;
procedure Rpt( const S: String; Color: Integer ); procedure Rpt( const S: KOLString; Color: Integer );
begin begin
asm asm
jmp @@e_signature jmp @@e_signature
@ -3375,7 +3381,7 @@ begin
KOLProject.Report( S, Color ); KOLProject.Report( S, Color );
end; end;
procedure RptDetailed( const S: String; Color: Integer ); procedure RptDetailed( const S: KOLString; Color: Integer );
begin begin
asm asm
jmp @@e_signature jmp @@e_signature
@ -3397,7 +3403,7 @@ begin
StrList := GetCallStack; StrList := GetCallStack;
TRY TRY
for I := 0 to StrList.Count-1 do for I := 0 to StrList.Count-1 do
Rpt( StrList[ I ], LIGHT + BLUE ); Rpt( KOLString(StrList[ I ]), LIGHT + BLUE );
FINALLY FINALLY
StrList.Free; StrList.Free;
end; end;
@ -4109,7 +4115,7 @@ end;}
function InterceptWndProc( W: HWnd; Msg: Cardinal; wParam, lParam: Integer ): Integer; stdcall; function InterceptWndProc( W: HWnd; Msg: Cardinal; wParam, lParam: Integer ): Integer; stdcall;
var var
KOLParentCtrl: PControl; KOLParentCtrl: PControl;
_Msg: TMsg; _Msg: KOL.TMsg;
OldWndProc: pointer; OldWndProc: pointer;
begin begin
@ -4530,7 +4536,7 @@ end;
procedure TKOLCtrlWrapper.CallKOLCtrlWndProc(var Message: TMessage); procedure TKOLCtrlWrapper.CallKOLCtrlWndProc(var Message: TMessage);
var var
_Msg: TMsg; _Msg: KOL.TMsg;
begin begin
Log( '->TKOLCtrlWrapper.CallKOLCtrlWndProc' ); Log( '->TKOLCtrlWrapper.CallKOLCtrlWndProc' );
try try
@ -10677,7 +10683,8 @@ begin
TRY TRY
//BuildKOLProject; //BuildKOLProject;
if (KOLProject <> nil) and not (KOLProject.FBuilding) then if not (csLoading in ComponentState) and
(KOLProject <> nil) and not (KOLProject.FBuilding) then
KOLProject.ConvertVCL2KOL( TRUE, FALSE ); KOLProject.ConvertVCL2KOL( TRUE, FALSE );
LogOK; LogOK;
@ -13798,13 +13805,19 @@ begin
Log( '->TKOLForm.GenerateUnit' ); Log( '->TKOLForm.GenerateUnit' );
try try
Result := False; Result := False;
if not FChanged then Exit; Log(Path);
if not FChanged then
begin
LogOK;
Exit;
end;
FChanged := FALSE; FChanged := FALSE;
//Rpt_Stack; //Rpt_Stack;
if not FLocked then if not FLocked then
begin begin
Log('-1');
for I := 0 to Owner.ComponentCount-1 do for I := 0 to Owner.ComponentCount-1 do
begin begin
C := Owner.Components[ I ]; C := Owner.Components[ I ];
@ -13819,6 +13832,7 @@ begin
end; end;
end; end;
Log('-2');
fUniqueID := 5000; fUniqueID := 5000;
Rpt( '----------- UNIQUE ID = ' + IntToStr( fUniqueID ), WHITE ); Rpt( '----------- UNIQUE ID = ' + IntToStr( fUniqueID ), WHITE );
if FormUnit = '' then if FormUnit = '' then
@ -13828,14 +13842,18 @@ begin
Exit; Exit;
end; end;
Log('-3');
PasUpdated := FALSE; PasUpdated := FALSE;
IncUpdated := FALSE; IncUpdated := FALSE;
PAS := GeneratePAS( Path, PasUpdated ); PAS := GeneratePAS( Path, PasUpdated );
Log('-4');
INC := GenerateINC( Path, IncUpdated ); INC := GenerateINC( Path, IncUpdated );
Log('-5');
Updated := PasUpdated or IncUpdated; Updated := PasUpdated or IncUpdated;
Result := PAS and INC; Result := PAS and INC;
if Result and Updated then if Result and Updated then
begin begin
Log('-6');
// force mark modified here // force mark modified here
if PasUpdated then if PasUpdated then
MarkModified( Path + '.pas' ); MarkModified( Path + '.pas' );
@ -13846,6 +13864,7 @@ begin
end; end;
end; end;
end; end;
Log('-7');
LogOK; LogOK;
finally finally
Log( '<-TKOLForm.GenerateUnit' ); Log( '<-TKOLForm.GenerateUnit' );
@ -15497,6 +15516,15 @@ begin
if not FLocked then if not FLocked then
begin begin
S := ''; S := '';
if CenterOnCurrentScreen then
begin
if FormCompact then
begin
FormAddCtlCommand( 'Form', 'TControl.CenterOnCurrentScreen', '' );
end else
S := Prefix + AName + '.CenterOnCurrentScreen';
end
else
if CenterOnScreen then if CenterOnScreen then
if FormCompact then if FormCompact then
begin begin
@ -18637,6 +18665,12 @@ begin
FreeAndNil( FormControlsList ); FreeAndNil( FormControlsList );
end; end;
procedure TKOLForm.SetCenterOnCurScrn(const Value: Boolean);
begin
fCenterOnCurScrn := Value;
Change(Self);
end;
{ TKOLProject } { TKOLProject }
procedure TKOLProject.AfterGenerateDPR(const SL: TStringList; var Updated: Boolean); procedure TKOLProject.AfterGenerateDPR(const SL: TStringList; var Updated: Boolean);
@ -18779,9 +18813,13 @@ begin
if FormsList = nil then if FormsList = nil then
begin begin
if not AutoBuilding then if not AutoBuilding then
begin
Log('--- There are not found TKOLForm instances ---');
ShowMessage( 'There are not found TKOLForm component instances. You must create '+ ShowMessage( 'There are not found TKOLForm component instances. You must create '+
'an instance for each form in your mirror project to provide ' + 'an instance for each form in your mirror project to provide ' +
'converting mirror project to KOL.' ); 'converting mirror project to KOL.' );
end;
LogOK; LogOK;
Exit; Exit;
end; end;
@ -19193,6 +19231,7 @@ var SL, Source, AForms: TStringList;
Updated: Boolean; Updated: Boolean;
Object2Run: TObject; Object2Run: TObject;
IsDLL: Boolean; IsDLL: Boolean;
FormsToAutoCreate: TStringList;
///////////////////////////////////////////////////////////////////////// /////////////////////////////////////////////////////////////////////////
procedure Prepare_0inc; procedure Prepare_0inc;
var SL: TStringList; var SL: TStringList;
@ -19438,15 +19477,24 @@ var SL, Source, AForms: TStringList;
if (F <> nil) and (F is TKOLFrame) then continue; if (F <> nil) and (F is TKOLFrame) then continue;
//Rpt( 'AutoForm: ' + S ); //Rpt( 'AutoForm: ' + S );
if LowerCase( A ) = LowerCase( S + '.Form' ) then Continue; if LowerCase( A ) = LowerCase( S + '.Form' ) then Continue;
if pos( ',', AForms[ I ] ) > 0 then
Log('check auto create: ' + AForms[I] + ' list: ' +
FormsToAutoCreate.Text);
if (pos( ',', AForms[ I ] ) > 0) and
((FormsToAutoCreate.Count = 0) or
(FormsToAutoCreate.IndexOf(AForms[I]) >= 0)
) then
begin begin
Log('Yes, auto create');
// MDI child form // MDI child form
S1 := AForms[ I ]; S1 := AForms[ I ];
Parse( S1, ',' ); if pos(',', S1) > 0 then Parse( S1, ',' );
SL.Add( ' New' + Trim( S ) + '( ' + Trim( S ) + ', ' + SL.Add( ' New' + Trim( S ) + '( ' + Trim( S ) + ', ' +
Trim( S1 ) + '.Form );' ); Trim( S1 ) + '.Form );' );
end end
else else
if (FormsToAutoCreate.Count = 0) or
(FormsToAutoCreate.IndexOf(AForms[I]) >= 0) then
begin begin
// normal or MDI parent form // normal or MDI parent form
SL.Add( ' New' + S + '( ' + S + ', Pointer( ' + A + ' ) );' ); SL.Add( ' New' + S + '( ' + S + ', Pointer( ' + A + ' ) );' );
@ -19464,6 +19512,7 @@ var SL, Source, AForms: TStringList;
///////////////////////////////////////////////////////////////////////// /////////////////////////////////////////////////////////////////////////
var Kol_added, DontChangeUses: Boolean; var Kol_added, DontChangeUses: Boolean;
forms_list_auto: String;
begin begin
asm asm
jmp @@e_signature jmp @@e_signature
@ -19472,6 +19521,16 @@ begin
@@e_signature: @@e_signature:
end; end;
Log( '->TKOLProject.GenerateDPR' ); Log( '->TKOLProject.GenerateDPR' );
//---------------------- ������ ���� ��� ��������������� �������� ------------
FormsToAutoCreate := TStringList.Create;
TRY
forms_list_auto := AutoCreateForms;
while forms_list_auto <> '' do
begin
FormsToAutoCreate.Add(KOL.Parse(forms_list_auto, ';'));
end;
TRY TRY
Rpt( 'Generating DPR for ' + Path, WHITE ); //Rpt_Stack; Rpt( 'Generating DPR for ' + Path, WHITE ); //Rpt_Stack;
@ -19570,6 +19629,11 @@ begin
begin begin
Inc( I ); Inc( I );
S := Source[ I ]; S := Source[ I ];
J := IndexOfStr(S, 'Vcl.');
if J > 0 then
S := Copy(S, 1, J-1) + Copy(S, J+4, MaxInt);
RptDetailed( 'generate dpr -- A1 - ' + IntToStr(I) + ': ' + S, WHITE ); RptDetailed( 'generate dpr -- A1 - ' + IntToStr(I) + ': ' + S, WHITE );
if RemoveSpaces( S ) = RemoveSpaces( Signature ) then continue; // skip signature if present if RemoveSpaces( S ) = RemoveSpaces( Signature ) then continue; // skip signature if present
if LowerCase( Trim( S ) ) = LowerCase( 'program ' + ProjectName + ';' ) then if LowerCase( Trim( S ) ) = LowerCase( 'program ' + ProjectName + ';' ) then
@ -19767,6 +19831,9 @@ begin
RptDetailed( 'ENDOF Generating dpr', LIGHT + BLUE ); RptDetailed( 'ENDOF Generating dpr', LIGHT + BLUE );
Log( '<-TKOLProject.GenerateDPR' ); Log( '<-TKOLProject.GenerateDPR' );
END; END;
FINALLY
FormsToAutoCreate.Free;
END;
end; end;
function TKOLProject.GetBuild: Boolean; function TKOLProject.GetBuild: Boolean;
@ -19798,16 +19865,19 @@ begin
begin begin
if fIsKOL = 0 then if fIsKOL = 0 then
begin begin
//ShowMessage( 'find if project Is KOL...' ); //ShowMessage( 'find if project Is KOL...: SourcePath=' + SourcePath +
if (SourcePath <> '') and DirectoryExists( SourcePath ) and // ' ProjectName:' + ProjectName);
(ProjectName <> '') and FileExists( SourcePath + ProjectName + '.dpr' ) then if (SourcePath <> '') and DirectoryExists( SourcePath ) then
begin
//ShowMessage('SourcePath=' + SourcePath + ' ProjectName=' + ProjectName);
if (ProjectName <> '') and FileExists( SourcePath + ProjectName + '.dpr' ) then
begin begin
//ShowMessage( 'find if project Is KOL in ' + SourcePath + ProjectName + '.dpr' ); //ShowMessage( 'find if project Is KOL in ' + SourcePath + ProjectName + '.dpr' );
SL := TStringList.Create; SL := TStringList.Create;
try try
LoadSource( SL, SourcePath + ProjectName + '.dpr' ); LoadSource( SL, SourcePath + ProjectName + '.dpr' );
for I := 0 to SL.Count - 1 do for I := 0 to SL.Count - 1 do
if RemoveSpaces( SL[ I ] ) = RemoveSpaces( Signature ) then if KOL.RemoveSpaces( SL[ I ] ) = KOL.RemoveSpaces( Signature ) then
begin begin
fIsKOL := 1; fIsKOL := 1;
break; break;
@ -19820,6 +19890,7 @@ begin
//ShowMessage( IntToStr( fIsKOL ) ); //ShowMessage( IntToStr( fIsKOL ) );
end; end;
end; end;
end;
Result := fIsKOL > 0; Result := fIsKOL > 0;
end; end;
@ -19946,25 +20017,33 @@ begin
end;*) end;*)
// TODO: It's maybe an goodiear to use Get_ProjectName instead (with DontGetFromKOLProject option)? // TODO: It's maybe an goodiear to use Get_ProjectName instead (with DontGetFromKOLProject option)?
Log('1');
if ToolServices <> nil then if ToolServices <> nil then
begin begin
Result := ExtractFileNameWOExt( ToolServices.GetProjectName ); Result := ExtractFileNameWOExt( ToolServices.GetProjectName );
Log('Result ' + Result);
LogOK; LogOK;
exit; exit;
end; end;
// TODO: use new OTAPI instead workaroud // TODO: use new OTAPI instead workaroud
// TODO: fix AAA_D12.dpoj copy from AAA.dproj that link to AAA.dpr (only AAA.dll affect) // TODO: fix AAA_D12.dproj copy from AAA.dproj that link to AAA.dpr (only AAA.dll affect)
{$IFDEF _D2005orHigher} {$IFDEF _D2005orHigher}
Log('2');
try
IProjectGroup := Get_ProjectGroup; IProjectGroup := Get_ProjectGroup;
if Assigned(IProjectGroup) then if Assigned(IProjectGroup) then
begin begin
Result := ExtractFileNameWOExt( IProjectGroup.ActiveProject.ProjectOptions.TargetName ); Result := ExtractFileNameWOExt( IProjectGroup.ActiveProject.ProjectOptions.TargetName );
// More Effective than dproj name by ActiveProject.GetFilename // More Effective than dproj name by ActiveProject.GetFilename
Log('Result ' + Result);
LogOK; LogOK;
Exit; Exit;
end; end;
except
end;
{$ENDIF} {$ENDIF}
Log('3');
Result := Application.MainForm.Caption; Result := Application.MainForm.Caption;
if Length(Result) <> 0 then if Length(Result) <> 0 then
begin begin
@ -19988,7 +20067,9 @@ begin
Result := Trim( Copy( Result, 1, pos( '(', Result ) - 1 ) ); Result := Trim( Copy( Result, 1, pos( '(', Result ) - 1 ) );
end; end;
end; end;
Log('4');
Log('Result ' + Result);
LogOK; LogOK;
FINALLY FINALLY
Log( '<-TKOLProject.GetProjectName' ) Log( '<-TKOLProject.GetProjectName' )
@ -20052,6 +20133,7 @@ var
IIL: PItemIdList; IIL: PItemIdList;
Buf: Array[ 0..MAX_PATH ] of Char; // TODO: dangerous, if D2 have treat Char as D2009? Buf: Array[ 0..MAX_PATH ] of Char; // TODO: dangerous, if D2 have treat Char as D2009?
SL: TStringList; SL: TStringList;
s: String;
{$IFDEF _D2005orHigher} {$IFDEF _D2005orHigher}
IProjectGroup: IOTAProjectGroup; IProjectGroup: IOTAProjectGroup;
{$ENDIF} {$ENDIF}
@ -20183,6 +20265,24 @@ begin
LogOK; LogOK;
FINALLY FINALLY
//ShowMessage('GetSourcePath==>' + Result);
if ExtractFileName(ExcludeTrailingPathDelimiter(Result)) = 'Debug' then
begin
s := ExtractFilePath(ExcludeTrailingPathDelimiter(Result));
//ShowMessage('Yes, Debug; s=' + s);
if ExtractFileName(ExcludeTrailingPathDelimiter(s)) = 'Win32' then
begin
s := ExtractFilePath(ExcludeTrailingPathDelimiter(s));
//ShowMessage('Yes, Win32; s=' + s);
//s := ExtractFilePath(ExcludeTrailingPathDelimiter(s));
// XE2, XE ����������� �� ����, ��� ��� ��� � ����� ������
if DirectoryExists(s) then
begin
Result := s;
//ShowMessage('Result==>' + s);
end;
end;
end;
Log( '<-TKOLProject.GetSourcePath' ); Log( '<-TKOLProject.GetSourcePath' );
END; END;
end; end;
@ -20390,6 +20490,16 @@ begin
END; END;
end; end;
procedure TKOLProject.SetAutoCreateForms(const Value: String);
begin
if FAutoCreateForms = Value then
Exit;
FAutoCreateForms := Value;
if not (csLoading in ComponentState) then
ConvertVCL2KOL(false, true);
end;
procedure TKOLProject.SetBuild(const Value: Boolean); procedure TKOLProject.SetBuild(const Value: Boolean);
var S: String; var S: String;
begin begin
@ -20825,7 +20935,7 @@ begin
if not FBuilding and not AutoBuilding then if not FBuilding and not AutoBuilding then
begin begin
fTimer.Enabled := False; fTimer.Enabled := False;
if not FLocked then if not FLocked and not (csLoading in ComponentState) then
begin begin
if AutoBuild then if AutoBuild then
begin begin
@ -22276,6 +22386,7 @@ begin
if fOwner is TKOLCustomControl then if fOwner is TKOLCustomControl then
if (fOwner as TKOLCustomControl).CanNotChangeFontColor then if (fOwner as TKOLCustomControl).CanNotChangeFontColor then
begin begin
if not (csLoading in fOwner.ComponentState) then
ShowMessage( 'Can not change font color for some of controls, such as button.' ); ShowMessage( 'Can not change font color for some of controls, such as button.' );
Exit; Exit;
end; end;
@ -22444,6 +22555,7 @@ begin
DB 'TKOLProjectBuilder.ExecuteVerb', 0 DB 'TKOLProjectBuilder.ExecuteVerb', 0
@@e_signature: @@e_signature:
end; end;
//ShowMessage('TKOLProjectBuilder.ExecuteVerb(Index=' + IntToStr(Index) + ')');
case Index of case Index of
0: Edit; 0: Edit;
1: if Component <> nil then 1: if Component <> nil then