commondm.pas

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

unit CommonDM;

{*******************************************
 * brief: 共用模块
 * autor: linzhenqun
 * date: 2006-6-18
 * email: [e-mail]
 * blog: http://blog.csdn.net/linzhengqun
********************************************}

interface

uses
  SysUtils, Classes, Dialogs, Graphics;

type
  TDMCommon = class(TDataModule)
    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    procedure DataModuleCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    (* 执行打开文件对话框,如果成功，返回结果 *)
    function ExecOpenDialog(AFilter: String; var AFileName: String;
      ADefDir: String): Boolean;
    (* 执行保存文件对话框，如果成功，返回结果 *)
    function ExecSaveDialog(AFilter: String; var AFileName: String;
      ADefDir: String): Boolean;

    function ExecDialog(ADlg: TOpenDialog; AFilter: string;
      var AFilterIndex: Integer; var AFileName: string; ADefDir: string): Boolean;
    function ExecOpenFile(AFilter: string;var AFilterIndex: Integer;
      var AFileName: string; ADefDir: string=''):Boolean;
    function ExecSaveFile(AFilter: string;var AFilterIndex: Integer;
      var AFileName: string; ADefDir: string=''):Boolean;

  end;

var
  DMCommon: TDMCommon;

implementation
uses
  CommonUtils;

{$R *.dfm}

function TDMCommon.ExecOpenDialog(AFilter: String;
  var AFileName: String; ADefDir: String): Boolean;
begin
  Result := False;
  OpenDialog.FileName := '';
  OpenDialog.Filter := AFilter + pubGet('ALL_File') + '|*.*';
  if ADefDir <> '' then
    OpenDialog.InitialDir := ADefDir
  else
    OpenDialog.InitialDir := '';

  if OpenDialog.Execute then
  begin
    AFileName := OpenDialog.FileName;
    Result := True;
  end;
end;

function TDMCommon.ExecSaveDialog(AFilter: String;
  var AFileName: String; ADefDir: String): Boolean;
begin
  Result := False;
  if Pos('.xml', AFilter) > 0 then
    SaveDialog.DefaultExt := '.xml'
  else if Pos('.html', AFilter) > 0 then
    SaveDialog.DefaultExt := '.html'
  else if Pos('.rtf', AFilter) > 0 then
    SaveDialog.DefaultExt := '.rtf'
  else if Pos('.txt', AFilter) > 0 then
    SaveDialog.DefaultExt := '.txt';

  if ADefDir <> '' then
    SaveDialog.InitialDir := ADefDir
  else
    SaveDialog.InitialDir := '';

  if AFileName <> '' then
    SaveDialog.FileName := AFileName
  else
    SaveDialog.FileName := '';

  SaveDialog.Filter := AFilter + pubGet('ALL_File') + '|*.*';
  if SaveDialog.Execute then
  begin
    AFileName := SaveDialog.FileName;
    Result := True;
  end;
end;

procedure TDMCommon.DataModuleCreate(Sender: TObject);
begin
  OpenDialog.InitialDir := ExtractFilePath(ParamStr(0)) + '\Accidence file\';
  SaveDialog.InitialDir := ExtractFilePath(ParamStr(0)) + '\Accidence file\';
end;


function TDMCommon.ExecDialog(ADlg: TOpenDialog; AFilter: string;
  var AFilterIndex: Integer; var AFileName: string; ADefDir: string): Boolean;
var
  i,n :integer;  
begin
  Result := False;
  with ADlg do
  begin
    Filter := AFilter + pubGet('ALL_File')+'|*.*'; //'所有文件(*.*)
    FilterIndex := AFilterIndex;
    if AFilterIndex =-1 then                       // 最后
    begin
      n :=0;
      for i:=0 to Length(Filter) do
        if Filter[i] = '|' then Inc(n);
      FilterIndex := (n+1) div 2;  
    end;
    InitialDir := ADefDir;
    FileName := '';
    if AFileName <> '' then FileName := AFileName;
        
    if Execute then
    begin
      AFileName := FileName;
      AFilterIndex := FilterIndex;
      Result := True;
    end;
  end;
end;

function TDMCommon.ExecOpenFile(AFilter: string;var AFilterIndex: Integer;
  var AFileName: string; ADefDir: string): Boolean;
begin
  Result :=ExecDialog(OpenDialog,AFilter,AFilterIndex,AFileName,ADefDir);
end;

function TDMCommon.ExecSaveFile(AFilter: string;var AFilterIndex: Integer;
  var AFileName: string; ADefDir: string): Boolean;
begin
  Result :=ExecDialog(SaveDialog,AFilter,AFilterIndex,AFileName,ADefDir);
end;


end.