delphi代码测试

unit mytype;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, Forms,
  Dialogs, StdCtrls, RzLstBox, ExtCtrls, RzPanel, RzSplit, RzCmboBx,IniFiles;

type
  TForm2 = class(TForm)
    rzszpnl1: TRzSizePanel;
    lst1: TRzListBox;
    mmo1: TMemo;
    rzszpnl2: TRzSizePanel;
    lbl1: TLabel;
    Label1: TLabel;
    btns1: TButton;
    Button1: TButton;
    btnsdel: TButton;
    Button3: TButton;
    Button4: TButton;
    morentype: TRzComboBox;
    Label4: TLabel;
    procedure lst1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure btnsdelClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btns1Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure mmo1Change(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    procedure FindFiles(APath, AFile: string;myitems:TStrings);
    procedure savetype;
    procedure msg;

  public
    { Public declarations }
  end;

var
  Form2: TForm2;
  changes:BOOL;
  itemsel:string;
  myini:TIniFile;

implementation
uses main,showtype;
{$R *.dfm}
////////////////////////////////////////////////////////////////////////////////
//1.遍历指定目录下的所有文件
////////////////////////////////////////////////////////////////////////////////
procedure TForm2.FindFiles(APath, AFile: string;myitems:TStrings);
var
 vSearchRec: TSearchRec;
 I: Integer;
 ts:string;
begin
I := FindFirst(APath+'*.*', faAnyFile, vSearchRec);
while I = 0 do begin
if (AnsiUpperCase(AFile) =AnsiUpperCase('*' + ExtractFileExt(vSearchRec.Name))) then
begin
ts:=vSearchRec.Name;
Delete(ts,Pos('.',ts),5);
myitems.Add(ts);
end;
I := FindNext(vSearchRec);
end;
FindClose(vSearchRec);
end;

procedure TForm2.savetype;
begin
  Assignfile(txt1,exedir+'data\'+itemsel+'.type');
  Rewrite(txt1);
  Write(txt1,mmo1.text);
  CloseFile(txt1);
  ShowMessage(itemsel+'保存成功!');
  changes:=false;
  Button1.Enabled:=changes;
  
  morentype.Clear;
  FindFiles(exedir+'data\','*.type',morentype.Items);

end;

procedure TForm2.lst1Click(Sender: TObject);
begin
//====样式========================
btnsdel.Enabled:=true;
  txtname2:=exedir+'data\'+lst1.SelectedItem+'.type';
  if changes then msg;
    if not FileExists(txtname2) then
  begin
    itemsel:=lst1.SelectedItem;
    msg;
    exit;
  end;
  Assignfile(txt2,txtname2);
  Reset(txt2);
  typetxt:='';
  while not EOF(txt2) do
  begin
    Readln(txt2,temp);
    typetxt:=typetxt+temp+#13#10;
  end;
  CloseFile(txt2);
  mmo1.Text:=typetxt;
  changes:=False;
  Button1.Enabled:=changes;

//====样式========================

end;
procedure TForm2.msg;
begin
    if Application.MessageBox(pchar('[ '+itemsel+' ]已经被修改,是否要保存?'), pchar(Application.Title),MB_OKCANCEL + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_TOPMOST)=1 then
    begin
      savetype;
    end;
end;

procedure TForm2.Button3Click(Sender: TObject);
begin

if lst1.ItemIndex<0 then Exit;
//====样式========================
  typetxt:=mmo1.Text;
//====样式========================
  Assignfile(txt1,txtname);
  form1.ReplaceStrs(typetxt,'[<TITLE>]','主题 "TITLE"');
  form1.ReplaceStrs(typetxt,'[<DESCRIPTION>]','简单描述 "DESCRIPTION"');
  form1.ReplaceStrs(typetxt,'[<MEMO>]','备注 "MEMO"');
  form1.ReplaceStrs(typetxt,'[<LASTTIMEMODIFIED>]','最后修改时间 "LASTTIMEMODIFIED"');
  form1.ReplaceStrs(typetxt,'[<CONTENT>]','内容 "CONTENT"');
  Rewrite(txt1);
  Write(txt1,typetxt);
  CloseFile(txt1);
Form3.wb1.Navigate(txtname);
form3.ShowModal;
end;

procedure TForm2.btnsdelClick(Sender: TObject);
begin
if lst1.ItemIndex<0 then Exit;
if Application.MessageBox(pchar('是否要删除'+lst1.SelectedItem+'?'), pchar(Application.Title),MB_OKCANCEL + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_TOPMOST)=1 then
DeleteFile(PChar(exedir+'data\'+lst1.SelectedItem+'.type'));
lst1.Clear;
FindFiles(exedir+'data\','*.type',lst1.Items);
Form1.FindFiles(exedir+'data\','*.type');
end;

procedure TForm2.FormShow(Sender: TObject);
begin
lst1.Clear;
FindFiles(exedir+'data\','*.type',lst1.Items);
morentype.Clear;
FindFiles(exedir+'data\','*.type',morentype.Items);

  try
  myini:=TIniFile.Create(inifile);
  with myini do
  begin
    morentype.ItemIndex:=strtoint(myini.ReadString('main','type','0'));
  end;
  myini.Free;
  except
  end;

end;

procedure TForm2.btns1Click(Sender: TObject);
var txttype:string;
i:Integer;
begin
txttype:='模版';
if InputQuery('提示','请填入名称:',txttype) then
begin
  for i := 0 to lst1.Items.Count-1 do
  begin
    if txttype=lst1.ItemCaption(i) then
    begin
      ShowMessage('该模版名已存在,请换一个名字');
    Exit;
    end;
  end;
  if (txttype<>'') and (not FileExists(exedir+'data\'+txttype+'.type')) then
  begin
    lst1.Items.Add(txttype);
    mmo1.Text:=form1.readtxt(exedir+'data\all.txt');
    lst1.Selected[lst1.Items.Count-1]:=true;
    itemsel:=lst1.SelectedItem;
    changes:=True;
  end else begin
    ShowMessage('该模版名已存在,请换一个名字');
    btns1Click(self);
  end;
end;

end;

procedure TForm2.Button4Click(Sender: TObject);
begin
Close;
end;

procedure TForm2.mmo1Change(Sender: TObject);
begin
changes:=True;
itemsel:=lst1.SelectedItem;
Button1.Enabled:=changes;
end;

procedure TForm2.Button1Click(Sender: TObject);
begin
  savetype;
end;

procedure TForm2.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  try
  myini:=TIniFile.Create(inifile);
  with myini do
  begin
    myini.WriteString('main','type',IntToStr(morentype.ItemIndex));
  end;
  myini.Free;
  except
  end;
  if changes then msg;
  Form1.FindFiles(exedir+'data\','*.type');
end;

end.

posted on 2009-03-10 20:14  fatkun  阅读(404)  评论(0编辑  收藏  举报

导航