settingfrm.pas

一个可以把源代码以语法高亮的形式转换成HTML格式或RTF格式。

unit SettingFrm;

{*******************************************
 * brief: 设置窗体
 * autor: linzhenqun
 * date: 2005-10-23
 * email: [e-mail]
 * blog: http://blog.csdn.net/linzhengqun
 * modi date: 2006-07-14 by liqj
********************************************}

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, BaseFrm, ComCtrls, StdCtrls, ActnList;

type
  TFrmSetting = class(TFrmBase)
    PCSetting: TPageControl;
    TSAccidenceMgr: TTabSheet;
    btnCancel: TButton;
    LVSrcType: TListView;
    BtnAdd: TButton;
    BtnEdit: TButton;
    BtnDel: TButton;
    BtnNew: TButton;
    ActionList: TActionList;
    acAdd: TAction;
    acNew: TAction;
    acEdit: TAction;
    acDel: TAction;
    acSaveAs: TAction;
    acMoveup: TAction;
    acMoveDown: TAction;
    btnSaveAS: TButton;
    btnMoveUp: TButton;
    btnMoveDown: TButton;
    btnOK: TButton;
    procedure btnCancelClick(Sender: TObject);
    procedure LVSrcTypeDblClick(Sender: TObject);
    procedure acAddExecute(Sender: TObject);
    procedure acNewExecute(Sender: TObject);
    procedure acEditExecute(Sender: TObject);
    procedure acDelExecute(Sender: TObject);
    procedure acSaveAsExecute(Sender: TObject);
    procedure acEditUpdate(Sender: TObject);
    procedure acMoveupExecute(Sender: TObject);
    procedure acMoveDownExecute(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure acMoveupUpdate(Sender: TObject);
    procedure acMoveDownUpdate(Sender: TObject);
    procedure LVSrcTypeInfoTip(Sender: TObject; Item: TListItem;
      var InfoTip: String);
    procedure FormCreate(Sender: TObject);
  private
    (* 检查词法文件是否正确 *)
    function CheckAccidenceFile(AFileName: string): Boolean;

    procedure UpdateAccidenceInfo;
    
    procedure XMLToListView;
    procedure ListViewToXML;
  public
    { Public declarations }
    function GetCurAcciNames:string;  // #13#10间隔并结尾
    procedure getLangRes;override;
  end;

var
  FrmSetting: TFrmSetting;

implementation
uses
  AccidenceEditFrm, CommonUtils, AcciInfoFrm, Config, CommonDM;//,
 // gnugettext;
{$R *.dfm}
{
resourcestring
  LV_Delete = '是否保留词法文件?';
  LV_NoSelect = '请选择一个项目.';
  Qry_ResetAcciFile = '这个文件路径不正确, 重新选择?';
}

procedure TFrmSetting.getLangRes;
begin
  inherited;
  Self.Caption := pubGet(200);
  TSAccidenceMgr.Caption := pubGet(201);
  LVSrcType.Column[0].Caption := pubGet(202);
  LVSrcType.Column[1].Caption := pubGet(203);

  acAdd.Caption := pubGet(204);
  acNew.Caption := pubGet(15);
  acEdit.Caption := pubGet(20);
  acDel.Caption := pubGet(24);
  acSaveAs.Caption := pubGet(13);
  acMoveUp.Caption := pubGet(31);
  acMoveDown.Caption := pubGet(32);
  
  btnOk.Caption := pubGet(5);
  btnCancel.Caption := pubGet(6);
  btnOK.Hint := pubGet(516);         // Save And Close
end;   

// 保存到内存 xml
procedure TFrmSetting.ListViewToXML;
var
  i :integer;
  s :string;
  ArrStr :array of string;
begin
  s :='';
  SetLength(ArrStr,LVSrcType.Items.Count);
  for i :=0 to LVSrcType.Items.Count -1 do
  begin
    ArrStr[i]:= 'Name='+LVSrcType.Items[i].Caption +#13#10+ 
                'FilePath='+LVSrcType.Items[i].SubItems[0];
  end;
  gAppConfig.SetAccidenceFiles(ArrStr);
  SetLength(ArrStr,0);    
end;

procedure TFrmSetting.XMLToListView;
var
  i,j :integer;
  SL :TStrings;
begin
  SL := TStringList.Create;
  try
    SL.Text := gAppConfig.GetAccidenceFiles ; // 名称与路径分开二行
    i := 0;
    while i < SL.Count-1 do
    with LVSrcType.Items.Add do
    begin
      Caption := SL[i];
      SubItems.Add(SL[i+1]);
      Inc(i,2);
    end;       
  finally
    SL.Free;
  end;
  if LVSrcType.Items.Count >0 then
    LVSrcType.Items.Item[0].Selected := True;
end;

procedure TFrmSetting.FormCreate(Sender: TObject);
begin
  inherited;
  XMLToListView;
end;

procedure TFrmSetting.UpdateAccidenceInfo;
begin
  ListViewToXML;      // 保存到内存 xml
end;

procedure TFrmSetting.btnOKClick(Sender: TObject);
begin
  //ListViewToXML;    // 每步改动都更新了，此处不在处理。
  gAppConfig.Save ;   // 退出才保存
  Close;
end;


procedure TFrmSetting.btnCancelClick(Sender: TObject);
begin
  Close;
end;

function TFrmSetting.CheckAccidenceFile(AFileName: string): Boolean;
var
  AcciConfig: TAccidenceConfig;
begin
  Result := True;
  AcciConfig := TAccidenceConfig.Create('');
  try
    try
      AcciConfig.LoadFromFile(AFileName);
    except
      Result := False;
    end;
  finally
    AcciConfig.Free;
  end;
end;

procedure TFrmSetting.LVSrcTypeDblClick(Sender: TObject);
begin
  if LVSrcType.Selected <> nil then
    acEdit.Execute;
end;

procedure TFrmSetting.acAddExecute(Sender: TObject);
var
  FileName: string;
begin
  if DMCommon.ExecOpenDialog(pubGet('XML_File') + '|*.xml|', FileName,
    ExtractFilePath(ParamStr(0)) + 'Accidence file') then
  begin
    if CheckAccidenceFile(FileName) then
      with TFrmAcciInfo.Create(nil) do
      try
        FilePath := FileName;
        if ShowModal = mrOk then
        begin
          with LVSrcType.Items.Add do
          begin
            Caption := AcciName;
            SubItems.Add(GetRelativePath(FilePath)) ; // 相对路径
          end;
          UpdateAccidenceInfo;                        // 保存到内存 xml
        end;
      finally
        Free;
      end
    else
      MessageBox(Handle, PChar(pubGet('Err_AcciInvalide')), 
        PChar(pubGet(1)), MB_OK+MB_ICONERROR);
  end;
end;

procedure TFrmSetting.acNewExecute(Sender: TObject);
begin
  with TFrmAccidenceEdit.Create(nil) do
  try
    AcciState := TNewAcciState.Create('', '');
    if ShowModal = mrOk then
    begin
      with LVSrcType.Items.Add do
      begin
        Caption := AcciState.AcciName;
        SubItems.Add(GetRelativePath(AcciState.FileName)) ; // 相对路径
      end;
      UpdateAccidenceInfo;
    end; 
  finally
    Free;
  end;
end;

procedure TFrmSetting.acEditExecute(Sender: TObject);
var
  FileName: string;
begin 
  FileName := GetAbsolutePath(LVSrcType.Selected.SubItems[0]);
  if not FileExists(FileName) then
    case MessageBox(Handle, PChar(pubGet('Qry_ResetAcciFile')), 
      PChar(pubGet(2)),MB_YESNO + MB_ICONQUESTION) of
    IDYES:
      begin
        if DMCommon.ExecOpenDialog(pubGet('XML_File') + '|*.xml|', FileName,
          ExtractFilePath(ParamStr(0)) + 'Accidence file') then
        begin  
          LVSrcType.Selected.SubItems[0] := GetRelativePath(FileName);
          UpdateAccidenceInfo;
        end  
        else
          Exit;
      end;
    else
        Exit;
    end;

  with TFrmAccidenceEdit.Create(nil) do
  try
    AcciState := TEditAcciState.Create(LVSrcType.Selected.Caption, FileName);
    ShowModal;
  finally
    Free;
  end;
end;

procedure TFrmSetting.acDelExecute(Sender: TObject);
var
  FileName: string;
begin
  case MessageBox(Handle, PChar(pubGet('LV_Delete')), PChar(pubGet(2)),
    MB_YESNOCANCEL + MB_ICONQUESTION) of
  IDYES:  // 只删除程序配置文件中的条目
    begin
      LVSrcType.Selected.Delete;
      UpdateAccidenceInfo;
    end;
  IDNO:   // 硬盘上的文件也删除
    begin
      FileName := GetAbsolutePath(LVSrcType.Selected.SubItems[0]);
      DeleteFile(FileName);
      LVSrcType.Selected.Delete;
      UpdateAccidenceInfo;      
    end;
  end;
end;

procedure TFrmSetting.acSaveAsExecute(Sender: TObject);
var
  LFilePath,SrcFileName: string;
begin
  SrcFileName := GetAbsolutePath(LVSrcType.Selected.SubItems[0]);
  LFilePath := ExtractFileName(SrcFileName);
  if DMCommon.ExecSaveDialog(pubGet('XML_File') + '|*.xml|', LFilePath,
    ExtractFilePath(ParamStr(0)) + 'Accidence file') then  // 选择路径
  begin
    with TFrmAcciInfo.Create(nil) do
    try
      FilePath := LFilePath;
      if ShowModal = mrOk then                             // 录入名称
      begin
        CopyFile(PChar(SrcFileName), PChar(LFilePath), False);
        LVSrcType.Selected.Caption  := AcciName;
        LVSrcType.Selected.SubItems[0] := GetRelativePath(LFilePath);
        UpdateAccidenceInfo;        
      end;
    finally
      Free;
    end
  end;
end;

procedure TFrmSetting.acEditUpdate(Sender: TObject);
begin
  TAction(Sender).Enabled := LVSrcType.Selected <> nil;
end;

procedure TFrmSetting.acMoveupExecute(Sender: TObject);
var
  index,i :integer;
  Str :TStrings;
begin
  // 向上移动
  index := LVSrcType.ItemIndex;
  if index>0 then       // 第一条不能向上移
  begin
    Str := TStringList.Create;
    LVSrcType.Items.BeginUpdate ;
    try
      // 得到转换后的列表
      i := 0 ;
      while i<LVSrcType.Items.Count do
      begin
        if i = index-1 then 
        begin
          Str.Add(LVSrcType.Items[i+1].Caption + '=' + 
                  LVSrcType.Items[i+1].SubItems.Strings[0]);
          Str.Add(LVSrcType.Items[i].Caption + '=' + 
                  LVSrcType.Items[i].SubItems.Strings[0]);
          Inc(i);                
        end          
        else
          Str.Add(LVSrcType.Items[i].Caption + '=' + 
                  LVSrcType.Items[i].SubItems.Strings[0]);
        Inc(i);          
      end;
      // 写回列表框
      LVSrcType.Items.Clear;
      for i:=0 to Str.Count -1 do
      begin
        with LVSrcType.Items.Add do
        begin
          Caption := Str.Names[i];
          SubItems.Add(Str.ValueFromIndex[i]); 
        end;
      end;
      LVSrcType.Items[Index-1].Selected := True; // 选择刚移动的
    finally
      LVSrcType.Items.EndUpdate;
      Str.Free;
    end;
    UpdateAccidenceInfo;
  end;
end;

procedure TFrmSetting.acMoveDownExecute(Sender: TObject);
var
  index,i :integer;
  Str :TStrings;
begin
  // 向下移动
  index := LVSrcType.ItemIndex;
  if index<LVSrcType.Items.Count-1 then  // 最后一条不能向下移
  begin
    Str := TStringList.Create;
    LVSrcType.Items.BeginUpdate ;
    try
      // 得到转换后的列表
      i := 0 ;
      while i<LVSrcType.Items.Count do
      begin
        if i = index then 
        begin
          Str.Add(LVSrcType.Items[i+1].Caption + '=' + 
                  LVSrcType.Items[i+1].SubItems.Strings[0]);
          Str.Add(LVSrcType.Items[i].Caption + '=' + 
                  LVSrcType.Items[i].SubItems.Strings[0]);
          Inc(i);                
        end          
        else
          Str.Add(LVSrcType.Items[i].Caption + '=' + 
                  LVSrcType.Items[i].SubItems.Strings[0]);
        Inc(i);          
      end;
      // 写回列表框
      LVSrcType.Items.Clear;
      for i:=0 to Str.Count -1 do
      begin
        with LVSrcType.Items.Add do
        begin
          Caption := Str.Names[i];
          SubItems.Add(Str.ValueFromIndex[i]); 
        end;
      end;
      LVSrcType.Items[Index+1].Selected := True; // 选择刚移动的
    finally
      LVSrcType.Items.EndUpdate;
      Str.Free;
    end;
    UpdateAccidenceInfo;
  end;
end;


procedure TFrmSetting.acMoveupUpdate(Sender: TObject);
begin
  TAction(Sender).Enabled := (LVSrcType.Selected <> nil) and
    (LvSrcType.ItemIndex >0) ;
end;

procedure TFrmSetting.acMoveDownUpdate(Sender: TObject);
begin
  TAction(Sender).Enabled := (LVSrcType.Selected <> nil) and
    (LvSrcType.ItemIndex <LvSrcType.Items.Count-1) ;
end;

procedure TFrmSetting.LVSrcTypeInfoTip(Sender: TObject; Item: TListItem;
  var InfoTip: String);
begin
  inherited;
  InfoTip := Format('%s : %s',[Item.Caption,Item.SubItems[0]]);
end;


function TFrmSetting.GetCurAcciNames: string;
var
  i :integer;
begin
  Result :='';
  for i:=0 to LVSrcType.Items.Count -1 do
    Result := Result + LVSrcType.Items[i].Caption + #13#10;
end;


end.