comdj.pas

delphi作得信息业进销存源码.功能全面,运行稳定.

unit ComDj;

interface

uses
	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
	ExtCtrls, DBCtrls, ImgList, ComCtrls, Menus, ToolWin, Grids, DBGrids,
	StdCtrls, Mask,Clipbrd,db, Buttons, DBTables, QuickRpt, DBClient,
	ActnList, Common, iniFiles, Variants;

type
  TfrmComDj = class(TForm)
    MainMenu1: TMainMenu;
    smnFile: TMenuItem;
    smnSave: TMenuItem;
    smnCancel: TMenuItem;
    N3: TMenuItem;
    smnPreview: TMenuItem;
    smnPrint: TMenuItem;
    N1: TMenuItem;
    smnExit: TMenuItem;
    smnEdit: TMenuItem;
    smnInsert: TMenuItem;
    smnDelete: TMenuItem;
    PopupMenu1: TPopupMenu;
    pmnSave: TMenuItem;
    pmnCancel: TMenuItem;
    smnDel: TMenuItem;
    Stool: TMenuItem;
    Panel1: TPanel;
    ControlBar1: TControlBar;
		ToolBar1: TToolBar;
    btnPreview: TToolButton;
    btnPrint: TToolButton;
    ToolButton3: TToolButton;
    btnSave: TToolButton;
    btnCancel: TToolButton;
    ToolButton9: TToolButton;
    btnInsert: TToolButton;
    btnDelete: TToolButton;
    btnNew: TToolButton;
    btnDel: TToolButton;
    ToolButton13: TToolButton;
    smnNew: TMenuItem;
    N9: TMenuItem;
    N11: TMenuItem;
    Label1: TLabel;
    DBGrid1: TDBGrid;
    smnPrior: TMenuItem;
    smnNext: TMenuItem;
    N2: TMenuItem;
    smnFirst: TMenuItem;
    smnLast: TMenuItem;
    smmCalendar: TMenuItem;
		smmCalculator: TMenuItem;
    ToolBar2: TToolBar;
    DBNavigator1: TDBNavigator;
    Panel2: TPanel;
    Panel3: TPanel;
    Label2: TLabel;
    DBEdit1: TDBEdit;
    Label3: TLabel;
    pmnNew: TMenuItem;
    pmnDel: TMenuItem;
    N6: TMenuItem;
    pmnInsert: TMenuItem;
    pmnDelete: TMenuItem;
    N10: TMenuItem;
    pmnFirst: TMenuItem;
    pmnPrior: TMenuItem;
    pmnNext: TMenuItem;
    pmnLast: TMenuItem;
    ActionList1: TActionList;
    aSave: TAction;
    aCancel: TAction;
    aPreview: TAction;
    aPrint: TAction;
		aExit: TAction;
    aNew: TAction;
    aDel: TAction;
    aDelete: TAction;
    aFirst: TAction;
    aPrior: TAction;
    aNext: TAction;
    aLast: TAction;
    aInsert: TAction;
    aCalendar: TAction;
    aCalculator: TAction;
    aSetColumn: TAction;
    N4: TMenuItem;
    O1: TMenuItem;
    N5: TMenuItem;
    O2: TMenuItem;
    ToolBar3: TToolBar;
    btnExit: TToolButton;
    Shape2: TShape;
    procedure FormCreate(Sender: TObject);virtual;
    procedure FormShow(Sender: TObject);virtual;
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);virtual;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);virtual;
    procedure sZbStateChange(Sender: TObject);virtual;
		procedure SetCanSave(Can: boolean);virtual;
    procedure sZbDataChange(Sender: TObject; Field: TField);virtual;
    procedure sMxDataChange(Sender: TObject; Field: TField);virtual;
    procedure ZbOnNewRecord(DataSet: TDataSet);virtual;
    procedure ZbBeforeEdit(DataSet: TDataSet);virtual;
    procedure ZbBeforePost(DataSet: TDataSet);virtual;
    procedure ZbAfterPost(DataSet: TDataSet);virtual;
    procedure ZbBeforeScroll(DataSet: TDataSet);virtual;
    procedure ZbAfterScroll(DataSet: TDataSet);virtual;
    procedure MxBeforeApplyUpdates;virtual;
    procedure MxBeforeInsert(DataSet: TDataSet);virtual;
    procedure MxOnNewRecord(DataSet: TDataSet);virtual;
    procedure MxAfterInsert(DataSet: TDataSet);virtual;
    procedure MxBeforeEdit(DataSet: TDataSet);virtual;
    procedure MxBeforePost(DataSet: TDataSet);virtual;
    procedure MxAfterPost(DataSet: TDataSet);virtual;
    procedure MxBeforeDelete(DataSet: TDataSet);virtual;
    procedure MxAfterDelete(DataSet: TDataSet);virtual;
    procedure MxBeforeCancel(DataSet: TDataSet);virtual;
    procedure MxAfterCancel(DataSet: TDataSet);virtual;
    procedure aSaveExecute(Sender: TObject);virtual;
    procedure aCancelExecute(Sender: TObject);virtual;
    procedure aPreviewExecute(Sender: TObject);virtual;
		procedure aPrintExecute(Sender: TObject);virtual;
    procedure aExitExecute(Sender: TObject);virtual;
    procedure aNewExecute(Sender: TObject);virtual;
    procedure aDelExecute(Sender: TObject);virtual;
    procedure aInsertExecute(Sender: TObject);virtual;
    procedure aDeleteExecute(Sender: TObject);virtual;
    procedure aFirstExecute(Sender: TObject);virtual;
    procedure aPriorExecute(Sender: TObject);virtual;
    procedure aNextExecute(Sender: TObject);virtual;
    procedure aLastExecute(Sender: TObject);virtual;
    procedure aCalendarExecute(Sender: TObject);virtual;
    procedure aCalculatorExecute(Sender: TObject);virtual;
    procedure DBGrid1EditButtonClick(Sender: TObject);virtual;
    //自定义
    procedure IniRecord; virtual;
    function SaveQuery:Boolean;virtual;
    procedure SetButton;virtual;
    procedure LoadPrintForm;virtual;
    procedure TotalField(Kind: char; Field: TField);virtual;
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);virtual;
    procedure aSetColumnExecute(Sender: TObject);
    procedure DBEditExit(Sender: TObject);
    procedure DBGrid1ColExit(Sender: TObject);virtual;
  private
		{ Private declarations }
		cdsZbEve: cdsEventsArray;
		cdsMxEve: cdsEventsArray;
		CanSave1: boolean;
    CanDataChange: boolean;
    wcTmp: TWinControl;
    CancelEdit: Boolean;
    blnPreview: boolean;
    procedure SaveColumnQuery;
    function GetColumnInfo(FileName: string): string;
  public
    { Public declarations }
    ReportName: string;
    dsZb : TClientDataSet;
    dsMx : TClientDataSet;
    arrMx : Variant;
    strState : String;
    rpt1 : TQuickRep;
		blnStopSetColumn: boolean;
    blnSetZbID: boolean;
    blnStopScroll: boolean;
		strAutoScale: string;
    strZbKeyFields, strMxKeyFields: string;
    strZbHelpFields, strMxHelpFields: string;
    strZbDetailTables, strZbDetailWheres: string;
    strMxDetailTables, strMxDetailWheres: string;
		strZbMxKey: string;  //设置明细与总表相同的字段 例：'总表字段1,明细字段1; 总表字段2,明细字段2'
    strMxHh: string;
    property CanSave :Boolean read CanSave1 write SetCanSave;
    function arMx(FileName: string): Variant;
  end;

var
  frmComDj: TfrmComDj;
  intGCIdx: Integer;

implementation

uses
	Dm, Main, Wnl, SetColumn, SetPrint, ComDjzb, Select, ComJbzl, SetDate,
  SetCal;

{$R *.DFM}

//Form.Create
procedure TfrmComDj.FormCreate(Sender: TObject);
begin
  screen.Cursor := crHourGlass;
  if self.icon.Empty then
    self.icon := screen.ActiveForm.Icon;
end;

//Form.Show
procedure TfrmComDj.FormShow(Sender: TObject);
var
  i, j: integer;
  intWid: integer;
  ctrTmp: TControl;
  CShape: TShape;
  strFileName: string;
  c: TComponent;
begin
	if DBNavigator1.DataSource <> nil then
		dsZb := TClientDataSet(DBNavigator1.DataSource.DataSet);
 	DBNavigator1.DataSource.OnStateChange := sZbStateChange;
	DBNavigator1.DataSource.OnDataChange := sZbDataChange;
  DBNavigator1.Enabled := not blnStopScroll;
	dsMx := TClientDataSet(DBGrid1.DataSource.DataSet);
	DBGrid1.DataSource.OnStateChange := sZbStateChange;
	DBGrid1.DataSource.OnDataChange := sMxDataChange;
	cdsZbEve := SaveCDSEvents(dsZb);
	cdsMxEve := SaveCDSEvents(dsMx);
  with dsZb do
  begin
    OnNewRecord := ZbOnNewRecord;
    BeforeEdit := ZbBeforeEdit;
    BeforePost := ZbBeforePost;
    AfterPost := ZbAfterPost;
    BeforeScroll := ZbBeforeScroll;
    AfterScroll := ZbAfterScroll;
  end;
	with dsMx do
	begin
		BeforeInsert := MxBeforeInsert;
		OnNewRecord := MxOnNewRecord;
		AfterInsert := MxAfterInsert;
		BeforeEdit := MxBeforeEdit;
		BeforePost := MxBeforePost;
		AfterPost := MxAfterPost;
		BeforeDelete := MxBeforeDelete;
		AfterDelete := MxAfterDelete;
		BeforeCancel := MxBeforeCancel;
		AfterCancel := MxAfterCancel;
	end;
	arrMx := VarArrayCreate([0, dsMx.FieldCount - 1], varVariant);
	for i := 0 to dsMx.FieldCount - 1 do
		if dsMx.Fields[i] is TNumericField then
			arrMx[i] := 0;
  //Popedom
  if UpperCase(pstrUserCode) <> 'SYS' then
    with Data.Tmpl do
    begin
      Close;
      CommandText := 'select * from AppGroupAction ' +
        'where gName = ''' + pstrUserGroup + ''' and ' +
        'fName = ''' + self.Name + '''';
      Open;
      while not Eof do
      begin
        c := self.FindComponent(FieldByName('aName').AsString);
        if c <> nil then
        begin
          c.Tag := 1;
          if c is TCustomAction then
            TCustomAction(c).Enabled := false;
          if c is TControl then
            TControl(c).Enabled := false;
        end;
        Next;
      end;
    end;
  //KeyFields
  if strZbKeyFields = null then
    strZbKeyFields := ''
  else
    strZbKeyFields := UpperCase(strZbKeyFields);
  if strZbKeyFields <> '' then
    strZbKeyFields := strZbKeyFields + ';';
  if strMxKeyFields = '' then
    strMxKeyFields := DBGrid1.Columns[0].FieldName
  else if strMxKeyFields = null then
    strMxKeyFields := ''
  else
    strMxKeyFields := UpperCase(strMxKeyFields);
  if strMxKeyFields <> '' then
    strMxKeyFields := strMxKeyFields + ';';
  //HelpFields
  if strZbHelpFields = null then
    strZbHelpFields := ''
  else
    strZbHelpFields := UpperCase(strZbHelpFields) + ';';
  if strMxHelpFields = null then
    strMxHelpFields := ''
  else
    strMxHelpFields := UpperCase(strMxHelpFields) + ';';
  //DBGrid
  for i := 0 to self.ComponentCount - 1 do
    if self.Components[i] is TDBGrid then
    begin
      //Title.Alignment , Color
      with TDBGrid(self.Components[i]) do
      begin
        intWid := 0;
        for j := 0 to Columns.Count - 1 do
        begin
          Columns[j].Title.Alignment := taCenter;
          if (Columns[j].ReadOnly) and (strState <> 'V') then
            Columns[j].Color := $00EFEFEF;
          if Columns[j].Visible then
            intWid := intWid + Columns[j].Width;
        end;
{        if intWid < Screen.Width div 2 then
          for j := 0 to Columns.Count - 1 do
            Columns[j].Width := Trunc( Columns[j].Width * 1.5 );}
        //Auto Scale
        if (Pos(UpperCase(Name), UpperCase(strAutoScale)) > 0) then
        begin
          for j := 0 to Columns.Count - 1 do
            Columns[j].Width := Round(Columns[j].Width * (Width - GetSystemMetrics(SM_CXVSCROLL)) / intWid) - 1;
          Columns[0].Width := Columns[0].Width - 2;
        end;
      end;
      //Save olumns
      strFileName := ExtractFilePath(Application.ExeName) + 'Column\' +
        FormatFloat('0000', pintUserID) +
        self.Name + TDBGrid(self.Components[i]).Name;
      TDBGrid(self.Components[i]).Columns.SaveToFile(strFileName + '.int');
      if not blnStopSetColumn and (self.Components[i].Tag = 0) and
        (UpperCase(pstrUserCode) <> 'SYS') then
      begin
       //Set Columns
       if FileExists(strFileName + '.cur') then
        begin
          strFileName := ExtractFilePath(Application.ExeName) + 'Column\' +
            FormatFloat('0000', pintUserID) +
            self.Name + TDBGrid(self.Components[i]).Name;
          TDBGrid(self.Components[i]).Columns.LoadFromFile(strFileName + '.cur');
        end
        else
          CopyFile(PChar(strFileName + '.int'), PChar(strFileName + '.cur'), True);
      end;
    end;
	//Set Title Space
	if Label1.Caption = 'Title' then
	begin
		Label1.Caption := '';
		for i := 1 to Length(self.Caption) div 2 do
			Label1.Caption := Label1.Caption + Copy(self.Caption, i * 2 - 1, 2) + '  ';
		Label1.Caption := Trim(Label1.Caption);
	end;
	//Create Lines, set Color, ToolBar1.Width
	for i := 0 to self.ComponentCount - 1 do
	begin
		ctrTmp := TControl(self.Components[i]);
    if (ctrTmp is TToolButton) and (ctrTmp.Parent = ToolBar1) and
      ((ctrTmp.Left + ctrTmp.Width + 1) > ToolBar1.Width) then
      ToolBar1.Width := ctrTmp.Left + ctrTmp.Width + 1;
		if (ctrTmp is TSpeedButton) and (strState = 'V') then
			TSpeedButton(ctrTmp).Enabled := false;
		if (ctrTmp is TDBEdit) or (ctrTmp is TDBText) or (ctrTmp is TEdit)then
		begin
			if (ctrTmp is TDBEdit) then
      begin
        if strZbHelpFields <> '' then
          //OnExit Even
          if Assigned(TDBEdit(ctrTmp).OnDblClick) and
            not Assigned(TDBEdit(ctrTmp).OnExit) and
            (Pos(UpperCase(TDBEdit(ctrTmp).DataField), strZbHelpFields) > 0) and
            (strState <> 'V') then
            TDBEdit(ctrTmp).OnExit := DBEditExit;
        //Color
				if TDBEdit(ctrTmp).ReadOnly and (strState <> 'V') then
					TDBEdit(ctrTmp).Color := $00EFEFEF
        else if TDBEdit(ctrTmp).Color = cl3DLight then
  				TDBEdit(ctrTmp).Color := TPanel(ctrTmp.Parent).Color;
      end;
			if (ctrTmp is TDBText) then
				if TDBText(ctrTmp).Color = cl3DLight then
					TDBText(ctrTmp).Color := TPanel(ctrTmp.Parent).Color;