home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DOS/V Power Report 1997 May
/
VPR9705A.ISO
/
VPR_DATA
/
PROGRAM
/
CBTRIAL
/
SETUP
/
DATA.Z
/
CLSSDLPH.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1997-02-14
|
103KB
|
2,603 lines
//---------------------------------------------------------------------------
// Borland C++Builder
// Copyright (c) 1987, 1997 Borland International Inc. All Rights Reserved.
//---------------------------------------------------------------------------
// Clssdlph.pas
//
// VCL Class Browser
//---------------------------------------------------------------------------
unit clssdlph;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
DB, DBTables, Grids, DBGrids, ExtCtrls, DBCtrls, Menus, ComCtrls,RichEdit,
StdCtrls,CodePage, Buttons, BDE,about, BtsClass,Registry;
type
TExtractObjects=class
public
procedure ExtractObjectNameAndType(StartPosition:Integer; EndPosition:Integer;
LineString:string;Phase:string);
protected
ObjectName:string;
ObjectType:string;
LastCommaPosition:Integer;
end;
TSearchEngine=class
public
procedure SearchForString(Word:string;Occurance:Integer;StartPosition:Integer;Page:string);
protected
PositionFound:longint;
LineNumberFound:longint;
LineFoundPositionOne:longint;
NewSearchPosition:longint;
end;
TMainDlg = class(TForm)
VCLTable: TTable;
DataSource1: TDataSource;
MainMenu1: TMainMenu;
File1: TMenuItem;
DisplayTblLabel: TLabel;
New1: TMenuItem;
Open1: TMenuItem;
Save1: TMenuItem;
SaveAs1: TMenuItem;
DestTblQuery: TQuery;
DestTable: TTable;
Search1: TMenuItem;
Windows1: TMenuItem;
Help1: TMenuItem;
FileOPenDlg: TOpenDialog;
DisplayTblQuery: TQuery;
SaveAll1: TMenuItem;
Project1: TMenuItem;
Project2: TMenuItem;
HeaderParser: TTable;
WIN32Table1: TMenuItem;
PopupMenu5: TPopupMenu;
ViewHeader2: TMenuItem;
EditHeader2: TMenuItem;
ViewSource1: TMenuItem;
About1: TMenuItem;
HeaderParserHeaderName: TStringField;
HeaderParserParse: TBooleanField;
BatchMove1: TBatchMove;
ParseVclTable: TTable;
Errorlogging: TTable;
ErrorloggingUser: TStringField;
ErrorloggingClassName: TStringField;
ErrorloggingListBoxText: TStringField;
ErrorloggingMemberName: TStringField;
ClassListTab: TTable;
ClassListTabClassName: TStringField;
Panel4: TPanel;
DeclarationRichEdit: TRichEdit;
Panel5: TPanel;
SourceEntryPage: TRichEdit;
DBGrid1: TDBGrid;
Panel6: TPanel;
Panel7: TPanel;
PageControl1: TPageControl;
Panel8: TPanel;
QuickClassListbox: TListBox;
Panel1: TPanel;
Panel2: TPanel;
DBNavigator1: TDBNavigator;
Print1: TMenuItem;
PrintDefinition1: TMenuItem;
PrintDialog1: TPrintDialog;
ParseallHeaders1: TMenuItem;
Timer2: TTimer;
ClassOrgDB: TDatabase;
Grid: TMenuItem;
Declaration: TMenuItem;
Definition: TMenuItem;
QuickClassBox: TMenuItem;
MemberList: TMenuItem;
ChangeFonts: TMenuItem;
FontDialog1: TFontDialog;
ChangeBkGround: TMenuItem;
HeaderPage1: TMenuItem;
Declaration1: TMenuItem;
Definition1: TMenuItem;
QuickClassBox1: TMenuItem;
MemberList1: TMenuItem;
ColorDialog1: TColorDialog;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
MainListBox: TListView;
ImageList1: TImageList;
DestTableClassName: TStringField;
DestTableMember: TStringField;
DestTableMemberName: TStringField;
DestTableRecNum: TAutoIncField;
DestTableScope: TStringField;
DestTableReturnType: TStringField;
DestTableHeader: TStringField;
DestTablePs: TSmallintField;
DestTablePType1: TStringField;
DestTablePObject1: TStringField;
DestTablePType2: TStringField;
DestTablePObject2: TStringField;
DestTablePType3: TStringField;
DestTablePObject3: TStringField;
DestTablePType4: TStringField;
DestTablePObject4: TStringField;
DestTablePType5: TStringField;
DestTablePObject5: TStringField;
DestTablePType6: TStringField;
DestTablePObject6: TStringField;
DestTablePType7: TStringField;
DestTablePObject7: TStringField;
DestTablePType8: TStringField;
DestTablePObject8: TStringField;
DestTableSecondClass: TStringField;
DestTableMisc: TStringField;
VCLTableClassName: TStringField;
VCLTableMember: TStringField;
VCLTableMemberName: TStringField;
VCLTableRecNum: TAutoIncField;
VCLTableScope: TStringField;
VCLTableReturnType: TStringField;
VCLTableHeader: TStringField;
VCLTablePs: TSmallintField;
VCLTablePType1: TStringField;
VCLTablePObject1: TStringField;
VCLTablePType2: TStringField;
VCLTablePObject2: TStringField;
VCLTablePType3: TStringField;
VCLTablePObject3: TStringField;
VCLTablePType4: TStringField;
VCLTablePObject4: TStringField;
VCLTablePType5: TStringField;
VCLTablePObject5: TStringField;
VCLTablePType6: TStringField;
VCLTablePObject6: TStringField;
VCLTablePType7: TStringField;
VCLTablePObject7: TStringField;
VCLTablePType8: TStringField;
VCLTablePObject8: TStringField;
VCLTableSecondClass: TStringField;
VCLTableMisc: TStringField;
CloseActivePage1: TMenuItem;
CloseAllPages2: TMenuItem;
ShowNextDerivation2: TMenuItem;
SearchByMemberName1: TMenuItem;
SearchByClassName1: TMenuItem;
N1: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
ClassName1: TMenuItem;
LoadVCLHeader1: TMenuItem;
PrintHeaderhpp1: TMenuItem;
PrintSourcepas1: TMenuItem;
Grid1: TMenuItem;
HeaderPage: TMenuItem;
Exit1: TMenuItem;
{Events}
procedure SelectaTab(Sender: TObject);
procedure MainSetupWindow(Sender: TObject);
procedure RebuildVCLTable(Sender: TObject);
procedure MainDlgOnShow(Sender: TObject);
procedure MoveToClass(Sender: TObject);
procedure SearchMemberName1Click(Sender: TObject);
procedure ViewHeader1Click(Sender: TObject);
procedure ShowRecordClass1Click(Sender: TObject);
procedure About1Click(Sender: TObject);
procedure SearchClassName1Click(Sender: TObject);
procedure ViewSource1Click(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure Print1Click(Sender: TObject);
procedure PrintDefinition1Click(Sender: TObject);
procedure HeaderSource1Click(Sender: TObject);
procedure ParseaNewHeader1Click(Sender: TObject);
procedure ClosePageClick(Sender: TObject);
procedure CloseAllPages1Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure ChangeFontsClick(Sender: TObject);
procedure ChangeBkGroundClick(Sender: TObject);
procedure MainListBoxClick(Sender: TObject);
procedure ShowNextDerivation1Click(Sender: TObject);
procedure PrintHeaderhpp1Click(Sender: TObject);
procedure PrintSourcepas1Click(Sender: TObject);
procedure Project1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Exit1Click(Sender: TObject);
procedure MainListBoxKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
InitializedTable:Boolean;
DoesFileExist:Boolean;
MemberSearch:Boolean;
CurrentSecondClass:string;
LocalVclSource:string;
LocalTablesDir:string;
LocalVclHeaders:string;
DefinitionLength:Integer;
PasSourceFileName:string;
LocateSuccess:Boolean;
RawVCLTable:TCloneTable;
UserName:string;
CurrentHeaderFileName:string;
CurrentSourceFileName:string;
MySearchOptions:TLocateOptions;
EndLineNum:longint;
DefinitionEditMode:Boolean;
DeclarationEditMode:Boolean;
CurrentSelectedMemberName:string[40];
FileOpenActive:Boolean;
ClassFinderSelectedItem:string[40];
CurrentTabClassName:string[40];
procedure WriteRegistryKeys;
procedure ProcessSelectedClass;
procedure LoadSourcePage;
procedure GetRegistryInfo;
procedure LoadDefinitionSource(MemberType:string);
procedure LoadDeclarationSource(ListBoxString:string);
function DetermineImageIndex(Scope:string;Member:string):Integer;
function IsItABadLine(Line:string;DefinedLineNumber:Integer):Boolean;
procedure ExtractClassMembers(ClassPosition:Integer;ClassName:string);
procedure ConvertCppToDestTable;
procedure QueryDispTbl_LoadQuickList;
procedure StringToTablePos(SelectedText:string;ClassName:string);
procedure ConvertTableToTabs;
procedure TableToListStrings(ClassName:string);
procedure MemberToTable(MemberDeclaration:string;MyScope:string;CppClassName:string;MemberLineNumber:Integer);
public
end;
var
MainDlg: TMainDlg = nil;
implementation
uses Rebuild, ParsHead;
//uses NewMemDG;
{$R *.DFM}
{ Source Code}
procedure TMainDlg.ConvertTableToTabs;
begin
MainListBox.Items.Clear;
DestTblQuery.Close();
DestTblQuery.SQL.Clear();
DestTblQuery.SQL.Add('SELECT DISTINCT ClassName FROM');
DestTblQuery.SQL.Add('"main2.db"');
DestTblQuery.SQL.Add('ORDER BY ClassName');
DestTblQuery.Open();
{ Clear all tabs}
if PageControl1.PageCount > 0 then
with PageControl1 do
begin
ActivePage := Pages[0];
while (ActivePage <> nil) do
begin
ActivePage.Free;
SelectNextPage(TRUE);
end;
end;
{Create tabs from query}
while not DestTblQuery.EOF do
begin
with TTabSheet.Create(Self) do
begin
Caption := DestTblQuery.FieldByName('ClassName').AsString;
PageControl := PageControl1;
end;
DestTblQuery.Next();
end;
end;
procedure TMainDlg.SelectaTab(Sender: TObject);
begin
Screen.Cursor:=crHourGlass;
CurrentTabClassName:=PageControl1.ActivePage.Caption;
RawVCLTable.DisableControls();
RawVCLTable.Filtered:=false;
RawVCLTable.SetRange([CurrentTabClassName], [CurrentTabClassName]);
CurrentHeaderFileName:=RawVCLTable.FieldByName('Header').AsString;
CurrentSourceFileName:=RawVCLTable.FieldByName('Misc').AsString;
DeclarationRichEdit.Clear;
SourceEntryPage.Clear;
CodePageForm.CodePage.Clear();
try
CodePageForm.CodePage.Lines.LoadFromFile(LocalVclHeaders + CurrentHeaderFileName);
except on EFOpenError do
begin
MessageDlg('Header File Not Found!' ,mtError, [mbOk], 0);
Screen.Cursor:=crDefault;
Exit;
end;
end;
CodePageForm.SourceRichEdit1.Clear();
LoadSourcePage;
TableToListStrings(CurrentTabClassName);
RawVCLTable.EnableControls();
Screen.Cursor:=crDefault;
end;
procedure TMainDlg.TableToListStrings(ClassName:string);
var
ParamNum:Longint;
FinalString:string[255];
RecordClassName:string[40];
MemberName:string[40];
MemberType:string[40];
ReturnType:string[40];
ScopeColor:string[40];
PType1:string[40];
PType2:string[40];
PType3:string[40];
PType4:string[40];
PType5:string[40];
PType6:string[40];
PType7:string[40];
PType8:string[40];
PObject1:string[40];
PObject2:string[40];
PObject3:string[40];
PObject4:string[40];
PObject5:string[40];
PObject6:string[40];
PObject7:string[40];
PObject8:string[40];
Break:Boolean;
NewItem:TListItem;
DataProperty:Boolean;
begin
if FileOpenActive=true then
begin
VCLTable.Close();
VCLTable.TableName:=DestTable.TableName;
VCLTable.Open();
end;
DataProperty:=false;
Break:=false;
MainListBox.Items.Clear();
while (Break<>true) and (not RawVCLTable.EOF) do
begin
FinalString:='';
RecordClassName:=RawVCLTable.FieldByName('ClassName').AsString;
if ClassName=RecordClassName then
begin
ReturnType:=RawVCLTable.FieldByName('ReturnType').AsString;
MemberName:=RawVCLTable.FieldByName('MemberName').AsString;
MemberType:=RawVCLTable.FieldByName('Member').AsString;
ParamNum:=RawVCLTable.FieldByName('Ps').AsInteger;
ScopeColor:=RawVCLTable.FieldByName('Scope').AsString;
{Is it a data property}
if ((MemberType='property')and(ParamNum=0)) then
begin
DataProperty:=true;
end;
{Start building string}
FinalString:='';
if (MemberType='data') or (DataProperty=true) then { if data member }
begin
FinalString:=concat(FinalString,MemberName);
NewItem := MainListBox.Items.Add;
NewItem.Caption := FinalString;
NewItem.ImageIndex:=DetermineImageIndex(ScopeColor,MemberType);
end else
begin
if ParamNum=0 then { Ps=0 }
begin
FinalString:=concat(FinalString,MemberName);
if MemberType='property' then FinalString:=concat(FinalString,' ={')
else FinalString:=concat(FinalString,' (');
end;
if ParamNum>0 then { Ps=1 }
begin
PType1:=RawVCLTable.FieldByName('PType1').AsString;
PObject1:=RawVCLTable.FieldByName('PObject1').AsString;
FinalString:=concat(FinalString,MemberName);
if MemberType='property' then FinalString:=concat(FinalString,' ={')
else FinalString:=concat(FinalString,' (');
FinalString:=concat(FinalString,PType1);
FinalString:=concat(FinalString,' ');
FinalString:=concat(FinalString,PObject1);
end;
if ParamNum>1 then { Ps=2 }
begin
PType2:=RawVCLTable.FieldByName('PType2').AsString;
PObject2:=RawVCLTable.FieldByName('PObject2').AsString;
FinalString:=concat(FinalString,',');
FinalString:=concat(FinalString,PType2);
FinalString:=concat(FinalString,' ');
FinalString:=concat(FinalString,PObject2);
end;
if ParamNum>2 then { Ps=3 }
begin
PType3:=RawVCLTable.FieldByName('PType3').AsString;
PObject3:=RawVCLTable.FieldByName('PObject3').AsString;
FinalString:=concat(FinalString,',');
FinalString:=concat(FinalString,PType3);
FinalString:=concat(FinalString,' ');
FinalString:=concat(FinalString,PObject3);
end;
if ParamNum>3 then { Ps=4 }
begin
PType4:=RawVCLTable.FieldByName('PType4').AsString;
PObject4:=RawVCLTable.FieldByName('PObject4').AsString;
FinalString:=concat(FinalString,',');
FinalString:=concat(FinalString,PType4);
FinalString:=concat(FinalString,' ');
FinalString:=concat(FinalString,PObject4);
end;
if ParamNum>4 then { Ps=5 }
begin
PType5:=RawVCLTable.FieldByName('PType5').AsString;
PObject5:=RawVCLTable.FieldByName('PObject5').AsString;
FinalString:=concat(FinalString,',');
FinalString:=concat(FinalString,PType5);
FinalString:=concat(FinalString,' ');
FinalString:=concat(FinalString,PObject5);
end;
if ParamNum>5 then { Ps=6 }
begin
PType6:=RawVCLTable.FieldByName('PType6').AsString;
PObject6:=RawVCLTable.FieldByName('PObject6').AsString;
FinalString:=concat(FinalString,',');
FinalString:=concat(FinalString,PType6);
FinalString:=concat(FinalString,' ');
FinalString:=concat(FinalString,PObject6);
end;
if ParamNum>6 then { Ps=7 }
begin
PType7:=RawVCLTable.FieldByName('PType7').AsString;
PObject7:=RawVCLTable.FieldByName('PObject7').AsString;
FinalString:=concat(FinalString,',');
FinalString:=concat(FinalString,PType7);
FinalString:=concat(FinalString,' ');
FinalString:=concat(FinalString,PObject7);
end;
if ParamNum>7 then { Ps=8 }
begin
PType8:=RawVCLTable.FieldByName('PType8').AsString;
PObject8:=RawVCLTable.FieldByName('PObject8').AsString;
FinalString:=concat(FinalString,',');
FinalString:=concat(FinalString,PType8);
FinalString:=concat(FinalString,' ');
FinalString:=concat(FinalString,PObject8);
end;
if MemberType='property' then FinalString:=concat(FinalString,' }')
else
begin
FinalString:=concat(FinalString,' )');
end;
NewItem := MainListBox.Items.Add;
NewItem.Caption := FinalString;
NewItem.ImageIndex:=DetermineImageIndex(ScopeColor,MemberType);
end;
RawVCLTable.Next();
end
else Break:=true;
end;
end;
procedure TMainDlg.MainListBoxClick(Sender: TObject);
var
MemberType:string;
CurrentSelectedReturnType:string;
begin
CurrentSelectedReturnType:='';
if (FileOpenActive=true) or (MainListBox.ItemFocused=nil) or
(MainListBox.ItemFocused.Caption='Class Member List') then Exit;
MemberType:='';
CurrentTabClassName:=PageControl1.ActivePage.Caption;
RawVCLTable.DisableControls;
RawVCLTable.First;
StringToTablePos(MainListBox.ItemFocused.Caption,CurrentTabClassName);
CurrentSelectedMemberName:=RawVCLTable.FieldByName('MemberName').AsString;
CurrentSelectedReturnType:=RawVCLTable.FieldByName('ReturnType').AsString;
LoadDeclarationSource(CurrentSelectedReturnType+MainListBox.ItemFocused.Caption);
MemberType:=RawVCLTable.FieldByName('Member').AsString;
LoadDefinitionSource(MemberType);
Screen.Cursor:=crDefault;
RawVCLTable.EnableControls;
MainListBox.SetFocus();
end;
procedure TMainDlg.MainSetupWindow(Sender: TObject);
begin
{Initialize Database}
GetRegistryInfo;
WriteRegistryKeys;
ClassOrgDB.Params.Values['Path'] := LocalTablesDir;
{Open Tables}
try
VCLTable.Open;
except on EDatabaseError do
begin
MessageDlg('Table is corrupt! Recopy all vcltable.* files from CD!' ,mtError, [mbOk], 0);
Exit;
end;
end;
DestTable.Open;
ClassListTab.Open;
HeaderParser.Open;
ErrorLogging.Open;
ParseVclTable.Open;
RawVCLTable := TCloneTable.CreateFromTable(VCLTable, True);
RawVCLTable.Open;
{Initialize Variables}
FileOpenActive:=false;
DefinitionEditMode:=false;
MemberSearch:=false;
WindowState:=wsMaximized;
InitializedTable:=false;
end;
procedure TMainDlg.RebuildVCLTable(Sender: TObject);
var
SelectOK:Boolean;
Password:string;
HeaderName:string;
ParseIt:Boolean;
PasFileSearch:TSearchEngine;
OneCharacter:string;
GotPasName:Boolean;
CharCount:Integer;
Line:string;
ValidHeader:Boolean;
begin
TabRebuildStats:=TTabRebuildStats.Create(nil);
if VCLTable.RecordCount<>0 then
begin
Password:='Rebuild';
SelectOK:=InputQuery('Enter Password','Warning you are about to rebuild your VCL table!!',Password);
if not SelectOK then Exit;
if SelectOK then
begin
if Password <>'Rebuild' then Exit
end;
end;
TabRebuildStats.Left:=Trunc((ClientWidth/2)-(TabRebuildStats.Width/2));
TabRebuildStats.Top:=Trunc((ClientHeight/2)-(TabRebuildStats.Height/2));
TabRebuildStats.Show;
Enabled:=false;
TabRebuildStats.RebuildBar.Position:=1;
TabRebuildStats.HeaderNameLabel.Caption:='emptying table';
Application.ProcessMessages;
VCLTable.Close;
try
VCLTable.EmptyTable;
except on EDatabaseError do
begin
MessageDlg('Table is corrupt! Recopy all vcltable.* files from CD!' ,mtError, [mbOk], 0);
Screen.Cursor:=crDefault;
TabRebuildStats.Free;
Exit;
end;
end;
VCLTable.Open;
FileOpenActive:=true;
Screen.Cursor:=crHourglass;
HeaderParser.First;
DestTable.DisableControls;
PasFileSearch:=TSearchEngine.Create;
while not HeaderParser.EOF do
begin
HeaderName:=HeaderParserHeaderName.AsString;
ParseIt:=HeaderParserParse.AsBoolean;
if ParseIt=true then
begin
TabRebuildStats.HeaderNameLabel.Caption:=HeaderName;
{Take care of status bar}
if HeaderName='dataform.hpp' then TabRebuildStats.RebuildBar.Position:=1;
if HeaderName='dbinpreq.hpp' then TabRebuildStats.RebuildBar.Position:=2;
if HeaderName='dialogs.hpp' then TabRebuildStats.RebuildBar.Position:=3;
if HeaderName='dsgnwnds.hpp' then TabRebuildStats.RebuildBar.Position:=4;
if HeaderName='frmexprt.hpp' then TabRebuildStats.RebuildBar.Position:=5;
if HeaderName='inifiles.hpp' then TabRebuildStats.RebuildBar.Position:=6;
if HeaderName='masktext.hpp' then TabRebuildStats.RebuildBar.Position:=7;
if HeaderName='nodeedit.hpp' then TabRebuildStats.RebuildBar.Position:=8;
if HeaderName='pageedit.hpp' then TabRebuildStats.RebuildBar.Position:=9;
if HeaderName='sbaredit.hpp' then TabRebuildStats.RebuildBar.Position:=10;
if HeaderName='updsqled.hpp' then TabRebuildStats.RebuildBar.Position:=11;
if HeaderName='zvcl.hpp' then TabRebuildStats.RebuildBar.Position:=12;
Application.ProcessMessages;
CharCount:=0;
GotPasName:=false;
PasSourceFileName:='';
OneCharacter:='';
Screen.Cursor:=crHourglass;
CurrentHeaderFileName:=HeaderName;
CodePageForm.CodePage.Clear();
ValidHeader:=true;
try
CodePageForm.CodePage.Lines.LoadFromFile(LocalVclHeaders + CurrentHeaderFileName);
except on EFOpenError do
begin
ValidHeader:=false
end;
end;
if ValidHeader=true then
begin
CodePageForm.SourceRichEdit1.Clear();
PasFileSearch.SearchForString('.pas',1,0,'Include');
if PasFileSearch.PositionFound=-1 then MessageDlg('Could not find .pas for '+HeaderName ,mtError, [mbOk], 0);
Line:=CodePageForm.CodePage.Lines[PasFileSearch.LineNumberFound];
while not GotPasName do
begin
OneCharacter:=Copy(Line,(PasFileSearch.PositionFound-PasFileSearch.LineFoundPositionOne)-CharCount,1);
if (OneCharacter=' ') or (OneCharacter='/')then GotPasName:=true;
if GotPasName=false then
begin
AppendStr(OneCharacter,PasSourceFileName);
PasSourceFileName:=OneCharacter;
Inc(CharCount);
end;
end;
AppendStr(PasSourceFileName,'.pas');
DestTable.Close();
DestTable.TableName:='main2.db';
DestTable.Open();
DestTable.Close();
DestTable.EmptyTable;
DestTable.Open();
ConvertCppToDestTable;
Screen.Cursor:=crDefault;
BatchMove1.Execute;
end;
end;
HeaderParser.Next;
end;
DestTable.Close;
HeaderParser.Close;
DestTable.EnableControls;
Screen.Cursor:=crDefault;
TabRebuildStats.Close;
TabRebuildStats.Free;
VCLTable.Close;
VCLTable.TableName:='vcltable.db';
VCLTable.Open;
VCLTable.Refresh;
RawVCLTable.Refresh;
DBGrid1.Refresh;
RawVCLTable.First;
MessageDlg('Successful Build',mtConfirmation, [mbOk], 0);
FileOpenActive:=false;
Enabled:=true;
end;
procedure TMainDlg.StringToTablePos(SelectedText:string;ClassName:string);
var
Match:Boolean;
ParamNum:Longint;
FinalString:string[255];
RecordClassName:string[40];
MemberName:string[40];
MemberType:string[40];
ReturnType:string[40];
PType1:string[40];
PType2:string[40];
PType3:string[40];
PType4:string[40];
PType5:string[40];
PType6:string[40];
PType7:string[40];
PType8:string[40];
PObject1:string[40];
PObject2:string[40];
PObject3:string[40];
PObject4:string[40];
PObject5:string[40];
PObject6:string[40];
PObject7:string[40];
PObject8:string[40];
DataProperty:Boolean;
begin
Match:=false;
DataProperty:=false;
while (not RawVCLTable.EOF) and (not Match) do
begin
FinalString:='';
ReturnType:=RawVCLTable.FieldByName('ReturnType').AsString;
MemberName:=RawVCLTable.FieldByName('MemberName').AsString;
MemberType:=RawVCLTable.FieldByName('Member').AsString;
RecordClassName:=RawVCLTable.FieldByName('ClassName').AsString;
ParamNum:=RawVCLTable.FieldByName('Ps').AsInteger;
{Is it a data property}
if ((MemberType='property')and(ParamNum=0)) then
begin
DataProperty:=true;
end;
if ClassName=RecordClassName then
begin
FinalString:='';
if (MemberType='data') or (DataProperty=true) then { if data member }
begin
FinalString:=concat(FinalString,MemberName);
end else { all other member types }
begin
if ParamNum=0 then { Ps=0 }
begin
FinalString:=concat(FinalString,MemberName);
if MemberType='property' then FinalString:=concat(FinalString,' ={')
else FinalString:=concat(FinalString,' (');
end;
if ParamNum>0 then { Ps=1 }
begin
PType1:=RawVCLTable.FieldByName('PType1').AsString;
PObject1:=RawVCLTable.FieldByName('PObject1').AsString;
FinalString:=concat(FinalString,MemberName);
if MemberType='property' then FinalString:=concat(FinalString,' ={')
else
FinalString:=concat(FinalString,' (');
FinalString:=concat(FinalString,PType1);
FinalString:=concat(FinalString,' ');
FinalString:=concat(FinalString,PObject1);
end;
if ParamNum>1 then { Ps=2 }
begin
PType2:=RawVCLTable.FieldByName('PType2').AsString;
PObject2:=RawVCLTable.FieldByName('PObject2').AsString;
FinalString:=concat(FinalString,',');
FinalString:=concat(FinalString,PType2);
FinalString:=concat(FinalString,' ');
FinalString:=concat(FinalString,PObject2);
end;
if ParamNum>2 then { Ps=3 }
begin
PType3:=RawVCLTable.FieldByName('PType3').AsString;
PObject3:=RawVCLTable.FieldByName('PObject3').AsString;
FinalString:=concat(FinalString,',');
FinalString:=concat(FinalString,PType3);
FinalString:=concat(FinalString,' ');
FinalString:=concat(FinalString,PObject3);
end;
if ParamNum>3 then { Ps=4 }
begin
PType4:=RawVCLTable.FieldByName('PType4').AsString;
PObject4:=RawVCLTable.FieldByName('PObject4').AsString;
FinalString:=concat(FinalString,',');
FinalString:=concat(FinalString,PType4);
FinalString:=concat(FinalString,' ');
FinalString:=concat(FinalString,PObject4);
end;
if ParamNum>4 then { Ps=5 }
begin
PType5:=RawVCLTable.FieldByName('PType5').AsString;
PObject5:=RawVCLTable.FieldByName('PObject5').AsString;
FinalString:=concat(FinalString,',');
FinalString:=concat(FinalString,PType5);
FinalString:=concat(FinalString,' ');
FinalString:=concat(FinalString,PObject5);
end;
if ParamNum>5 then { Ps=6 }
begin
PType6:=RawVCLTable.FieldByName('PType6').AsString;
PObject6:=RawVCLTable.FieldByName('PObject6').AsString;
FinalString:=concat(FinalString,',');
FinalString:=concat(FinalString,PType6);
FinalString:=concat(FinalString,' ');
FinalString:=concat(FinalString,PObject6);
end;
if ParamNum>6 then { Ps=7 }
begin
PType7:=RawVCLTable.FieldByName('PType7').AsString;
PObject7:=RawVCLTable.FieldByName('PObject7').AsString;
FinalString:=concat(FinalString,',');
FinalString:=concat(FinalString,PType7);
FinalString:=concat(FinalString,' ');
FinalString:=concat(FinalString,PObject7);
end;
if ParamNum>7 then { Ps=8 }
begin
PType8:=RawVCLTable.FieldByName('PType8').AsString;
PObject8:=RawVCLTable.FieldByName('PObject8').AsString;
FinalString:=concat(FinalString,',');
FinalString:=concat(FinalString,PType8);
FinalString:=concat(FinalString,' ');
FinalString:=concat(FinalString,PObject8);
end;
if MemberType='property' then FinalString:=concat(FinalString,' }')
else
begin
FinalString:=concat(FinalString,' )');
end;
if Selectedtext=FinalString then Match:=true;
end;
end;
if Selectedtext=FinalString then Match:=true;
if Match<>true then RawVCLTable.Next();
end;
RawVCLTable.EnableControls;
end;
procedure TMainDlg.MainDlgOnShow(Sender: TObject);
begin
{Set Resizing}
DeclarationRichEdit.Height:=Trunc(ClientHeight * 0.18);
Panel4.Width:=ClientWidth div 2;
PageControl1.Height:=Trunc(ClientHeight * 0.6);
QuickClassListbox.Height:=Trunc(ClientHeight* 0.4)-30;
SourceEntryPage.Height:=(PageControl1.Height-15)-(DeclarationRichEdit.Height);
MainListBox.Height:=PageControl1.Height -40;
MainListBox.Width:=PageControl1.Width -5;
Label1.Left:=Trunc(Panel2.Width * 0.174);
Label2.Left:=Trunc(Panel2.Width * 0.300);
Label3.Left:=Trunc(Panel2.Width * 0.532);
Label4.Left:=Trunc(Panel2.Width * 0.725);
CodePageForm:=TCodePageForm.Create(Self);
with TRegistry.Create do
begin
{Load background colors from registry}
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('\software\borland\VCL Class Organizer\colors', false);
DeclarationRichEdit.Color:=TColor(StrToInt(ReadString('Declaration')));
SourceEntryPage.Color:=TColor(StrToInt(ReadString('Definition')));
QuickClassListbox.Color:=TColor(StrToInt(ReadString('QuickClass')));
MainListBox.Color:=TColor(StrToInt(ReadString('MemberList')));
DBGrid1.Color:=TColor(StrToInt(ReadString('Grid')));
CodePageForm.CodePage.Color:=TColor(StrToInt(ReadString('HeaderPage')));
CodePageForm.SourceRichEdit1.Color:=TColor(StrToInt(ReadString('DefinitionPage')));
{Load fonts from registry}
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('\software\borland\VCL Class Organizer\fonts', false);
DeclarationRichEdit.Font.Color:=TColor(StrToInt(ReadString('Declaration')));
SourceEntryPage.Font.Color:=TColor(StrToInt(ReadString('Definition')));
QuickClassListbox.Font.Color:=TColor(StrToInt(ReadString('QuickClass')));
MainListBox.Font.Color:=TColor(StrToInt(ReadString('MemberList')));
CodePageForm.CodePage.Font.Color:=TColor(StrToInt(ReadString('HeaderPage')));
CodePageForm.SourceRichEdit1.Font.Color:=TColor(StrToInt(ReadString('DefinitionPage')));
DBGrid1.Columns[1].Font.Color:=TColor(StrToInt(ReadString('Grid')));
DBGrid1.Columns[2].Font.Color:=TColor(StrToInt(ReadString('Grid')));
DBGrid1.Columns[3].Font.Color:=TColor(StrToInt(ReadString('Grid')));
DBGrid1.Columns[4].Font.Color:=TColor(StrToInt(ReadString('Grid')));
Free;
end;
QueryDispTbl_LoadQuickList;
end;
procedure TMainDlg.QueryDispTbl_LoadQuickList;
begin
QuickClassListbox.Clear;
ClassListTab.Open;
ClassListTab.First;
while not ClassListTab.EOF do
begin
QuickClassListbox.Items.Add(ClassListTabClassName.AsString);
ClassListTab.Next;
end;
SendMessage(QuickClassListbox.Handle,LB_SETSEL,WPARAM(TRUE),LPARAM(280));
SendMessage(QuickClassListbox.Handle,LB_SETSEL,WPARAM(TRUE),LPARAM(188));
SendMessage(QuickClassListbox.Handle,LB_SETSEL,WPARAM(FALSE),LPARAM(280));
end;
procedure TMainDlg.ConvertCppToDestTable;
var
OneLinerClass:Boolean;
ThisIsDerivedClass:Boolean;
ClassCommentLine:Boolean;
Break:Boolean;
x:Integer;
p:Integer;
StrLength:Integer;
CopyLength:Integer;
CompensateFirstSearch:Integer;
EndOfSearch:Integer;
CommentPagePosToLinePos:longint;
OneLineOfCode:string[200];
ExtractedClassName:string[40];
OneChar:string;
ClassSearch:TSearchEngine;
CommentSearch:TSearchEngine;
Sender:TObject;
TempString:string;
Done:Boolean;
begin
CurrentSecondClass:='';
EndOfSearch:=0;
CompensateFirstSearch:=0;
ClassSearch:=TSearchEngine.Create;
CommentSearch:=TSearchEngine.Create;
ClassSearch.LineNumberFound:=0;
CommentSearch.LineNumberFound:=0;
ClassSearch.PositionFound:=0;
CommentSearch.PositionFound:=0;
{Clear all tabs}
if FileOpenActive<>true then
begin
if PageControl1.PageCount > 0 then
with PageControl1 do
begin
ActivePage := Pages[0];
while (ActivePage <> nil) do
begin
ActivePage.Free;
SelectNextPage(TRUE);
end;
end;
end;
{start page search for 'class' and start extracting Class names}
while EndOfSearch<>-1 do
begin
OneLinerClass:=false;
ThisIsDerivedClass:=false;
Break:=false;
ClassCommentLine:=false;
ExtractedClassName:='';
ClassSearch.SearchForString('class ',1,CompensateFirstSearch,'Include'); { Find 'class' from pos 0 }
CommentSearch.SearchForString('//',1,ClassSearch.LineFoundPositionOne,'Include');{ is class line a comment line }
if ClassSearch.LineNumberFound=CommentSearch.LineNumberFound then ClassCommentLine:=true;
if CommentSearch.PositionFound=-1 then CommentSearch.PositionFound:= 999999;
if ((ClassCommentLine=true) and (ClassSearch.PositionFound<CommentSearch.PositionFound)
and (ClassSearch.PositionFound<>-1))
or ((ClassCommentLine=false) and (ClassSearch.PositionFound<>-1)) then
begin
OneLineOfCode:=CodePageForm.CodePage.Lines[ClassSearch.LineNumberFound];
StrLength:=Length(OneLineOfCode);
while StrLength=0 do {skip blank lines}
begin
OneLineOfCode:=CodePageForm.CodePage.Lines[ClassSearch.LineNumberFound+1];
StrLength:=Length(OneLineOfCode);
end;
{found valid class line}
if ClassCommentLine=true then {strip off comments}
begin
CommentPagePosToLinePos:=CommentSearch.PositionFound-CommentSearch.LineFoundPositionOne;
OneLineOfCode:=CodePageForm.CodePage.Lines[ClassSearch.LineNumberFound];
OneLineOfCode:=Copy(OneLineOfCode,0,CommentPagePosToLinePos);
StrLength:=Length(OneLineOfCode);
end;
for p:=1 to (StrLength+1) do {check for forward declaration}
begin
OneChar:=Copy(OneLineOfCode,p,1);
if OneChar=';' then Break:=true;
if OneChar=':' then ThisIsDerivedClass:=true;
if OneChar='{' then OneLinerClass:=true;
end;
{extract derived class}
if ThisIsDerivedClass=true then
begin
{ Get the 2nd derivation class name}
CopyLength:=StrLength;
TempString:='';
Done:=false;
CurrentSecondClass:='';
while Done=false do
begin
TempString:=Copy(OneLineOfCode,CopyLength,1);
if (TempString=':') or (TempString=' ') then Done:=true;
if (TempString<>'{') and (Done=false) then
begin
AppendStr(TempString,CurrentSecondClass);
CurrentSecondClass:=TempString;
end;
Dec(CopyLength);
end;
{Get Class Name}
x:=1;
while (x<>StrLength+1) and (Break<>true) do {read 1 char at a time of string}
begin
OneChar:=''; {clear it}
OneChar:=Copy(OneLineOfCode,x,1);
if OneChar=':' then { Search for derived classes, find scope operator}
begin
OneChar:=' '; {clear it}
x:=x-1; {move off of : }
OneChar:=Copy(OneLineOfCode,x,1);
while OneChar=' ' do {backup until found last class letter}
begin
Dec(x);
OneChar:=Copy(OneLineOfCode,x,1);
end;
while OneChar<>' ' do {backup until found first class letter}
begin
OneChar:=Copy(OneLineOfCode,x,1);
Dec(x);
end;
x:=x+2;
OneChar:=Copy(OneLineOfCode,x,1);
while (OneChar<>' ') and (OneChar<>':') do
begin
ExtractedClassName:=ExtractedClassName+OneChar;
Inc(x);
OneChar:=Copy(OneLineOfCode,x,1);
end;
Break:=true; {stop loading chars- one at a time}
ExtractClassMembers(ClassSearch.PositionFound,ExtractedClassName); {derived class}
end;
Inc(x);
end;
CurrentSecondClass:='';
end;{end of extract derived class}
{extract base classes}
if (ThisIsDerivedClass=false) and (OneLinerClass=true) then
begin
x:=1;
while (x<>StrLength+1) and (Break<>true) do {read 1 char at a time of string}
begin
OneChar:=''; {clear it}
OneChar:=Copy(OneLineOfCode,x,1);
if OneChar='{' then
begin
x:=x-1; { move off of : }
OneChar:=Copy(OneLineOfCode,x,1);
while OneChar=' ' do {backup until found last class letter}
begin
Dec(x);
OneChar:=Copy(OneLineOfCode,x,1);
end;
while OneChar<>' ' do {backup until found first class letter}
begin
OneChar:=Copy(OneLineOfCode,x,1);
Dec(x);
end;
x:=x+2;
OneChar:=Copy(OneLineOfCode,x,1);
while (OneChar<>' ') and (OneChar<>'{') do
begin
ExtractedClassName:=ExtractedClassName+OneChar;
Inc(x);
OneChar:=Copy(OneLineOfCode,x,1);
end;
Break:=true; {stop loading chars- one at a time}
ExtractClassMembers(ClassSearch.PositionFound,ExtractedClassName); {Base class}
end;
Inc(x);
end;
end;{end of base class extraction}
{start of two line class declaration}
if (OneLinerClass=false) and (ThisIsDerivedClass=false) and (Break<>true) then
begin
x:=StrLength;
OneChar:=Copy(OneLineOfCode,x,1);
while OneChar=' ' do {backup until found last class letter}
begin
Dec(x);
OneChar:=Copy(OneLineOfCode,x,1);
end;
while OneChar<>' ' do {backup until found first class letter}
begin
OneChar:=Copy(OneLineOfCode,x,1);
Dec(x);
end;
x:=x+2;
OneChar:=Copy(OneLineOfCode,x,1);
while x<>StrLength+1 do
begin
ExtractedClassName:=ExtractedClassName+OneChar;
Inc(x);
OneChar:=Copy(OneLineOfCode,x,1);
end; {stop loading chars- one at a time}
ExtractClassMembers(ClassSearch.PositionFound,ExtractedClassName); { 2 line class }
end;
end;
{end of two line class declaration}
EndOfSearch:=ClassSearch.PositionFound;
CompensateFirstSearch:=ClassSearch.NewSearchPosition;
end;
{Dont do tabs if table rebuild}
if FileOpenActive<>true then
begin
ConvertTableToTabs;
SelectaTab(Sender);
end;
end;
procedure TMainDlg.ExtractClassMembers(ClassPosition:Integer;ClassName:string);
var
PublishedMember:string;
HasPublishedMembers:Boolean;
PublishedMembers:TSearchEngine;
PublishedMemberLineNumber:Integer;
AllMembersDone:Boolean;
PublicMembersDone:Boolean;
ProtectedMembersDone:Boolean;
PrivateMembersDone:Boolean;
PublishedMembersDone:Boolean;
PublicMember:string;
PrivateMember:string;
ProtectedMember:string;
HasPublicMembers:Boolean;
HasProtectedMembers:Boolean;
HasPrivateMembers:Boolean;
BeginClassBracket:TSearchEngine;
PublicMembers:TSearchEngine;
PrivateMembers:TSearchEngine;
ProtectedMembers:TSearchEngine;
MemberCommentSearch:TSearchEngine;
n:Integer;
StrLength:Integer;
j:Integer;
ClassMember:string;
PublicMemberLineNumber:Integer;
ProtectedMemberLineNumber:Integer;
PrivateMemberLineNumber:Integer;
FoundEnd:Boolean;
LineLength:Integer;
CompleteMemberLinesCount:Integer;
r:Integer;
OneChar:string;
b:Integer;
Break:Boolean;
x:Integer;
FoundAnOpenBracket:Boolean;
MyCount:Integer;
MemberFoundPositionOne:uint;
EndBracket:uint;
FoundEqual:Boolean;
MorePublisheds:Integer;
MorePublics:Integer;
MoreProtecteds:Integer;
MorePrivates:Integer;
begin
HasPublishedMembers:=false;
PublishedMember:='';
PublishedMembers:=TSearchEngine.Create;
PublishedMembers.SearchForString('__published:',1,ClassPosition,'Include');
Break:=false;
MyCount:=0;
FoundAnOpenBracket:=false;
AllMembersDone:=false;
HasPublicMembers:=false;
HasProtectedMembers:=false;
HasPrivateMembers:=false;
PublicMember:='';
PrivateMember:='';
ProtectedMember:='';
MemberCommentSearch:=TSearchEngine.Create;
BeginClassBracket:=TSearchEngine.Create;
PublicMembers:=TSearchEngine.Create;
ProtectedMembers:=TSearchEngine.Create;
PrivateMembers:=TSearchEngine.Create;
BeginClassBracket.SearchForString('{',1,ClassPosition,'Include');
PublicMembers.SearchForString('public:',1,ClassPosition,'Include');
ProtectedMembers.SearchForString('protected:',1,ClassPosition,'Include');
PrivateMembers.SearchForString('private:',1,ClassPosition,'Include');
b:= BeginClassBracket.LineNumberFound;
MorePublisheds:=2;
MorePublics:=2;
MoreProtecteds:=2;
MorePrivates:=2;
DestTable.Close();
DestTable.TableName:='main2.db';
DestTable.Open();
while Break<>true do
begin
x:=1;
StrLength:=Length(CodePageForm.CodePage.Lines[b]); {actual void Calls() line}
while (x<>StrLength+1) and (Break<>True) do
begin
OneChar:=Copy(CodePageForm.CodePage.Lines[b],x,1);
if OneChar='{' then
begin
FoundAnOpenBracket:=true;
MyCount:=MyCount+1;
end;
if OneChar='}' then MyCount:=MyCount-1;
Inc(x);
if (MyCount=0) and (FoundAnOpenBracket=true) then Break:=true;
end;
Inc(b);
end;
b:=b-1;
{ line position that last ; is on }
MemberFoundPositionOne:=SendMessage(CodePageForm.CodePage.Handle,EM_LINEINDEX,b,0);
EndBracket:=MemberFoundPositionOne+(x-1);
if (PublishedMembers.PositionFound<EndBracket) and (PublishedMembers.PositionFound<>-1) then HasPublishedMembers:=true;
if (PublicMembers.PositionFound<EndBracket) and (PublicMembers.PositionFound<>-1) then HasPublicMembers:=true;
if (ProtectedMembers.PositionFound<EndBracket) and (ProtectedMembers.PositionFound<>-1) then HasProtectedMembers:=true;
if (PrivateMembers.PositionFound<EndBracket) and (PrivateMembers.PositionFound<>-1) then HasPrivateMembers:=true;
while HasPublishedMembers do {begin Published members}
begin
n:=1;
PublishedMembersDone:=false;
while PublishedMembersDone<>true do
begin
if ((PublishedMembers.LineNumberFound+n)=(PublicMembers.LineNumberFound)) or
((PublishedMembers.LineNumberFound+n)=(ProtectedMembers.LineNumberFound)) or
((PublishedMembers.LineNumberFound+n)=(PrivateMembers.LineNumberFound)) or
((PublishedMembers.LineNumberFound+n)=(b)) then PublishedMembersDone:=true;
ClassMember:='';
ClassMember:=CodePageForm.CodePage.Lines[PublishedMembers.LineNumberFound+n]; {line where Published is}
if (Pos('public:',ClassMember)<>0) then PublishedMembersDone:=true;
if (Pos('private:',ClassMember)<>0) then PublishedMembersDone:=true;
if (Pos('__published:',ClassMember)<>0) then PublishedMembersDone:=true;
if (Pos('protected:',ClassMember)<>0) then PublishedMembersDone:=true;
PublishedMemberLineNumber:=PublishedMembers.LineNumberFound+n;
while IsItABadLine(ClassMember,PublishedMemberLineNumber)=true do {check for bad line}
begin
ClassMember:=CodePageForm.CodePage.Lines[PublishedMembers.LineNumberFound+n+1];
if (Pos('public:',ClassMember)<>0) then PublishedMembersDone:=true;
if (Pos('private:',ClassMember)<>0) then PublishedMembersDone:=true;
if (Pos('__published:',ClassMember)<>0) then PublishedMembersDone:=true;
if (Pos('protected:',ClassMember)<>0) then PublishedMembersDone:=true;
if ((PublishedMembers.LineNumberFound+n+1)=(PublicMembers.LineNumberFound)) or
((PublishedMembers.LineNumberFound+n+1)=(ProtectedMembers.LineNumberFound)) or
((PublishedMembers.LineNumberFound+n+1)=(PrivateMembers.LineNumberFound)) or
((PublishedMembers.LineNumberFound+n+1)=(b)) then PublishedMembersDone:=true;
PublishedMemberLineNumber:=PublishedMembers.LineNumberFound+n+1;
Inc(n);
end;{end of bad line adjustment}
if PublishedMembersDone=false then
begin
FoundEqual:=false;
FoundEnd:=false;
CompleteMemberLinesCount:=1;
while FoundEnd<>true do {Append multiple line functions}
begin
LineLength:=Length(ClassMember);
for r:=1 to LineLength+1 do {check first line}
begin
OneChar:=Copy(ClassMember,r,1);
if OneChar='=' then FoundEqual:=true;
if OneChar=';' then FoundEnd:=true;
if (OneChar='}') and (FoundEqual=false) then FoundEnd:=true;
end;
if FoundEnd=false then
ClassMember:=ClassMember+CodePageForm.CodePage.Lines[PublishedMembers.LineNumberFound+n+CompleteMemberLinesCount];
Inc(CompleteMemberLinesCount);
end;
MemberToTable(ClassMember,'__published',ClassName,PublishedMemberLineNumber);
end;
n:=n+CompleteMemberLinesCount-2;
Inc(n);
end;
HasPublishedMembers:=false;
PublishedMembers.SearchForString('__published:',MorePublisheds,ClassPosition,'Include');
if (PublishedMembers.PositionFound<EndBracket) and (PublishedMembers.PositionFound<>-1) then
begin
HasPublishedMembers:=true;
Inc(MorePublisheds);
end;
end;
while HasPublicMembers do {begin public members}
begin
n:=1;
PublicMembersDone:=false;
while PublicMembersDone<>true do
begin
if ((PublicMembers.LineNumberFound+n)=(PublishedMembers.LineNumberFound)) or
((PublicMembers.LineNumberFound+n)=(ProtectedMembers.LineNumberFound)) or
((PublicMembers.LineNumberFound+n)=(PrivateMembers.LineNumberFound)) or
((PublicMembers.LineNumberFound+n)=(b)) then PublicMembersDone:=true;
ClassMember:='';
ClassMember:=CodePageForm.CodePage.Lines[PublicMembers.LineNumberFound+n]; { line where public is }
if (Pos('public:',ClassMember)<>0) then PublicMembersDone:=true;
if (Pos('private:',ClassMember)<>0) then PublicMembersDone:=true;
if (Pos('__published:',ClassMember)<>0) then PublicMembersDone:=true;
if (Pos('protected:',ClassMember)<>0) then PublicMembersDone:=true;
PublicMemberLineNumber:=PublicMembers.LineNumberFound+n;
while IsItABadLine(ClassMember,PublicMemberLineNumber)=true do { check for bad line }
begin
ClassMember:=CodePageForm.CodePage.Lines[PublicMembers.LineNumberFound+n+1];
if (Pos('public:',ClassMember)<>0) then PublicMembersDone:=true;
if (Pos('private:',ClassMember)<>0) then PublicMembersDone:=true;
if (Pos('__published:',ClassMember)<>0) then PublicMembersDone:=true;
if (Pos('protected:',ClassMember)<>0) then PublicMembersDone:=true;
if ((PublicMembers.LineNumberFound+n+1)=(PublishedMembers.LineNumberFound)) or
((PublicMembers.LineNumberFound+n+1)=(ProtectedMembers.LineNumberFound)) or
((PublicMembers.LineNumberFound+n+1)=(PrivateMembers.LineNumberFound)) or
((PublicMembers.LineNumberFound+n+1)=(b)) then PublicMembersDone:=true;
PublicMemberLineNumber:=PublicMembers.LineNumberFound+n+1;
Inc(n);
end;{ end of bad line adjustment }
if PublicMembersDone=false then
begin
FoundEqual:=false;
FoundEnd:=false;
CompleteMemberLinesCount:=1;
while FoundEnd<>true do {Append multiple line functions }
begin
LineLength:=Length(ClassMember);
for r:=1 to LineLength+1 do { check first line }
begin
OneChar:=Copy(ClassMember,r,1);
if OneChar='=' then FoundEqual:=true;
if OneChar=';' then FoundEnd:=true;
if (OneChar='}') and (FoundEqual=false) then FoundEnd:=true;
end;
if FoundEnd=false then
ClassMember:=ClassMember+CodePageForm.CodePage.Lines[PublicMembers.LineNumberFound+n+CompleteMemberLinesCount];
Inc(CompleteMemberLinesCount);
end;
MemberToTable(ClassMember,'public',ClassName,PublicMemberLineNumber);
end;
n:=n+CompleteMemberLinesCount-2;
Inc(n);
end;
HasPublicMembers:=false;
PublicMembers.SearchForString('public:',MorePublics,ClassPosition,'Include');
if (PublicMembers.PositionFound<EndBracket) and (PublicMembers.PositionFound<>-1) then
begin
HasPublicMembers:=true;
Inc(MorePublics);
end;
end;
while HasProtectedMembers do { begin protected members }
begin
n:=1;
ProtectedMembersDone:=false;
while ProtectedMembersDone<>true do
begin
if ((ProtectedMembers.LineNumberFound+n)=(PublishedMembers.LineNumberFound)) or
((ProtectedMembers.LineNumberFound+n)=(PublicMembers.LineNumberFound)) or
((ProtectedMembers.LineNumberFound+n)=(PrivateMembers.LineNumberFound)) or
((ProtectedMembers.LineNumberFound+n)=(b)) then ProtectedMembersDone:=true;
ClassMember:='';
{skip blank lines and load a new line }
ClassMember:=CodePageForm.CodePage.Lines[ProtectedMembers.LineNumberFound+n]; { line where protected is }
if (Pos('public:',ClassMember)<>0) then ProtectedMembersDone:=true;
if (Pos('private:',ClassMember)<>0) then ProtectedMembersDone:=true;
if (Pos('__published:',ClassMember)<>0) then ProtectedMembersDone:=true;
if (Pos('protected:',ClassMember)<>0) then ProtectedMembersDone:=true;
ProtectedMemberLineNumber:=ProtectedMembers.LineNumberFound+n;
while IsItABadLine(ClassMember,ProtectedMemberLineNumber)=true do
begin
ClassMember:=CodePageForm.CodePage.Lines[ProtectedMembers.LineNumberFound+n+1];
if (Pos('public:',ClassMember)<>0) then ProtectedMembersDone:=true;
if (Pos('private:',ClassMember)<>0) then ProtectedMembersDone:=true;
if (Pos('__published:',ClassMember)<>0) then ProtectedMembersDone:=true;
if (Pos('protected:',ClassMember)<>0) then ProtectedMembersDone:=true;
if ((ProtectedMembers.LineNumberFound+n+1)=(PublishedMembers.LineNumberFound)) or
((ProtectedMembers.LineNumberFound+n+1)=(PublicMembers.LineNumberFound)) or
((ProtectedMembers.LineNumberFound+n+1)=(PrivateMembers.LineNumberFound)) or
((ProtectedMembers.LineNumberFound+n+1)=(b)) then ProtectedMembersDone:=true;
ProtectedMemberLineNumber:=ProtectedMembers.LineNumberFound+n+1;
Inc(n)
end;{ end of blank line adjustment }
if ProtectedMembersDone=false then
begin
FoundEqual:=false;
FoundEnd:=false;
CompleteMemberLinesCount:=1;
while FoundEnd<>true do {Append multiple line functions }
begin
LineLength:=Length(ClassMember);
for r:=1 to LineLength+1 do { check first line }
begin
OneChar:=Copy(ClassMember,r,1);
if OneChar='=' then FoundEqual:=true;
if OneChar=';' then FoundEnd:=true;
if (OneChar='}') and (FoundEqual=false) then FoundEnd:=true;
end;
if FoundEnd=false then
ClassMember:=ClassMember+CodePageForm.CodePage.Lines[ProtectedMembers.LineNumberFound+n+CompleteMemberLinesCount];
Inc(CompleteMemberLinesCount);
end;
MemberToTable(ClassMember,'protected',ClassName,ProtectedMemberLineNumber);
end;
n:=n+CompleteMemberLinesCount-2;
Inc(n);
end;
HasProtectedMembers:=false;
ProtectedMembers.SearchForString('protected:',MoreProtecteds,ClassPosition,'Include');
if (ProtectedMembers.PositionFound<EndBracket) and (ProtectedMembers.PositionFound<>-1) then
begin
HasProtectedMembers:=true;
Inc(MoreProtecteds);
end;
end;
while HasPrivateMembers do { begin public members }
begin
n:=1;
PrivateMembersDone:=false;
while PrivateMembersDone<>true do
begin
if ((PrivateMembers.LineNumberFound+n)=(PublishedMembers.LineNumberFound)) or
((PrivateMembers.LineNumberFound+n)=(ProtectedMembers.LineNumberFound)) or
((PrivateMembers.LineNumberFound+n)=(PublicMembers.LineNumberFound)) or
((PrivateMembers.LineNumberFound+n)=(b)) then PrivateMembersDone:=true;
ClassMember:='';
{skip blank lines and load a new line }
ClassMember:=CodePageForm.CodePage.Lines[PrivateMembers.LineNumberFound+n]; { line where public is }
if (Pos('public:',ClassMember)<>0) then PrivateMembersDone:=true;
if (Pos('private:',ClassMember)<>0) then PrivateMembersDone:=true;
if (Pos('__published:',ClassMember)<>0) then PrivateMembersDone:=true;
if (Pos('protected:',ClassMember)<>0) then PrivateMembersDone:=true;
PrivateMemberLineNumber:=PrivateMembers.LineNumberFound+n;
while IsItABadLine(ClassMember,PrivateMemberLineNumber)=true do
begin
ClassMember:=CodePageForm.CodePage.Lines[PrivateMembers.LineNumberFound+n+1];
if (Pos('public:',ClassMember)<>0) then PrivateMembersDone:=true;
if (Pos('private:',ClassMember)<>0) then PrivateMembersDone:=true;
if (Pos('__published:',ClassMember)<>0) then PrivateMembersDone:=true;
if (Pos('protected:',ClassMember)<>0) then PrivateMembersDone:=true;
if ((PrivateMembers.LineNumberFound+n+1)=(PublishedMembers.LineNumberFound)) or
((PrivateMembers.LineNumberFound+n+1)=(ProtectedMembers.LineNumberFound)) or
((PrivateMembers.LineNumberFound+n+1)=(PublicMembers.LineNumberFound)) or
((PrivateMembers.LineNumberFound+n+1)=(b)) then PrivateMembersDone:=true;
PrivateMemberLineNumber:=PrivateMembers.LineNumberFound+n+1;
Inc(n)
end;{ end of blank line adjustment }
if PrivateMembersDone=false then
begin
FoundEqual:=false;
FoundEnd:=false;
CompleteMemberLinesCount:=1;
while FoundEnd<>true do {Append multiple line functions }
begin
LineLength:=Length(ClassMember);
for r:=1 to LineLength+1 do { check first line }
begin
OneChar:=Copy(ClassMember,r,1);
if OneChar='=' then FoundEqual:=true;
if OneChar=';' then FoundEnd:=true;
if (OneChar='}') and (FoundEqual=false) then FoundEnd:=true;
end;
if FoundEnd=false then
ClassMember:=ClassMember+CodePageForm.CodePage.Lines[PrivateMembers.LineNumberFound+n+CompleteMemberLinesCount];
Inc(CompleteMemberLinesCount);
end;
MemberToTable(ClassMember,'private',ClassName,PrivateMemberLineNumber);
end;
n:=n+CompleteMemberLinesCount-2;
Inc(n);
end;
HasPrivateMembers:=false;
PrivateMembers.SearchForString('private:',MorePrivates,ClassPosition,'Include');
if (PrivateMembers.PositionFound<EndBracket) and (PrivateMembers.PositionFound<>-1) then
begin
HasPrivateMembers:=true;
Inc(MorePrivates);
end;
end;
end;
procedure TMainDlg.MemberToTable(MemberDeclaration:string;MyScope:string;CppClassName:string;MemberLineNumber:Integer);
var
k:Integer;
v:Integer;
EndOfParams:Boolean;
ExtractObjects:TExtractObjects;
IsItAFunction:Boolean;
Break:Boolean;
StrLength:Integer;
y:Integer;
OneChar:string;
ArrayObjectNames:array[0..8] of string;
ArrayObjectTypes:array[0..8]of string;
MemberCommentSearch:TSearchEngine;
MemberFoundPositionOne:uint;
IsItAProperty:Integer;
Len:Integer;
ClassMemberName:string;
begin
DestTable.Append();
MemberCommentSearch:=TSearchEngine.Create;
IsItAFunction:=false;
ExtractObjects:=TExtractObjects.Create;
Break:=false;
StrLength:=Length(MemberDeclaration);
y:=1;
IsItAProperty:=Pos('__property',MemberDeclaration);
while (y<>StrLength+1) and (Break<>true) do { read line }
begin
OneChar:=''; { clear it}
OneChar:=Copy(MemberDeclaration,y,1); { look for ( bracket }
if (OneChar='(') or (y=StrLength) or (OneChar='=')or (OneChar='[')then {for data and function members }
begin
if OneChar='(' then IsItAFunction:=true;
if OneChar='=' then IsItAFunction:=true;
{skip over member comments and extract member type and name }
MemberFoundPositionOne:=SendMessage(CodePageForm.CodePage.Handle,EM_LINEINDEX,MemberLineNumber,0);
MemberCommentSearch.SearchForString('*/',1,MemberFoundPositionOne,'Include');
if (MemberCommentSearch.PositionFound=-1) or (MemberCommentSearch.PositionFound>MemberFoundPositionOne+y) then
ExtractObjects.ExtractObjectNameAndType(1,y,MemberDeclaration,'MemberName')
else
begin
ExtractObjects.ExtractObjectNameAndType((MemberCommentSearch.PositionFound-MemberFoundPositionOne)+3,
y,MemberDeclaration,'MemberName');{ get name and type }
end;
OneChar:=Copy(ExtractObjects.ObjectName,0,1);
if OneChar='*' then
begin { make sure pointers are on type side }
Len:=Length(ExtractObjects.ObjectName);
ExtractObjects.ObjectName:=Copy(ExtractObjects.ObjectName,2,Len);
AppendStr(ExtractObjects.ObjectType,'*');
end;
if OneChar='&' then
begin { make sure references are on type side }
Len:=Length(ExtractObjects.ObjectName);
ExtractObjects.ObjectName:=Copy(ExtractObjects.ObjectName,2,Len);
AppendStr(ExtractObjects.ObjectType,'&');
end;
ClassMemberName:=ExtractObjects.ObjectName;
DestTableMemberName.AsString:=ClassMemberName;
DestTableReturnType.AsString:=ExtractObjects.ObjectType;
Break:=true;
EndOfParams:=false;
v:=0;
{extract parameters}
while (EndOfParams<>true) and (v<>StrLength+1) and (IsItAFunction=true )do
begin
k:=1;
v:=y+1;
OneChar:=Copy(MemberDeclaration,v,1);
if OneChar=')' then EndOfParams:=true;
if OneChar='}' then EndOfParams:=true;
ExtractObjects.LastCommaPosition:=y;
while EndOfParams<>true do
begin
OneChar:=Copy(MemberDeclaration,v,1);
if OneChar=')' then EndOfParams:=true;
if OneChar='}' then EndOfParams:=true;
if (OneChar=',') or (OneChar=')') or (OneChar='}')then
begin
ExtractObjects.ObjectName:='';
ExtractObjects.ObjectType:='';
ExtractObjects.ExtractObjectNameAndType(ExtractObjects.LastCommaPosition+1,v,MemberDeclaration,
'Parameter');
OneChar:=Copy(ExtractObjects.ObjectName,0,1);
if OneChar='*' then
begin {make sure pointers are on type side }
Len:=Length(ExtractObjects.ObjectName);
ExtractObjects.ObjectName:=Copy(ExtractObjects.ObjectName,2,Len);
AppendStr(ExtractObjects.ObjectType,'*');
end;
if OneChar='&' then
begin { make sure references are on type side }
Len:=Length(ExtractObjects.ObjectName);
ExtractObjects.ObjectName:=Copy(ExtractObjects.ObjectName,2,Len);
AppendStr(ExtractObjects.ObjectType,'&');
end;
ArrayObjectNames[k]:=ExtractObjects.ObjectName;
ArrayObjectTypes[k]:=ExtractObjects.ObjectType;
Inc(k);
if k=9 then EndOfParams:=true;
end;
Inc(v);
end;
end;
DestTablePType1.AsString:=ArrayObjectTypes[1];
DestTablePType2.AsString:=ArrayObjectTypes[2];
DestTablePType3.AsString:=ArrayObjectTypes[3];
DestTablePType4.AsString:=ArrayObjectTypes[4];
DestTablePType5.AsString:=ArrayObjectTypes[5];
DestTablePType6.AsString:=ArrayObjectTypes[6];
DestTablePType7.AsString:=ArrayObjectTypes[7];
DestTablePType8.AsString:=ArrayObjectTypes[8];
DestTablePObject1.AsString:=ArrayObjectNames[1];
DestTablePObject2.AsString:=ArrayObjectNames[2];
DestTablePObject3.AsString:=ArrayObjectNames[3];
DestTablePObject4.AsString:=ArrayObjectNames[4];
DestTablePObject5.AsString:=ArrayObjectNames[5];
DestTablePObject6.AsString:=ArrayObjectNames[6];
DestTablePObject7.AsString:=ArrayObjectNames[7];
DestTablePObject8.AsString:=ArrayObjectNames[8];
ArrayObjectTypes[1]:='';
ArrayObjectNames[1]:='';
ArrayObjectTypes[2]:='';
ArrayObjectNames[2]:='';
ArrayObjectTypes[3]:='';
ArrayObjectNames[3]:='';
ArrayObjectTypes[4]:='';
ArrayObjectNames[4]:='';
ArrayObjectTypes[5]:='';
ArrayObjectNames[5]:='';
ArrayObjectTypes[6]:='';
ArrayObjectNames[6]:='';
ArrayObjectTypes[7]:='';
ArrayObjectNames[7]:='';
ArrayObjectTypes[8]:='';
ArrayObjectNames[8]:='';
if IsItAFunction=false then DestTablePs.AsInteger:=0;
if IsItAFunction=true then DestTablePs.AsInteger:=k-1;
DestTableSecondClass.AsString:=CurrentSecondClass;
DestTableHeader.AsString:=CurrentHeaderFileName;
DestTableScope.AsString:=MyScope;
DestTableClassName.AsString:=CppClassName;
DestTableMisc.AsString:=PasSourceFileName;
if IsItAFunction=true then
begin
if CppClassName=ClassMemberName then DestTableMember.AsString:='constructor'
else DestTableMember.AsString:='function';
end;
if IsItAFunction=false then DestTableMember.AsString:='data';
if IsItAProperty<>0 then DestTableMember.AsString:='property';
DestTable.Post();
end;
Inc(y);
end;
end;
procedure TExtractObjects.ExtractObjectNameAndType(StartPosition:Integer;
EndPosition:Integer; LineString:string;Phase:string);
var
IsItAProperty:Integer;
FindStartofReturnType:Integer;
MemberNameFirstCharPos:Integer;
x:Integer;
j:Integer;
OneChar:string;
NoReturnType:Boolean;
begin
NoReturnType:=false;
x:=EndPosition;
ObjectName:='';
ObjectType:='';
LastCommaPosition:=EndPosition;
x:=x-1;
OneChar:=Copy(LineString,x,1);
while (OneChar=' ') or (OneChar=#9) do {backup until found last letter of Object Name}
begin
Dec(x);
OneChar:=Copy(LineString,x,1);
end; {backup until found first letter of member name or (OneChar<>'(')}
while (OneChar<>' ') and (OneChar<>'(') and (OneChar<>#9) and (OneChar<>',') and (OneChar<>'{')and (OneChar<>'*')do
begin
OneChar:=Copy(LineString,x,1);
if OneChar='{' then NoReturnType:=true;
Dec(x);
end;
x:=x+2;
MemberNameFirstCharPos:=x;
OneChar:=Copy(LineString,x,1);
IsItAProperty:=Pos('__property',LineString);
{Handle extracting property names differently stop only at = and curl bracket}
if (IsItAProperty<>0) and (Phase='MemberName') then
begin
while (OneChar<>'=') and (OneChar<>'}') and (OneChar<>';')do
begin
ObjectName:=ObjectName+OneChar;
Inc(x);
OneChar:=Copy(LineString,x,1);
end;
end
else {extract object name}
begin
while (OneChar<>' ') and (OneChar<>#9) and (OneChar<>';') and (OneChar<>',')
and (OneChar<>'(') and (OneChar<>')')
and (OneChar<>'{') and (OneChar<>'}') do
begin
ObjectName:=ObjectName+OneChar;
Inc(x);
OneChar:=Copy(LineString,x,1);
end;
end;
{extract return type}
if MemberNameFirstCharPos=1 then NoReturnType:=true; { is it constructor or destructor}
MemberNameFirstCharPos:=MemberNameFirstCharPos-1; { move off of : }
OneChar:=Copy(LineString,MemberNameFirstCharPos,1);
while (OneChar=' ') and (NoReturnType<>true) do {backup until found last letter of Return Type}
begin
if MemberNameFirstCharPos=1 then NoReturnType:=true;
Dec(MemberNameFirstCharPos);
OneChar:=Copy(LineString,MemberNameFirstCharPos,1);
end;
if NoReturnType=false then
begin
FindStartofReturnType:=StartPosition;
OneChar:=Copy(LineString,FindStartofReturnType,1);
while OneChar=' ' do {find start pos of ReturnType}
begin
FindStartofReturnType:=FindStartofReturnType+1;
OneChar:=Copy(LineString,FindStartofReturnType,1);
end;
for j:=FindStartofReturnType to MemberNameFirstCharPos do
begin
OneChar:=Copy(LineString,j,1);
if OneChar<>#9 then ObjectType:=ObjectType+OneChar;
end;
end;
end;
function TMainDlg.IsItABadLine(Line:string;DefinedLineNumber:Integer):Boolean; { or # line }
var
StringLength:Integer;
x:Integer;
FoundSemicolon:Boolean;
FoundOpenBracket:Boolean;
OneCharacter:string;
BadLine:Boolean;
DefineLineSearch:TSearchEngine;
MemberFoundPositionOne:uint;
FoundPound:Boolean;
begin
DefineLineSearch:=TSearchEngine.Create;
FoundSemicolon:=false;
FoundOpenBracket:=false;
BadLine:=true;
FoundPound:=false;
StringLength:=Length(Line);
for x:=1 to StringLength+1 do
begin
OneCharacter:=Copy(Line,x,1);
if OneCharacter=';' then FoundSemicolon:=true;
if OneCharacter='#' then FoundPound:=true;
if (OneCharacter='(') or (OneCharacter='{') then
begin
FoundOpenBracket:=true;
MemberFoundPositionOne:=SendMessage(CodePageForm.CodePage.Handle,EM_LINEINDEX,DefinedLineNumber,0);
DefineLineSearch.SearchForString('define',1,MemberFoundPositionOne,'Include');
if (DefineLineSearch.PositionFound<MemberFoundPositionOne+x) and (DefineLineSearch.PositionFound <>-1)
and (FoundPound=true) then
FoundOpenBracket:=false;
end
end;
if FoundSemicolon=true then BadLine:=false;
if FoundOpenBracket=true then BadLine:=false;
Result:=BadLine;
end;
procedure TMainDlg.LoadDeclarationSource(ListBoxString:string);
var
FoundAnEqual:Boolean;
LineCount:Integer;
FoundAnEnd:Boolean;
MemberDeclareSearch:TSearchEngine;
ClassDeclareSearch:TSearchEngine;
ActualCodeLine:string;
StrLength:Integer;
OneChar:string;
d:Integer;
FoundFirstChar:Boolean;
OccuranceNum:Integer;
ListStringLen:Integer;
x:Integer;
CondensedString:string;
HeaderMemberCondensed:string;
MatchFound:Boolean;
DeclareStringList:TStringList;
begin
DeclareStringList:=TStringList.Create;
DeclareStringList.Clear;
DeclarationRichEdit.Lines.Clear;
MatchFound:=false;
OccuranceNum:=1;
FoundFirstChar:=false;
ClassDeclareSearch:=TSearchEngine.Create;
ClassDeclareSearch.SearchForString(CurrentTabClassName,1,0,'Include');{Search for Class}
MemberDeclareSearch:=TSearchEngine.Create;
if CurrentTabClassName=CurrentSelectedMemberName then
begin
OccuranceNum:=2;
end;
{strip spaces from listbox string}
CondensedString:='';
ListStringLen:=Length(ListBoxString);
for x:=1 to ListStringLen do
begin
OneChar:=Copy(ListBoxString,x,1);
if (OneChar<>' ') and (OneChar<>#9) then CondensedString:=CondensedString+OneChar;
end;
{Search for MemberName only}
while MatchFound<>true do
begin {this is the member name only}
MemberDeclareSearch.SearchForString(CurrentSelectedMemberName,OccuranceNum,ClassDeclareSearch.PositionFound,'Include');
if MemberDeclareSearch.PositionFound=-1 then
begin
Errorlogging.Open;
ErrorLogging.Append;
ErrorLoggingUser.AsString:=UserName;
ErrorLoggingClassName.AsString:=CurrentTabClassName;
ErrorLoggingListBoxText.AsString:=ListBoxString;
ErrorLoggingMemberName.AsString:=CurrentSelectedMemberName;
ErrorLogging.Post;
Errorlogging.Close;
MessageDlg('Table/ListBox error !! '+ListBoxString+
' record does not match header!',mtError, [mbOk], 0);
Exit;
end;
FoundAnEqual:=false;
FoundAnEnd:=false;
LineCount:=0;
HeaderMemberCondensed:='';
while FoundAnEnd<>true do {Append multiple line functions}
begin
d:=1;
ActualCodeLine:='';
StrLength:=Length(CodePageForm.CodePage.Lines[MemberDeclareSearch.LineNumberFound + LineCount]);
while (d<>StrLength+1) and (FoundAnEnd<>true) do
begin
OneChar:=Copy(CodePageForm.CodePage.Lines[MemberDeclareSearch.LineNumberFound + LineCount],d,1);
if OneChar='=' then FoundAnEqual:=true;
if OneChar=';' then FoundAnEnd:=true;
if (OneChar='}') and (FoundAnEqual=false) then FoundAnEnd:=true;
if (OneChar<>' ') and (OneChar<>#9) then
begin
FoundFirstChar:=true; { Once we found a source match we want to condense it}
HeaderMemberCondensed:=HeaderMemberCondensed+OneChar;
end;
if FoundFirstChar=true then ActualCodeLine:=ActualCodeLine + OneChar;
Inc(d);
end;
DeclareStringList.Add(ActualCodeLine);
Inc(LineCount);
end; { Use Pos to see if listbox string is in source string}
if (Pos(CondensedString,HeaderMemberCondensed)<>0) then MatchFound:=true;
if (Pos(CondensedString,HeaderMemberCondensed)=0) then
begin
Inc(OccuranceNum);
DeclareStringList.Clear;
end;
end;
DeclarationRichEdit.Lines.AddStrings(DeclareStringList);
DeclarationRichEdit.SetFocus;
SendMessage(DeclarationRichEdit.Handle,EM_SETSEL,0,0);
DeclarationEditMode:=true;
end;
procedure TSearchEngine.SearchForString(Word:string;Occurance:Integer;StartPosition:Integer;Page:string);
var
MyTFindText:TFindText;
OccuranceCount:Integer;
SearchValue:string;
begin
OccuranceCount:=0;
SearchValue:=Word;
NewSearchPosition:=0;
LineNumberFound:=0;
LineFoundPositionOne:=0;
PositionFound:=0;
with MyTFindText.chrg do { setup Find Text Struct }
begin
cpMin:=StartPosition;
cpMax:=-1;
MyTFindText.lpstrText:=PChar(Word);
end;
{if none found stop at defined Occurance }
while (PositionFound<>-1)and(OccuranceCount<>Occurance) do
begin
if Page='Include' then PositionFound:=SendMessage(CodePageForm.CodePage.Handle,EM_FINDTEXT,FT_MATCHCASE,LongInt(@MyTFindText));
if Page='Source' then PositionFound:=SendMessage(CodePageForm.SourceRichEdit1.Handle,EM_FINDTEXT,FT_MATCHCASE,LongInt(@MyTFindText));
if (PositionFound<>-1) and (OccuranceCount<>Occurance) then { move cursor }
begin
if Page='Include' then
begin
SendMessage(CodePageForm.CodePage.Handle,EM_SETSEL,PositionFound,PositionFound);
LineNumberFound := SendMessage(CodePageForm.CodePage.Handle, EM_LINEFROMCHAR,CodePageForm.CodePage.SelStart,0);
LineFoundPositionOne := SendMessage(CodePageForm.CodePage.Handle, EM_LINEINDEX, LineNumberFound, 0);
end;
if Page='Source' then
begin
SendMessage(CodePageForm.SourceRichEdit1.Handle,EM_SETSEL,PositionFound,PositionFound);
LineNumberFound := SendMessage(CodePageForm.SourceRichEdit1.Handle, EM_LINEFROMCHAR,CodePageForm.SourceRichEdit1.SelStart,0);
LineFoundPositionOne := SendMessage(CodePageForm.SourceRichEdit1.Handle, EM_LINEINDEX, LineNumberFound, 0);
end;
MyTFindText.chrg.cpMin:=PositionFound+1;{ should be +sizeof searchvalue }
NewSearchPosition:=PositionFound+1;
Inc(OccuranceCount);
end;
if PositionFound=-1 then LineNumberFound:=999999;
end;
end;
procedure TMainDlg.MoveToClass(Sender: TObject);
begin
if FileOpenActive =true then Exit;
ClassFinderSelectedItem:=QuickClassListbox.Items[QuickClassListbox.ItemIndex];
ProcessSelectedClass;
end;
procedure TMainDlg.SearchMemberName1Click(Sender: TObject);
var
SelectOK:Boolean;
SearchMember:string;
begin
{We have to use VCL Table for secondary indexes then refresh RawVCLTable}
Screen.Cursor := crHourglass;
SelectOK:=InputQuery('SEARCH ENGINE','Enter Member Name',SearchMember);
if SelectOK then
begin
VCLTable.IndexName:='MemberNameIndex';
VCLTable.SetRange([SearchMember], [SearchMember]);
DataSource1.DataSet:=VCLTable;
MemberSearch:=true;
if VCLTable.RecordCount=0 then
begin
MessageDlg(SearchMember+' is not a VCL Class member !' ,mtError, [mbOk], 0);
VCLTable.IndexName:='';
DataSource1.Dataset:=RawVCLTable;
DBGrid1.DataSource:=DataSource1;
MemberSearch:=false;
end;
end;
Screen.Cursor := crDefault;
end;
procedure TMainDlg.ViewHeader1Click(Sender: TObject);
begin
CodePageForm.Show;
CodePageForm.SourceRichEdit1.Hide;
CodePageForm.CodePage.Show;
SendMessage(CodePageForm.CodePage.Handle,EM_SETSEL,CodePageForm.CodePage.SelStart,
CodePageForm.CodePage.SelStart+Length(CurrentSelectedMemberName));
CodePageForm.CodePage.SetFocus;
end;
procedure TMainDlg.ShowRecordClass1Click(Sender: TObject);
begin
if FileOpenActive =true then Exit;
{For some reason I'm Stuck using VCLTable. Maybe its the indexing}
if MemberSearch=true then
begin
ClassFinderSelectedItem:=VCLTable.FieldByName('ClassName').AsString;
MemberSearch:=false;
end else
begin
ClassFinderSelectedItem:=RawVCLTable.FieldByName('ClassName').AsString;
end;
ProcessSelectedClass;
end;
procedure TMainDlg.About1Click(Sender: TObject);
begin
AboutBox:=TAboutBox.Create(nil);
AboutBox.ShowModal;
AboutBox.Free;
end;
procedure TMainDlg.SearchClassName1Click(Sender: TObject);
var
SearchClass:string;
SelectOK:Boolean;
begin
if FileOpenActive =true then Exit;
SelectOK:=InputQuery('SEARCH ENGINE','Enter Class Name',SearchClass);
if Not SelectOK then Exit;
if SelectOK then
begin
LocateSuccess:=ClassListTab.Locate('ClassName',SearchClass,[]);
if LocateSuccess=false then
begin
MessageDlg(SearchClass+' class not found! Check case sensitivity or verify possible TypeDef' ,mtError, [mbOk], 0);
Exit;
end;
ClassFinderSelectedItem:=SearchClass;
ProcessSelectedClass;
end;
end;
procedure TMainDlg.ViewSource1Click(Sender: TObject);
begin
CodePageForm.CodePage.Hide;
CodePageForm.Show;
CodePageForm.SourceRichEdit1.Show;
SendMessage(CodePageForm.SourceRichEdit1.Handle,EM_SETSEL,CodePageForm.SourceRichEdit1.SelStart,
CodePageForm.SourceRichEdit1.SelStart+DefinitionLength);
CodePageForm.SourceRichEdit1.SetFocus;
end;
procedure TMainDlg.LoadDefinitionSource(MemberType:string);
var
n:Integer;
k:Integer;
SearchForDefinitions:TSearchEngine;
FoundFirstBegin:Boolean;
ExtractionDone:Boolean;
CheckLine:string;
CheckLineLength:Integer;
EndPosition:Integer;
BeginPosition:Integer;
TryPosition:Integer;
SourceStringList:TStringList;
begin
SourceStringList:=TStringList.Create;
n:=1;
k:=1;
FoundFirstBegin:=false;
ExtractionDone:=false;
SearchForDefinitions:=TSearchEngine.Create;
DefinitionLength:=Length(CurrentTabClassName+'.'+CurrentSelectedMemberName);
if MemberType='constructor' then CurrentSelectedMemberName:='Create';
SearchForDefinitions.SearchForString(CurrentTabClassName+'.'+CurrentSelectedMemberName+'(',1,0,'Source');
if SearchForDefinitions.PositionFound=-1 then
begin
SearchForDefinitions.SearchForString(CurrentTabClassName+'.'+CurrentSelectedMemberName+';',1,0,'Source');
if SearchForDefinitions.PositionFound=-1 then
begin
SearchForDefinitions.SearchForString(CurrentTabClassName+'.'+CurrentSelectedMemberName+':',1,0,'Source');
if SearchForDefinitions.PositionFound=-1 then
begin
SourceEntryPage.Lines.Clear;
SourceStringList.Clear;
SourceEntryPage.Lines[0]:='No function or procedure exist!';
end;
end
end;
if SearchForDefinitions.PositionFound<>-1 then
begin
SourceEntryPage.Lines.Clear;
SourceStringList.Add(CodePageForm.SourceRichEdit1.Lines[SearchForDefinitions.LineNumberFound]);
while ExtractionDone=false do
begin
CheckLine:=CodePageForm.SourceRichEdit1.Lines[SearchForDefinitions.LineNumberFound+n];
CheckLineLength:=Length(CheckLine);
BeginPosition:=Pos('begin',CheckLine);{'begin' by itself no indent}
if (BeginPosition=1) and (BeginPosition=CheckLineLength-4) then
begin
if FoundFirstBegin<>true then
begin
k:=0;
end;
FoundFirstBegin:=true;
k:=k+1;
end;
BeginPosition:=Pos(' begin',CheckLine);{'begin' by itself no indent}
if (BeginPosition<>0) and (BeginPosition=CheckLineLength-5) then
begin
if FoundFirstBegin<>true then
begin
k:=0;
end;
FoundFirstBegin:=true;
k:=k+1;
end;
TryPosition:=Pos('try',CheckLine);{'begin' by itself no indent}
if (TryPosition=1) and ((TryPosition=CheckLineLength-4) or(TryPosition=CheckLineLength-3)) then
begin
k:=k+1;
end;
TryPosition:=Pos(' try',CheckLine);{'begin' by itself no indent}
if (TryPosition<>0) and ((TryPosition=CheckLineLength-4) or(TryPosition=CheckLineLength-3)) then
begin
k:=k+1;
end;
EndPosition:=Pos('end else',CheckLine);{'end' by itself no indent}
if (EndPosition=1) and ((EndPosition=CheckLineLength-9)or(EndPosition=CheckLineLength-8)) then
begin
k:=k-1;
end else
EndPosition:=Pos('end',CheckLine);{'end' by itself no indent}
if (EndPosition=1) and ((EndPosition=CheckLineLength-4)or(EndPosition=CheckLineLength-3)) then
begin
k:=k-1;
end;
EndPosition:=Pos(' end else',CheckLine);{' end' by itself yes indent}
if (EndPosition<>0) and ((EndPosition=CheckLineLength-9)or(EndPosition=CheckLineLength-8)) then
begin
k:=k-1;
end else
EndPosition:=Pos(' end',CheckLine);{' end' by itself yes indent}
if (EndPosition<>0) and ((EndPosition=CheckLineLength-4)or(EndPosition=CheckLineLength-3)) then
begin
k:=k-1;
end;
if ExtractionDone<>true then SourceStringList.Add(CheckLine);
if k=0 then ExtractionDone:=true;
Inc(n);
end;
SourceEntryPage.Lines.AddStrings(SourceStringList);
end;
end;
procedure TMainDlg.FormResize(Sender: TObject);
begin
DeclarationRichEdit.Height:=Trunc(ClientHeight * 0.18);
Panel4.Width:=ClientWidth div 2;
PageControl1.Height:=Trunc(ClientHeight * 0.6);
QuickClassListbox.Height:=Trunc(ClientHeight* 0.4)-30;
SourceEntryPage.Height:=(PageControl1.Height-15)-(DeclarationRichEdit.Height);
MainListBox.Height:=PageControl1.Height -40;
MainListBox.Width:=PageControl1.Width -5;
Label1.Left:=Trunc(Panel2.Width * 0.174);
Label2.Left:=Trunc(Panel2.Width * 0.300);
Label3.Left:=Trunc(Panel2.Width * 0.532);
Label4.Left:=Trunc(Panel2.Width * 0.725);
end;
procedure TMainDlg.Print1Click(Sender: TObject);
begin
PrintDialog1.Execute;
DeclarationRichEdit.Print(CurrentSelectedMemberName+' Declaration');
end;
procedure TMainDlg.PrintDefinition1Click(Sender: TObject);
begin
PrintDialog1.Execute;
SourceEntryPage.Print(CurrentSelectedMemberName+' Definition');
end;
procedure TMainDlg.HeaderSource1Click(Sender: TObject);
begin
FileOPenDlg.InitialDir:=LocalVclHeaders;
FileOPenDlg.Options := [ofHideReadOnly];
FileOPenDlg.Filter := '*.cpp,*.hpp,*.h|*.cpp;*.hpp;*.h';
if FileOPenDlg.Execute then
try
CodePageForm.CodePage.Lines.LoadFromFile(FileOPenDlg.FileName);
except on EFOpenError do
begin
MessageDlg('Header File Not Found!' ,mtError, [mbOk], 0);
Exit;
end;
end;
end;
procedure TMainDlg.ParseaNewHeader1Click(Sender: TObject);
var
PasFileSearch:TSearchEngine;
OneCharacter:string;
GotPasName:Boolean;
CharCount:Integer;
Line:string;
begin
{Initialize stuff}
FileOpenActive:=true;
DestTable.Open;
PasFileSearch:=TSearchEngine.Create;
CharCount:=0;
GotPasName:=false;
PasSourceFileName:='';
OneCharacter:='';
{Get File Name}
FileOPenDlg.InitialDir:=LocalVclHeaders;
FileOPenDlg.Options := [ofHideReadOnly];
FileOPenDlg.Filter := '*.hpp,*.h|*.hpp;*.h';
if FileOPenDlg.Execute then
begin
Screen.Cursor:=crHourglass;
CurrentHeaderFileName:=ExtractFileName(FileOPenDlg.FileName);
CodePageForm.CodePage.Clear();
try
CodePageForm.CodePage.Lines.LoadFromFile(FileOPenDlg.FileName);
except on EFOpenError do
begin
MessageDlg('Header File Not Found!' ,mtError, [mbOk], 0);
Screen.Cursor:=crDefault;
Exit;
end;
end;
{Search header for .pas filename}
CodePageForm.SourceRichEdit1.Clear();
PasFileSearch.SearchForString('.pas',1,0,'Include');
if PasFileSearch.PositionFound<>-1 then
begin
Line:=CodePageForm.CodePage.Lines[PasFileSearch.LineNumberFound];
while not GotPasName do
begin
OneCharacter:=Copy(Line,(PasFileSearch.PositionFound-PasFileSearch.LineFoundPositionOne)-CharCount,1);
if (OneCharacter=' ') or (OneCharacter='/')then GotPasName:=true;
if GotPasName=false then
begin
AppendStr(OneCharacter,PasSourceFileName);
PasSourceFileName:=OneCharacter;
Inc(CharCount);
end;
end;
AppendStr(PasSourceFileName,'.pas');
end else
begin
MessageDlg('Could not find .pas for '+CurrentHeaderFileName ,mtError, [mbOk], 0);
end;
{Empty table to hold 1 header parsing and load it up}
DestTable.Close();
DestTable.TableName:='main2.db';
DestTable.Open();
DestTable.Close();
DestTable.EmptyTable;
DestTable.Open();
{Parse and load}
ConvertCppToDestTable;
ConvertTableToTabs;
RawVCLTable.Free;
RawVCLTable := TCloneTable.CreateFromTable(DestTable, True);
RawVCLTable.Open;
DataSource1.Dataset:=RawVCLTable;
DBGrid1.Refresh;
RawVCLTable.First;
SelectaTab(Sender);
{Clean up}
Screen.Cursor:=crDefault;
MessageDlg('Success',mtConfirmation, [mbOk], 0);
end;
{Append Main2.db to VCL table}
if MessageDlg('Append to VCLTable',mtConfirmation, [mbYes, mbNo], 0)=mrYes then
begin
MessageDlg('Your about to do a batchmove!!!',mtConfirmation, [mbOk], 0);
ParseVclTable.Open;
BatchMove1.Execute;
ParseVclTable.Close;
end else Exit;
end;
procedure TMainDlg.ClosePageClick(Sender: TObject);
begin
if PageControl1.PageCount > 1 then
begin
PageControl1.ActivePage.Free;
MainListBox.Items.Clear;
PageControl1.ActivePage := PageControl1.Pages[0];
SelectATab(Sender);
end;
end;
procedure TMainDlg.CloseAllPages1Click(Sender: TObject);
begin
if PageControl1.PageCount > 0 then
with PageControl1 do
begin
ActivePage := Pages[0];
while (ActivePage <> nil) do
begin
ActivePage.Free;
SelectNextPage(TRUE);
end;
end;
MainListBox.Items.Clear;
end;
procedure TMainDlg.GetRegistryInfo;
var
MyString:string;
Status:Boolean;
begin
with TRegistry.Create do
begin
RootKey := HKEY_LOCAL_MACHINE;
Status:=OpenKey('\software\borland\C++Builder\1.0', false);
if Status then MyString := ReadString('RootDir');
LocalVclSource:=MyString+'\source\';
LocalVclHeaders:=MyString+'\include\vcl\';
LocalTablesDir:=MyString+'\examples\classbrw\';
Free;
end;
end;
procedure TMainDlg.LoadSourcePage;
begin
CodePageForm.SourceRichEdit1.Clear();
DoesFileExist:=FileExists(LocalVclSource+'vcl\' + CurrentSourceFileName);
if DoesFileExist then
CodePageForm.SourceRichEdit1.Lines.LoadFromFile(LocalVclSource+'vcl\' + CurrentSourceFileName)
else
begin
DoesFileExist:=FileExists(LocalVclSource+'toolsapi\' + CurrentSourceFileName);
if DoesFileExist then
CodePageForm.SourceRichEdit1.Lines.LoadFromFile(LocalVclSource+'toolsapi\' + CurrentSourceFileName)
else
begin
CodePageForm.SourceRichEdit1.Lines[0]:='Source Not Available for this Class!';
end;
end;
end;
procedure TMainDlg.FormActivate(Sender: TObject);
begin
if InitializedTable=true then Exit;
if VCLTable.RecordCount=0 then
begin
RebuildVCLTable(Sender);
end;
InitializedTable:=true;
end;
procedure TMainDlg.ChangeFontsClick(Sender: TObject);
var
MyFontInteger:Integer;
begin
if FontDialog1.Execute then
begin
if Sender=ChangeFonts then CodePageForm.SourceRichEdit1.Font:=FontDialog1.Font;
if Sender=HeaderPage then CodePageForm.CodePage.Font:=FontDialog1.Font;
if Sender=Declaration then DeclarationRichEdit.Font:=FontDialog1.Font;
if Sender=Definition then SourceEntryPage.Font:=FontDialog1.Font;
if Sender=QuickClassBox then QuickClassListbox.Font:=FontDialog1.Font;
if Sender=MemberList then MainListBox.Font:=FontDialog1.Font;
if Sender=Grid then
begin
DBGrid1.Columns[1].Font:=FontDialog1.Font;
DBGrid1.Columns[2].Font:=FontDialog1.Font;
DBGrid1.Columns[3].Font:=FontDialog1.Font;
DBGrid1.Columns[4].Font:=FontDialog1.Font;
end;
MyFontInteger:=FontDialog1.Font.Color;
with TRegistry.Create do
begin
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('\software\borland\VCL Class Organizer\fonts', false);
if Sender=ChangeFonts then WriteString('DefinitionPage',IntToStr(MyFontInteger));
if Sender=HeaderPage then WriteString('HeaderPage',IntToStr(MyFontInteger));
if Sender=Declaration then WriteString('Declaration',IntToStr(MyFontInteger));
if Sender=Definition then WriteString('Definition',IntToStr(MyFontInteger));
if Sender=QuickClassBox then WriteString('QuickClass',IntToStr(MyFontInteger));
if Sender=MemberList then WriteString('MemberList',IntToStr(MyFontInteger));
if Sender=Grid then WriteString('Grid',IntToStr(MyFontInteger));
Free;
end;
end;
end;
procedure TMainDlg.ChangeBkGroundClick(Sender: TObject);
begin
if ColorDialog1.Execute then
begin
if Sender=ChangeBkGround then CodePageForm.SourceRichEdit1.Color:=ColorDialog1.Color;
if Sender=HeaderPage1 then CodePageForm.CodePage.Color:=ColorDialog1.Color;
if Sender=Declaration1 then DeclarationRichEdit.Color:=ColorDialog1.Color;
if Sender=Definition1 then SourceEntryPage.Color:=ColorDialog1.Color;
if Sender=QuickClassBox1 then QuickClassListbox.Color:=ColorDialog1.Color;
if Sender=MemberList1 then MainListBox.Color:=ColorDialog1.Color;
if Sender=Grid1 then DBGrid1.Color:=ColorDialog1.Color;
{Store in background colors registry}
with TRegistry.Create do
begin
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('\software\borland\VCL Class Organizer\colors', false);
if Sender=ChangeBkGround then WriteString('DefinitionPage',IntToStr(ColorDialog1.Color));
if Sender=HeaderPage1 then WriteString('HeaderPage',IntToStr(ColorDialog1.Color));
if Sender=Declaration1 then WriteString('Declaration',IntToStr(ColorDialog1.Color));
if Sender=Definition1 then WriteString('Definition',IntToStr(ColorDialog1.Color));
if Sender=QuickClassBox1 then WriteString('QuickClass',IntToStr(ColorDialog1.Color));
if Sender=MemberList1 then WriteString('MemberList',IntToStr(ColorDialog1.Color));
if Sender=Grid1 then WriteString('Grid',IntToStr(ColorDialog1.Color));
Free;
end;
end;
end;
function TMainDlg.DetermineImageIndex(Scope:string;Member:string):Integer;
begin
if (Scope='protected') and (Member='function') then Result:=0;
if (Scope='protected') and (Member='data') then Result:=1;
if (Scope='protected') and (Member='constructor') then Result:=2;
if (Scope='protected') and (Member='property') then Result:=3;
if (Scope='__published') and (Member='function') then Result:=4;
if (Scope='__published') and (Member='data') then Result:=5;
if (Scope='__published') and (Member='constructor') then Result:=6;
if (Scope='__published') and (Member='property') then Result:=7;
if (Scope='private') and (Member='function') then Result:=8;
if (Scope='private') and (Member='data') then Result:=9;
if (Scope='private') and (Member='constructor') then Result:=10;
if (Scope='private') and (Member='property') then Result:=11;
if (Scope='public') and (Member='function') then Result:=12;
if (Scope='public') and (Member='data') then Result:=13;
if (Scope='public') and (Member='constructor') then Result:=14;
if (Scope='public') and (Member='property') then Result:=15;
end;
procedure TMainDlg.ShowNextDerivation1Click(Sender: TObject);
begin
if FileOpenActive =true then Exit;
ClassFinderSelectedItem:=RawVCLTable.FieldByName('SecondClass').AsString;
if (ClassFinderSelectedItem<> '') and (ClassFinderSelectedItem <> 'TObject')then
begin
DBGrid1.DataSource:=DataSource1;
RawVClTable.Refresh;
Screen.Cursor:=crHourGlass;
RawVCLTable.DisableControls;
RawVCLTable.Filtered:=false;
RawVCLTable.SetRange([ClassFinderSelectedItem], [ClassFinderSelectedItem]);
CurrentHeaderFileName:=RawVCLTable.FieldByName('Header').AsString;
CurrentSourceFileName:=RawVCLTable.FieldByName('Misc').AsString;
with TTabSheet.Create(Self) do
begin
Caption := ClassFinderSelectedItem;
PageControl := PageControl1;
end;
PageControl1.ActivePage:=PageControl1.Pages[PageControl1.PageCount-1];
TableToListStrings(ClassFinderSelectedItem);
CodePageForm.CodePage.Clear();
try
CodePageForm.CodePage.Lines.LoadFromFile(LocalVclHeaders+ CurrentHeaderFileName);
except on EFOpenError do
begin
MessageDlg('Header File Not Found!' ,mtError, [mbOk], 0);
Screen.Cursor:=crDefault;
Exit;
end;
end;
LoadSourcePage;
RawVCLTable.First;
RawVCLTable.EnableControls;
Screen.Cursor:=crDefault;
end else
MessageDlg('No class derivation exist or TObject class not available!' ,mtError, [mbOk], 0);
end;
procedure TMainDlg.PrintHeaderhpp1Click(Sender: TObject);
begin
PrintDialog1.Execute;
CodePageForm.CodePage.Print(CurrentHeaderFileName);
end;
procedure TMainDlg.PrintSourcepas1Click(Sender: TObject);
begin
PrintDialog1.Execute;
CodePageForm.SourceRichEdit1.Print(CurrentSourceFileName);
end;
procedure TMainDlg.Project1Click(Sender: TObject);
begin
ParseHeaders:=TParseHeaders.Create(nil);
with ParseHeaders do
begin
Position:=poScreenCenter;
HeadersToParseTab.Open;
ShowModal;
end;
end;
procedure TMainDlg.FormClose(Sender: TObject; var Action: TCloseAction);
begin
CodePageForm.Free;
Action :=caFree;
MainDlg := nil;
end;
procedure TMainDlg.ProcessSelectedClass;
begin
CurrentSelectedMemberName:='';
DefinitionLength:=0;
VCLTable.IndexName:='';
DataSource1.Dataset:=RawVCLTable;
Screen.Cursor:=crHourGlass;
RawVCLTable.DisableControls();
RawVCLTable.Filtered:=false;
RawVCLTable.SetRange([ClassFinderSelectedItem], [ClassFinderSelectedItem]);
RawVCLTable.First;
CurrentHeaderFileName:=RawVCLTable.FieldByName('Header').AsString;
CurrentSourceFileName:=RawVCLTable.FieldByName('Misc').AsString;
with TTabSheet.Create(Self) do
begin
Caption := ClassFinderSelectedItem;
PageControl := PageControl1;
end;
PageControl1.ActivePage:=PageControl1.Pages[PageControl1.PageCount-1];
TableToListStrings(ClassFinderSelectedItem);
RawVCLTable.First;
CodePageForm.SourceRichEdit1.Clear();
LoadSourcePage;
try
CodePageForm.CodePage.Lines.LoadFromFile(LocalVclHeaders + CurrentHeaderFileName);
except on EFOpenError do
begin
MessageDlg('Header File Not Found!' ,mtError, [mbOk], 0);
Screen.Cursor:=crDefault;
Exit;
end;
end;
RawVCLTable.EnableControls();
Screen.Cursor:=crDefault;
end;
procedure TMainDlg.Exit1Click(Sender: TObject);
begin
Application.Terminate;
end;
procedure TMainDlg.WriteRegistryKeys;
begin
with TRegistry.Create do
begin
{Check for registry keys and create if no exist}
RootKey := HKEY_LOCAL_MACHINE;
if not KeyExists('\software\borland\VCL Class Organizer\colors') then
begin
OpenKey('\software\borland\VCL Class Organizer\colors',True);
WriteString('Declaration','16777215');
WriteString('Definition','16777215');
WriteString('DefinitionPage','16777215');
WriteString('Grid','16777215');
WriteString('HeaderPage','16777215');
WriteString('MemberList','16777215');
WriteString('QuickClass','16777215');
CloseKey;
end;
if not KeyExists('\software\borland\VCL Class Organizer\fonts') then
begin
OpenKey('\software\borland\VCL Class Organizer\fonts',True);
WriteString('Declaration','0');
WriteString('Definition','0');
WriteString('DefinitionPage','0');
WriteString('Grid','0');
WriteString('HeaderPage','0');
WriteString('MemberList','0');
WriteString('QuickClass','0');
CloseKey;
end;
Free;
end;
end;
procedure TMainDlg.MainListBoxKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
MainListBoxClick(Sender);
end;
end.