frmcheckout.pas

商场管理系统源码 一套值得初学者学习的源码包含全部源码,控件

unit FRMCHECKOUT;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, FRMBASSDIALOGS, DsFancyButton, ExtCtrls, ComCtrls, MenuBar,
  ToolWin, StdCtrls, TFlatEditUnit, TFlatCheckListBoxUnit, Buttons,
  TFlatPanelUnit, TFlatCheckBoxUnit, Grids, DBGrids,ShellApi;

type
  TFrm_checkout = class(TFrm_bassDialogs)
    SaveDialog: TSaveDialog;
    FlatPanel: TFlatPanel;
    Label1: TLabel;
    E_filename: TFlatEdit;
    SB_selectpath: TSpeedButton;
    CLB_field: TFlatCheckListBox;
    CB_autoopen: TFlatCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure SB_selectpathClick(Sender: TObject);
    procedure OKBtnClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure E_filenameChange(Sender: TObject);
  private
    { Private declarations }
  public
    DBG_savedata:Tdbgrid;
    { Public declarations }
  end;

var
  Frm_checkout: TFrm_checkout;

implementation

{$R *.dfm}

procedure TFrm_checkout.FormCreate(Sender: TObject);
begin
  inherited;
   self.Caption :=application.Title + ' - 数据导出';
end;

procedure TFrm_checkout.SB_selectpathClick(Sender: TObject);
begin
  inherited;
   SaveDialog.Filter :='ＣＳＶ格式文件（*.CSV）|*.CSV';
   SaveDialog.Title :='导出 CSV格式文件';
   SaveDialog.DefaultExt :='CSV';
   if SaveDialog.Execute  then
   begin
      E_filename.Text :=SaveDialog.FileName;
   end;
end;

procedure TFrm_checkout.OKBtnClick(Sender: TObject);
var
   fn,S_text:string;
   Out_file:textfile;
   I_row,I_col:integer;
   Scr_hDC : longint;
   temp_rundir : String ;
begin
  inherited;
  I_col:=0;
  for I_row:=0 to clb_field.Items.Count -1 do
  begin
     if clb_field.Checked[I_row] then
       inc(I_col);
  end;
  if I_col<0 then
  begin
     messagedlg('没有选择要导出的内容，数据导出失败！“'+fn+'”',mtInformation,[mbok],0);
     exit;
  end;
  if uppercase(copy(E_filename.Text,length(E_filename.Text)-3,4))<>'.CSV' then
     E_filename.Text:=E_filename.Text+'.CSV';
  fn:=trim(E_filename.Text );
  if FileExists(fn) then
  begin
     if messagedlg('文件已经存在，是否覆盖？',mtConfirmation,[mbyes,mbno],0)=mrno then
     begin
        exit;
     end;
  end;
  I_row:=DBG_savedata.DataSource.DataSet.RecNo ;
  try
     assignfile(Out_file,fn);
     rewrite(Out_file);
      //写入文件头
     S_text:='';
     for I_col:=0 to clb_field.Items.Count -1 do
     begin
        if clb_field.Checked[I_col] then
        S_text:=S_text+trim(clb_field.Items.Strings[I_col])+',';
     end;
     //去除最后一个“,”
     s_text:=copy(S_text,1,length(S_text)-1);
     writeln(out_file,s_text);
     //写入数据
     with DBG_savedata.DataSource.DataSet do
     begin
        DisableControls ;
        first;
        while not eof do
        begin
           S_text:='';
           for I_col:=0 to clb_field.Items.Count -1 do
           begin
               //以下代码可能造成数据与文件头不对应，暂时使用
              if clb_field.Checked[I_col] then
                 S_text:=S_text+trim(Fields[I_col].AsString)+',';
           end;
           //去除最后一个“,”
           s_text:=copy(S_text,1,length(S_text)-1);
           writeln(out_file,s_text);
           next;
        end;
        RecNo :=I_row;
        EnableControls ;
     end;
     closefile(out_file);
     messagedlg('CSV数据文件导出成功，文件名为【'+fn+'】',mtInformation,[mbok],0);
     if cb_autoopen.Checked then        //打开文件
     begin
        try
           temp_rundir := ExtractFileDir(fn);
           Scr_hdc:=GetDesktopWindow();
           ShellExecute(Scr_hDC, 'Open', pchar(fn), '', pchar(temp_rundir), SW_SHOWNORMAL)
        except
           messagedlg('【'+fn+'】数据文件自动打开失败，请手工打开！',mtInformation,[mbok],0);
        end;
     end;
     self.Close ;
  except
     DBG_savedata.DataSource.DataSet.recno:=I_row;
     DBG_savedata.DataSource.DataSet.EnableControls ;
     closefile(out_file);
     messagedlg('未知错误导致CSV数据文件导出失败！',mtInformation,[mbok],0);
  end;
end;

procedure TFrm_checkout.FormShow(Sender: TObject);
var
   I_col:integer;
begin
  inherited;
   for I_col:=0 to DBG_savedata.FieldCount -1 do
   begin
      clb_field.Items.Append (DBG_savedata.Columns.Items[I_col].Title.Caption );
   end;
   for I_col:=0 to clb_field.Items.Count -1 do
   begin
      clb_field.Checked[I_col]:=true;
   end;
end;

procedure TFrm_checkout.E_filenameChange(Sender: TObject);
begin
  inherited;
   okbtn.Enabled := (trim(E_filename.Text)<>'')
end;

end.