upub3.pas

成本系统三层结构源码 开发工具：Delphi 7.0+SQLServer 2005 主要技术：Midas、COM+ 所用第三方控件： FastReport V2.47 D7 Inforp

unit upub3;

interface

uses
  Windows, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, Buttons, ExtCtrls, Menus, ComCtrls,
  dxCntner, dxTL, dxDBCtrl, dxDBGrid, StdCtrls, Tabs, DateUtils,
  dxExEdtr, wwstr, registry, ImgList,
  ToolWin, ActnList, DBClient, wwdbdatetimepicker, dxEditor, dxEdLib;

type
  Tfmpub3 = class(TForm)
    DataSource1: TDataSource;
    OptionPanel: TPanel;
    PageControl: TPageControl;
    TabBrowse: TTabSheet;
    TabReport: TTabSheet;
    Splitter: TSplitter;
    DBGrid1: TdxDBGrid;
    LbLStart: TLabel;
    DTPMonth: TDateTimePicker;
    LblEnd: TLabel;
    SubAction: TActionList;
    APreview: TAction;
    APrint: TAction;
    ALocate: TAction;
    ALocateNext: TAction;
    AFilter: TAction;
    ARefresh: TAction;
    AExcel: TAction;
    AApprove: TAction;
    AConfirm: TAction;
    AFirst: TAction;
    APrior: TAction;
    ANext: TAction;
    ALast: TAction;
    AClose: TAction;
    AHelp: TAction;
    ToolBar1: TToolBar;
    TBPreview: TToolButton;
    TBPrint: TToolButton;
    TBExcel: TToolButton;
    TBBlank1: TToolButton;
    TBLocate: TToolButton;
    TBFilter: TToolButton;
    TBRefresh: TToolButton;
    TBBlank2: TToolButton;
    TBTemp: TToolButton;
    TBApprove: TToolButton;
    TBConfirm: TToolButton;
    TBFirst: TToolButton;
    TBLast: TToolButton;
    TBBlank3: TToolButton;
    TBClose: TToolButton;
    TBHelp: TToolButton;
    TBBlank4: TToolButton;
    DateTo: TwwDBDateTimePicker;
    DateFrm: TwwDBDateTimePicker;
    PnlProject: TPanel;
    LblProject: TLabel;
    CmbProject: TComboBox;
    PnlMonth: TPanel;
    LblMonth: TLabel;
    PnlDate: TPanel;
    PnlSelect: TPanel;
    LBLSelect: TLabel;
    dxBtnSelect: TdxButtonEdit;
    Menu1: TPopupMenu;
    N22222: TMenuItem;
    Menu2: TPopupMenu;
    N2: TMenuItem;
    Menu3: TPopupMenu;
    Mutl: TMenuItem;
    Column: TMenuItem;
    Grid: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure SpdprintClick(Sender: TObject);
    procedure menuviewClick(Sender: TObject);
    procedure menuprintClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure DBGrid1AddGroupColumn(Sender: TObject;
      Column: TdxDBTreeListColumn; var Allow: Boolean);
    procedure DBGrid1ColumnClick(Sender: TObject;
      Column: TdxDBTreeListColumn);
    procedure DBGrid1HeaderButtonClick(Sender: TObject);
    procedure GriddClick(Sender: TObject);
    procedure APreviewExecute(Sender: TObject);
    procedure APrintExecute(Sender: TObject);
    procedure ALocateExecute(Sender: TObject);
    procedure AFilterExecute(Sender: TObject);
    procedure AFirstExecute(Sender: TObject);
    procedure ALastExecute(Sender: TObject);
    procedure AExcelExecute(Sender: TObject);
    procedure ACloseExecute(Sender: TObject);
    procedure APriorExecute(Sender: TObject);
    procedure ANextExecute(Sender: TObject);
    procedure ARefreshExecute(Sender: TObject);
    procedure ColumnClick(Sender: TObject);
    procedure GridClick(Sender: TObject);
    procedure AHelpExecute(Sender: TObject);
    procedure dxBtnSelectChange(Sender: TObject);
  private
    { Private declarations }
    Reg3:Tregistry;
    FilterStr:TStrings;
    procedure myclick(Sender: TObject);
  public
    { Public declarations }
  end;

var
  fmpub3: Tfmpub3;
  showmess :boolean=true;

implementation

uses SherryLib, uReport, udata;

{$R *.dfm}

procedure Tfmpub3.myclick(Sender: TObject);
var i:integer;
begin
  if (Tmenuitem(sender).Caption='显示所有字段') or
     (Tmenuitem(sender).name='showall') then
  for i:=0 to DBgrid1.ColumnCount-1 do
  begin
    DBgrid1.Columns[i].Visible:=true;
    column.Items[i].Checked:=true;
  end;
  for i:=0 to DBgrid1.ColumnCount-1 do
  if DBgrid1.Columns[i].FieldName=Tmenuitem(sender).Name then
  begin
    DBgrid1.Columns[i].Visible:=not DBgrid1.Columns[i].Visible;
    Tmenuitem(sender).Checked:=not Tmenuitem(sender).Checked;
  end;
end;

procedure Tfmpub3.FormCreate(Sender: TObject);
var i,j:integer;
    menu:Tmenuitem;
    list,temp:Tstringlist;
begin
  FilterStr:=TStringList.Create;
  reg3:=Tregistry.Create;
  reg3.RootKey:=HKEY_CURRENT_USER;
  reg3.OpenKey('sherry\Grid\'+self.Name,true);
  DTPMonth.Date:=EnCodeDate(Yearof(Date),Monthof(Date),1);
  DateFrm.Date:=GDateFrm;
  DateTo.Date:=GDateTo;
  if not self.Scaled then  self.Scaled:=True;
  TabBrowse.TabVisible:=False;
  TabReport.TabVisible:=False;
  PageControl.ActivePage:=TabBrowse;
  DBgrid1.GridLineColor:=$00ff0000;
  Dbgrid1.FixedBandLineColor:=clred;
  if datasource1.DataSet=nil then Warn('请先指定数据! ');
  try
    if reg3.ValueExists('savestatus') then
    if reg3.ReadBool('savestatus') then
    begin
      grid.Checked:=true;
      list:=Tstringlist.Create;
      temp:=Tstringlist.create;
      reg3.GetValueNames(list);
      for i:=list.Count-1 downto 0 do
      begin
        if lowercase(list.Strings[i])='savestatus' then continue;
        strBreakApart(reg3.ReadString(list.Strings[i]), #13, temp);  //wwstr
        if length(temp.Strings[0])=4 then
        dbgrid1.ColumnByFieldName(list.Strings[i]).Visible:=True else
        dbgrid1.ColumnByFieldName(list.Strings[i]).Visible:=False;
        dbgrid1.ColumnByFieldName(list.Strings[i]).Width:=StrToInt(temp.Strings[1]);
        dbgrid1.ColumnByFieldName(list.Strings[i]).ColIndex:=StrToInt(temp.Strings[2]);
        dbgrid1.ColumnByFieldName(list.Strings[i]).BandIndex:=StrToInt(temp.Strings[3]);
        dbgrid1.ColumnByFieldName(list.Strings[i]).Index:=StrToInt(temp.Strings[4]);
      end;
      list.Free;
      temp.Free;
    end;
  except
  end;

  //sherrylib.FormCreate(self);
  for i:=0 to DBGrid1.ColumnCount-1 do
  begin
    if i<3 then
    DBGrid1.Columns[i].BandIndex:=0
    else
    DBGrid1.Columns[i].BandIndex:=1;
  end;
  for i:=0 to DBGrid1.ColumnCount-1 do
  begin
    DBGrid1.Columns[i].DisableEditor:=true;
    Dbgrid1.Columns[i].TreeList.ApplyBestFit(nil);
  end;

  if Dbgrid1.ColumnCount<=3 then DBgrid1.Bands[1].Visible:=false;
  dbgrid1.Bands.Items[0].Fixed:=bfLeft;
  dbgrid1.Bands.Items[0].Width:=0;

  dbgrid1.OptionsBehavior:=dbgrid1.OptionsBehavior+
          [edgoautosort,edgoautosearch,edgomultisort];
  dbgrid1.OptionsDB:=dbgrid1.OptionsDB  //+[edgoloadallrecords]
          -[edgocandelete,edgocaninsert];

  if not TMenuItem(Column).Visible then exit;
  j:=0;
  for i:=0 to DBgrid1.ColumnCount-1 do
  begin
   begin
     if DBgrid1.Columns[i].Field=nil then continue;
     menu:=Tmenuitem.Create(self);
     Column.Add(menu);
     menu.Name:=DBgrid1.Columns[i].FieldName;
     menu.Caption:=DBgrid1.Columns[i].Field.DisplayName;
     menu.Checked:=true;
     menu.onclick:=myclick;
     j:=j+1;
     if (j mod 20=0) then menu.Break:=mbBarBreak;
   end;
  end;
  menu:=Tmenuitem.Create(self);
  Column.Add(menu);
  menu.Name:='showall';
  menu.Default:=true;
  menu.Caption:='显示所有字段';
  menu.onclick:=myclick;
end;

procedure Tfmpub3.FormClose(Sender: TObject; var Action: TCloseAction);
var i:integer;
    str:string;
begin
  CloseData(DataSource1);
  FilterStr.Free;
  if assigned(reg3) then begin
  try
    if reg3.ValueExists('savestatus') then
    if reg3.ReadBool('savestatus') then
    begin
      dbgrid1.Refresh;
      for i:=dbgrid1.ColumnCount-1 downto 0 do
      begin
        str:='';
        begin
          if dbgrid1.Columns[i].Visible=true then
          str:='True' else str:='False';
          str:=str+#13+inttostr(dbgrid1.Columns[i].Width);
          str:=str+#13+inttostr(dbgrid1.Columns[i].ColIndex);
          str:=str+#13+inttostr(dbgrid1.Columns[i].BandIndex);
          str:=str+#13+inttostr(dbgrid1.Columns[i].Index);
          reg3.WriteString(dbgrid1.Columns[i].FieldName,str);
          str:='';
        end;
      end;
    end;
  finally
    reg3.CloseKey;
    reg3.Destroy;
  end;
  end;
  Log(Self.Caption,'关闭'+Self.Caption);
  sherrylib.FormClose(self);
  action:=cafree;
end;

procedure Tfmpub3.SpdprintClick(Sender: TObject);
begin
  if not (APrint.Enabled and APrint.Visible) then abort;
end;

procedure Tfmpub3.menuviewClick(Sender: TObject);
begin
  if not (APrint.Enabled and APrint.Visible) then abort;
  ToExcel(DbGrid1.DataSource.DataSet,self.Caption)
end;

procedure Tfmpub3.menuprintClick(Sender: TObject);
begin
  if not (APrint.Enabled and APrint.Visible) then abort;
  ToExcel(DbGrid1.DataSource.DataSet,self.Caption)
end;

procedure Tfmpub3.FormActivate(Sender: TObject);
begin
  self.WindowState:=wsMaximized;
  ComboBoxDropDown(CmbProject);  
end;

procedure Tfmpub3.DBGrid1AddGroupColumn(Sender: TObject;
  Column: TdxDBTreeListColumn; var Allow: Boolean);
begin
  if DBGrid1.GroupColumnCount>2 then
  Warn('系统允许的最多分组是3组，分组太多会影响系统的速度!');
end;

procedure Tfmpub3.DBGrid1ColumnClick(Sender: TObject;
  Column: TdxDBTreeListColumn);
begin
  if length(Dbgrid1.KeyField)=0 then
  begin
     Dbgrid1.KeyField:=Column.FieldName;
     dbgrid1.OptionsDB:=dbgrid1.OptionsDB+[edgoloadallrecords];
  end
  else
  dbgrid1.OptionsDB:=dbgrid1.OptionsDB+[edgoloadallrecords];
end;

procedure Tfmpub3.DBGrid1HeaderButtonClick(Sender: TObject);
begin
  dbgrid1.OptionsDB:=dbgrid1.OptionsDB+[edgoloadallrecords]
end;

procedure Tfmpub3.GriddClick(Sender: TObject);
begin
  grid.Checked:=not grid.Checked;
  reg3.WriteBool('savestatus',grid.Checked);
end;

procedure Tfmpub3.APreviewExecute(Sender: TObject);
begin
  if not (TAction(Sender).Enabled and TAction(Sender).Visible) then abort;
  if (DataSource1 = nil) or (DataSource1.DataSet = nil) or (not DataSource1.DataSet.Active) then Warn('数据源未激活,请先完成查询或统计!');
  Preview(self.Name,False,DataSource1.DataSet);
end;

procedure Tfmpub3.APrintExecute(Sender: TObject);
begin
  if not (TAction(Sender).Enabled and TAction(Sender).Visible) then abort;
  if (DataSource1 = nil) or (DataSource1.DataSet = nil) or (not DataSource1.DataSet.Active) then Warn('数据源未激活,请先完成查询或统计!');
  Preview(self.Name,True,DataSource1.DataSet);  
end;

procedure Tfmpub3.ALocateExecute(Sender: TObject);
begin
  if not (TAction(Sender).Enabled and TAction(Sender).Visible) then abort;
  if (DataSource1 = nil) or (DataSource1.DataSet = nil) or (not DataSource1.DataSet.Active) then Warn('数据源未激活,请先完成查询或统计!');
  if DBGrid1.FocusedField<>nil then
    sherryLib.Locate(DataSource1,DBGrid1.FocusedField.FieldName)
  else
    sherryLib.Locate(DataSource1,DBGrid1.DataSource.DataSet.Fields.Fields[0].FieldName)  
end;

procedure Tfmpub3.AFilterExecute(Sender: TObject);
begin
  if not (TAction(Sender).Enabled and TAction(Sender).Visible) then abort;
  if (DataSource1 = nil) or (DataSource1.DataSet = nil) or (not DataSource1.DataSet.Active) then Warn('数据源未激活,请先完成查询或统计!');
  Filter(DataSource1,FilterStr);
end;

procedure Tfmpub3.AFirstExecute(Sender: TObject);
begin
  if not (TAction(Sender).Enabled and TAction(Sender).Visible) then abort;
  if (DataSource1 = nil) or (DataSource1.DataSet = nil) or (not DataSource1.DataSet.Active) then Warn('数据源未激活,请先完成查询或统计!');
  Datasource1.DataSet.First;
end;

procedure Tfmpub3.ALastExecute(Sender: TObject);
begin
  if not (TAction(Sender).Enabled and TAction(Sender).Visible) then abort;
  if (DataSource1 = nil) or (DataSource1.DataSet = nil) or (not DataSource1.DataSet.Active) then Warn('数据源未激活,请先完成查询或统计!');
  Datasource1.DataSet.Last;
end;

procedure Tfmpub3.AExcelExecute(Sender: TObject);
begin
  if (DataSource1 = nil) or (DataSource1.DataSet = nil) or (not DataSource1.DataSet.Active) then Warn('数据源未激活,请先完成查询或统计!');
  GridToExcel(DBGrid1,self.Caption);
end;

procedure Tfmpub3.ACloseExecute(Sender: TObject);
begin
  close;
end;

procedure Tfmpub3.APriorExecute(Sender: TObject);
begin
  if not (TAction(Sender).Enabled and TAction(Sender).Visible) then abort;
  if (DataSource1 = nil) or (DataSource1.DataSet = nil) or (not DataSource1.DataSet.Active) then Warn('数据源未激活,请先完成查询或统计!');
  Datasource1.DataSet.Prior;
end;

procedure Tfmpub3.ANextExecute(Sender: TObject);
begin
  if not (TAction(Sender).Enabled and TAction(Sender).Visible) then abort;
  if (DataSource1 = nil) or (DataSource1.DataSet = nil) or (not DataSource1.DataSet.Active) then Warn('数据源未激活,请先完成查询或统计!');
  Datasource1.DataSet.Next;
end;

procedure Tfmpub3.ARefreshExecute(Sender: TObject);
var
  SavePlace:TBookmark;
begin
  if not (TAction(Sender).Enabled and TAction(Sender).Visible) then abort;
  if (DataSource1 = nil) or (DataSource1.DataSet = nil) or (not DataSource1.DataSet.Active) then Warn('数据源未激活,请先完成查询或统计!');  
  SavePlace := DbGrid1.DataSource.DataSet.GetBookmark;
  try
    CloseData(DataSource1);
    OpenData(DataSource1);
    DbGrid1.DataSource.DataSet.GotoBookmark(SavePlace);
  finally
    DataSource1.DataSet.FreeBookmark(SavePlace);
  end;
end;

procedure Tfmpub3.ColumnClick(Sender: TObject);
begin
  Mutl.Checked:=not Mutl.Checked;
  if Mutl.Checked then
    dbgrid1.OptionsBehavior:=dbgrid1.OptionsBehavior+[edgomultiselect]
  else
    dbgrid1.OptionsBehavior:=dbgrid1.OptionsBehavior-[edgomultiselect];
end;

procedure Tfmpub3.GridClick(Sender: TObject);
begin
  grid.Checked:=not grid.Checked;
  reg3.WriteBool('savestatus',grid.Checked);
end;

procedure Tfmpub3.AHelpExecute(Sender: TObject);
begin
  Help1(Self.HelpKeyword)
end;

procedure Tfmpub3.dxBtnSelectChange(Sender: TObject);
begin
  TdxButtonEdit(Sender).ShowHint:=True;
  TdxButtonEdit(Sender).Hint:=TdxButtonEdit(Sender).Text;
end;

end.