bbdcfrm.pas

来自「本人编写的有关军队营房工作的管理系统」· PAS 代码 · 共 268 行

unit bbdcfrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Buttons, StdCtrls, ComCtrls, Gauges,db, te_controls,
  ksthemelistboxs;

type
  Tbbdc = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Label1: TLabel;
    Panel4: TPanel;
    Edit1: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    Label4: TLabel;
    Edit2: TEdit;
    Label5: TLabel;
    SpeedButton5: TSpeedButton;
    SpeedButton6: TSpeedButton;
    Gauge1: TGauge;
    DateTimePicker1: TDateTimePicker;
    ListBox1: TTeThemeListBox;
    ListBox2: TTeThemeListBox;
    procedure SpeedButton6Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    varexcel:variant;
    range:variant;
    procedure getdata;
    procedure exportdatatoexcel;
    { Private declarations }
  public
    vps_filter: string;
    vps_name: string;
    procedure moveselected(list: TTeThemeListBox; items: tstrings);
    procedure setitem(list: TTeThemeListBox; index: integer);
    function getfirstselection(list: TTeThemeListBox): integer;
    procedure setbuttons;
    { Public declarations }
  end;

var
  bbdc: Tbbdc;

implementation

uses datafrm,yhsdffrm,comobj,excel97,mainfrm;
{$R *.dfm}

procedure Tbbdc.SpeedButton6Click(Sender: TObject);
begin
close;
end;

procedure Tbbdc.SpeedButton1Click(Sender: TObject);
var
  index: integer;
begin
  index:=getfirstselection(listbox1);
  moveselected(listbox1,listbox2.Items);
  setitem(listbox1,index);
end;

procedure Tbbdc.SpeedButton3Click(Sender: TObject);
var
  index: integer;
begin
  index:=getfirstselection(listbox2);
  moveselected(listbox2,listbox1.Items);
  setitem(listbox2,index);
end;

procedure Tbbdc.SpeedButton4Click(Sender: TObject);
var
  i: integer;
begin
  for i:=0 to listbox2.Items.Count-1 do
    listbox1.Items.AddObject(listbox2.Items[i],listbox2.Items.Objects[i]);
  listbox2.Items.Clear;
  setitem(listbox2,0);
end;

procedure Tbbdc.SpeedButton2Click(Sender: TObject);
var
  i: integer;
begin
  for i:=0 to listbox1.Items.Count-1 do
    listbox2.Items.AddObject(listbox1.Items[i],listbox1.Items.Objects[i]);
  listbox1.Items.Clear;
  setitem(listbox1,0);
end;

procedure tbbdc.setbuttons;
var
  srcempty, dscempty: boolean;
begin
  srcempty:=listbox1.Items.Count=0;
  dscempty:=listbox2.Items.Count=0;
  speedbutton1.Enabled:= not srcempty;
  speedbutton2.Enabled:= not srcempty;
  speedbutton3.Enabled:= not dscempty;
  speedbutton4.Enabled:= not dscempty;
end;

function tbbdc.getfirstselection(list: TTeThemeListBox): integer;
begin
  for result:=0 to list.Items.Count-1 do
    if list.Selected[result] then exit;
  result:=lb_err;
end;

procedure tbbdc.setitem(list: TTeThemeListBox; index: integer);
var
  maxindex:integer;
begin
  with list do
  begin
    setfocus;
    maxindex:= list.Items.Count-1;
    if index=lb_err then index:=0
    else if index>maxindex then index:=maxindex;
    selected[index]:=true;
  end;
  setbuttons;
end;

procedure tbbdc.getdata;
begin
  yfgldata.dbbdc.TableName:=vps_name;
  yfgldata.dbbdc.Active:=true;
  yfgldata.dbbdc.Filter:=vps_filter;
  yfgldata.dbbdc.Filtered:=true;
end;

procedure tbbdc.exportdatatoexcel;
var
  i,j,k,l,m: integer;
  xxx1: string;
begin
  if bbdc.ListBox2.Items.Count=0 then
  begin
    MessageBox(bbdc.Handle,'没有选择目标字段！','营房工作管理系统',mb_iconwarning+mb_defbutton1);
    exit;
  end;
  main.Bar1.Panels[0].Text:='正在载入EXCEL，请稍侯......';
  main.Bar1.Refresh;
  try
    screen.Cursor:=crhourglass;
    try
      varexcel:=createoleobject('excel.application');
      if not varisempty(varexcel) then
      begin
        varexcel.workbooks.add;
        varexcel.workbooks[1].worksheets[1].name:='数据库信息';
      end;
    except
      MessageBox(bbdc.Handle,'请确认是否安装EXCEL？','营房工作管理系统',mb_iconquestion+mb_defbutton1);
      exit;
    end;
    begin
      getdata;
      range:=varexcel.workbooks[1].worksheets[1].columns;
      for i:=0 to bbdc.ListBox2.Items.Count-1 do
      begin
        varexcel.workbooks[1].worksheets[1].cells[2,i+1].value:=bbdc.ListBox2.Items.Strings[i];
        varexcel.workbooks[1].worksheets[1].cells[2,i+1].font.bold:=true;
        range.columns[i+1].columnwidth:=yfgldata.dbbdc.FieldByName(bbdc.ListBox2.Items.Strings[i]).DisplayWidth;
        range.columns[i+1].horizontalalignment:=xlcenter;
      end;
      try
        try
          main.Bar1.Panels[0].Text:='正在向EXCEL导出数据......';
          yfgldata.dbbdc.First;
          j:=3;
          for l:=1 to yfgldata.dbbdc.RecordCount do
            begin
              for i:=0 to bbdc.ListBox2.Items.Count-1 do
              begin
                varexcel.workbooks[1].worksheets[1].cells[j,i+1].value:=yfgldata.dbbdc.FieldValues[bbdc.ListBox2.Items.Strings[i]];
              end;
              yfgldata.dbbdc.FindNext;
              bbdc.Gauge1.Progress:=(100*yfgldata.dbbdc.RecNo) div yfgldata.dbbdc.RecordCount;
              j:=j+1;
            end;
            varexcel.workbooks[1].worksheets[1].cells[j+1,2].value:='制表：'+bbdc.Edit2.Text;
            varexcel.workbooks[1].worksheets[1].cells[j+1,4].value:='日期：'+datetostr(bbdc.DateTimePicker1.Date);
        except
        end;
      finally
        bbdc.Gauge1.Progress:=0;
        main.Bar1.Panels[0].Text:='欢迎使用营房工作管理系统。';
        k:=i div 26;
        m:=i mod 26;
        if k>0 then
          xxx1:=chr(k-1+ord('A'))+chr(m-1+ord('A'))
        else
          xxx1:=chr(m-1+ord('A'));
        xxx1:='A2:'+xxx1+inttostr(j-1);
        range:=varexcel.workbooks[1].worksheets[1].range[xxx1];
        range.borders.linestyle:=xlcontinuous;
        k:=i div 26;
        m:=i mod 26;
        if k>0 then
          xxx1:=chr(k-1+ord('A'))+chr(m-1+ord('A'))
        else
          xxx1:=chr(m-1+ord('A'));
        xxx1:='a1:'+xxx1+'1';
        range:=varexcel.workbooks[1].worksheets[1].range[xxx1];
        range.horizontalalignment:=xlcenter;
        range.verticalalignment:=xlcenter;
        range.mergecells:=true;
        varexcel.workbooks[1].worksheets[1].range['a1:a1']:=bbdc.Edit1.Text;
        varexcel.workbooks[1].worksheets[1].range['a1:a1'].font.name:='黑体';
        varexcel.workbooks[1].worksheets[1].range['a1:a1'].font.size:='18';
        varexcel.visible:=true;
        bbdc.Close;
      end;
    end;
  finally
    screen.Cursor:=crarrow;
  end;
end;

procedure Tbbdc.SpeedButton5Click(Sender: TObject);
begin
if bbdc.Edit1.Text<>'' then
  if bbdc.Edit2.Text<>'' then
    bbdc.exportdatatoexcel
  else
    messagebox(bbdc.handle,'请输入制表人。','营房工作管理系统',16)
else
  messagebox(bbdc.handle,'请输入报表标题。','营房工作管理系统',16);
end;

procedure tbbdc.moveselected(list: TTeThemeListBox; items: tstrings);
var
  i: integer;
begin
  for i:=list.Items.Count-1 downto 0 do
    if list.Selected[i] then
    begin
      items.AddObject(list.Items[i],list.Items.Objects[i]);
      list.Items.Delete(i);
    end;
end;

procedure Tbbdc.FormActivate(Sender: TObject);
begin
bbdc.setbuttons;
bbdc.DateTimePicker1.Date:=now;
end;

end.