main.pas

来自「最新版 JCL+JVCL控件！非常不错的控件资源。包含了所能用到的大部分功能！」· PAS 代码 · 共 262 行

unit Main;

{$I jvcl.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ImgList, ActnList, PDPackageLoader, JvSimpleXml;

type
  TFormMain = class(TForm)
    ImageListComponents: TImageList;
    OpenDialogPackages: TOpenDialog;
    TreeViewComponents: TTreeView;
    BtnAdd: TButton;
    Button2: TButton;
    ActionList1: TActionList;
    ActionAddPackage: TAction;
    ActionRemovePackage: TAction;
    ProgressBar: TProgressBar;
    LblComponentCount: TLabel;
    LblActionCount: TLabel;
    LblUnitCount: TLabel;
    BtnExport: TButton;
    SaveDialogExport: TSaveDialog;
    LblPackage: TLabel;
    procedure ActionAddPackageExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ActionRemovePackageUpdate(Sender: TObject);
    procedure ActionRemovePackageExecute(Sender: TObject);
    procedure BtnExportClick(Sender: TObject);
  private
    { Private-Deklarationen }
    procedure UpdateTreeView;
    procedure SaveToXml(xml: TJvSimpleXMLElem);
    procedure SavePackagesToXml(xml: TJvSimpleXMLElem);
  public
    { Public-Deklarationen }
  end;

var
  FormMain: TFormMain;

implementation

{$R *.dfm}

{$IFDEF COMPILER5}
function GetEnvironmentVariable(const Variable: string): string;
begin
  SetLength(Result, 4096 - 16);
  SetLength(Result, Windows.GetEnvironmentVariable(PChar(Variable), PChar(Result), Length(Result)));
end;
{$ENDIF COMPILER5}

procedure TFormMain.SaveToXml(xml: TJvSimpleXMLElem);
begin
  SavePackagesToXml(xml.Items.Add('Packages'));
end;

procedure TFormMain.SavePackagesToXml(xml: TJvSimpleXMLElem);

  procedure SavePackage(xml: TJvSimpleXMLElem; Package: IPackage);
  var
    i: Integer;
    xmlReqs: TJvSimpleXMLElem;
    xmlUnits: TJvSimpleXMLElem;
    xmlComps: TJvSimpleXMLElem;
    xmlActs: TJvSimpleXMLElem;
  begin
    xml.Properties.Add('Name', Package.Name);
    xml.Properties.Add('Description', Package.Description);
    xml.Properties.Add('DcpBpiName', Package.DcpBpiName);
    xml.Properties.Add('Flags', IntToHex(Package.Flags, 8));

    if Package.RequireCount > 0 then
    begin
      xmlReqs := xml.Items.Add('Requires');
      for i := 0 to Package.RequireCount - 1 do
      begin
        with xmlReqs.Items.Add('Require') do
          Properties.Add('Name', Package.Requires[i]);
      end;
    end;

    if Package.UnitCount > 0 then
    begin
      xmlUnits := xml.Items.Add('Units');
      for i := 0 to Package.UnitCount - 1 do
      begin
        with xmlUnits.Items.Add('Unit') do
        begin
          Properties.Add('Name', Package.Units[i].Name);
          Properties.Add('Flags', IntToHex(Package.Units[i].Flags, 8));
        end;
      end;
    end;

    if Package.ComponentCount > 0 then
    begin
      xmlComps := xml.Items.Add('Components');
      for i := 0 to Package.ComponentCount - 1 do
      begin
        if Package.Components[i].ComponentClass.ClassName = 'TJvPageManager' then
          Write;
        with xmlComps.Items.Add('Component') do
        begin
          Properties.Add('Palette', Package.Components[i].Palette);
          Properties.Add('ClassName', Package.Components[i].ComponentClass.ClassName);
          Properties.Add('ImageIndex', Package.Components[i].ImageIndex);
          Properties.Add('UnitName', Package.Components[i].UnitName);
        end;
      end;
    end;

    if Package.ActionCount > 0 then
    begin
      xmlActs := xml.Items.Add('Actions');
      for i := 0 to Package.ActionCount - 1 do
      begin
        with xmlActs.Items.Add('Action') do
        begin
          Properties.Add('Category', Package.Actions[i].Category);
          Properties.Add('ClassName', Package.Actions[i].ActionClass.ClassName);
          if Package.Actions[i].Resource <> nil then
            Properties.Add('Resource', Package.Actions[i].Resource.ClassName);
          Properties.Add('UnitName', Package.Actions[i].UnitName);
        end;
      end;
    end;

  end;

var
  i: Integer;
begin
  for i := 0 to PackageLoader.PackageCount - 1 do
    SavePackage(xml.Items.Add('Package'), PackageLoader.Packages[i]);
end;

procedure TFormMain.UpdateTreeView;
var
  Item: IComponentItem;
  Pkg: IPackage;
  ParentNode, Node: TTreeNode;
  i, k: Integer;
begin
  TreeViewComponents.Items.BeginUpdate;
  try
    TreeViewComponents.Items.Clear;
    for i := 0 to PackageLoader.PackageCount - 1 do
    begin
      Pkg := PackageLoader.Packages[i];
      ParentNode := TreeViewComponents.Items.Add(nil, Pkg.Name);
      ParentNode.ImageIndex := -1;
      ParentNode.SelectedIndex := ParentNode.ImageIndex;
      for k := 0 to Pkg.ComponentCount - 1 do
      begin
        Item := Pkg.Components[k];
        if Item.Palette = sNoIconPalette then
          Continue;
        Node := TreeViewComponents.Items.AddChild(ParentNode, Item.ComponentClass.ClassName);
        Node.ImageIndex := Item.ImageIndex;
        Node.SelectedIndex := Node.ImageIndex;
      end;
    end;
  finally
    TreeViewComponents.Items.EndUpdate;
  end;
end;

procedure TFormMain.ActionAddPackageExecute(Sender: TObject);
var
  i: Integer;
begin
  if OpenDialogPackages.Execute then
  begin
    ProgressBar.Position := 0;
    ProgressBar.Max := OpenDialogPackages.Files.Count;
    for i := 0 to OpenDialogPackages.Files.Count - 1 do
    begin
      if PackageLoader.IndexOf(ChangeFileExt(ExtractFileName(OpenDialogPackages.Files[i]), '')) = -1 then
      begin
        LblPackage.Caption := ChangeFileExt(ExtractFileName(OpenDialogPackages.Files[i]), '');
        try
          PackageLoader.AddPackage(OpenDialogPackages.Files[i]);
        except
          Application.HandleException(Self);
        end;
        ProgressBar.StepBy(1);
        LblComponentCount.Caption := 'Components: ' + IntToStr(PackageLoader.ComponentCount);
        LblActionCount.Caption := 'Actions: ' + IntToStr(PackageLoader.ActionCount);
        LblUnitCount.Caption := 'Units: ' + IntToStr(PackageLoader.UnitCount);
        Application.ProcessMessages;
      end;
    end;

    UpdateTreeView;
  end;
end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  SetEnvironmentVariable('PATH', 
    {$IFDEF DELPHI5}
    PChar('C:\Borland\Delphi5\Bin;' + 
    {$ENDIF DELPHI5}
    {$IFDEF DELPHI6}
    PChar('C:\Borland\Delphi6\Bin;' + 
    {$ENDIF DELPHI6}
    {$IFDEF DELPHI7}
    PChar('C:\Borland\Delphi7\Bin;' + 
    {$ENDIF DELPHI7}
    {$IFDEF DELPHI9}
    PChar('C:\Borland\BDS\3.0\Bin;' + 
    {$ENDIF DELPHI9}
    GetEnvironmentVariable('PATH')));
  PackageLoader := TPackageLoader.Create(Self);
  PackageLoader.ImageList := ImageListComponents;
end;

procedure TFormMain.ActionRemovePackageUpdate(Sender: TObject);
begin
  ActionRemovePackage.Enabled := (TreeViewComponents.Selected <> nil) and
    (TreeViewComponents.Selected.Level = 0);
end;

procedure TFormMain.ActionRemovePackageExecute(Sender: TObject);
begin
  PackageLoader.RemovePackage(TreeViewComponents.Selected.Index);
  TreeViewComponents.Selected.Delete;
end;

procedure TFormMain.BtnExportClick(Sender: TObject);
var
  Doc: TJvSimpleXML;
  Bmp: TBitmap;
begin
  if SaveDialogExport.Execute then
  begin
    Doc := TJvSimpleXML.Create(nil);
    try
      SaveToXml(Doc.Root);
      Doc.SaveToFile(SaveDialogExport.FileName);

      Bmp := TBitmap.Create;
      try
        Bmp.Handle := ImageListComponents.GetImageBitmap;
        Bmp.SaveToFile(ChangeFileExt(SaveDialogExport.FileName, '.bmp'));
        Bmp.Handle := 0;
      finally
        Bmp.Free;
      end;
    finally
      Doc.Free;
    end;
  end;
end;

end.