⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mainform.pas

📁 East make Tray Icon in delphi
💻 PAS
📖 第 1 页 / 共 2 页
字号:
        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 + -