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

📄 unit1.pas

📁 一款基于DELPHI环境的MVC框架
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit Unit1;

interface

uses
  Windows, SysUtils, Classes, Controls, forms, Dialogs, ShellAPI, Grids,
  LibXmlParser, LibXmlComps, StdCtrls, ComCtrls, ExtCtrls, RichEditBrowser,
  OleCtrls, EmbeddedWB, Buttons, SHDocVw_EWB;

type
  Tform1 = class(Tform)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Label2: TLabel;
    XmlScanner1: TXmlScanner;
    TreeView: TTreeView;
    TabSheet3: TTabSheet;
    RichEditWB1: TRichEditWB;
    Panel1: TPanel;
    memInfo: TMemo;
    Panel2: TPanel;
    GroupBox1: TGroupBox;
    Panel3: TPanel;
    Panel4: TPanel;
    stgrInst: TStringGrid;
    Panel5: TPanel;
    Panel6: TPanel;
    GroupBox2: TGroupBox;
    cbOverWrite: TCheckBox;
    Panel7: TPanel;
    Button1: TButton;
    Button2: TButton;
    TabSheet4: TTabSheet;
    EmbeddedWB1: TEmbeddedWB;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn1: TBitBtn;
    BitBtn4: TBitBtn;
    gbFile: TGroupBox;
    BitBtn5: TBitBtn;
    BitBtn6: TBitBtn;
    BitBtn7: TBitBtn;
    edtPath: TEdit;
    cbNumerator: TCheckBox;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    edtName: TEdit;
    edtVersion: TEdit;
    edtAuthor: TEdit;
    edtCompany: TEdit;
    Label1: TLabel;
    Label3: TLabel;
    Author: TLabel;
    Label4: TLabel;
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure XmlScanner1XmlProlog(Sender: TObject; XmlVersion,
      Encoding: string; Standalone: Boolean);
    procedure XmlScanner1StartTag(Sender: TObject; TagName: string;
      Attributes: TAttrList);
    procedure XmlScanner1PI(Sender: TObject; Target, Content: string;
      Attributes: TAttrList);
    procedure XmlScanner1EndTag(Sender: TObject; TagName: string);
    procedure XmlScanner1EmptyTag(Sender: TObject; TagName: string;
      Attributes: TAttrList);
    procedure XmlScanner1DtdRead(Sender: TObject; RootElementName: string);
    procedure XmlScanner1Content(Sender: TObject; Content: string);
    procedure XmlScanner1Comment(Sender: TObject; Comment: string);
    procedure XmlScanner1CData(Sender: TObject; Content: string);
    procedure btnLoadClick(Sender: TObject);
    procedure btnExploreClick(Sender: TObject);
    procedure stgrInstKeyPress(Sender: TObject; var Key: Char);
    procedure btnOpenIEClick(Sender: TObject);
    procedure btnOpenNotepadClick(Sender: TObject);
    procedure ledtVersionKeyPress(Sender: TObject; var Key: Char);
    procedure ledtCompanyKeyPress(Sender: TObject; var Key: Char);
    procedure ledtAuthorKeyPress(Sender: TObject; var Key: Char);
    procedure ledtNameKeyPress(Sender: TObject; var Key: Char);
    procedure btnLoadDemoClick(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btnCreateXMLClick(Sender: TObject);
  private
     CurNode : TTreeNode;
     fXmlParser : TXmlParser;
     procedure HideControls();
     procedure UpdateControls(Name: string);
     procedure UpdateComponents();
     procedure ParseInit(XmlFile: string);
     procedure SetAttr(AttrName: string; var st: string);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  form1: Tform1;

implementation

{$R *.dfm}

procedure Tform1.UpdateComponents();
begin
  TreeView.Items.BeginUpdate;
  TreeView.Items.Clear;
  CurNode := nil;
  XmlScanner1.Filename := edtPath.Text;
  XmlScanner1.Execute;
  TreeView.Items.EndUpdate;
  RichEditWB1.LoadFromFile(edtPath.Text);
  RichEditWB1.DoHighlightXML;
 // EmbeddedWB1.Navigate(edtPath.Text);
end;

procedure Tform1.UpdateControls(Name: string);
var
 i: integer;
begin
  edtPath.Text := Name;
  gbFile.Visible:= true;
  Caption := 'Updates XML creator : '+ Name;
  for i :=1 to PageControl1.PageCount -1 do
  PageControl1.Pages[i].TabVisible := true;
end;

procedure Tform1.HideControls();
var
 i: integer;
begin
   gbFile.Visible := false;
   RichEditWB1.Clear;
   TreeView.Items.Clear;
   Caption := 'XML creator : by bsalsa';
   EmbeddedWB1.Navigate('About:Blank');
   for i :=1 to PageControl1.PageCount -1 do
   PageControl1.Pages[i].TabVisible := false;
end;

procedure Tform1.FormShow(Sender: TObject);
var
i : integer;
begin
   Caption := 'Updates XML creator : by bsalsa';
   stgrInst.Cols[0].Text := '#';
   for i := 1 to stgrInst.RowCount -1 do
   begin
     stgrInst.Cells[0, i] := IntToStr(i);
   end;
   stgrInst.Cols[1].Text := 'File Name';
   stgrInst.Cols[2].Text := 'Destination folder (Include SubFolders if needed)';
   stgrInst.Cols[3].Text := 'Terminate (yes/no)';
   memInfo.Lines.Text := 'The Change Log: ';
   PageControl1.ActivePageIndex :=0;
   HideControls();
end;

procedure Tform1.btnClearClick(Sender: TObject);
var
  i, j : integer;
begin
   for i:=1 to stgrInst.RowCount -1 do
     for j:= 1 to stgrInst.ColCount -1 do
      stgrInst.Cells[j, i] := '';
   memInfo.Lines.Clear;
   edtName.Text := '';
   edtVersion.Text := '';
   edtCompany.Text := '';
   edtAuthor.Text := '';
   TreeView.Items.Clear;
   HideControls();
end;

procedure Tform1.btnLoadDemoClick(Sender: TObject);
begin
  edtName.Text := 'project1';
  edtVersion.Text := '1.132';
  edtCompany.Text := 'bsalsa Productions';
  edtAuthor.Text := 'bsalsa';
  memInfo.Lines.Add('*Added new demo for the updater.');
  memInfo.Lines.Add('*Added an option to create XML files.');
  memInfo.Lines.Add('*Cleaned up the code.');
  memInfo.Lines.Add('*Faster update proceures.');
  memInfo.Lines.Add('*Option to add personal details.');
  memInfo.Lines.Add('*Option to match details (application and remote file).');
  memInfo.Lines.Add('and so on...');
  stgrInst.Cells[1, 1] := 'Test.txt';
  stgrInst.Cells[2, 1] := 'ApplicationFolder';
  stgrInst.Cells[3, 1] := 'no';
  stgrInst.Cells[1, 2] := 'Credits.txt';
  stgrInst.Cells[2, 2] := 'Updater_Test';
  stgrInst.Cells[3, 2] := 'no';
  stgrInst.Cells[1, 3] := 'ReadMe.txt';
  stgrInst.Cells[2, 3] := 'Updater_Test';
  stgrInst.Cells[3, 3] := 'yes';
  stgrInst.Cells[1, 4] := 'Project1.exe';
  stgrInst.Cells[2, 4] := 'ApplicationFolder';
  stgrInst.Cells[3, 4] := 'yes';
end;

procedure Tform1.ledtNameKeyPress(Sender: TObject; var Key: Char);
begin
  if (key = #13) or (key = #09) then EdtVersion.SetFocus;
end;

procedure Tform1.ledtVersionKeyPress(Sender: TObject; var Key: Char);
begin
   if (key = #13) or (key = #09) then EdtAuthor.SetFocus;
end;

procedure Tform1.ledtAuthorKeyPress(Sender: TObject; var Key: Char);
begin
   if (key = #13) or (key = #09) then EdtCompany.SetFocus;
end;

procedure Tform1.ledtCompanyKeyPress(Sender: TObject; var Key: Char);
begin
   if (key = #13) or (key = #09) then memInfo.SetFocus;
end;

procedure Tform1.btnOpenNotepadClick(Sender: TObject);
begin
   if edtPath.Text <> '' then
   ShellExecute(Handle,'open','notepad.exe',Pchar(edtPath.Text), nil, SW_SHOWNORMAL)
   else
     MessageDlg('What file exactly you want to open?' ,
                 mtError, [mbCancel], 0);
end;

procedure Tform1.btnOpenIEClick(Sender: TObject);
begin
   if edtPath.Text <> '' then
   ShellExecute(Handle,'open','Explorer',Pchar(edtPath.Text), nil, SW_SHOWNORMAL)
   else
     MessageDlg('What file exactly you want to open?' ,mtError, [mbCancel], 0);
end;

procedure Tform1.btnExploreClick(Sender: TObject);
begin
  if edtPath.Text <> '' then
   ShellExecute(Application.Handle, PChar('explore'),
                Pchar(ExtractFilePath(edtPath.Text)), nil,nil, SW_SHOWNORMAL)
   else
     MessageDlg('What file exactly you want to open?',
                 mtError, [mbCancel], 0); 
end;           ///ExtractFilePath

procedure Tform1.stgrInstKeyPress(Sender: TObject; var Key: Char);
begin
     if (key = #13) or (key = #09) then
     if stgrInst.Col < stgrInst.ColCount -1 then
       with stgrInst do
          begin
            if col < 3 then
             begin
               Col := Col + 1;
               SetFocus;
             end
         end
  else
     with stgrInst do
            begin
               Row := Row + 1;
               Col :=  1;
               SetFocus;
             end;
    if stgrInst.Row = stgrInst.RowCount -1 then
      MessageDlg('You have reached the limit of 50 lines (You can change it '+
                  'to what ever, if you need more).' ,mtError, [mbCancel], 0);
end;

procedure Tform1.btnLoadClick(Sender: TObject);
var
  Container : string;
  od : TOpenDialog;
  i : integer;
  Node      : TNvpNode;
function GetXmlHead(): boolean;
begin
  Result:=false;
  while fXmlParser.Scan() do
    begin
      if fXmlParser.CurPartType = ptXmlProlog then
      begin
        Result:= true;
        exit;
      end;
    end;
end;

function GetXmlTag(const TagName:string): boolean;
begin
  Result:=false;
  while fXmlParser.Scan() do
    begin
      if ((fXmlParser.CurPartType = ptStartTag)
      or  (fXmlParser.CurPartType = ptEmptyTag))

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -