mainfrm.pas

vVC显示图片 VC显示图片 VC显示图片 VC显示图片 VC显示图片

unit MainFrm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics,
  Controls, Forms, Dialogs, ExtCtrls, 
  StdCtrls, IniFiles, CalcDelphi, CalcBcb, CalcVb,
  Grids, ComCtrls, ImgList, ShellApi, Registry, WizardCtrl;

type
  TMainForm = class(TForm)
    Panel1: TPanel;
    Image1: TImage;
    Notebook1: TNotebook;
    NotShowFirstCheckBox: TCheckBox;
    Bevel1: TBevel;
    Label1: TLabel;
    LanguageListBox: TListBox;
    Bevel2: TBevel;
    Label2: TLabel;
    PrjEdit: TEdit;
    PrjBrowseButton: TButton;
    Label3: TLabel;
    Label4: TLabel;
    Bevel3: TBevel;
    Label5: TLabel;
    Label6: TLabel;
    FilesListBox: TListBox;
    Label7: TLabel;
    AddFileButton: TButton;
    RemoveFileButton: TButton;
    Label10: TLabel;
    Label11: TLabel;
    OpenPrjDialog: TOpenDialog;
    OpenFilesDialog: TOpenDialog;
    Bevel5: TBevel;
    Label13: TLabel;
    ResultListView: TListView;
    Panel2: TPanel;
    LineTotalLabel: TLabel;
    ImageList1: TImageList;
    JokeLabel: TLabel;
    Image2: TImage;
    Label8: TLabel;
    Label9: TLabel;
    Image3: TImage;
    Image4: TImage;
    Image5: TImage;
    Label12: TLabel;
    EMailPanel: TPanel;
    URLPanel: TPanel;
    WizardCtrl: TWizardCtrl;
    Label14: TLabel;
    procedure WizardCtrlCancelClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure NotShowFirstCheckBoxClick(Sender: TObject);
    procedure WizardCtrlNextClick(Sender: TObject;
      var AllowChange: Boolean);
    procedure LanguageListBoxClick(Sender: TObject);
    procedure PrjBrowseButtonClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure WizardCtrlFinishClick(Sender: TObject);
    procedure AddFileButtonClick(Sender: TObject);
    procedure RemoveFileButtonClick(Sender: TObject);
    procedure LanguageListBoxDblClick(Sender: TObject);
    procedure EMailPanelClick(Sender: TObject);
    procedure URLPanelClick(Sender: TObject);
    procedure EMailPanelMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure URLPanelMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure WizardCtrlHelpClick(Sender: TObject);
  private
    { Private declarations }
    DelphiCounter: TCalcDelphi;
    BcbCounter: TCalcBcb;
    VbCounter: TCalcVb;
    FLanguage: integer;

    function CheckExistInList(Name: string; List: TStrings): boolean;
    function CheckPrjExt(Language: integer; PrjFileName: string): boolean;
    procedure BeginCalculate;
    procedure DoCommandLine;
    procedure GetFileListByPrj(PrjFileName: string);
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

uses Misc, OptionFrm;

{$R *.DFM}

procedure TMainForm.FormCreate(Sender: TObject);
begin
  DelphiCounter := TCalcDelphi.Create;
  BcbCounter := TCalcBcb.Create;
  VbCounter := TCalcVb.Create;

  LoadOptions;
  if Options.ShowWizardFirstPage then
    WizardCtrl.PageIndex := 0
  else
    WizardCtrl.PageIndex := 1;
  NotShowFirstCheckBox.Checked := not Options.ShowWizardFirstPage;
  LanguageListBox.ItemIndex := 1;
  LanguageListBox.ItemIndex := 0;
  FLanguage := LanguageListBox.ItemIndex;
  SendMessage(FilesListBox.Handle, LB_SETHORIZONTALEXTENT, 500, 0);
  DoCommandLine;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  DelphiCounter.Free;
  BcbCounter.Free;
  VbCounter.Free;
end;

function TMainForm.CheckExistInList(Name: string; List: TStrings): boolean;
var
  i: integer;
begin
  for i := 0 to List.Count - 1 do
  begin
    if UpperCase(Name) = UpperCase(List[i]) then
    begin
      Result := true;
      exit;
    end;
  end;
  Result := false;
end;

function TMainForm.CheckPrjExt(Language: integer; PrjFileName: string): boolean;
var
  Ext: string;
begin
  Ext := UpperCase(ExtractFileExt(PrjFileName));
  case Language of
    0:  Result := (Ext = '.DPR');
    1:  Result := (Ext = '.BPR');
    2:  Result := (Ext = '.VBP');
    else Result := false;
  end;
  if not Result then
    MessageBox(Handle, '您的工程文件扩展名好像不太正确！', '提示', 48);
end;

procedure TMainForm.BeginCalculate;
var
  i, LineCount: integer;
  Ret: TStrings;
  ListItem: TListItem;
begin
  LineCount := 0;
  Ret := TStringList.Create;
  case FLanguage of
    0: LineCount := DelphiCounter.GetLineCount(FilesListBox.Items, Ret);
    1: LineCount := BcbCounter.GetLineCount(FilesListBox.Items, Ret);
    2: LineCount := VbCounter.GetLineCount(FilesListBox.Items, Ret);
  end;
  LineTotalLabel.Caption := AddThoundandFlag(LineCount) + ' 行';
  JokeLabel.Visible := (LineCount >= 10000);
  ResultListView.Items.Clear;
  for i := 0 to Ret.Count - 1 do
  begin
    ListItem := ResultListView.Items.Add;
    ListItem.Caption := FilesListBox.Items[i];
    ListItem.SubItems.Add(AddThoundandFlag(StrToInt(Ret[i])));
  end;
  Ret.Free;
