📄 mainform.pas
字号:
begin
propname := jsgFiles.Rows[0][j];
StrReplace(propname, ' ', '', [rfReplaceAll]);
fileNode.Properties.Add(propname, row[j]);
end;
end;
end;
// save into file
xml.SaveToFile(fileName);
finally
xml.Free;
end;
// reload package list
i := jlbList.ItemIndex;
LoadPackagesList;
jlbList.ItemIndex := i;
LoadPackage;
end;
procedure TfrmMain.actPrevPackageUpdate(Sender: TObject);
begin
actPrevPackage.Enabled := jlbList.ItemIndex > 0;
end;
procedure TfrmMain.actNextPackageUpdate(Sender: TObject);
begin
actNextPackage.Enabled := (jlbList.ItemIndex > -1) and
(jlbList.ItemIndex < jlbList.Items.Count-1);
end;
procedure TfrmMain.LoadPackage;
var
xml : TJvSimpleXml;
i : Integer;
j : Integer;
xmlFileName : string;
propname : string;
row : TStrings;
rootNode : TJvSimpleXmlElemClassic;
requiredNode : TJvSimpleXmlElem;
packageNode : TJvSimpleXmlElem;
filesNode : TJvSimpleXmlElem;
fileNode : TJvSimpleXmlElem;
savedChanged : Boolean;
begin
savedChanged := Changed;
ClearAll;
Changed := savedChanged;
if jlbList.ItemIndex < 0 then
Exit;
if PathIsAbsolute(PackagesLocation) then
xmlFileName := PackagesLocation
else
xmlFileName := PathNoInsideRelative(StrEnsureSuffix(PathSeparator, StartupDir) + PackagesLocation);
xmlFileName := xmlFileName + PathSeparator+'xml'+PathSeparator;
if rbtDesign.Checked then
xmlFileName := xmlFileName + jlbList.Items[jlbList.ItemIndex] + '.xml'
else
xmlFileName := xmlFileName + jlbList.Items[jlbList.ItemIndex] + '.xml';
xml := TJvSimpleXml.Create(nil);
try
with xml do
begin
Options := [sxoAutoCreate];
LoadFromFile(xmlFileName);
// read root node
rootNode := xml.Root;
ledName.Text := rootNode.Properties.ItemNamed['Name'].Value;
rbtDesign.Checked := rootNode.Properties.ItemNamed['Design'].BoolValue;
rbtRuntime.Checked := not rbtDesign.Checked;
// read description, PFLAGS, GUID, and libs
ledDescription.Text := rootNode.Items.ItemNamed['Description'].Value;
ledC5PFlags.Text := rootNode.Items.ItemNamed['C5PFlags'].Value;
ledC6PFlags.Text := rootNode.Items.ItemNamed['C6PFlags'].Value;
if Assigned(rootNode.Items.ItemNamed['GUID']) then
edtGUID.Text := rootNode.Items.ItemNamed['GUID'].Value;
frmAdvancedBCB.edtBCB5.Text := rootNode.Items.ItemNamed['C5Libs'].Value;
frmAdvancedBCB.edtBCB6.Text := rootNode.Items.ItemNamed['C6Libs'].Value;
if Assigned(rootNode.Items.ItemNamed['ClxDescription']) then
FClxDescription := rootNode.Items.ItemNamed['ClxDescription'].Value;
// read required packages
requiredNode := rootNode.Items.ItemNamed['Requires'];
jsgDependencies.RowCount := requiredNode.Items.Count + 2;
jsgDependencies.Rows[jsgDependencies.RowCount-1].Text := '';
jsgDependencies.FixedRows := 1;
for i := 0 to requiredNode.Items.Count - 1 do
begin
row := jsgDependencies.Rows[i+1];
packageNode := requiredNode.Items[i];
for j := 0 to row.Count - 1 do
begin
row[j] := packageNode.Properties.ItemNamed[jsgDependencies.Rows[0][j]].Value;
end;
end;
// read files
filesNode := rootNode.Items.ItemNamed['Contains'];
jsgFiles.RowCount := filesNode.Items.Count + 2;
jsgFiles.FixedRows := 1;
jsgFiles.Rows[jsgFiles.RowCount-1].Text := '';
for i := 0 to filesNode.Items.Count - 1 do
begin
row := jsgFiles.Rows[i+1];
fileNode := filesNode.Items[i];
for j := 0 to row.Count - 1 do
begin
propname := jsgFiles.Rows[0][j];
StrReplace(propname, ' ', '', [rfReplaceAll]);
row[j] := fileNode.Properties.ItemNamed[propname].Value;
end;
end;
end;
Changed := False;
finally
xml.Free;
end;
end;
procedure TfrmMain.jlbListClick(Sender: TObject);
begin
LoadPackage;
end;
procedure TfrmMain.actGenerateExecute(Sender: TObject);
var
path : string;
targets : TStringList;
i : Integer;
ErrMsg : string;
begin
if IsOkToChange then
begin
if PathIsAbsolute(PackagesLocation) then
path := PackagesLocation
else
path := PathNoInsideRelative(StrEnsureSuffix(PathSeparator, StartupDir) + PackagesLocation);
frmTargets.Path := path;
if frmTargets.ShowModal = mrOk then
begin
targets := TStringList.Create;
try
for i := 0 to frmTargets.clbBuilds.Items.Count - 1 do
begin
with frmTargets.clbBuilds do
begin
if Checked[i] then
targets.Add(Items[i]);
end;
end;
frmGenMessages.Show;
Generate(jlbList.Items, targets, AddMessage, jaxStore.FileName, cmbModel.Items[cmbModel.ItemIndex], ErrMsg);
finally
targets.Free;
end;
end;
end;
end;
procedure TfrmMain.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Shift = [ssCtrl] then
begin
case Key of
VK_UP:
begin
if actPrevPackage.Enabled then
actPrevPackage.Execute;
Key := 0;
end;
VK_DOWN:
begin
if actNextPackage.Enabled then
actNextPackage.Execute;
Key := 0;
end;
end;
end;
end;
procedure TfrmMain.actPrevPackageExecute(Sender: TObject);
begin
if IsOkToChange then
begin
jlbList.ItemIndex := jlbList.ItemIndex - 1;
LoadPackage;
end;
end;
procedure TfrmMain.actNextPackageExecute(Sender: TObject);
begin
if IsOkToChange then
begin
jlbList.ItemIndex := jlbList.ItemIndex + 1;
LoadPackage;
end;
end;
procedure TfrmMain.actMainToolbarUpdate(Sender: TObject);
begin
actMainToolbar.Checked := jtbTools.Visible;
end;
procedure TfrmMain.actMainToolbarExecute(Sender: TObject);
begin
jtbTools.Visible := actMainToolbar.Checked;
end;
procedure TfrmMain.actKnownExecute(Sender: TObject);
begin
frmKnownTags.ShowModal;
end;
function TfrmMain.IsOkToChange: Boolean;
begin
if Changed then
begin
Result := True;
case Application.MessageBox(
'The values for this package have changed.'#13#10 +
'Do you want to save before the next action ?',
'Package has changed',
MB_ICONQUESTION or MB_YESNOCANCEL) of
MRYES:
actSave.Execute;
MRCANCEL:
Result := False;
end;
end
else
Result := True;
end;
procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := IsOkToChange;
end;
procedure TfrmMain.jlbListMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
IsOkToChange;
end;
procedure TfrmMain.sptDepAndFilesMoved(Sender: TObject);
begin
lblDependencies.Top := pnlDepAndFiles.Top +
(jsgDependencies.Height - lblDependencies.Height) div 2;
lblFiles.Top := pnlDepAndFiles.Top +
pnlDepAndFiles.Height - jsgFiles.Height +
(jsgFiles.Height - lblFiles.Height) div 2;
end;
procedure TfrmMain.mnuAboutClick(Sender: TObject);
begin
ShowMessage(
'Jedi Package Generator'#13#10+
#13#10+
'(c) 2003 Olivier Sannier for the Jedi group');
end;
procedure TfrmMain.jsgFilesGetEditText(Sender: TObject; ACol,
ARow: Integer; var Value: String);
begin
if Sender = jsgDependencies then
begin
FOrgValueDep := Value;
FValidOrgDep := True;
end
else
if Sender = jsgFiles then
begin
FOrgValueFiles := Value;
FValidOrgFiles := True;
end;
end;
procedure TfrmMain.btnAdvancedBCBClick(Sender: TObject);
begin
frmAdvancedBCB.ShowModal;
end;
procedure TfrmMain.FormShow(Sender: TObject);
var
ErrMsg : string;
begin
if not Application.Terminated then
begin
// force the models to be loaded in appropriate form and
// load the names in the combo box
frmModels.LoadModels(jaxStore.FileName, ConfigLoadedOk);
cmbModel.Items.Assign(frmModels.cmbModels.Items);
jfsStore.RestoreFormPlacement;
if cmbModel.ItemIndex >-1 then
ConfigLoadedOk := LoadConfig(jaxStore.FileName, cmbModel.Items[cmbModel.ItemIndex], ErrMsg)
else
ConfigLoadedOk := LoadConfig(jaxStore.FileName, '', ErrMsg);
if not ConfigLoadedOk then
begin
Application.MessageBox(PChar('Error loading configuration:'#13#10+
#13#10+
ErrMsg),
'Error loading configuration',
MB_ICONERROR);
Application.Terminate;
Exit;
end;
// Load the list of packages
LoadPackagesList;
end;
end;
procedure TfrmMain.MoveLine(sg : TStringGrid; direction : Integer);
var
tmpRow : TStrings;
RowIndex : Integer;
begin
RowIndex := sg.Row;
if not ((RowIndex + direction = 0) or
(RowIndex + direction = sg.RowCount - 1)) then
begin
tmpRow := TStringList.Create;
try
tmpRow.Assign(sg.Rows[RowIndex]);
sg.Rows[RowIndex] := sg.Rows[RowIndex + direction];
sg.Rows[RowIndex + direction] := tmpRow;
Changed := True;
sg.Row := RowIndex + direction;
finally
tmpRow.Free;
end;
end;
end;
procedure TfrmMain.actUpExecute(Sender: TObject);
begin
if ActiveControl is TInPlaceEdit then
begin
MoveLine((ActiveControl as TInPlaceEdit).Parent as TStringGrid, -1);
end;
end;
procedure TfrmMain.actDownExecute(Sender: TObject);
begin
if ActiveControl is TInPlaceEdit then
begin
MoveLine((ActiveControl as TInPlaceEdit).Parent as TStringGrid, +1);
end;
end;
procedure TfrmMain.actUpUpdate(Sender: TObject);
var
curRow : Integer;
sg : TStringGrid;
begin
if ActiveControl is TInPlaceEdit then
begin
sg := ((ActiveControl as TInPlaceEdit).Parent as TStringGrid);
curRow := sg.Row ;
actUp.Enabled := (curRow > 1) and (curRow < sg.RowCount-1);
end;
end;
procedure TfrmMain.actDownUpdate(Sender: TObject);
var
sg : TStringGrid;
begin
if ActiveControl is TInPlaceEdit then
begin
sg := ((ActiveControl as TInPlaceEdit).Parent as TStringGrid);
actDown.Enabled := sg.Row < sg.RowCount-2;
end;
end;
procedure TfrmMain.jdePackagesLocationChange(Sender: TObject);
begin
LoadPackagesList;
end;
procedure TfrmMain.ClearAll;
begin
// empty everything
ledName.Text := '';
ledDescription.Text := '';
rbtDesign.Checked := False;
rbtRuntime.Checked := True;
edtGUID.Text := '';
ledC5PFlags.Text := '';
ledC6PFlags.Text := '';
jsgDependencies.Rows[1].Text := '';
jsgDependencies.RowCount := 2;
jsgFiles.Rows[1].Text := '';
jsgFiles.RowCount := 2;
end;
procedure TfrmMain.jlbListKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
case Key of
VK_DELETE:
actDelete.Execute;
end;
end;
procedure TfrmMain.actDeleteExecute(Sender: TObject);
var
path : string;
begin
if (jlbList.ItemIndex > -1) and
(Application.MessageBox(PChar(
'You are about to delete '+jlbList.Items[jlbList.ItemIndex]+#13#10+
'Are you sure you want to do that ?'),
'Deleting a package',
MB_ICONQUESTION or MB_YESNO) = MRYES) then
begin
if PathIsAbsolute(PackagesLocation) then
path := PackagesLocation
else
path := PathNoInsideRelative(StrEnsureSuffix(PathSeparator, StartupDir)+PackagesLocation);
path := StrEnsureSuffix(PathSeparator, path) + 'xml'+PathSeparator + jlbList.Items[jlbList.ItemIndex]+'.xml';
if not DeleteFile(path) then
Application.MessageBox(PChar('Unable to delete ' + path),
'Error',
MB_ICONERROR);
LoadPackagesList;
end;
end;
procedure TfrmMain.actOptionsExecute(Sender: TObject);
begin
pnlOptions.Visible := not pnlOptions.Visible;
end;
procedure TfrmMain.actOptionsUpdate(Sender: TObject);
begin
actOptions.Checked := pnlOptions.Visible;
end;
procedure TfrmMain.btnEditModelClick(Sender: TObject);
begin
frmModels.EditIndex := cmbModel.ItemIndex;
if frmModels.ShowModal = mrOk then
begin
cmbModel.ItemIndex := frmModels.cmbModels.ItemIndex;
LoadPackagesList;
jaxStore.Reload;
end;
end;
procedure TfrmMain.cmbModelClick(Sender: TObject);
var
ErrMsg : string;
begin
if not LoadConfig(jaxStore.FileName, cmbModel.Items[cmbModel.ItemIndex], ErrMsg) then
Application.MessageBox(PChar(ErrMsg), 'Error loading configuration', MB_ICONERROR)
else
LoadPackagesList;
end;
procedure TfrmMain.btnCLXDescriptionClick(Sender: TObject);
begin
if (FClxDescription = '') and (cmbModel.Items[cmbModel.ItemIndex] = 'JVCL') then
begin
FClxDescription := ledDescription.Text;
StrReplace(FClxDescription, 'JVCL ', 'JVCLX ', [rfReplaceAll]);
end;
if InputQuery('CLX Description',
'Please indicate the CLX Description',
FClxDescription) then
Changed := True;
end;
procedure TfrmMain.btnGenerateGUIDClick(Sender: TObject);
var
GeneratedGUID : TGUID;
begin
// Generate a GUID for the package
CreateGUID(GeneratedGUID);
edtGUID.Text := GUIDToString(GeneratedGUID);
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -