untopenlbl.pas

自动创建带密码的Access数据库及表,第三方控件主要有: ReportMachine3.67 ,WinSkin4.22, DBGridEh等

unit untOpenLbl;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, DB, ADODB, UntMain, StdCtrls, ComCtrls, UDM, Buttons,
  Menus, DBTables, Mask, DBCtrls, Grids, DBGrids, RM_Common, RM_Class,
  RM_Dataset, RM_AsBarView, RM_Designer, RM_BarCode, RM_e_main, RM_e_Xls;

type
  TfrmOpenLabel = class(TForm)
    pnlTitle: TPanel;
    pnlBot: TPanel;
    qryLblInput: TADOQuery;
    dsLblInput: TDataSource;
    pnlLbl: TPanel;
    lblTitle: TLabel;
    lblTitle1: TLabel;
    lblTitle2: TLabel;
    lvLabel: TListView;
    qrytmp: TADOQuery;
    btnAdd: TSpeedButton;
    pmRebuildTable: TPopupMenu;
    mmRbdTbl: TMenuItem;
    btnModify: TSpeedButton;
    btnDelete: TSpeedButton;
    btnSave: TSpeedButton;
    btnCancel: TSpeedButton;
    btnPriview: TSpeedButton;
    btnExit: TSpeedButton;
    pgcDataShow: TPageControl;
    tsInput: TTabSheet;
    tsView: TTabSheet;
    pnlShInput: TPanel;
    dbgrdShowData: TDBGrid;
    qryLblInputHis: TADOQuery;
    N1: TMenuItem;
    RmDBDtStLbl: TRMDBDataSet;
    RmRptLbl: TRMReport;
    RmDsgnrLbl: TRMDesigner;
    RmBarCdeObjlbl: TRMBarCodeObject;
    rmxlsxprt1: TRMXLSExport;
    btnAllDelete: TSpeedButton;
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure mmRbdTblClick(Sender: TObject);
    procedure pmRebuildTablePopup(Sender: TObject);
    procedure lvLabelChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure lvLabelChanging(Sender: TObject; Item: TListItem;
      Change: TItemChange; var AllowChange: Boolean);
    procedure btnAddClick(Sender: TObject);
    procedure btnModifyClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
    procedure btnPriviewClick(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
    CurrOpenTblName:String;
    FindInHistory : Boolean;
    procedure SetBtnStatus;
    Procedure setLvLabelData;     //加载标签数据；
    procedure SetLblInputOpen;
    function  TestTblExists(tblName:string):Boolean;  //测试标签表是否存在；
    procedure CreateLblTblAndHisTbl(TblName:String);  //创建标签表和标签录入历史表；
    procedure DeleteTbl(TblName:string);  //删除指定的表,删除之前自动测试表是否存在；
    procedure AutoShowInput(TblName:String); //自动创建数据录入界面控件；
    function  GetQryTmpFldName(LblID:string;out GetFldName : TStringList):Boolean;
                        //获取表字段列表;
    //说明：MLabel表中的LblID字段，即是关键字，也是自动创建表的表名；
    procedure FindItInHistory(Sender:TObject);
    procedure FindHistory(Sender:TObject);
    procedure setDbeditFocus;
  public
    { Public declarations }
  end;

var
  frmOpenLabel: TfrmOpenLabel;

implementation

uses LblDBA;

{$R *.dfm}

procedure TfrmOpenLabel.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
var
  i:integer;
begin
  for i:=0 to frmMain.ChildFrm.Count-1 do
    if frmMain.ChildFrm.Strings[i] = Self.Name then
      frmMain.ChildFrm.Delete(i);
  frmOpenLabel := nil;
end;

procedure TfrmOpenLabel.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  action := CaFree;
end;

procedure TfrmOpenLabel.FormCreate(Sender: TObject);
begin
  frmMain.ChildFrm.Add(Self.Name);
  setLvLabelData;
end;

procedure TfrmOpenLabel.setLvLabelData;
var
  i:integer;
begin
  with qrytmp do
  begin
    Close;
    SQL.Clear;
    SQL.Add('select * from MLabel');
    Open;
    First;
    lvLabel.Items.Clear;
      for i:=0 to recordcount-1 do
        begin
          lvLabel.Items.Add;
          lvLabel.Items[i].Caption := FieldByName('LblID').AsString;
          lvLabel.Items[i].SubItems.Text := FieldByName('LblName').AsString;
          Next;
        end;
  end;
end;

function TfrmOpenLabel.TestTblExists(tblName:string):Boolean;
var
  sl : TStrings;
  i  : Integer;
begin
  tblName := Trim(tblName);
  Result := False;
  sl := TStringList.Create;
  with qrytmp.Connection do
  begin
    GetTableNames(SL, False);
  end;
  for i := 0 to sl.Count -1 do
    begin
      if Trim(sl[i])=tblName then
        begin
          Result := True;
          exit;
        end;
    end;
end;

procedure TfrmOpenLabel.CreateLblTblAndHisTbl(TblName: String);
var
  CreateTblSQL,FldLst   : TStringList;
  ss :string;
  i  :Integer;
begin
  TblName := Trim(TblName);
  If TestTblExists(TblName) then DeleteTbl(TblName);
  CreateTblSQL := TStringList.Create;
  FldLst := TStringList.Create;
  if GetQryTmpFldName(TblName,FldLst) then
  if FldLst.Count = 0 then
     begin
       ShowMessage('您还没有定义相应的字段');
       exit;
     end;

  ss := '';
  for i:=0 to FldLst.Count - 1 do
  begin
    ss := ss + FldLst[i]+ ' varChar(30) WITH COMP';
    If i <> FldLst.Count -1 then
       ss := ss +',';
  end;
  ss := 'ID int identity(1,1) not null primary key, ' + ss; 
  ss := ss +',PrtLblNum int';
  
  CreateTblSQL.Add(' Create Table ' + TblName +'('
                  + ss +')' );
  CreateTblSQL.Add(' Create Table ' + TblName +'His('
                  +ss +' )');

  For i:= 0 to CreateTblSQL.Count-1 do
  begin
    with qrytmp do
    begin
      Close;
      SQL.Clear;
      SQL.Add(CreateTblSQL.Strings[i]);
      ExecSQL;
    end;
  end;


end;

procedure TfrmOpenLabel.AutoShowInput(TblName: String);
var
  i:Integer;
  FldLst : TStringlist;
begin
  TblName := Trim(TblName);
  FldLst := TStringList.Create;
  qryLblInput.Close;

  if GetQryTmpFldName(TblName,FldLst) then
     for i:= 0 to FldLst.Count -1 do
         begin
           with TLabel.Create(pnlShInput) do
             begin
               Caption := FldLst[i];
               Name := 'lbl' +intToStr(i);
               Parent := pnlShInput;
               top := Trunc(i/2)*40 + 30 ;
               if (i mod 2) =  0 then
                  Left := 80 - Width
               else
                  left := 340 - Width;

               if i = FldLst.Count-1 then
                 begin
                   with TLabel.Create(pnlShInput) do
                     begin
                       Caption := '打印数量';
                       Name    := 'Lbl'+ IntToStr(i+1);
                       Parent  := pnlShInput;
                       Top := Trunc((i+1)/2)*40 + 30;
                       if ((i+1) mod 2) =  0 then
                          Left := 80 - Width
                       else
                          left := 340 - Width;
                     end;
                 end;

             end;

           with TDBEdit.Create(pnlShInput) do
             begin
               Parent := pnlShInput;
               Name   := 'dbedt'+ IntToStr(i);
               Top    := Trunc(i/2)*40 + 30;
               Width  := 150;
               DataSource := dsLblInput;
               DataField  := fldLst[i];
               if i = 0 then
                 begin
                   OnExit := FinditInHistory;
                   OnDblClick := FindHistory;
                 end;
               if (i mod 2) = 0 then
                 Left := 90
               else
                 left := 350;
             end;

               if i = FldLst.Count-1 then
                 begin
                   with TDBEdit.Create(pnlShInput) do
                     begin
                       Caption := '打印数量';
                       Name    := 'dbedt'+ IntToStr(i+1);
                       Parent  := pnlShInput;
                       Top := Trunc((i+1)/2)*40 + 30;
                       Width := 150;
                       DataSource := dsLblInput;
                       DataField  := 'PrtLblNum';
                       if ((i+1) mod 2) =  0 then
                          Left := 90
                       else
                          left := 350;
                     end;
                 end;
         end;

   with qryLblInput do
   begin
     CurrOpenTblName := TblName;
     SetLblInputOpen;
     pnlBot.Enabled := True;
     setbtnstatus;
   end;
end;

function TfrmOpenLabel.GetQryTmpFldName(LblID:string;out GetFldName : TStringList):Boolean;
var
  i:integer;
begin
  With qrytmp do
  begin
    Close;
    SQL.Clear;
    SQL.Add('select * from  MLblFld where LblID =');
    SQL.Add(QuotedStr(LblID));
    SQL.Add(' order by fldID ');
    Try
      Open;
      Result := True;
    except
      Result := False;
    end;
    for i:=0 to Recordcount -1 do
      begin
        GetFldName.Add(Trim(fieldByName('FldName').AsString));
        next;
      end;
  end;
end;

procedure TfrmOpenLabel.DeleteTbl(TblName: string);