ubaseinfo.pas

进销存以及BOM管理,SQl Server数据库程序

unit ubaseinfo;
                                                                        
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, MDIBase, ToolWin, ComCtrls, ImgList, ActnList, Grids, DBGridEh,
  StdCtrls, Buttons, ExtCtrls, DB, ADODB, Base, Menus, FR_Desgn, FR_DSet,
  FR_DBSet, FR_Class, Comobj, dbTABLES, MSNPopUp, Jpeg;

const
  WM_USER_GETQINFOBASE = WM_USER+1024;

type
  TfrmBaseinfo = class(TfrmMDIbase)
    ToolBar1: TToolBar;
    CoolBar1: TCoolBar;
    ActionList1: TActionList;
    s01: TAction;
    s03: TAction;
    s04: TAction;
    s05: TAction;
    ToolButtonImages: TImageList;
    s06: TAction;
    s07: TAction;
    s08: TAction;
    Panel1: TPanel;
    SpeedButton1: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    Panel2: TPanel;
    SpeedButton5: TSpeedButton;
    SpeedButton6: TSpeedButton;
    SpeedButton7: TSpeedButton;
    SpeedButton8: TSpeedButton;
    QBaseInfo: TADOQuery;
    dsBaseInfo: TDataSource;
    Lcaption: TLabel;
    PopupMenu1: TPopupMenu;
    reportpre: TAction;
    reports: TAction;
    reportmodify: TAction;
    excel: TAction;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    reportset: TAction;
    N8: TMenuItem;
    N9: TMenuItem;
    frreport: TfrReport;
    frDBDataSet1: TfrDBDataSet;
    frDesigner1: TfrDesigner;
    ADSfield: TADODataSet;
    PmenuRight: TPopupMenu;
    interfacep: TAction;
    fieldproperty: TAction;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    N18: TMenuItem;
    N19: TMenuItem;
    N20: TMenuItem;
    N21: TMenuItem;
    N22: TMenuItem;
    N23: TMenuItem;
    N24: TMenuItem;
    mpopupLX: TMSNPopUp;
    ADSfieldfid: TAutoIncField;
    ADSfieldftablename: TWideStringField;
    ADSfieldffieldname: TWideStringField;
    ADSfieldffielddesc: TWideStringField;
    ADSfieldffieldtype: TIntegerField;
    ADSfieldffieldlong: TWideStringField;
    ADSfieldfisnull: TBooleanField;
    ADSfieldfdefaultvalue: TWideStringField;
    ADSfieldfisvisible: TBooleanField;
    Grid: TDBGridEh;
    procedure s08Execute(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormShow(Sender: TObject);
    procedure GridGetCellParams(Sender: TObject; Column: TColumnEh;
      AFont: TFont; var Background: TColor; State: TGridDrawState);
    procedure s06Execute(Sender: TObject);
    procedure s01Execute(Sender: TObject);
    procedure s07Execute(Sender: TObject);
    procedure s03Execute(Sender: TObject);
    procedure s04Execute(Sender: TObject);
    procedure s05Execute(Sender: TObject);
    procedure reportpreExecute(Sender: TObject);
    procedure reportsExecute(Sender: TObject);
    procedure reportsetExecute(Sender: TObject);
    procedure reportmodifyExecute(Sender: TObject);
    procedure excelExecute(Sender: TObject);
    procedure interfacepExecute(Sender: TObject);
    procedure fieldpropertyExecute(Sender: TObject);
  private
    procedure getqbaseinfo(var msg:Tmessage);message WM_USER_GETQINFOBASE;
    { Private declarations }
  protected
    //iFunctionID :Integer;
    UnitTitle:String;
    MainTable:string;
    SubTable:string;
    ReportName:string;
    ModifyForm:TformClass;

    bCanNew,bCanModify,bCanDelete,bCanPrint :Boolean;
    function CheckSave :Boolean;  {检测当前数据是否保存函数}
    Procedure GetPermiss ; virtual; {得到当前用户的权限}
    function GetGridTitle(TableName:String):Boolean;
 //   function getfieldtype(sfieldtype:String):Tfieldtype;
 //   function getfieldlong(sfieldtype:String;const Flong:String):Integer;
  public
    { Public declarations }
  end;

var
  frmBaseinfo: TfrmBaseinfo;

implementation

uses Global, Data, usearch, ufieldproperty;

{$R *.dfm}

function TfrmBaseinfo.CheckSave: Boolean;
begin
Result:=true;
if QBaseInfo.State in [dsInsert,dsEdit] then //判断当前状态
   Case Messagedlg('是否保存当前的修改？',mtWarning,[mbYes,mbNo,mbCancel],0) of
   mrYes:
     begin
     QBaseInfo.Post ;
     Result := QBaseInfo.State = dsBrowse;  //状态是否为Browse
     end;
   mrNo:
     begin
     QBaseInfo.Cancel ;
     Result := QBaseInfo.State = dsBrowse;  //状态是否为Browse
     end;
   mrCancel:
     Result := False ;
   End
end;

procedure TfrmBaseinfo.GetPermiss;
begin
{初始化变量}
bCanNew :=gs_admin;
bCanModify :=gs_admin;
bCanDelete :=gs_admin;
bCanPrint :=gs_admin;

if gs_admin then //判断是否为超级用户
begin
   bCanNew :=gs_admin;
   bCanModify :=gs_admin;
   bCanDelete :=gs_admin;
   bCanPrint :=gs_admin;
end
else  //否则查找当前用户是否有当前窗体的操作权限
{with dmClient.spUserRight do
  if Locate('fModuleID;fActionName',varArrayOf([iModuleID,sFunctionName]),[]) then
     begin
     bCanNew := FieldByName('fInsert').AsBoolean;
     bCanModify := FieldByName('fEdit').AsBoolean;
     bCanDelete := FieldByName('fDelete').AsBoolean;
     bCanPrint := FieldByName('fPrint').AsBoolean;
     end}
end;

procedure TfrmBaseinfo.s08Execute(Sender: TObject);
begin
  inherited;
  close;
end;

procedure TfrmBaseinfo.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  inherited;
  canClose:=checkSave;
end;

procedure TfrmBaseinfo.FormShow(Sender: TObject);
begin
  inherited;
  Lcaption.Caption:=UnitTitle;
  postmessage(handle,WM_USER_GETQINFOBASE,0,0);
  application.ProcessMessages;
end;

procedure TfrmBaseinfo.GridGetCellParams(Sender: TObject;
  Column: TColumnEh; AFont: TFont; var Background: TColor;
  State: TGridDrawState);
begin
  inherited;
  if Grid.SumList.RecNo mod 2=1 then
    BackGround:=$00EAEFED
    else
    BackGround:=clWhite;
end;

procedure TfrmBaseinfo.s06Execute(Sender: TObject);
var
  Point:Tpoint;
begin
  inherited;
  Point:=GetScreenpoint(SpeedButton7);
  popupmenu1.Popup(point.X,point.Y);
end;

procedure TfrmBaseinfo.s01Execute(Sender: TObject);
var
  Child:Tform;
begin
  inherited;

  Qbaseinfo.Append;

  Child:=ModifyForm.Create(Application);
  Child.ShowModal;

  postmessage(handle,WM_USER_GETQINFOBASE,0,0);
  application.ProcessMessages;      
end;

procedure TfrmBaseinfo.s07Execute(Sender: TObject);
begin
  inherited;
  postmessage(handle,WM_USER_GETQINFOBASE,0,0);
  application.ProcessMessages;
end;

procedure TfrmBaseinfo.s03Execute(Sender: TObject);
var
  Child:Tform;
begin
  inherited;

  Qbaseinfo.Edit;

  Child:=ModifyForm.Create(Application);
  Child.ShowModal;

  postmessage(handle,WM_USER_GETQINFOBASE,0,0);
  application.ProcessMessages;
end;

procedure TfrmBaseinfo.s04Execute(Sender: TObject);
begin
  inherited;
  if Qbaseinfo.RecordCount > 0 then
    begin
      if messagedlg('请确认删除该记录吗 ? ',mtConfirmation,[mbok,mbcancel],0)=mrok then
        begin
          Qbaseinfo.Delete;
        end;
    end;
end;

procedure TfrmBaseinfo.s05Execute(Sender: TObject);
var
  i,j:Integer;
begin
  inherited;
  InitArray;
  for i:=0 to Qbaseinfo.FieldCount-1 do
    begin
      FindArray1[i]:=Qbaseinfo.Fields[i].FieldName;
    end;
  for j:=0 to Grid.Columns.Count-1 do
    begin
      FindArray2[j]:=Grid.Columns[j].Title.Caption;
    end;

  if not Assigned(frmSearch) then
    frmSearch:=TfrmSearch.Create(application);
    frmSearch.ShowModal;

  if searchtiao<>'' then
    begin
      try
        with Qbaseinfo do
          begin
            close;
            sql.Clear;
            sql.Add('Select * from '+MainTable+' Where '+Searchtiao+' order by fid');
            open;
          end;
      except
        on E:exception do
          begin
            messagedlg('条件设置错误 , 请重新设置 ! '+#10#13+E.Message,mtError,[mbok],0);
            Abort;
          end;
      end;
    end;
end;

procedure TfrmBaseinfo.reportpreExecute(Sender: TObject);
begin
  inherited;
//  Qbaseinfo.DisableControls;
  frReport.LoadFromFile(reportName);
  frReport.ShowReport;
//  Qbaseinfo.EnableControls;
end;

procedure TfrmBaseinfo.reportsExecute(Sender: TObject);
begin
  inherited;
  Qbaseinfo.DisableControls;
  frReport.LoadFromFile(ReportName);
  frReport.PrepareReport;
  frReport.PrintPreparedReport('',1,True,frAll);
  Qbaseinfo.EnableControls;
end;

procedure TfrmBaseinfo.reportsetExecute(Sender: TObject);
begin
  inherited;
  Qbaseinfo.DisableControls;
  frReport.LoadFromFile(ReportName);
  frReport.PrepareReport;
  frReport.PrintPreparedReportDlg;
  Qbaseinfo.EnableControls;
end;

procedure TfrmBaseinfo.reportmodifyExecute(Sender: TObject);
begin
  inherited;
  Qbaseinfo.DisableControls;
  frReport.LoadFromFile(ReportName);
  frReport.DesignReport;
  Qbaseinfo.EnableControls;   
end;

procedure TfrmBaseinfo.excelExecute(Sender: TObject);
Var
  ExcelApp:Variant;
  SaveDialog1: TSaveDialog;
  i,j,row,column:integer;
  FileUsed:Boolean;
begin
  inherited;
  if Qbaseinfo.IsEmpty then
  begin
    ShowMessage('没有数据需要存盘！');//test
    Exit;
  end;

  Qbaseinfo.DisableControls;

  SaveDialog1:= TSaveDialog.Create(nil);
  SaveDialog1.Filter := 'Excel 文件 (*.xls)|*.xls';
  SaveDialog1.Title:='确定另存为excel的文件名';
  if savedialog1.Execute Then
    begin
      while f_IsFileInUse(savedialog1.FileName) do
      begin
        case Application.MessageBox(PChar('无法存盘，'+string(ExtractFileName(savedialog1.FileName))+'正在使用中'), '请确认', MB_ICONQuestion+MB_ABORTRETRYIGNORE+MB_DEFBUTTON2) of
          IDAbort:
            begin
              SaveDialog1.Free;
              Exit;
            end;
          IDRetry:
            begin
              continue;
            end;
          IDIgnore:
            begin
              if Not savedialog1.Execute then break;
            end;
        end;
      end;
    end
  else
    begin
      SaveDialog1.Free;
      exit;
    end;//if
  Screen.Cursor:=crSQLWait;
  Qbaseinfo.First;
      
  ExcelApp:=CreateOleObject( 'Excel.Application' );//首先创建 Excel 对象，使用ComObj
  try
    ExcelApp.Visible := False;//显示当前窗口
    ExcelApp.Caption := '应用程序调用 Microsoft Excel';//更改 Excel 标题栏
    ExcelApp.WorkBooks.Add;//添加新工作簿：
    ExcelApp.WorkSheets[ 'Sheet1' ].Activate;//设置第1个工作表为活动工作表
//    ExcelApp.Cells[1,4].Value := '第一行第四列';//给单元格赋值：
  //设置第一行字体属性：
    ExcelApp.ActiveSheet.Rows[1].Font.Name := '宋体';
    ExcelApp.ActiveSheet.Rows[1].Font.Size:=12;
    ExcelApp.ActiveSheet.Rows[1].Font.Color := clBlue;
    ExcelApp.ActiveSheet.Rows[1].Font.Bold := False;
//    ExcelApp.ActiveSheet.Rows[1].Font.UnderLine := True;
    row:=1;
    column:=1;
//    for j:= 0 to Qbaseinfo.FieldCount-1 do
    for j:= 0 to grid.Columns.Count - 1 do
      begin
        ExcelApp.Cells[row,column].Value:=Grid.Columns[j].Title.Caption;
        column:=column+1;
      end;
    row:=2;
    while Not Qbaseinfo.Eof do
    begin
      column:=1;
      for i:=1 to Qbaseinfo.FieldCount do
        begin
          ExcelApp.Cells[row,column].Value:=Qbaseinfo.fields[i-1].AsString;
          column:=column+1;
        end;
      Qbaseinfo.Next;
      row:=row+1;
    end;
    if Not f_IsFileInUse(savedialog1.FileName) then
      try
        ExcelApp.ActiveWorkBook.SaveAs(savedialog1.filename);
      except
        SaveDialog1.Free;
        ExcelApp.WorkBooks.Close;
        ExcelApp.Quit;
        ExcelApp:= Unassigned;
        exit;
      end;
    SaveDialog1.Free;
    ExcelApp.WorkBooks.Close;
    ExcelApp.Quit;
    ExcelApp:= Unassigned;
  except
    SaveDialog1.Free;
    ExcelApp:= Unassigned;
  end;
Qbaseinfo.EnableControls;
Screen.Cursor:=crDefault;
end;

function TfrmBaseinfo.GetGridTitle(TableName: String): Boolean;
var
  i:integer;
begin
if TableName='' then
    Exit;
    
  i:=0;
  with ADSfield do
    Begin
      close;
      CommandText:='Select * from Ttablefield where ftablename='+Quotedstr(TableName);
      open;
    end;
  if ADSfield.RecordCount > 0 then
    begin
      Qbaseinfo.First;
      for i:=0 to Qbaseinfo.Fields.Count-1 do
        begin
          ADSfield.First;
          while not ADSfield.Eof do
          begin
            if Qbaseinfo.Fields[i].DisplayName=ADSfield.FieldByName('ffieldname').AsString then
              begin
                Qbaseinfo.Fields[i].DisplayLabel:=ADSfield.FieldByName('ffielddesc').AsString;
                if (ADSfield.fieldbyname('ffieldtype').AsInteger=4) or
                   (ADSfield.fieldbyname('ffieldtype').AsInteger=5) or
                   (ADSfield.fieldbyname('ffieldtype').AsInteger=7) then
                    Qbaseinfo.Fields[i].DisplayWidth:=12
                  else
                    Qbaseinfo.Fields[i].DisplayWidth:=trunc(ADSfield.FieldByName('ffieldlong').AsInteger/1.5);
                if not ADSfield.FieldByName('fisvisible').AsBoolean then
                  begin
                    Qbaseinfo.Fields[i].Visible:=False;
                  end;
              end;
            if Qbaseinfo.Fields[i].DisplayName='fid' then
              begin
                Qbaseinfo.Fields[i].DisplayLabel:='  #  ';
              end;
            ADSfield.next;
          end;
        end;
    end;
end;


procedure TfrmBaseinfo.interfacepExecute(Sender: TObject);
var
  ResStream:TADOBlobStream;
begin
  inherited;
  try
       try
        ADSField.Edit;
        ResStream:=TADOBlobStream.Create(ADSfield.fieldbyname('ffieldproperty') as Tblobfield,bmwrite);
        resStream.WriteComponent(self);
        ADSfield.Post;
        mpopupLX.Text:='界面属性保存成功 ! ';
        mpopupLX.ShowPopUp;
      finally
        ResStream.Free;
      end;
  except
        mpopupLX.Text:='界面属性保存失败 ! ';
        mpopupLX.ShowPopUp;
      Abort;
  end;
end;




procedure TfrmBaseinfo.fieldpropertyExecute(Sender: TObject);
var
  i:Integer;
begin
  inherited;
  InitArray;
  
  ADSfield.First;
  for i:=0 to ADSfield.RecordCount-1 do
    begin
      FindArray1[i]:=ADSfield.fieldbyname('ffielddesc').AsString;
      FindArray2[i]:=ADSfield.fieldbyname('fisVisible').AsString;
      FindArray3[i]:=ADSfield.fieldbyname('fid').AsString;
      ADSfield.Next;
    end;

  if not Assigned(frmfieldproperty) then
    frmfieldproperty:=Tfrmfieldproperty.Create(application);
    frmfieldproperty.ShowModal;

  postmessage(handle,WM_USER_GETQINFOBASE,0,0);
  application.ProcessMessages;    
end;

procedure TfrmBaseinfo.getqbaseinfo(var msg: Tmessage);
begin
  try
    with Qbaseinfo do
      begin
        close;
        sql.Clear;
        sql.Add('Select * from '+MainTable+' order by fid');
        open;
      end;
  except
    Abort;
  end;
 GetGridTitle(MainTable);
end;

end.