uaddbutton.pas

Delphi函数工厂。。。。。。。。。。。。。

unit uAddButton;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, BusinessSkinForm, StdCtrls, Mask, bsSkinBoxCtrls, bsSkinCtrls,
  bsSkinShellCtrls, bsMessages, ShellAPI, ComCtrls, bsSkinTabs, ExtCtrls,ShlObj;

type
  TfmAddButton = class(TForm)
    skinForm: TbsBusinessSkinForm;
    OpenDialog: TbsSkinOpenDialog;
    skinMsg: TbsSkinMessage;
    bsSkinPageControl1: TbsSkinPageControl;
    bsSkinTabSheet1: TbsSkinTabSheet;
    bsSkinTabSheet2: TbsSkinTabSheet;
    lblParams: TLabel;
    lblExefile: TLabel;
    lblButtonName: TLabel;
    Label1: TLabel;
    edtParams: TbsSkinMemo;
    edtExefile: TbsSkinMemo;
    edtButtonName: TbsSkinMemo;
    cbSection: TbsSkinComboBox;
    btnTest: TbsSkinSpeedButton;
    btnOK: TbsSkinSpeedButton;
    btnCancel: TbsSkinSpeedButton;
    btnBrowse: TbsSkinSpeedButton;
    lbPanel: TbsSkinListBox;
    btnDelPanel: TbsSkinSpeedButton;
    btnAddPanel: TbsSkinSpeedButton;
    Label2: TLabel;
    mmPanelName: TbsSkinMemo;
    btnModify: TbsSkinSpeedButton;
    Label3: TLabel;
    lblModifyButton: TLabel;
    btnFileBrowse: TbsSkinSpeedButton;
    procedure btnBrowseClick(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure edtExefileChange(Sender: TObject);
    procedure btnTestClick(Sender: TObject);
    procedure edtButtonNameKeyPress(Sender: TObject; var Key: Char);
    procedure mmPanelNameKeyPress(Sender: TObject; var Key: Char);
    procedure btnAddPanelClick(Sender: TObject);
    procedure btnModifyClick(Sender: TObject);
    procedure btnDelPanelClick(Sender: TObject);
    procedure lbPanelListBoxClick(Sender: TObject);
    procedure lblModifyButtonClick(Sender: TObject);
    procedure btnFileBrowseClick(Sender: TObject);
  private
    { Private declarations }
    function CheckInput:boolean;
  public
    { Public declarations }
  end;

var
  fmAddButton: TfmAddButton;

implementation

uses uMainForm2;

{$R *.dfm}

function  TfmAddButton.CheckInput;
begin
result:=true;
if trim(mmPanelName.Text)='' then
begin
MessageBox(Handle, PChar('请输入面板的名字!'), PChar('错误'),
  MB_ICONERROR or MB_OK);
mmPanelName.SetFocus;
result:=false;
exit;
end;
if lbPanel.Items.IndexOf(trim(mmPanelName.Text))<>-1 then
begin
MessageBox(Handle, PChar('这个面板名称已经存在,请换个新名称!'), PChar('错误'),
  MB_ICONERROR or MB_OK);
mmPanelName.SetFocus;
result:=false;
exit;
end;
end;
procedure TfmAddButton.btnBrowseClick(Sender: TObject);
begin
  fmMain.PlayDefButtonClickSound;
  if OpenDialog.Execute then
  begin
    edtExefile.Text := OpenDialog.FileName;
    edtButtonName.Text := ExtractFileName(OpenDialog.FileName);
  end;
end;

procedure TfmAddButton.btnOKClick(Sender: TObject);
begin
  fmMain.PlayDefButtonClickSound;
  // awen modify
  // 下面的代码我修改了，原因是为了保证添加文件夹的按钮时，程序不会拒绝添加
  if (edtExefile.Text = '') or ((not DirectoryExists(edtExefile.Text))
    and (not FileExists(edtExefile.Text))) then
  begin
    MessageBeep(MB_ICONEXCLAMATION);
    skinMsg.MessageDlg('您尚未选择可执行文件，或者文件不存在！'#13#10 +
      '如果您选择的是目录，可能目录不存在！',
      mtWarning, [mbOK], 0);
    fmMain.PlayDefButtonClickSound;
    edtExefile.SetFocus;
    Exit;
  end;
  if edtButtonName.Text = '' then
  begin
    MessageBeep(MB_ICONEXCLAMATION);
    skinMsg.MessageDlg('请输入按钮名称！', mtWarning, [mbOK], 0);
    fmMain.PlayDefButtonClickSound;
    edtButtonName.SetFocus;
    Exit;
  end;
  if cbSection.ItemIndex = -1 then
  begin
    MessageBeep(MB_ICONEXCLAMATION);
    skinMsg.MessageDlg('请选择面板类别！', mtWarning, [mbOK], 0);
    fmMain.PlayDefButtonClickSound;
    cbSection.SetFocus;
    Exit;
  end;
  if fmMain.AddToolButton(edtButtonName.Text, edtExefile.Text,
    edtParams.Text, cbSection.itemindex) then
  begin
    edtExefile.Text := '';
    edtButtonName.Text := '';
    //Close;
  end
  else
  begin
    MessageBeep(MB_ICONHAND);
    skinMsg.MessageDlg(Format('添加 "%s" 按钮失败，可能是存在重名的按钮'#13#10 +
      '，建议您更改按钮名称。',
      [edtButtonName.Text]), mtError, [mbOK], 0);
    fmMain.PlayDefButtonClickSound;
  end;
end;

procedure TfmAddButton.btnCancelClick(Sender: TObject);
begin
  fmMain.PlayDefButtonClickSound;
  edtExefile.Text := '';
  edtButtonName.Text := '';
  Close;
end;

procedure TfmAddButton.edtExefileChange(Sender: TObject);
begin
  btnTest.Enabled := edtExefile.Text <> '';
end;

procedure TfmAddButton.btnTestClick(Sender: TObject);
begin
  fmMain.PlayDefButtonClickSound;
  if (edtExefile.Text = '') or (not(FileExists(edtExefile.Text) or DirectoryExists(edtExefile.Text))) then
  begin
    MessageBeep(MB_ICONEXCLAMATION);
    skinMsg.MessageDlg('您尚未选择可执行文件，或者文件不存在！',
      mtWarning, [mbOK], 0);
    fmMain.PlayDefButtonClickSound;
    edtExefile.SetFocus;
    Exit;
  end;
  if ShellExecute(Handle, 'OPEN', PChar(edtExefile.Text),
    PChar(edtParams.Text), PChar(ExtractFilePath(edtExefile.Text)),
    SW_SHOWNORMAL) > 32 then
  begin
    beep;
    skinMsg.MessageDlg('测试成功！', mtInformation, [mbOK], 0);
    fmMain.PlayDefButtonClickSound;
  end
  else
  begin
    MessageBeep(MB_ICONHAND);
    skinMsg.MessageDlg('无法启动或打开可执行文件！', mtError, [mbOK], 0);
    fmMain.PlayDefButtonClickSound;
  end;
end;

procedure TfmAddButton.edtButtonNameKeyPress(Sender: TObject; var Key: Char);
begin
  if key = #13 then
    key := #0;
end;

procedure TfmAddButton.mmPanelNameKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then
key:=#0;
end;

procedure TfmAddButton.btnAddPanelClick(Sender: TObject);
begin
fmMain.PlayDefButtonClickSound;
if CheckInput then
begin
lbPanel.Items.Add(mmPanelName.Text);
fmMain.AddUserPanel(mmPanelName.Text);
lbPanel.Selected[lbPanel.Items.Count-1];
cbSection.Items.Add(mmPanelName.Text);
mmPanelName.Text:='';
end;
end;

procedure TfmAddButton.btnModifyClick(Sender: TObject);
begin
  fmMain.PlayDefButtonClickSound;
if CheckInput then
begin
cbSection.Items[lbPanel.ItemIndex+3]:=mmPanelName.Text;
lbPanel.Items[lbPanel.ItemIndex]:=mmPanelName.Text;
fmMain.ModifyUserPanel(mmPanelName.Text,lbPanel.ItemIndex);
end;
end;

procedure TfmAddButton.btnDelPanelClick(Sender: TObject);
var
name:string;
index:integer;
begin
fmMain.PlayDefButtonClickSound;
index := lbPanel.ItemIndex;
if index<>-1 then
begin
cbSection.Items.Delete(index+3);
name:=lbPanel.Items[index];
lbPanel.Items.Delete(lbPanel.ItemIndex);
fmMain.DeleteUserPanel(name,index);
if index>0 then
lbPanel.ItemIndex:=index-1;
lbPanelListBoxClick(nil);
end;
end;

procedure TfmAddButton.lbPanelListBoxClick(Sender: TObject);
begin
if lbPanel.ItemIndex<>-1 then
mmPanelName.Text:=lbPanel.Items[lbPanel.ItemIndex]
else
mmPanelName.Text:='';
end;

procedure TfmAddButton.lblModifyButtonClick(Sender: TObject);
begin
fmMain.btnModifyClick(nil);
end;

procedure TfmAddButton.btnFileBrowseClick(Sender: TObject);
var
BrowseInfo  : TBrowseInfo;
PIDL        : PItemIDList;
DisplayName : array[0..MAX_PATH] of Char;
begin
FillChar(BrowseInfo,SizeOf(BrowseInfo),#0);
BrowseInfo.hwndOwner      := Handle;
BrowseInfo.pszDisplayName := @DisplayName[0];
BrowseInfo.lpszTitle      := '请选择一个文件夹';
BrowseInfo.ulFlags        := BIF_RETURNONLYFSDIRS;
PIDL := SHBrowseForFolder(BrowseInfo);
if Assigned(PIDL) then
if SHGetPathFromIDList(PIDL, DisplayName) then
edtExefile.Text:=DisplayName;
edtButtonName.Text := ExtractFileName(DisplayName);
end;

end.