end;

procedure TMainForm.DoCommandLine;
var
  Param, Ext: string;
begin
  Param := ParamStr(1);
  Ext := UpperCase(ExtractFileExt(Param));
  if Ext = '.DPR' then FLanguage := 0
  else if Ext = '.BPR' then FLanguage := 1
  else if Ext = '.VBP' then FLanguage := 2
  else exit;

  LanguageListBox.ItemIndex := FLanguage;
  PrjEdit.Text := Param;
  GetFileListByPrj(PrjEdit.Text);
  WizardCtrl.PageIndex := 2;
end;

procedure TMainForm.GetFileListByPrj(PrjFileName: string);
var
  FileList: TStrings;
begin
  FileList := TStringList.Create;
  case FLanguage of
    0:
      begin
        DelphiCounter.PrjFileName := PrjFileName;
        DelphiCounter.GetFileList(FileList);
      end;
    1:
      begin
        BcbCounter.PrjFileName := PrjFileName;
        BcbCounter.GetFileList(FileList);
      end;
    2:
      begin
        VbCounter.PrjFileName := PrjFileName;
        VbCounter.GetFileList(FileList);
      end;
  end;
  FilesListBox.Items.Assign(FileList);
  FileList.Free;
end;

procedure TMainForm.WizardCtrlCancelClick(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.NotShowFirstCheckBoxClick(Sender: TObject);
begin
  Options.ShowWizardFirstPage := not NotShowFirstCheckBox.Checked;
  SaveOptions;
end;

procedure TMainForm.WizardCtrlNextClick(Sender: TObject;
  var AllowChange: Boolean);
begin
  case WizardCtrl.PageIndex of
    1:
      if LanguageListBox.ItemIndex = -1 then AllowChange := false;
    2:
      begin
        if PrjEdit.Text = '' then
        begin
          MessageBox(Handle, '你没有填如工程文件名，所有文件将在下一步手工设置。', '提示', 48);
          FilesListBox.Items.Clear;
        end
        else if not CheckPrjExt(FLanguage, PrjEdit.Text) then AllowChange := false;
      end;
    3:
      BeginCalculate;
  end;
end;

procedure TMainForm.LanguageListBoxClick(Sender: TObject);
begin
  FLanguage := LanguageListBox.ItemIndex;
  PrjEdit.Text := '';
end;

procedure TMainForm.LanguageListBoxDblClick(Sender: TObject);
begin
  if LanguageListBox.ItemIndex <> -1 then WizardCtrl.NextPage;
end;

procedure TMainForm.PrjBrowseButtonClick(Sender: TObject);
begin
  case FLanguage of
    0:
      OpenPrjDialog.Filter := 'Delphi Project(*.dpr)|*.dpr';
    1:
      OpenPrjDialog.Filter := 'C++Builder Project(*.bpr)|*.bpr';
    2:
      OpenPrjDialog.Filter := 'VB Project(*.vbp)|*.vbp';
  end;
  OpenPrjDialog.FilterIndex := 1;
  OpenPrjDialog.FileName := '';
  if OpenPrjDialog.Execute then
  begin
    PrjEdit.Text := OpenPrjDialog.FileName;
    GetFileListByPrj(PrjEdit.Text);
  end;
end;

procedure TMainForm.WizardCtrlFinishClick(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.AddFileButtonClick(Sender: TObject);
var
  i: integer;
begin
  if OpenFilesDialog.Execute then
  begin
    for i := 0 to OpenFilesDialog.Files.Count - 1 do
    begin
      if not CheckExistInList(OpenFilesDialog.Files[i], FilesListBox.Items) then
        FilesListBox.Items.Add(OpenFilesDialog.Files[i]);
    end;
  end;
end;

procedure TMainForm.RemoveFileButtonClick(Sender: TObject);
var
  i: integer;
begin
  for i := 0 to FilesListBox.Items.Count - 1 do
  begin
    if FilesListBox.Selected[i] then
    begin
      FilesListBox.Items.Delete(i);
      break;
    end;
  end;
end;

procedure TMainForm.EMailPanelClick(Sender: TObject);
begin
  ShellExecute(Self.Handle, 'Open', PChar('mailto:[e-mail]'), '', '', 1);
end;

procedure TMainForm.URLPanelClick(Sender: TObject);
begin
  ShellExecute(Self.Handle, 'Open', PChar('http://haoxg.yeah.net'), '', '', 1);
end;

procedure TMainForm.EMailPanelMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  if (X >=0) and (X < EMailPanel.Width) and (Y >=0) and (Y < EMailPanel.Height) then
  begin
    EMailPanel.Font.Style := [fsUnderline];
    EMailPanel.Font.Color := clRed;
    SetCapture(EMailPanel.Handle);
  end else
  begin
    EMailPanel.Font.Style := [];
    EMailPanel.Font.Color := clBlue;
    ReleaseCapture;
  end;
end;

procedure TMainForm.URLPanelMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  if (X >=0) and (X < URLPanel.Width) and (Y >=0) and (Y < URLPanel.Height) then
  begin
    URLPanel.Font.Style := [fsUnderline];
    URLPanel.Font.Color := clRed;
    SetCapture(URLPanel.Handle);
  end else
  begin
    URLPanel.Font.Style := [];
    URLPanel.Font.Color := clBlue;
    ReleaseCapture;
  end;
end;


procedure TMainForm.WizardCtrlHelpClick(Sender: TObject);
begin
  ShowOptionForm;
end;

end.